[ create a new paste ] login | about

Link: http://codepad.org/ETbL5UUF    [ raw code | fork ]

Haskell, pasted on Oct 8:
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)


Create a new paste based on this one


Comments: