Permalink
Browse files

Added more (old) small examples for tracing.

  • Loading branch information...
1 parent bc56086 commit 02bbe95448ae1d14fc85bd83d297765edf4d8b43 @OlafChitil 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
View
@@ -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]))
View
@@ -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)
View
@@ -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 " "
View
@@ -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" ]

0 comments on commit 02bbe95

Please sign in to comment.