{-
	Copyright (C) 2011-2015 Dr. Alistair Ward

	This program is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	This program is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with this program.  If not, see <https://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	Facilitates representation of 'Integral' values in alternative 'Integral' bases.
-}

module Factory.Math.Radix(
-- * Constants
--	decodes,
--	digits,
--	encodes,
-- * Functions
	digitSum,
	digitalRoot,
	fromBase,
	toBase
) where

import			Data.Array.IArray((!))
import qualified	Data.Array.IArray
import qualified	Data.Char
import qualified	Data.List
import qualified	Data.Maybe

-- | Characters used to represent the digits of numbers in @(-36 <= base <= 36)@.
digits :: String
digits :: String
digits	= [Char
'0' .. Char
'9'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'a' .. Char
'z']

-- | Constant random-access lookup for 'digits'.
encodes :: (Data.Array.IArray.Ix index, Integral index) => Data.Array.IArray.Array index Char
encodes :: Array index Char
encodes	= (index, index) -> String -> Array index Char
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Data.Array.IArray.listArray (index
0, Int -> index
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> index) -> (Int -> Int) -> Int -> index
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred (Int -> index) -> Int -> index
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
digits) String
digits

-- | Constant reverse-lookup for 'digits'.
decodes :: Integral i => [(Char, i)]
decodes :: [(Char, i)]
decodes	= String -> [i] -> [(Char, i)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
digits [i
0 ..]

{- |
	* Convert the specified integral quantity, to an alternative base, and represent the result as a 'String'.

	* Both negative integers and negative bases are permissible.

	* The conversion to 'Char' can only succeed where printable and intelligible characters exist to represent all digits in the chosen base;
	which in practice means @(-36 <= base <= 36)@.
-}
toBase :: (
	Data.Array.IArray.Ix	decimal,
	Integral		base,
	Integral		decimal,
	Show			base,
	Show			decimal
 ) => base -> decimal -> String
toBase :: base -> decimal -> String
toBase base
10 decimal
decimal	= decimal -> String
forall a. Show a => a -> String
show decimal
decimal	-- Base unchanged.
toBase base
_ decimal
0		= String
"0"		-- Zero has the same representation in any base.
toBase base
base decimal
decimal
	| base -> base
forall a. Num a => a -> a
abs base
base base -> base -> Bool
forall a. Ord a => a -> a -> Bool
< base
2			= String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"Factory.Math.Radix.toBase:\tan arbitrary integer can't be represented in base " String -> String -> String
forall a. [a] -> [a] -> [a]
++ base -> String
forall a. Show a => a -> String
show base
base
	| base -> base
forall a. Num a => a -> a
abs base
base base -> base -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> base
forall a b. (Integral a, Num b) => a -> b
fromIntegral (
		String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
digits
	)				= String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"Factory.Math.Radix.toBase:\tunable to clearly represent the complete set of digits in base " String -> String -> String
forall a. [a] -> [a] -> [a]
++ base -> String
forall a. Show a => a -> String
show base
base
	| base
base base -> base -> Bool
forall a. Ord a => a -> a -> Bool
> base
0 Bool -> Bool -> Bool
&& decimal
decimal decimal -> decimal -> Bool
forall a. Ord a => a -> a -> Bool
< decimal
0	= Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: (decimal -> Char) -> [decimal] -> String
forall a b. (a -> b) -> [a] -> [b]
map decimal -> Char
forall i. (Ix i, Integral i, Show i) => i -> Char
toDigit (decimal -> [decimal] -> [decimal]
forall a. Integral a => a -> [a] -> [a]
fromDecimal (decimal -> decimal
forall a. Num a => a -> a
negate decimal
decimal) [])
	| Bool
otherwise			= decimal -> Char
forall i. (Ix i, Integral i, Show i) => i -> Char
toDigit (decimal -> Char) -> [decimal] -> String
forall a b. (a -> b) -> [a] -> [b]
`map` decimal -> [decimal] -> [decimal]
forall a. Integral a => a -> [a] -> [a]
fromDecimal decimal
decimal []
	where
		fromDecimal :: a -> [a] -> [a]
fromDecimal a
0		= [a] -> [a]
forall a. a -> a
id
		fromDecimal a
n
			| a
remainder a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0	= a -> [a] -> [a]
fromDecimal (a -> a
forall a. Enum a => a -> a
succ a
quotient) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a
remainder a -> a -> a
forall a. Num a => a -> a -> a
- base -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral base
base) a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)	-- This can only occur when base is negative; cf. 'divMod'.
			| Bool
