|
|
|
@ -2,6 +2,8 @@
|
|
|
|
|
|
|
|
|
|
module Encoding (Trit(..), Encode(..), Stream(..), encode, decode, decodeStrict, toTrit, fromTrit) where
|
|
|
|
|
|
|
|
|
|
import Control.Monad
|
|
|
|
|
|
|
|
|
|
data Trit = T0 | T1 | T2 deriving (Enum, Eq)
|
|
|
|
|
|
|
|
|
|
instance Show Trit where
|
|
|
|
@ -30,8 +32,6 @@ toTrit = toEnum
|
|
|
|
|
fromTrit :: Integral i => Trit -> i
|
|
|
|
|
fromTrit = fromIntegral . fromEnum
|
|
|
|
|
|
|
|
|
|
type DR a = ([Trit], a)
|
|
|
|
|
|
|
|
|
|
class Stream a where
|
|
|
|
|
streamread :: a -> [Trit]
|
|
|
|
|
streamwrite :: [Trit] -> a
|
|
|
|
@ -48,50 +48,75 @@ instance Stream String where
|
|
|
|
|
streamread = map (toEnum . read . (:[]))
|
|
|
|
|
streamwrite = concat . map (show . fromEnum)
|
|
|
|
|
|
|
|
|
|
data Decoder i o = Decoder { doDecode :: [i] -> ([i], o) }
|
|
|
|
|
type Encoder o i = i -> [o]
|
|
|
|
|
type DR a = Decoder Trit a
|
|
|
|
|
|
|
|
|
|
instance Monad (Decoder i) where
|
|
|
|
|
f >>= g = Decoder $ \x -> let (x0, r0) = doDecode f x in doDecode (g r0) x0
|
|
|
|
|
f >> g = Decoder $ \x -> let (x0, r0) = doDecode f x in doDecode g x0
|
|
|
|
|
return a = Decoder $ \x -> (x, a)
|
|
|
|
|
fail = error
|
|
|
|
|
|
|
|
|
|
class Encode a where
|
|
|
|
|
sdecode :: [Trit] -> ([Trit], a)
|
|
|
|
|
sencode :: a -> [Trit]
|
|
|
|
|
sdecode :: DR a
|
|
|
|
|
sencode :: Encoder Trit a
|
|
|
|
|
|
|
|
|
|
encode :: (Stream s, Encode a) => a -> s
|
|
|
|
|
encode = streamwrite . sencode
|
|
|
|
|
decode :: (Stream s, Encode a) => s -> a
|
|
|
|
|
decode = snd . sdecode . streamread
|
|
|
|
|
decode = snd . (doDecode sdecode) . streamread
|
|
|
|
|
decodeStrict :: (Stream s, Encode a) => s -> a
|
|
|
|
|
decodeStrict x = case (sdecode $ streamread x) of
|
|
|
|
|
decodeStrict x = case (doDecode sdecode $ streamread x) of
|
|
|
|
|
([], a) -> a
|
|
|
|
|
(_, _) -> error "Expected end of input"
|
|
|
|
|
|
|
|
|
|
getTrit :: Decoder Trit Trit
|
|
|
|
|
getTrit = Decoder $ \xs -> case xs of
|
|
|
|
|
[] -> error "Unexpected end of stream"
|
|
|
|
|
(i:xs) -> (xs, i)
|
|
|
|
|
|
|
|
|
|
instance Encode Bool where
|
|
|
|
|
sdecode xs = case sdecode xs :: DR Int of
|
|
|
|
|
(x0, 0) -> (x0, False)
|
|
|
|
|
(x0, 1) -> (x0, True)
|
|
|
|
|
(x0, i) -> error "Expected 0 or 1"
|
|
|
|
|
sdecode = do
|
|
|
|
|
i <- sdecode :: DR Int
|
|
|
|
|
case i of
|
|
|
|
|
0 -> return False
|
|
|
|
|
1 -> return True
|
|
|
|
|
_ -> fail "Expected 0 or 1"
|
|
|
|
|
sencode True = [1]
|
|
|
|
|
sencode False = [0]
|
|
|
|
|
|
|
|
|
|
instance Encode Trit where
|
|
|
|
|
sdecode [] = error "Unexpected end of stream"
|
|
|
|
|
sdecode (i:xs) = (xs, i)
|
|
|
|
|
sdecode = getTrit
|
|
|
|
|
sencode t = [t]
|
|
|
|
|
|
|
|
|
|
instance Encode a => Encode [a] where
|
|
|
|
|
sdecode [] = error "Unexpected end of stream"
|
|
|
|
|
sdecode (T0:xs) = (xs, [])
|
|
|
|
|
sdecode (T1:xs) = let (x0, a) = sdecode xs in (x0, [a])
|
|
|
|
|
sdecode (T2:T2:xs) = let (x0, a) = sdecode xs :: DR Int in get [] (a+2) x0 where
|
|
|
|
|
get r 0 x = (x, r)
|
|
|
|
|
get r k x | k > 0 = let (xn, e) = sdecode x in get (r ++ e) (k-1) xn
|
|
|
|
|
sdecode = do
|
|
|
|
|
i <- getTrit
|
|
|
|
|
case i of
|
|
|
|
|
T0 -> return []
|
|
|
|
|
T1 -> sdecode >>= (\x -> return [x])
|
|
|
|
|
T2 -> do
|
|
|
|
|
i <- getTrit
|
|
|
|
|
case i of
|
|
|
|
|
T2 -> do
|
|
|
|
|
n <- sdecode :: DR Int
|
|
|
|
|
replicateM (n+2) sdecode
|
|
|
|
|
_ -> fail "Unexpected end of stream"
|
|
|
|
|
sencode [] = [T0]
|
|
|
|
|
sencode [x] = T1:sencode x
|
|
|
|
|
sencode xs = (sencode $ length xs - 2) ++ concat (map sencode xs)
|
|
|
|
|
|
|
|
|
|
instance Encode Int where
|
|
|
|
|
sdecode xs = let (x0, i) = sdecode xs :: DR Integer in (x0, fromIntegral i)
|
|
|
|
|
sdecode = do
|
|
|
|
|
n <- sdecode :: DR Integer
|
|
|
|
|
return $ fromIntegral n
|
|
|
|
|
sencode i = sencode (fromIntegral i :: Integer)
|
|
|
|
|
|
|
|
|
|
instance Encode Integer where
|
|
|
|
|
sdecode xs = let (x0, digits) = sdecode xs :: DR [Trit] in
|
|
|
|
|
let sum = decodeTern digits in (x0, (3^(length digits - 1) `div` 2) + sum)
|
|
|
|
|
sdecode = do
|
|
|
|
|
digits <- sdecode :: DR [Trit]
|
|
|
|
|
return $ decodeTern digits + (3^(length digits - 1) `div` 2)
|
|
|
|
|
sencode n
|
|
|
|
|
| n < 0 = error "Can't encode negative numbers"
|
|
|
|
|
| n == 0 = [0]
|
|
|
|
@ -100,11 +125,17 @@ instance Encode Integer where
|
|
|
|
|
log3 n = (head $ filter (\len -> n < base len) [0..]) - 1
|
|
|
|
|
|
|
|
|
|
instance (Encode a, Encode z) => Encode (a, z) where
|
|
|
|
|
sdecode xs = let (x0, a) = sdecode xs in let (x1, z) = sdecode x0 in (x1, (a, z))
|
|
|
|
|
sdecode = do
|
|
|
|
|
a <- sdecode
|
|
|
|
|
z <- sdecode
|
|
|
|
|
return (a, z)
|
|
|
|
|
sencode (a, z) = sencode a ++ sencode z
|
|
|
|
|
|
|
|
|
|
instance (Encode (a, b), Encode z) => Encode (a, b, z) where
|
|
|
|
|
sdecode xs = let (x0, (a, b)) = sdecode xs in let (x1, z) = sdecode x0 in (x1, (a, b, z))
|
|
|
|
|
sdecode = do
|
|
|
|
|
(a, b) <- sdecode
|
|
|
|
|
z <- sdecode
|
|
|
|
|
return (a, b, z)
|
|
|
|
|
sencode (a, b, z) = sencode (a, b) ++ sencode z
|
|
|
|
|
|
|
|
|
|
decodeTern :: Integral i => [Trit] -> i
|
|
|
|
@ -115,6 +146,3 @@ decodeTern digits = dec 0 digits where
|
|
|
|
|
encodeTern :: Integral i => Int -> i -> [Trit]
|
|
|
|
|
encodeTern 0 0 = []
|
|
|
|
|
encodeTern k x = (encodeTern (k-1) (x `div` 3)) ++ [toTrit $ fromIntegral (x `mod` 3)]
|
|
|
|
|
|
|
|
|
|
-- cartanks :: Car -> Nat
|
|
|
|
|
-- cartanks = (1+) . maximum . concat . map (\(upper, _, lower) -> upper ++ lower)
|
|
|
|
|