import Data.List
import Char
type Bin = String
type Dec = Integer
type Hex = String
binToDec:: Bin -> Dec
binToDec = btd.reverse
where
btd [] = 0
btd (x:xs) = (fromIntegral (digitToInt x)) + 2 * btd xs
decToBin:: Dec ->Bin
decToBin = reverse.dtb
where
dtb 0 = []
dtb n = intToDigit (fromIntegral(n `mod` 2)) : dtb (n `div` 2)
hexToBin:: Hex -> Bin
hexToBin h = htb h
where
htb []=[]
htb (h:hs) = d !!(digitToInt h) ++ (htb hs)
d = ["0000","0001","0010","0011","0100","0101","0110","0111","1000","1001","1010","1011","1100","1101","1110","1111"]
binToHex:: Bin -> Hex
binToHex b = bth b
where
bth []=[]
bth (b1:b2:b3:b4:bs)= d!!(fromIntegral$binToDec (b1:b2:b3:b4:[])): bth bs
d="0123456789abcdef"
bitadjust:: Int -> Bin -> Bin
bitadjust bit b= reverse $ take bit $ (reverse b)++ cycle "0"
p=[('0','0'),('0','1'),('1','0'),('1','1')]
binAdd:: Bin -> Bin -> Bin
binAdd a b= decToBin(binToDec a + (binToDec b))
binAdd2:: Bin -> Bin -> Bin
binAdd2 a b=decToBin(binToDec a + (binToDec b) +1)
t:: Bin -> Bin -> Bin ->Bool
t a b c =t' a $length b
where
t' a bit=t'' (bitadjust bit a)
where
t'' a' = t''' $bitadjust bit $binAdd b c
where
t''' b'|a'==b' = True
|a'/=b' = False
t2:: Bin -> Bin -> Bin -> Bool
t2 a b c = t2' a $length b
where
t2' a bit=t2'' $reverse(bitadjust bit (reverse a))
where
t2'' a' = t2''' $bitadjust bit $binAdd (reverse b) (reverse c)
where
t2''' b'|a'==b' = True
|a'/=b' = False
t3:: Bin -> Bin -> Bin -> Bool
t3 a b c = t3' a $length b
where
t3' a bit=t3'' $reverse(bitadjust bit (reverse a))
where
t3'' a' = t3''' $bitadjust bit $binAdd2 (reverse b) (reverse c)
where
t3''' b'|a'==b' = True
|a'/=b' = False
test:: Bin -> Bin -> Bin -> Bool
test a b c = t a b c && (t2 a b c || t3 a b c)
tt:: Bin -> Bin -> Bin -> [(Char,Char)]
tt a b c = [(x,y)|(x,y)<-p,test a (x:b)(y:c)]
ttt:: Bin -> Bin -> Bin -> [(Bin,Bin)]
ttt a b c = map(\ (x,y)-> ((x:b),(y:c))) $ tt a b c
tttt :: Bin -> [(Bin, Bin)] -> [Bin]
tttt a [] = []
tttt a ((b,c):xs) | (length a) == (length b)*2 = ts a (reverse c ++ b) ++(tttt a xs)
| (length a) == (length b)*2-1 = ts a (reverse (drop 1 c) ++ b) ++(tttt a xs)
| otherwise =tttt a (ttt a b c) ++ (tttt a xs)
where
ts a b' | a == bitadjust (length a) (binAdd b' (reverse b')) = [b']
| otherwise =[]
f a=tttt a [("","")]
fx a= map(binToHex)$tttt (hexToBin a) [("","")]
rx a = rx' (hexToBin a)
where
rx' b = binToHex $ bitadjust (length b) $ binAdd b (reverse b)
r a = r' a
where
r' b = binAdd b (reverse b)