codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
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)
Private
[
?
]
Run code
Submit