otherwise	= a -> [a] -> [a]
fromDecimal a
quotient ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
remainder a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)
			where
				(a
quotient, a
remainder)	= a
n a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`quotRem` base -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral base
base

		toDigit :: (Data.Array.IArray.Ix i, Integral i, Show i) => i -> Char
		toDigit :: i -> Char
toDigit i
n
			| i
n i -> Array i Char -> Bool
forall i. Ix i => i -> Array i Char -> Bool
>&< Array i Char
forall index. (Ix index, Integral index) => Array index Char
encodes	= Array i Char
forall index. (Ix index, Integral index) => Array index Char
encodes Array i Char -> i -> Char
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! i
n
			| Bool
otherwise	= String -> Char
forall a. HasCallStack => String -> a
error (String -> Char) -> String -> Char
forall a b. (a -> b) -> a -> b
$ String
"Factory.Math.Radix.toBase.toDigit:\tno suitable character-representation for integer " String -> String -> String
forall a. [a] -> [a] -> [a]
++ i -> String
forall a. Show a => a -> String
show i
n
			where
				(>&<) :: (Data.Array.IArray.Ix i) => i -> Data.Array.IArray.Array i Char -> Bool
				i
index >&< :: i -> Array i Char -> Bool
>&< Array i Char
array	= ((i -> Bool) -> i -> Bool
forall a b. (a -> b) -> a -> b
$ i
index) ((i -> Bool) -> Bool) -> [i -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`all` [(i -> i -> Bool
forall a. Ord a => a -> a -> Bool
>= i
lower), (i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
upper)]	where
					(i
lower, i
upper)	= Array i Char -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
Data.Array.IArray.bounds Array i Char
array

{- |
	* Convert the 'String'-representation of a number in the specified base, to an integer.

	* Both negative numbers and negative bases are permissible.
-}
fromBase :: (
	Integral	base,
	Integral	decimal,
	Read		decimal,
	Show		base
 ) => base -> String -> decimal
fromBase :: base -> String -> decimal
fromBase base
10 String
s	= String -> decimal
forall a. Read a => String -> a
read String
s	-- Base unchanged.
fromBase base
_ String
""	= String -> decimal
forall a. HasCallStack => String -> a
error String
"Factory.Math.Radix.fromBase:\tnull string."
fromBase base
_ String
"0"	= decimal
0		-- Zero has the same representation in any base.
fromBase base
base String
s
	| base -> base
forall a. Num a => a -> a
abs base
base base -> base -> Bool
forall a. Ord a => a -> a -> Bool
< base
2			= String -> decimal
forall a. HasCallStack => String -> a
error (String -> decimal) -> String -> decimal
forall a b. (a -> b) -> a -> b
$ String
"Factory.Math.Radix.fromBase:\tan arbitrary integer can't be represented in base " String -> String -> String
forall a. [a] -> [a] -> [a]
++ base -> String
forall a. Show a => a -> String
show base
base
	| base -> base
forall a. Num a => a -> a
abs base
base base -> base -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> base
forall a b. (Integral a, Num b) => a -> b
fromIntegral (
		String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
digits
	)				= String -> decimal
forall a. HasCallStack => String -> a
error (String -> decimal) -> String -> decimal
forall a b. (a -> b) -> a -> b
$ String
"Factory.Math.Radix.fromBase:\tunable to clearly represent the complete set of digits in base " String -> String -> String
forall a. [a] -> [a] -> [a]
++ base -> String
forall a. Show a => a -> String
show base
base
	| base
base base -> base -> Bool
forall a. Ord a => a -> a -> Bool
> base
0
	, Char
'-' : String
remainder <- String
s	= decimal -> decimal
forall a. Num a => a -> a
negate (decimal -> decimal) -> decimal -> decimal
forall a b. (a -> b) -> a -> b
$ base -> String -> decimal
forall base decimal.
(Integral base, Integral decimal, Read decimal, Show base) =>
base -> String -> decimal
fromBase base
base String
remainder	-- Recurse.
	| Bool
otherwise			= (decimal -> Char -> decimal) -> decimal -> String -> decimal
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (\decimal
l -> ((decimal
l decimal -> decimal -> decimal
forall a. Num a => a -> a -> a
* base -> decimal
forall a b. (Integral a, Num b) => a -> b
fromIntegral base
base) decimal -> decimal -> decimal
forall a. Num a => a -> a -> a
+) (decimal -> decimal) -> (Char -> decimal) -> Char -> decimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> decimal
forall i. Integral i => Char -> i
fromDigit) decimal
0 String
s	where
		fromDigit :: Integral i => Char -> i
		fromDigit :: Char -> i
fromDigit Char
c	= case Char
c Char -> [(Char, i)] -> Maybe i
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Char, i)]
forall i. Integral i => [(Char, i)]
decodes of
			Just i
