1 
    2 
    3 
    4 
    5 
    6 
    7 module KnightHeuristic(
    8         ChessSet,
    9         startTour,
   10         descendents,
   11         tourFinished 
   12 ) where
   13 
   14 
   15 
   16 
   17 
   18 
   19 
   20 
   21 
   22 
   23 
   24 
   25 
   26 import Sort(quickSort) 
   27 import ChessSetList
   28 
   29 data Direction = UL | UR | DL |DR | LU | LD | RU | RD
   30 
   31 
   32 
   33 
   34 
   35 move::Direction -> Tile -> Tile
   36 move UL (x,y) = (x-1,y-2)
   37 move UR (x,y) = (x+1,y-2)
   38 move DL (x,y) = (x-1,y+2)
   39 move DR (x,y) = (x+1,y+2)
   40 move LU (x,y) = (x-2,y-1)
   41 move LD (x,y) = (x-2,y+1)
   42 move RU (x,y) = (x+2,y-1)
   43 move RD (x,y) = (x+2,y+1)
   44 
   45 
   46 
   47 
   48 
   49 
   50 
   51 
   52 
   53 startTour::Tile -> Int -> ChessSet
   54 startTour st size 
   55    | (size `mod` 2) == 0 = createBoard size st 
   56    | otherwise           = error "Tour doesnt exist for odd size board"
   57 
   58 
   59 
   60 
   61 
   62 
   63 
   64 
   65 
   66 moveKnight::ChessSet -> Direction -> ChessSet
   67 moveKnight board dir
   68    = addPiece (move dir (lastPiece board)) board
   69 
   70 canMove::ChessSet -> Direction -> Bool
   71 canMove board dir
   72    = canMoveTo (move dir (lastPiece board)) board
   73 
   74 canMoveTo::Tile -> ChessSet -> Bool
   75 canMoveTo t@(x,y) board
   76    = (x >= 1) && (x <=sze) && 
   77      (y >= 1) && (y <=sze) &&
   78      isSquareFree t board
   79      where
   80         sze = sizeBoard board
   81 
   82 
   83 
   84 
   85 
   86 
   87 
   88 
   89 
   90 
   91 
   92 
   93 
   94 
   95 
   96 
   97 
   98 
   99 
  100 
  101 
  102 
  103 
  104 
  105 
  106 
  107 
  108 
  109 
  110 
  111 
  112 
  113 
  114 
  115 
  116 
  117 
  118 
  119 descendents::ChessSet -> [ChessSet]
  120 descendents board 
  121    | (canJumpFirst board) &&
  122      (deadEnd (addPiece (firstPiece board) board)) = []
  123    | otherwise          = case (length singles) of
  124                              0  -> map snd (quickSort (descAndNo board))
  125                              1  -> singles
  126                              _  -> []               -- Going to be dead end
  127                           where
  128                              singles = singleDescend board
  129 
  130 singleDescend::ChessSet -> [ChessSet]     
  131 singleDescend board =[x | (y,x) <- descAndNo board, y==1] 
  132   
  133 descAndNo::ChessSet -> [(Int,ChessSet)]
  134 descAndNo board
  135    = [(length (possibleMoves (deleteFirst x)),x) | x<- allDescend board]
  136     
  137 allDescend::ChessSet -> [ChessSet]
  138 allDescend board
  139    =  map (moveKnight board) (possibleMoves board)
  140 
  141 possibleMoves::ChessSet -> [Direction]
  142 possibleMoves board
  143    =[x | x <- [UL,UR,DL,DR,LU,LD,RU,RD], (canMove board x)]
  144 
  145 deadEnd::ChessSet -> Bool
  146 deadEnd board = (length (possibleMoves board)) == 0
  147 
  148 canJumpFirst::ChessSet -> Bool
  149 canJumpFirst board
  150   = canMoveTo (firstPiece board) (deleteFirst board)
  151 
  152 
  153 
  154 
  155 
  156 
  157 
  158 
  159 
  160 tourFinished::ChessSet -> Bool
  161 tourFinished board
  162    = (noPieces board == sze*sze) && (canJumpFirst board)  
  163      where
  164         sze = sizeBoard board
  165