Gray codes

-- naryGrayCodes from hackage
naryGrayCodes :: [a] -> Int -> [[a]]
naryGrayCodes xs 1 = map (\x -> [x]) xs
naryGrayCodes xs k = snd $ foldl prefixAndShift (ys,[]) zs
  where ys = naryGrayCodes xs 1
        zs = naryGrayCodes xs (k-1)

-- | Shift elements right.
shift :: [a] -> [a]
shift as = last as : init as

prefixAndShift :: ([[a]],[[a]]) -> [a] -> ([[a]],[[a]])
prefixAndShift (ys,zs) xs = (shift ys, zs ++ (map (xs++) ys))

l = "0123456789"

dumb = [[x,y,z] | x<-l, y<-l, z<-l]
gray = naryGrayCodes l 3


scanlx f xs = go f xs []
  where
    go f [x1, x2]   acc = (f x1 x2):acc
    go f (x1:x2:xs) acc = go f (x2:xs) ((f x1 x2):acc)

scanlx2 f xs = zipWith f xs (tail xs)

hamd xs ys = go xs ys 0
   where
      go []     []     acc = acc
      go (x:xs) (y:ys) acc = go xs ys (if x==y then acc else acc+1)

hamd2 xs ys = length (filter id (zipWith (/=) xs ys))

main = putStrLn $ unlines $ map show $ zip3 [1..] dumb gray
--main = putStrLn $ show $ map sum $ map (scanlx hamd) $ [dumb, gray]