[project @ 1997-03-14 08:02:40 by simonpj]
[nofib.git] / spectral / knights / ChessSetArray.lhs
1 %               Filename:  ChessSetArray.lhs
2 %               Version :  1.4
3 %               Date    :  3/4/92
4 \section{Building chess boards out of arrays}
5 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%M O D U L E%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
6 Lots of data abstraction is used in this version of the knights tour. The
7 searching mechanism can be either a sequential depth first search, or a
8 data parallel search (for instance wedge first??). This module
9 abstracts data type specific operations used in the Heuristic part of the tour.
10
11 \begin{code}
12 module ChessSetArray(Tile,
13                     ChessSet,
14                     createBoard,
15                     sizeBoard,
16                     addPiece,
17                     deleteFirst,
18                     noPieces,
19                     positionPiece,
20                     lastPiece,
21                     firstPiece,
22                     pieceAtTile,
23                     isSquareFree
24 ) where
25 \end{code}
26
27
28 %%%%%%%%%%%%%%%%%% I M P O R T S  /  T Y P E   D E F S %%%%%%%%%%%%%%
29 @Tile@ is a type synonym that represents the $(x,y)$ coordinates of a
30 tile on chess board. The chess board is represented as an algebraic 
31 data type\footnote{And hence we can include it in class @Text@, making it
32 @show@able} of an :
33 \begin{itemize}
34 \item   {\tt Int} representing the size of the chess board.
35 \item   {\tt Int} representing the current move number.
36 \item   {\tt Tile} representing the first move of the knight.
37 \item   {\tt Tile} representing the first move of the knight.
38 \item   A 1D array (A) of {\tt Int} where $A_{i}=n$ represents the $n^{th}$
39         move of the knight; where $n\ge 1$ or the empty tile if $n=0$. 
40         A tile at position $(x,y)$ would be represnted by the array element
41         $A_{(x-1)*size + y}$.
42         
43 \end{itemize}
44 A One dimensional array was used in this implementation due to problems with
45 the current release of Glasgow Haskell. We include information in this 
46 type that could of been deduced from the trail alone, but adding the 
47 information prevents unnecessary traversal of the trail.
48
49
50 \begin{code}
51 import Array
52 import Sort(quickSort)
53
54 type Tile     = (Int,Int)
55 data ChessSet = Board Int Int Tile Tile (Array Int Int)
56 \end{code}
57
58
59 %%%%%%%%%%%%%%%%%%%% C L A S S  I N S T A N C E S %%%%%%%%%%%%%%%%%%%
60 Various instance declarations for @show@ , @==@ and @<=@. Note the little
61 hack with ordinals, we do not want to compare chess sets, but if we have 
62 for instance a tuple of @(Int,ChessSet)@, then we want to compare on the
63 @Int@ part of the tuple. Therefore {\em any} @ChessSet@ is smaller than any
64 other.
65
66 \begin{code}
67 instance Eq ChessSet where
68     _ == _ = True
69
70 instance Ord ChessSet where
71     _ <= _ = True                       
72
73 instance Show ChessSet where
74    showsPrec p board@(Board s n l f ts) 
75       = showString "Move number " . (showsPrec p n).
76         showString "\n" . showString (printBoard s (elems ts) 1)
77 \end{code}
78
79
80 %%%%%%%%%%%%%%%%%%%%% B O D Y  O F  M O D U L E %%%%%%%%%%%%%%%%%%%%%
81 \begin{code}
82 createBoard::Int -> Tile -> ChessSet
83 createBoard x t = Board x 1 t t onlyFirst
84                   where
85                      onlyFirst = empty // [(tileIndex x t, 1)]
86                      empty     = array (1,x*x) [ (i,0) | i<-[1..x*x]]
87
88 sizeBoard::ChessSet -> Int
89 sizeBoard (Board s _ _ _ _) = s
90
91 noPieces::ChessSet -> Int 
92 noPieces (Board _ n _ _ _) = n
93
94 addPiece::Tile -> ChessSet -> ChessSet
95 addPiece t (Board s n l f ts) =Board s (n+1) t f 
96                                     (ts // [(tileIndex s t, n+1)])
97 \end{code}
98
99
100 @deletePiece@ deletes the $x^{th}$ piece placed on the board, and 
101 depending on the representation ensures the remaining trail is valid.
102
103
104 \begin{code}
105 deleteFirst::ChessSet -> ChessSet
106 deleteFirst (Board s n l f ts) = Board s n l l 
107                                        (ts // [(tileIndex s f, 0)])
108 \end{code}
109
110 {\bf Note:} the below function does not change the trail.
111
112 \begin{code}
113 positionPiece::Int -> ChessSet -> Tile
114 positionPiece x (Board s _ _ _ ts) 
115    = findPiece x ts [ i | i<-[1..s*s] ]
116      where
117         findPiece x ts []     = error "Piece not found"
118         findPiece x ts (y:ys) = if ((ts ! y)==x) then (indexTile s y)
119                                 else
120                                    findPiece x ts ys
121         
122 lastPiece::ChessSet -> Tile
123 lastPiece (Board _ _ l _ _) = l
124
125 firstPiece::ChessSet -> Tile
126 firstPiece (Board _ _ _ f _) = f
127
128 pieceAtTile::Tile -> ChessSet -> Int
129 pieceAtTile x (Board s _ _ _ts)
130    = ts ! (tileIndex s x)
131
132 isSquareFree::Tile -> ChessSet -> Bool
133 isSquareFree x (Board s _ _ _ ts) = (ts ! (tileIndex s x)) == 0
134
135 \end{code}
136
137
138 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% M I S C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
139 Various auxiliary functions used above which I would of liked to 
140 include in @where@ clauses if they were not so large.
141
142 \begin{code}
143
144 tileIndex:: Int -> Tile -> Int
145 tileIndex size (x,y) = ((x-1)*size) + y
146
147 indexTile::Int -> Int -> Tile
148 indexTile size x     = ((x `div` size)+1 , x `mod` size)
149
150 printBoard s [] i    = []
151 printBoard s (x:xs) i 
152    | (i/=s) && (x==0) ="*"     ++(spaces (s*s) 1)++(printBoard s xs (i+1))
153    | (i==s) && (x==0) ="*\n"                     ++(printBoard s xs 1)
154    | (i/=s)           =(show x)++(spaces (s*s) x)++(printBoard s xs (i+1))
155    | (i==s)           =(show x)++ "\n"           ++(printBoard s xs 1)
156
157 spaces s y = take ((logTen s) - (logTen y) + 1) [' ',' '..]
158              where
159                 logTen 1 = 0
160                 logTen x = 1+ logTen (x `div` 10)
161
162 \end{code}