Main.lhs 3.93 KB
Newer Older
1 2 3 4 5 6 7
%               Filename:  Main.lhs
%               Version :  1.4
%               Date    :  3/2/92

\section{The Main Program.}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%M O D U L E%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
8
{-# LANGUAGE CPP #-}
9 10 11 12
module Main(main) where
\end{code}
%%%%%%%%%%%%%%%%%% I M P O R T S  /  T Y P E   D E F S %%%%%%%%%%%%%%
\begin{code}
dnt's avatar
dnt committed
13
import ChessSetList (Tile) -- partain:for hbc
14 15
import KnightHeuristic
import Queue
Sebastian Graf's avatar
Sebastian Graf committed
16
import Control.Monad
17 18
import System.Environment
import Data.Char
sof's avatar
sof committed
19 20 21

#define fail ioError

22 23 24 25
\end{code}

%%%%%%%%%%%%%%%%%%%%% B O D Y  O F  M O D U L E %%%%%%%%%%%%%%%%%%%%%
The value of a Haskell program is the value of the identifier @main@ in the
26 27
module @Main@, and @main@ must have type @[Response] -> [Request]@. Any
function having this type is an I/O request that
28
communicates with the outside world via {\em streams} of messages. Since
29 30 31 32
Haskell is lazy language, we have the strange anomaly that the result of a
I/O operation is a list of @Requests@'s that is generated by a list of
@Response@'s. This characteristic is due to laziness because forcing
evaluation on the $n^{th}$ @Response@, will in turn force evaluation on the
33 34 35 36 37 38 39 40
$n^{th}$ request - enabling I/O to occur.

The @main@ function below uses the continuation style of I/O. Its purpose is
to read two numbers off the command line, and print out $x$ solutions to
the knights tour with a board of size $y$; where $x$ and $y$ represent
the first and second command line option respectively.

\begin{code}
41
main:: IO ()
Sebastian Graf's avatar
Sebastian Graf committed
42
main=replicateM_ 100 $ getArgs >>= \ss ->
43
     if (argsOk ss) then
Sebastian Graf's avatar
Sebastian Graf committed
44
        print (length (printTour ss))
45
     else
46
        fail (userError usageString)
47 48 49 50 51 52 53 54 55 56 57
     where
        usageString= "\nUsage: knights <board size> <no solutions> \n"
	argsOk ss = (length ss == 2) && (foldr ((&&) . all_digits) True ss)
	all_digits s = foldr ((&&) . isDigit) True s

printTour::[[Char]] -> [Char]
printTour ss
   = pp (take number (depthSearch (root size) grow isFinished))
     where
        [size,number]     = map (strToInt 0) ss
	strToInt y []     = y
58
	strToInt y (x:xs) = strToInt (10*y+(fromEnum x - fromEnum '0')) xs
59
	pp []		  = []
60
	pp ((x,y):xs)     = "\nKnights tour with " ++ (show x)  ++
61 62 63 64 65 66 67 68 69 70
	   	            " backtracking moves\n" ++ (show y) ++
			    (pp xs)

grow::(Int,ChessSet) -> [(Int,ChessSet)]
grow (x,y) = zip [(x+1),(x+1)..] (descendents y)

isFinished::(Int,ChessSet) -> Bool
isFinished (x,y) = tourFinished y

root::Int -> Queue (Int,ChessSet)
71 72
root sze= addAllFront
             (zip [-(sze*sze)+1,-(sze*sze)+1..]
73 74
	          (zipWith
		     startTour
75
		      [(x,y) | x<-[1..sze], y<-[1..sze]]
76 77 78 79 80 81 82
		     (take (sze*sze) [sze,sze..])))
             createQueue
\end{code}


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
The knights tour proceeds by applying a depth first search on the combinatorial
83
search space. The higher order function @depthSearch@ applies this search
84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
strategy, and returns a stream of valid search nodes. The arguments
to this function are :
\begin{itemize}
\item   A {\tt Queue} of all the possible starting positions of the search.
\item   A function that given a node in the search returns a list of valid
        nodes that are reachable from the parent node (the descendents).
\item	A function that determines if a given node in the search space is
        a valid solution to the problem (i.e is it a knights tour).
\end{itemize}

\begin{code}
depthSearch :: (Eq a) => Queue a -> (a -> [a]) -> (a -> Bool) -> Queue a
depthSearch q growFn finFn
   | emptyQueue q           = []
   | finFn (inquireFront q) = (inquireFront q):
			      (depthSearch (removeFront q) growFn finFn)
   | otherwise    	    = (depthSearch
101
	                         (addAllFront (growFn (inquireFront q))
102 103 104 105
					      (removeFront q))
	    	                 growFn
	                         finFn)
\end{code}
106 107
{\bf Note :} the above function should be abstracted out into a
seperate search module, but as depth first search is the only
108 109
realistic search strategy for the knights tour....