Skip to content

Instantly share code, notes, and snippets.

@TakashiHarada
Last active August 20, 2018 03:55
Show Gist options
  • Save TakashiHarada/3709fb2c76098d18cfcce13b0ebf41f8 to your computer and use it in GitHub Desktop.
Save TakashiHarada/3709fb2c76098d18cfcce13b0ebf41f8 to your computer and use it in GitHub Desktop.
-- もっと効率の良い実装があるはず...
import Data.Char
main :: IO ()
main = putStrLn "Enter a length of element: "
>> (readLn :: IO Int)
>>= \d -> putStrLn ("graph Lattice" ++ show d ++ " {")
>> putStr "\n graph [\n rankdir = BT\n ]\n\n"
>> putStrLn ((unlines . concatMap piyo . reverse . mkLattice) d ++ "}")
hoge = ("000",["001","010","100"])
piyo = \(x,ys) -> map (\y -> " " ++ x ++ " -- " ++ y ++ ";") ys
-- mapM_ print $ mkLattice 6
mkLattice :: Int -> [(String, [String])]
mkLattice d = map (\x -> (x, plusOne x)) (mkBinarySequence d)
countOnBit :: String -> Int
countOnBit = length . filter (== '1')
plusOne :: String -> [String]
plusOne xs = [ ys | ys <- mkBinarySequence (length xs), plusOneString xs ys]
-- hamming distance of ys and xs == 1 and the number of ones in ys is that of x + 1
plusOneString :: String -> String -> Bool
plusOneString xs ys = hammingDistance xs ys == 1 && countOnBit ys > countOnBit xs
diffOne :: String -> [String]
diffOne xs = [ ys | ys <- mkBinarySequence (length xs), (hammingDistance xs ys == 1)]
hammingDistance :: String -> String -> Int
hammingDistance xs ys = sum $ zipWith (\x y -> abs $ (ord x) - (ord y)) xs ys
mkBinarySequence :: Int -> [String]
mkBinarySequence d =
map (map (\x -> chr (x+48))) [int2bin' x d | x <- [0..(2^d-1)]]
int2bin :: Int -> [Int]
int2bin 0 = []
int2bin n = n `mod` 2 : int2bin (n `div` 2)
int2bin' :: Int -> Int -> [Int]
int2bin' n k = reverse $ take k $ int2bin n ++ repeat 0
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment