diff options
Diffstat (limited to 'testsuite/tests/programs/Queens')
-rw-r--r-- | testsuite/tests/programs/Queens/Makefile | 3 | ||||
-rw-r--r-- | testsuite/tests/programs/Queens/queens.hs | 50 | ||||
-rw-r--r-- | testsuite/tests/programs/Queens/queens.stdout | 24 | ||||
-rw-r--r-- | testsuite/tests/programs/Queens/test.T | 6 |
4 files changed, 83 insertions, 0 deletions
diff --git a/testsuite/tests/programs/Queens/Makefile b/testsuite/tests/programs/Queens/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/programs/Queens/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/programs/Queens/queens.hs b/testsuite/tests/programs/Queens/queens.hs new file mode 100644 index 0000000000..548e20cb8d --- /dev/null +++ b/testsuite/tests/programs/Queens/queens.hs @@ -0,0 +1,50 @@ +-- The classic 8-queens problem made famous by Wirth. +-- This version Colin Runciman, March 2000. + +main = + if null solutions then putStrLn "no solution!" + else putStr (board (head solutions)) + where + solutions = queens 8 + +queens :: Int -> [[Int]] +queens n = valid n n + +valid :: Int -> Int -> [[Int]] +valid 0 n = [[]] +valid m n = filter safe (extend n (valid (m-1) n)) + +extend n b = cp (fromTo 1 n) b + +cp :: [a] -> [[a]] -> [[a]] +cp [] y = [] +cp (a:x) y = map (a:) y ++ cp x y + +safe (a:b) = no_threat a b 1 + +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) + +board :: [Int] -> String +board b = + unlines (concat (zipWith rank (from 1) b)) + where + rank r qcol = + map line ["o o o", " \\|/ ", " === "] + where + line crown_slice = + concat (zipWith square (from 1) b) + where + square scol _ = + if scol == qcol then crown_slice + else if (scol `rem` (2::Int)) == (r `rem` (2::Int)) then "....." + else " " + +-- in place of .. + +from :: Int -> [Int] +from n = n : from (n+1) + +fromTo :: Int -> Int -> [Int] +fromTo m n = if m > n then [] else m : fromTo (m+1) n diff --git a/testsuite/tests/programs/Queens/queens.stdout b/testsuite/tests/programs/Queens/queens.stdout new file mode 100644 index 0000000000..95eafd8a49 --- /dev/null +++ b/testsuite/tests/programs/Queens/queens.stdout @@ -0,0 +1,24 @@ +o o o ..... ..... ..... + \|/ ..... ..... ..... + === ..... ..... ..... + ..... .....o o o..... ..... + ..... ..... \|/ ..... ..... + ..... ..... === ..... ..... +..... ..... ..... .....o o o +..... ..... ..... ..... \|/ +..... ..... ..... ..... === + ..... ..... o o o ..... + ..... ..... \|/ ..... + ..... ..... === ..... +..... o o o ..... ..... +..... \|/ ..... ..... +..... === ..... ..... + ..... ..... .....o o o..... + ..... ..... ..... \|/ ..... + ..... ..... ..... === ..... +.....o o o..... ..... ..... +..... \|/ ..... ..... ..... +..... === ..... ..... ..... + ..... o o o ..... ..... + ..... \|/ ..... ..... + ..... === ..... ..... diff --git a/testsuite/tests/programs/Queens/test.T b/testsuite/tests/programs/Queens/test.T new file mode 100644 index 0000000000..044ebf6a2c --- /dev/null +++ b/testsuite/tests/programs/Queens/test.T @@ -0,0 +1,6 @@ + +test('queens', + [skip_if_fast, + extra_clean(['Main.hi', 'Main.o'])], + compile_and_run, + ['']) |