module Factory.Math.Radix(
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
digits :: String
digits :: String
digits = [Char
'0' .. Char
'9'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'a' .. Char
'z']
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
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 ..]
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
toBase base
_ decimal
0 = String
"0"
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]
:)
| 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
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
fromBase base
_ String
"" = String -> decimal
forall a. HasCallStack => String -> a
error String
"Factory.Math.Radix.fromBase:\tnull string."
fromBase base
_ String
"0" = decimal
0
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
| 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
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
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))