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