i
				| i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
>= i -> i
forall a. Num a => a -> a
abs (base -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral base
base)	-> String -> i
forall a. HasCallStack => String -> a
error (String -> i) -> String -> i
forall a b. (a -> b) -> a -> b
$ String
"Factory.Math.Radix.fromBase.fromDigit:\tillegal char " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", for base " String -> String -> String
forall a. [a] -> [a] -> [a]
++ base -> String
forall a. Show a => a -> String
show base
base
				| Bool
otherwise			-> i
i
			Maybe i
_					-> String -> i
forall a. HasCallStack => String -> a
error (String -> i) -> String -> i
forall a b. (a -> b) -> a -> b
$ String
"Factory.Math.Radix.fromBase.fromDigit:\tunrecognised char " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c

{- |
	* <https://mathworld.wolfram.com/DigitSum.html>.

	* <https://en.wikipedia.org/wiki/Digit_sum>.
-}
digitSum :: (
	Data.Array.IArray.Ix	decimal,
	Integral		base,
	Integral		decimal,
	Show			base,
	Show			decimal
 ) => base -> decimal -> decimal
digitSum :: base -> decimal -> decimal
digitSum base
10	= Int -> decimal
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> decimal) -> (decimal -> Int) -> decimal -> decimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int -> Int) -> Int -> String -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> (Char -> Int) -> Char -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
Data.Char.digitToInt) Int
0 (String -> Int) -> (decimal -> String) -> decimal -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. decimal -> String
forall a. Show a => a -> String
show
digitSum base
base	= [decimal] -> decimal
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([decimal] -> decimal)
-> (decimal -> [decimal]) -> decimal -> decimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Maybe decimal) -> String -> [decimal]
forall a b. (a -> Maybe b) -> [a] -> [b]
Data.Maybe.mapMaybe (Char -> [(Char, decimal)] -> Maybe decimal
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Char, decimal)]
forall i. Integral i => [(Char, i)]
decodes) (String -> [decimal])
-> (decimal -> String) -> decimal -> [decimal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. base -> decimal -> String
forall decimal base.
(Ix decimal, Integral base, Integral decimal, Show base,
 Show decimal) =>
base -> decimal -> String
toBase base
base

-- | <https://en.wikipedia.org/wiki/Digital_root>.
digitalRoot :: (
	Data.Array.IArray.Ix	decimal,
	Integral		decimal,
	Show			decimal
 ) => decimal -> decimal
digitalRoot :: decimal -> decimal
digitalRoot	= (decimal -> Bool) -> (decimal -> decimal) -> decimal -> decimal
forall a. (a -> Bool) -> (a -> a) -> a -> a
until (decimal -> decimal -> Bool
forall a. Ord a => a -> a -> Bool
<= decimal
9) (Int -> decimal -> decimal
forall decimal base.
(Ix decimal, Integral base, Integral decimal, Show base,
 Show decimal) =>
base -> decimal -> decimal
digitSum (Int
10 :: Int))