# OlafChitil/hat

Added more (old) small examples for tracing.

1 parent bc56086 commit 02bbe95448ae1d14fc85bd83d297765edf4d8b43 committed Oct 11, 2012
Showing with 134 additions and 0 deletions.
1. +14 −0 examples/Hamming.hs
2. +12 −0 examples/Hanoi.hs
3. +48 −0 examples/Queens.hs
4. +60 −0 examples/Soda.hs
 @@ -0,0 +1,14 @@ +hamming :: [Int] -> [Int] +hamming ps = + tail (hamming_ps) + where + hamming_ps = 1 : foldl1 merge (map hamProd ps) + hamProd p = map (p*) hamming_ps + +merge (x:xs) (y:ys) = + case compare x y of + LT -> x : merge xs (y:ys) + EQ -> x : merge xs ys + GT -> y : merge (x:xs) ys + +main = print (take 10 (hamming [2, 3, 5]))
 @@ -0,0 +1,12 @@ +main = hanoi 3 + +hanoi :: Int -> IO () +hanoi = h 'A' 'B' 'C' + where + h :: Char -> Char -> Char -> Int -> IO () + h a b c 0 = return () + h a b c n = + do + h a c b (n-1) + putStr ("move disc from " ++ a : " to " ++ b : "\n") + h c b a (n-1)
 @@ -0,0 +1,48 @@ + +-- The queens problem made famous by Wirth. + +type Board = [Int] + +main :: IO () +main = + if null solutions then putStrLn "no solution!" + else putStr (showBoard (head solutions)) + where + solutions = queens 4 + +queens :: Int -> [Board] +queens n = valid n n + +valid :: Int -> Int -> [Board] +valid 0 n = [[]] +valid m n = filter safe (extend n (valid (m-1) n)) + +extend :: Int -> [Board] -> [Board] +extend n bs = consEach [1..n] bs + +consEach :: [a] -> [[a]] -> [[a]] +consEach [] y = [] +consEach (a:x) y = map (a:) y ++ consEach x y + +safe :: Board -> Bool +safe (a:b) = no_threat a b 1 + +no_threat :: Int -> Board -> Int -> Bool +no_threat a [] m = True +no_threat a (b:y) m = + a /= b && a+m /= b && a-m /= b && no_threat a y (m+1) + +showBoard :: Board -> String +showBoard b = + unlines (concat (zipWith rank [1..] b)) + where + rank r qcol = + map line ["o o o", " \\|/ ", " === "] + where + line crown_slice = + concat (zipWith square [1..] b) + where + square scol _ = + if scol == qcol then crown_slice + else if scol `rem` (2::Int) == r `rem` (2::Int) then "....." + else " "
 @@ -0,0 +1,60 @@ +------------------------------------------------------------------ +-- Searching in a grid of words for hidden words oriented in any of +-- the 8 possible directions. +-- Colin Runciman, May 1984 (this version, for tracing, March 2000) +------------------------------------------------------------------ + +main = mapM (putStr.find) hidden + where + find word = word ++ " " ++ concat dirs ++ "\n" + where + dirs = map snd ( + filter (any (contains word) . fst) + [(r,"right "), (d,"down "), (dl,"downleft "), (ul,"upleft ")] + ++ + filter (any (contains drow) . fst) + [(r,"left "), (d,"up "), (dl,"upright "), (ul,"downright ")] ) + drow = reverse word + r = grid + d = transpose grid + dl = diagonals grid + ul = diagonals (reverse grid) + +transpose [r] = map (:[]) r +transpose (r:rs) = zipWith (:) r (transpose rs) + +diagonals [r] = map (:[]) r +diagonals (r:rs) = zipinit r ([]:diagonals rs) + +zipinit [] ys = ys +zipinit (x:xs) (y:ys) = (x : y) : zipinit xs ys + +contains xs ys = any (prefix xs) (suffixes ys) + +suffixes [] = [] +suffixes xs = xs : suffixes (tail xs) + +prefix [] ys = True +prefix xs [] = False +prefix (x:xs) (y:ys) = x == y && prefix xs ys + +grid = + [['Y', 'I', 'O', 'M', 'R', 'E', 'S', 'K', 'S', 'T'], + ['A', 'E', 'H', 'Y', 'G', 'E', 'H', 'E', 'D', 'W'], + ['Z', 'F', 'I', 'A', 'C', 'N', 'I', 'T', 'I', 'A'], + ['N', 'T', 'O', 'C', 'O', 'M', 'V', 'O', 'O', 'R'], + ['E', 'R', 'D', 'L', 'O', 'C', 'E', 'N', 'S', 'M'], + ['Z', 'O', 'U', 'R', 'P', 'S', 'R', 'N', 'D', 'A'], + ['O', 'Y', 'A', 'S', 'M', 'O', 'Y', 'E', 'D', 'L'], + ['R', 'N', 'D', 'E', 'N', 'L', 'O', 'A', 'I', 'T'], + ['F', 'I', 'W', 'I', 'N', 'T', 'E', 'R', 'R', 'C'], + ['F', 'E', 'Z', 'E', 'E', 'R', 'F', 'T', 'F', 'I'], + ['I', 'I', 'D', 'T', 'P', 'H', 'U', 'B', 'R', 'L'], + ['C', 'N', 'O', 'H', 'S', 'G', 'E', 'I', 'O', 'N'], + ['E', 'G', 'M', 'O', 'P', 'S', 'T', 'A', 'S', 'O'], + ['T', 'G', 'F', 'F', 'C', 'I', 'S', 'H', 'T', 'H'], + ['O', 'T', 'B', 'C', 'S', 'S', 'N', 'O', 'W', 'I']] + +hidden = + ["COSY", "SOFT", "WINTER", "SHIVER", "FROZEN", "SNOW", + "WARM", "HEAT", "COLD", "FREEZE", "FROST", "ICE" ]