Main.lhs 3.93 KB
 partain committed Jan 08, 1996 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}  Ben Gamari committed Dec 20, 2019 8 {-# LANGUAGE CPP #-}  partain committed Jan 08, 1996 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 committed Nov 26, 1996 13 import ChessSetList (Tile) -- partain:for hbc  partain committed Jan 08, 1996 14 15 import KnightHeuristic import Queue  Sebastian Graf committed Jan 08, 2019 16 import Control.Monad  Simon Marlow committed Oct 13, 2010 17 18 import System.Environment import Data.Char  sof committed Jan 18, 1999 19 20 21  #define fail ioError  partain committed Jan 08, 1996 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  Matthew Pickering committed Jun 16, 2018 26 27 module @Main@, and @main@ must have type @[Response] -> [Request]@. Any function having this type is an I/O request that  partain committed Jan 08, 1996 28 communicates with the outside world via {\em streams} of messages. Since  Matthew Pickering committed Jun 16, 2018 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  partain committed Jan 08, 1996 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}  partain committed Jul 25, 1996 41 main:: IO ()  Sebastian Graf committed Jan 08, 2019 42 main=replicateM_ 100 \$ getArgs >>= \ss ->  partain committed Jan 08, 1996 43  if (argsOk ss) then  Sebastian Graf committed Jan 08, 2019 44  print (length (printTour ss))  Matthew Pickering committed Jun 16, 2018 45  else  partain committed Jul 25, 1996 46  fail (userError usageString)  partain committed Jan 08, 1996 47 48 49 50 51 52 53 54 55 56 57  where usageString= "\nUsage: knights \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  partain committed Jul 25, 1996 58  strToInt y (x:xs) = strToInt (10*y+(fromEnum x - fromEnum '0')) xs  partain committed Jan 08, 1996 59  pp [] = []  Matthew Pickering committed Jun 16, 2018 60  pp ((x,y):xs) = "\nKnights tour with " ++ (show x) ++  partain committed Jan 08, 1996 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)  Matthew Pickering committed Jun 16, 2018 71 72 root sze= addAllFront (zip [-(sze*sze)+1,-(sze*sze)+1..]  partain committed Jan 08, 1996 73 74  (zipWith startTour  Matthew Pickering committed Jun 16, 2018 75  [(x,y) | x<-[1..sze], y<-[1..sze]]  partain committed Jan 08, 1996 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  Matthew Pickering committed Jun 16, 2018 83 search space. The higher order function @depthSearch@ applies this search  partain committed Jan 08, 1996 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  Matthew Pickering committed Jun 16, 2018 101  (addAllFront (growFn (inquireFront q))  partain committed Jan 08, 1996 102 103 104 105  (removeFront q)) growFn finFn) \end{code}  Matthew Pickering committed Jun 16, 2018 106 107 {\bf Note :} the above function should be abstracted out into a seperate search module, but as depth first search is the only  partain committed Jan 08, 1996 108 109 realistic search strategy for the knights tour....