[nhc-users] -b vs. -p

[Saswat Anand]

Sorry. Here is my Program.

module Main(main) where

import IOExtras
type Var = Int
type Val = Int
data Assignment = Var := Val deriving (Eq,Show)
data Assgn = Tree Assignment [Assgn] deriving (Eq,Show)


main = do putStrLn $ "Solutions = " ++ (show $ length $ results (bb [1..9]
9) 9)
          c <- readIORef counter
          putStrLn $ "Checks = " ++ show c

cc :: [[Assignment]->Bool] -> Assgn -> [Assgn]
cc cons t = fun [] 0 t
    where fun part var (Tree t cs)  = 
               let new_ass = part++[t]
    		   new_chi = concatMap (fun new_ass (var+1)) cs
	       in if (cons!!var) new_ass 
		   then  [Tree t new_chi]
 		   else []


bb :: [Var] -> Int -> [Assgn]
bb vars n = let cons = take n $ (true : [ f a | a <- [2..]]) 
                f a = foldl1 (&) [check a m | m <- [1..a-1]] 
            in concatMap (cc cons) (fun vars)
  where fun (v:vs) = [Tree (v:=x) (fun vs) | x <- [1..n]]
        fun []     = []

check :: Int -> Int -> [Assignment] -> Bool
check m n ass = safe (ass!!(m-1)) (ass!!(n-1))

true :: [Assignment] -> Bool
true _ = True

(&) :: ([Assignment]->Bool) -> ([Assignment]->Bool) ->
([Assignment]->Bool)
f1 & f2 = \ints -> f1 ints && f2 ints

safe :: Assignment -> Assignment ->  Bool
safe (i:=j) (m:=n) = unsafePerformIO $
			do c <- readIORef counter
		   	   writeIORef counter $! (c+1)
			   return $ not (j==n || i+j==m+n || i-j==m-n)


results :: [Assgn] -> Int -> [[Assignment]]
results t no= concatMap ((filter (\l->length l == no)).flatten) t
  where flatten (Tree t []) = [[t]]
	flatten (Tree t cs) = map (t:) (concatMap flatten cs)

counter :: IORef Integer
counter = unsafePerformIO $ newIORef (0::Integer)