summaryrefslogtreecommitdiff
path: root/progs/demo/queens.hs
blob: 0f8de597a073ed667a12fd9e3041504a6fd9bf3b (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
{- This is the n Queens problem. -}

module Main where

queens :: Int -> [[Int]]
queens size  = queens' size size

queens' :: Int -> Int -> [[Int]]
queens' 0     _    = [[]]
queens' (n+1) size = [q:qs | qs <- queens' n size, q <- [1..size],
			     not (threatens q qs)]

threatens :: Int -> [Int] -> Bool
threatens q qs = q `elem` qs || q `elem` (diagonals 1 qs)

diagonals :: Int -> [Int] -> [Int]
diagonals _  []    = []
diagonals n (q:qs) = (q+n) : (q-n) : diagonals (n+1) qs

main = appendChan stdout "Enter board size: " abort $
       readChan stdin abort $ \input -> 
       let line1 : ~(line2 : _) = lines input
	   size = read line1
           solns = read line2
       in if size == 0 then done else  -- This causes the size to actually read
         appendChan stdout "Number of solutions: " abort $
         appendChan stdout (concat (map (\x -> showBoard size x)
                                        (take solns (queens size))))
  	 abort done

showBoard :: Int -> [Int] -> String

showBoard size pos =
  concat (map showRow pos) ++ "\n"
    where
      showRow n = concat [if i == n then "Q " else ". " | i <- [1..size]]
                  ++ "\n"