Last active
August 20, 2018 03:55
-
-
Save TakashiHarada/3709fb2c76098d18cfcce13b0ebf41f8 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- もっと効率の良い実装があるはず... | |
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