diff --git a/examples/benchmarks/lib/benchmarks/knights.ak b/examples/benchmarks/lib/benchmarks/knights.ak index d99b2ec8..f6d01146 100644 --- a/examples/benchmarks/lib/benchmarks/knights.ak +++ b/examples/benchmarks/lib/benchmarks/knights.ak @@ -7,11 +7,11 @@ use benchmarks/queue.{ } test run_knights0() { - run_knights(0, 0) == [] + run_knights(100, 0) == [] } test run_knights1() { - run_knights(2, 2) == [] + run_knights(100, 2) == [] } fn run_knights(depth: Int, board_size: Int) -> Solution { diff --git a/examples/benchmarks/lib/benchmarks/knights/chess_set.ak b/examples/benchmarks/lib/benchmarks/knights/chess_set.ak index 465758e7..8d9454b1 100644 --- a/examples/benchmarks/lib/benchmarks/knights/chess_set.ak +++ b/examples/benchmarks/lib/benchmarks/knights/chess_set.ak @@ -25,6 +25,18 @@ pub fn first_piece(board: ChessSet) -> Tile { tile } +// {-# INLINABLE lastPiece #-} +// lastPiece :: ChessSet -> Tile +// lastPiece (Board _ _ _ (t:_)) = t +// lastPiece _ = Tx.error () + +pub fn last_piece(board: ChessSet) -> Tile { + when board.visited is { + [] -> fail + [x, ..] -> x + } +} + pub fn delete_first(board: ChessSet) -> ChessSet { let ChessSet { move_number, visited, .. } = board @@ -64,71 +76,10 @@ pub fn is_square_free(board: ChessSet, tile: Tile) -> Bool { pub fn not_in(tiles: List, tile: a) -> Bool { !list.has(tiles, tile) } -// {-# INLINABLE createBoard #-} -// createBoard :: Integer -> Tile -> ChessSet -// createBoard x t = Board x 1 (Just t) [t] - -// {-# INLINABLE sizeBoard #-} -// sizeBoard :: ChessSet -> Integer -// sizeBoard (Board s _ _ _) = s - -// {-# INLINABLE noPieces #-} -// noPieces :: ChessSet -> Integer -// noPieces (Board _ n _ _) = n - -// {-# INLINABLE addPiece #-} -// addPiece :: Tile -> ChessSet -> ChessSet -// addPiece t (Board s n f ts) = Board s (n+1) f (t:ts) - -// -- % Remove the last element from a list -// {-# INLINABLE init #-} -// init :: [a] -> [a] -// init l = case reverse l of -// _:as -> reverse as -// [] -> Tx.error () - -// {-# INLINABLE secondLast #-} -// secondLast :: [a] -> Maybe a -// secondLast l = -// case reverse l of -// [] -> Tx.error () -// [_] -> Nothing -// _:a:_ -> Just a - -// {-% Note [deleteFirst]. -// deleteFirst removes the first position from the tour. -// Since the sequence of positions (ts) is stored in reverse this involves -// deleting the last element of ts and also storing the second-last element of -// ts as the new starting position. In the strict world this will *fail* if the -// length of ts is 1. The lazy version got away with this because the starting -// position is never examined in that case (possibly just through luck: with -// enough backtracking that might still happen). To solve this we have to store -// the starting position as a Maybe value, deferring any error until we actually -// look at it. -// %-} - -// {-# INLINABLE deleteFirst #-} -// deleteFirst :: ChessSet -> ChessSet -// deleteFirst (Board s n _ ts) = -// Board s (n-1) f' ts' -// where ts' = init ts -// f' = secondLast ts - // {-# INLINABLE positionPiece #-} // positionPiece :: Integer -> ChessSet -> Tile // positionPiece x (Board _ n _ ts) = ts Tx.!! (n - x) -// {-# INLINABLE lastPiece #-} -// lastPiece :: ChessSet -> Tile -// lastPiece (Board _ _ _ (t:_)) = t -// lastPiece _ = Tx.error () - -// {-# INLINABLE firstPiece #-} -// firstPiece :: ChessSet -> Tile -// firstPiece (Board _ _ f _) = -// case f of Just tile -> tile -// Nothing -> Tx.error () - // {-# INLINABLE pieceAtTile #-} // pieceAtTile :: Tile -> ChessSet -> Integer // pieceAtTile x0 (Board _ _ _ ts) @@ -139,15 +90,6 @@ pub fn not_in(tiles: List, tile: a) -> Bool { // | x == y = 1 + Tx.length xs // | otherwise = findPiece x xs -// {-# INLINABLE notIn #-} -// notIn :: Eq a => a -> [a] -> Bool -// notIn _ [] = True -// notIn x (a:as) = (x /= a) && (notIn x as) - -// {-# INLINABLE isSquareFree #-} -// isSquareFree :: Tile -> ChessSet -> Bool -// isSquareFree x (Board _ _ _ ts) = notIn x ts - // -- % Everything below here is only needed for printing boards. // -- % This is useful for debugging. diff --git a/examples/benchmarks/lib/benchmarks/knights/heuristic.ak b/examples/benchmarks/lib/benchmarks/knights/heuristic.ak index 37d27f22..9099b24a 100644 --- a/examples/benchmarks/lib/benchmarks/knights/heuristic.ak +++ b/examples/benchmarks/lib/benchmarks/knights/heuristic.ak @@ -1,7 +1,7 @@ use aiken/builtin use aiken/list use benchmarks/knights/chess_set.{ - add_piece, create_board, delete_first, first_piece, is_square_free, + add_piece, create_board, delete_first, first_piece, is_square_free, last_piece, } use benchmarks/knights/sort.{quick_sort} use benchmarks/knights/types.{ChessSet, Tile} @@ -17,6 +17,10 @@ type Direction { RD } +fn direction_list() { + [UL, UR, DL, DR, LU, LD, RU, RD] +} + fn move(direction: Direction, tile: Tile) -> Tile { let (x, y) = tile @@ -111,6 +115,10 @@ pub fn can_move_to(board: ChessSet, tile: Tile) -> Bool { } } +fn can_move(board: ChessSet, direction: Direction) -> Bool { + board |> can_move_to(move(direction, last_piece(board))) +} + pub fn all_descend(board: ChessSet) -> List { board |> possible_moves @@ -118,94 +126,9 @@ pub fn all_descend(board: ChessSet) -> List { } fn move_knight(board: ChessSet, direction: Direction) -> ChessSet { - todo + add_piece(board, move(direction, last_piece(board))) } fn possible_moves(board: ChessSet) -> List { - todo + direction_list() |> list.filter(fn(direction) { can_move(board, direction) }) } -// data Direction = UL | UR | DL |DR | LU | LD | RU | RD - -// {-# INLINABLE move #-} -// move :: Direction -> Tile -> Tile -// move UL (x,y) = (x-1,y-2) -// move UR (x,y) = (x+1,y-2) -// move DL (x,y) = (x-1,y+2) -// move DR (x,y) = (x+1,y+2) -// move LU (x,y) = (x-2,y-1) -// move LD (x,y) = (x-2,y+1) -// move RU (x,y) = (x+2,y-1) -// move RD (x,y) = (x+2,y+1) - -// {-# INLINABLE startTour #-} -// startTour :: Tile -> Integer -> ChessSet -// startTour st size -// | (size `Tx.remainder` 2) == 0 = createBoard size st -// | otherwise = {-Tx.trace "startTour" $ -} Tx.error () - -// {-# INLINABLE moveKnight #-} -// moveKnight :: ChessSet -> Direction -> ChessSet -// moveKnight board dir -// = addPiece (move dir (lastPiece board)) board - -// {-# INLINABLE canMove #-} -// canMove :: ChessSet -> Direction -> Bool -// canMove board dir -// = canMoveTo (move dir (lastPiece board)) board - -// {-# INLINABLE canMoveTo #-} -// canMoveTo :: Tile -> ChessSet -> Bool -// canMoveTo t@(x,y) board -// = (x Tx.>= 1) && (x Tx.<= sze) && -// (y Tx.>= 1) && (y Tx.<= sze) && -// isSquareFree t board -// where -// sze = sizeBoard board - -// {-# INLINABLE descendents #-} -// descendents :: ChessSet -> [ChessSet] -// descendents board = -// if (canJumpFirst board) && (deadEnd (addPiece (firstPiece board) board)) -// then [] -// else -// let l = Tx.length singles in -// if l == 0 then map snd (quickSort (descAndNo board)) -// else if l == 1 then singles -// else [] -- Going to be dead end -// where -// singles = singleDescend board - -// {-# INLINABLE singleDescend #-} -// singleDescend :: ChessSet -> [ChessSet] -// singleDescend board =[x | (y,x) <- descAndNo board, y==1] - -// {-# INLINABLE descAndNo #-} -// descAndNo :: ChessSet -> [(Integer,ChessSet)] -// descAndNo board -// = [(Tx.length (possibleMoves (deleteFirst x)),x) | x <- allDescend board] - -// {-# INLINABLE allDescend #-} -// allDescend :: ChessSet -> [ChessSet] -// allDescend board -// = map (moveKnight board) (possibleMoves board) - -// {-# INLINABLE possibleMoves #-} -// possibleMoves :: ChessSet -> [Direction] -// possibleMoves board -// =[x | x <- [UL,UR,DL,DR,LU,LD,RU,RD], (canMove board x)] - -// {-# INLINABLE deadEnd #-} -// deadEnd :: ChessSet -> Bool -// deadEnd board = (Tx.length (possibleMoves board)) == 0 - -// {-# INLINABLE canJumpFirst #-} -// canJumpFirst :: ChessSet -> Bool -// canJumpFirst board -// = canMoveTo (firstPiece board) (deleteFirst board) - -// {-# INLINABLE tourFinished #-} -// tourFinished :: ChessSet -> Bool -// tourFinished board -// = (noPieces board == (sze*sze)) && (canJumpFirst board) -// where -// sze = sizeBoard board