59 lines
1.6 KiB
Haskell
59 lines
1.6 KiB
Haskell
data BalancedTernary = Bt [Int]
|
|
|
|
zeroTrim a = if null s then [0] else s where
|
|
s = fst $ foldl f ([],[]) a
|
|
f (x,y) 0 = (x, y++[0])
|
|
f (x,y) z = (x++y++[z], [])
|
|
|
|
btList (Bt a) = a
|
|
|
|
instance Eq BalancedTernary where
|
|
(==) a b = btList a == btList b
|
|
|
|
btNormalize = listBt . _carry 0 where
|
|
_carry c [] = if c == 0 then [] else [c]
|
|
_carry c (a:as) = r:_carry cc as where
|
|
(cc, r) = f $ (a+c) `quotRem` 3 where
|
|
f (x, 2) = (x + 1, -1)
|
|
f (x, -2) = (x - 1, 1)
|
|
f x = x
|
|
|
|
listBt = Bt . zeroTrim
|
|
|
|
instance Show BalancedTernary where
|
|
show = reverse . map (\d->case d of -1->'-'; 0->'0'; 1->'+') . btList
|
|
|
|
strBt = Bt . zeroTrim.reverse.map (\c -> case c of '-' -> -1; '0' -> 0; '+' -> 1)
|
|
|
|
intBt :: Integral a => a -> BalancedTernary
|
|
intBt = fromIntegral . toInteger
|
|
|
|
btInt = foldr (\a z -> a + 3 * z) 0 . btList
|
|
|
|
listAdd a b = take (max (length a) (length b)) $ zipWith (+) (a++[0,0..]) (b++[0,0..])
|
|
|
|
-- mostly for operators, also small stuff to make GHC happy
|
|
instance Num BalancedTernary where
|
|
negate = Bt . map negate . btList
|
|
(+) x y = btNormalize $ listAdd (btList x) (btList y)
|
|
(*) x y = btNormalize $ mul_ (btList x) (btList y) where
|
|
mul_ _ [] = []
|
|
mul_ as b = foldr (\a z -> listAdd (map (a*) b) (0:z)) [] as
|
|
|
|
-- we don't need to define binary "-" by hand
|
|
|
|
signum (Bt a) = if a == [0] then 0 else Bt [last a]
|
|
abs x = if signum x == Bt [-1] then negate x else x
|
|
|
|
fromInteger = btNormalize . f where
|
|
f 0 = []
|
|
f x = fromInteger (rem x 3) : f (quot x 3)
|
|
|
|
|
|
main = let (a,b,c) = (strBt "+-0++0+", intBt (-436), strBt "+-++-")
|
|
r = a * (b - c)
|
|
in do
|
|
print $ map btInt [a,b,c]
|
|
print $ r
|
|
print $ btInt r
|