├── .gitignore ├── LICENSE ├── README.md ├── elm.json ├── example ├── EightPuzzle │ ├── Main.elm │ └── Search.elm ├── InfiniteLoop │ └── Main.elm ├── RiverCrossing.elm ├── RubiksCube │ └── Search.elm └── elm-package.json └── src └── Search.elm /.gitignore: -------------------------------------------------------------------------------- 1 | logs/* 2 | node_modules/ 3 | tmp 4 | .sass-cache 5 | .directory 6 | .idea 7 | app/ 8 | dist/ 9 | elm-stuff/ 10 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2018 The Sett Ltd. 2 | 3 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 4 | 5 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 6 | 7 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 8 | 9 | 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 10 | 11 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # AI-Search 2 | 3 | 'ai-search' is an Elm package that provides a suite of search functions in the 4 | Good Old Fashioned Artificial Intelligence (GOFAI) paradigm. See Part II on 5 | Searching in 'Artificial Intelligence a Modern Approach' published by Prentice 6 | Hall (http://aima.cs.berkeley.edu/) for a comprehensive guide to the theory. 7 | 8 | # Get started 9 | 10 | Example search problems can be found in the 'example/' folder. To run them in 11 | the Elm reactor: 12 | 13 | cd example 14 | elm-reactor 15 | 16 | ### More Searches that could be added to this package: 17 | 18 | Beam Search [https://en.wikipedia.org/wiki/Beam_search] 19 | 20 | B* [https://en.wikipedia.org/wiki/B*] 21 | 22 | SMA* [https://en.wikipedia.org/wiki/SMA*] 23 | 24 | Fringe Search [https://en.wikipedia.org/wiki/Fringe_search] 25 | -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "the-sett/ai-search", 4 | "summary": "AI Search for Elm", 5 | "license": "BSD-3-Clause", 6 | "version": "5.0.0", 7 | "exposed-modules": [ 8 | "Search" 9 | ], 10 | "elm-version": "0.19.0 <= v < 0.20.0", 11 | "dependencies": { 12 | "TSFoster/elm-heap": "2.1.1 <= v < 3.0.0", 13 | "elm/core": "1.0.0 <= v < 2.0.0" 14 | }, 15 | "test-dependencies": {} 16 | } -------------------------------------------------------------------------------- /example/EightPuzzle/Main.elm: -------------------------------------------------------------------------------- 1 | module EightPuzzle.Main exposing (main) 2 | 3 | import Array exposing (Array) 4 | import EightPuzzle.Search exposing (Previous(..), State, informed, start) 5 | import Html exposing (Html, div, text) 6 | import Random 7 | import Search exposing (SearchResult(..)) 8 | 9 | 10 | main = 11 | viewResult <| 12 | Search.nextN 50000 <| 13 | Search.iterativeDeepeningAStar 5 informed [ start 3 seed ] 14 | 15 | 16 | viewResult : SearchResult State -> Html Never 17 | viewResult result = 18 | case result of 19 | Complete -> 20 | text "Search space exhausted with no solution found." 21 | 22 | Goal state _ -> 23 | viewMoves state 24 | 25 | Ongoing state _ -> 26 | viewMoves state 27 | 28 | 29 | viewMoves : State -> Html Never 30 | viewMoves state = 31 | let 32 | previousMoves state = 33 | case state.previous of 34 | None -> 35 | [ Html.p [] [ stateToString state |> text ] ] 36 | 37 | Previous prevState -> 38 | Html.p [] [ stateToString state |> text ] :: previousMoves prevState 39 | in 40 | div [] (previousMoves state |> List.reverse) 41 | 42 | 43 | stateToString : State -> String 44 | stateToString state = 45 | (Array.toList state.board |> toString) 46 | ++ ", distance = " 47 | ++ toString state.distance 48 | ++ ", numMoves = " 49 | ++ toString state.numMoves 50 | ++ ", lastMove = " 51 | ++ toString state.lastMove 52 | 53 | 54 | seed = 55 | Random.initialSeed 120 56 | -------------------------------------------------------------------------------- /example/EightPuzzle/Search.elm: -------------------------------------------------------------------------------- 1 | module EightPuzzle.Search exposing (Previous(..), State, informed, start) 2 | 3 | {-| Constructs an informed search for the 8-puzzle family. 4 | 5 | The Manhatten Heuristic is used. 6 | Immediate move reversals are prevented (up then down, left then right...). 7 | 8 | Advanced heuristics such as linear conflict or admissable database heuristics 9 | are not implemented. Linear conflict at least is needed to solve 4x4 puzzles. 10 | 11 | An A\* search can be used, IDA\* will use less memory. 12 | 13 | -} 14 | 15 | import Array exposing (Array) 16 | import Lazy.List as LL 17 | import List.Extra exposing (elemIndex, swapAt, zip) 18 | import Random 19 | import Random.List 20 | import Search 21 | 22 | 23 | {-| The puzzles state 24 | -} 25 | type alias State = 26 | { board : Array Int -- Current board representation. 27 | , size : Int -- Board dimension (dimension x dimension). 28 | , emptyTile : Int -- Empty tile location. 29 | , distance : Int -- Manhattan distance of the entire board. 30 | , numMoves : Int -- Number of moves taken to get here. 31 | , lastMove : Maybe Direction -- The last move taken to get here. 32 | , previous : Previous -- The state just before this one. 33 | } 34 | 35 | 36 | type Previous 37 | = None 38 | | Previous State 39 | 40 | 41 | 42 | -- Functions for manipulating the board. 43 | 44 | 45 | xyToOffset : Int -> Int -> Int -> Int 46 | xyToOffset size x y = 47 | size * y + x 48 | 49 | 50 | offsetToXy : Int -> Int -> ( Int, Int ) 51 | offsetToXy size index = 52 | ( modBy size index, index // size ) 53 | 54 | 55 | {-| Gets the tile at the specified index from the board. 56 | -} 57 | getTileAtIndex : Int -> Array Int -> Int 58 | getTileAtIndex index board = 59 | Array.get index board |> Maybe.withDefault 0 60 | 61 | 62 | {-| Checks if a board is solvable. To be solvable: 63 | 64 | - The row number of the empty tile is calculated as `zeroRow` (row index starts from 1). 65 | - The number of pairs of tiles Ai and Aj such that i < j but Ai > Aj is calculated, as `numberOfInversions`. 66 | - `zeroRow + numberOfInversions` must be even. 67 | 68 | -} 69 | solvable : Int -> List Int -> Bool 70 | solvable size tiles = 71 | let 72 | zeroRow = 73 | 1 + Maybe.withDefault 0 (elemIndex 0 tiles) // size 74 | 75 | numberOfInversions = 76 | let 77 | tilesAndOffset = 78 | zip tiles (List.range 0 (size * size)) |> LL.fromList 79 | 80 | inversions = 81 | LL.product2 tilesAndOffset tilesAndOffset 82 | |> LL.keepIf 83 | (\( ( x, xi ), ( y, yi ) ) -> 84 | x /= 0 && y /= 0 && yi > xi && x > y 85 | ) 86 | in 87 | LL.length inversions 88 | in 89 | modBy 2 (zeroRow + numberOfInversions) == 0 90 | 91 | 92 | {-| Swaps the tile at the specified location with the empty tile, to produce a new 93 | puzzle state with its distance metric updated for the swap. 94 | -} 95 | swap : Int -> Int -> State -> State 96 | swap x y state = 97 | let 98 | index = 99 | xyToOffset state.size x y 100 | 101 | newBoard = 102 | Array.set state.emptyTile (getTileAtIndex index state.board) state.board 103 | |> Array.set index 0 104 | 105 | newDistance = 106 | state.distance 107 | - manhattan (getTileAtIndex index state.board) state.size index 108 | + manhattan (getTileAtIndex index state.board) state.size state.emptyTile 109 | in 110 | { state 111 | | board = newBoard 112 | , emptyTile = index 113 | , distance = newDistance 114 | } 115 | 116 | 117 | {-| Calculates the Manhattan distance of a specified tile at a specified location 118 | from its goal location. 119 | -} 120 | manhattan : Int -> Int -> Int -> Int 121 | manhattan tile size index = 122 | let 123 | ( x, y ) = 124 | offsetToXy size index 125 | 126 | ( tileX, tileY ) = 127 | offsetToXy size (tile - 1) 128 | 129 | xDistance = 130 | abs (x - tileX) 131 | 132 | yDistance = 133 | abs (y - tileY) 134 | in 135 | if tile == 0 then 136 | 0 137 | 138 | else 139 | xDistance + yDistance 140 | 141 | 142 | {-| Calculates the Manhattan distance of all tiles on the board to their goal positions. 143 | -} 144 | distance : Int -> List Int -> Int 145 | distance size board = 146 | List.indexedMap (\index -> \tile -> manhattan tile size index) board 147 | |> List.sum 148 | 149 | 150 | {-| Provides a shuffled board. 151 | Note: this board may not be solvable, additional checks are needed 152 | to see if it is solvable. 153 | -} 154 | shuffled : Int -> Random.Seed -> ( List Int, Random.Seed ) 155 | shuffled size seed = 156 | goalList size 157 | |> Random.List.shuffle 158 | |> (\b a -> Random.step a b) seed 159 | 160 | 161 | {-| Provides the goal state of the board. This consists of a list of integers numbered 162 | contiguously from zero up to the board size. 163 | -} 164 | goalList : Int -> List Int 165 | goalList size = 166 | List.range 0 (size * size - 1) 167 | 168 | 169 | {-| Provides a shuffled board that is also solvable. 170 | The puzzle state is set up from this with the correct size, empty tile position 171 | and distance metric. 172 | -} 173 | start : Int -> Random.Seed -> State 174 | start size seed = 175 | let 176 | solvableShuffle size seed = 177 | let 178 | ( try, newSeed ) = 179 | shuffled size seed 180 | in 181 | if solvable size try then 182 | try 183 | 184 | else 185 | solvableShuffle size newSeed 186 | 187 | board = 188 | solvableShuffle size seed 189 | in 190 | { board = Array.fromList <| board 191 | , size = size 192 | , emptyTile = elemIndex 0 board |> Maybe.withDefault 0 193 | , distance = distance size board 194 | , numMoves = 0 195 | , lastMove = Nothing 196 | , previous = None 197 | } 198 | 199 | 200 | 201 | -- Board operations and goal checks. 202 | 203 | 204 | type Direction 205 | = Up 206 | | Down 207 | | Left 208 | | Right 209 | 210 | 211 | directions : List Direction 212 | directions = 213 | [ Up, Down, Left, Right ] 214 | 215 | 216 | {-| Moves a tile on the board in the specified directon, and checks if the resulting 217 | board is the correct final state of the puzzle. 218 | 219 | - A tile cannot be moved off the edge of the board. 220 | - A tile will be moved into the empty position only, tiles cannot be swapped 221 | with other tiles. 222 | - A tile will not be moved back into the position it was in the previous board 223 | state, eliminating the worst source of repeated board states. 224 | 225 | -} 226 | move : Direction -> State -> Maybe ( State, Bool ) 227 | move direction state = 228 | let 229 | ( x, y ) = 230 | offsetToXy state.size state.emptyTile 231 | 232 | previousMoveIs direction state = 233 | state.lastMove == Just direction 234 | 235 | maybeState = 236 | case direction of 237 | Up -> 238 | if x <= 0 || previousMoveIs Down state then 239 | Nothing 240 | 241 | else 242 | Just <| swap (x - 1) y state 243 | 244 | Right -> 245 | if y >= state.size - 1 || previousMoveIs Left state then 246 | Nothing 247 | 248 | else 249 | Just <| swap x (y + 1) state 250 | 251 | Down -> 252 | if x >= state.size - 1 || previousMoveIs Up state then 253 | Nothing 254 | 255 | else 256 | Just <| swap (x + 1) y state 257 | 258 | Left -> 259 | if y <= 0 || previousMoveIs Right state then 260 | Nothing 261 | 262 | else 263 | Just <| swap x (y - 1) state 264 | in 265 | maybeState 266 | |> Maybe.andThen 267 | (\newState -> 268 | Just 269 | ( { newState 270 | | lastMove = Just direction 271 | , previous = Previous state 272 | , numMoves = state.numMoves + 1 273 | } 274 | , goal newState 275 | ) 276 | ) 277 | 278 | 279 | {-| Checks if all the tiles are in the correct position. 280 | -} 281 | goal : State -> Bool 282 | goal state = 283 | state.distance == 0 284 | 285 | 286 | {-| Produces a list of new board positions that are 1 step away from the specified state, 287 | by trying to apply all of the possible moves. 288 | -} 289 | step : Search.Step State 290 | step node = 291 | List.filterMap (\direction -> move direction node) 292 | directions 293 | 294 | 295 | {-| Packages the search operators as an informed search. 296 | -} 297 | informed : Search.Informed State 298 | informed = 299 | { step = step 300 | , cost = \state -> toFloat state.numMoves 301 | , heuristic = \state -> toFloat state.distance 302 | } 303 | -------------------------------------------------------------------------------- /example/InfiniteLoop/Main.elm: -------------------------------------------------------------------------------- 1 | module Main exposing (Model, Msg(..), State, init, main, step, uninformed, update, view) 2 | 3 | import Html exposing (button, div, text) 4 | import Html.Events exposing (onClick) 5 | import Search 6 | import Time exposing (Time) 7 | 8 | 9 | type alias Model = 10 | { state : State 11 | , running : Bool 12 | , startTime : Int 13 | , endTime : Int 14 | } 15 | 16 | 17 | type Msg 18 | = Run 19 | | Pause 20 | | StartTime Time 21 | | EndTime Time 22 | 23 | 24 | init = 25 | ( { state = 0 26 | , running = False 27 | , startTime = 0 28 | , endTime = 0 29 | } 30 | , Cmd.none 31 | ) 32 | 33 | 34 | update : Msg -> Model -> ( Model, Cmd Msg ) 35 | update msg model = 36 | case Debug.log "update" msg of 37 | Run -> 38 | ( model, Cmd.none ) 39 | 40 | Pause -> 41 | ( model, Cmd.none ) 42 | 43 | StartTime time -> 44 | ( model, Cmd.none ) 45 | 46 | EndTime time -> 47 | ( model, Cmd.none ) 48 | 49 | 50 | main = 51 | Html.program 52 | { init = init 53 | , update = update 54 | , subscriptions = \_ -> Sub.none 55 | , view = view 56 | } 57 | 58 | 59 | view model = 60 | div [] 61 | [ if model.running then 62 | button [ onClick Pause ] [ text "pause" ] 63 | 64 | else 65 | button [ onClick Run ] [ text "start" ] 66 | , text (toString model.state) 67 | ] 68 | 69 | 70 | 71 | -- An infinite looping search space, just incremenets a counter. 72 | 73 | 74 | type alias State = 75 | Int 76 | 77 | 78 | step : Search.Step State 79 | step state = 80 | [ ( state + 1, False ) ] 81 | 82 | 83 | {-| Packages the infinite loop as an uninformed search. 84 | -} 85 | uninformed : Search.Uninformed State 86 | uninformed = 87 | { step = step 88 | , cost = \_ -> 1.0 89 | } 90 | -------------------------------------------------------------------------------- /example/RiverCrossing.elm: -------------------------------------------------------------------------------- 1 | module RiverCrossing exposing (start, uninformed) 2 | 3 | import EveryDict as Dict exposing (EveryDict) 4 | import Html exposing (text) 5 | import Maybe.Extra 6 | import Search 7 | 8 | 9 | main = 10 | text <| 11 | toString <| 12 | Search.nextN 250 <| 13 | Search.iterativeDeepening 1 uninformed [ start ] 14 | 15 | 16 | 17 | {- Description of the puzzles state. -} 18 | 19 | 20 | type Character 21 | = Farmer 22 | | Wolf 23 | | Goat 24 | | Cabbage 25 | 26 | 27 | type Position 28 | = West 29 | | East 30 | 31 | 32 | type alias State = 33 | EveryDict Character Position 34 | 35 | 36 | characters : List Character 37 | characters = 38 | [ Farmer, Wolf, Goat, Cabbage ] 39 | 40 | 41 | start : State 42 | start = 43 | Dict.empty 44 | |> Dict.insert Farmer West 45 | |> Dict.insert Wolf West 46 | |> Dict.insert Goat West 47 | |> Dict.insert Cabbage West 48 | 49 | 50 | {-| Flips a position between east and west. 51 | -} 52 | switch position = 53 | case position of 54 | East -> 55 | West 56 | 57 | West -> 58 | East 59 | 60 | 61 | {-| Moves the specified character to the opposite bank. 62 | 63 | - The farmer must always be in the boat for the move, so moving a non-farmer 64 | will automatically include the farmer in the move. 65 | - When moving a non-farmer the farmer must be on the same side as the thing 66 | being moved, or else the boat will not be there to make the move. 67 | - States resulting in the goat or cabbage being eaten will result in Nothing. 68 | - The goal state where all are on the West bank will be marked as succesfull. 69 | 70 | -} 71 | move : Character -> State -> Maybe ( State, Bool ) 72 | move character state = 73 | let 74 | nextState = 75 | if character == Farmer then 76 | Dict.update Farmer (Maybe.map switch) state |> Just 77 | 78 | else 79 | let 80 | farmerPos = 81 | Dict.get Farmer state 82 | 83 | characterPos = 84 | Dict.get character state 85 | in 86 | if farmerPos == characterPos then 87 | Just <| 88 | Dict.update Farmer (Maybe.map switch) <| 89 | Dict.update character (Maybe.map switch) state 90 | 91 | else 92 | Nothing 93 | in 94 | Maybe.Extra.filter (not << illegal) nextState 95 | |> Maybe.andThen (\state -> Just ( state, goal state )) 96 | 97 | 98 | {-| Checks if a state results in the goat or cabbage being eaten. 99 | -} 100 | illegal : State -> Bool 101 | illegal state = 102 | let 103 | farmerFlip = 104 | Maybe.map switch <| Dict.get Farmer state 105 | 106 | wolf = 107 | Dict.get Wolf state 108 | 109 | goat = 110 | Dict.get Goat state 111 | 112 | cabbage = 113 | Dict.get Cabbage state 114 | in 115 | (farmerFlip == wolf && farmerFlip == goat) 116 | || (farmerFlip == goat && farmerFlip == cabbage) 117 | 118 | 119 | {-| Checks if a state matches the goal of everthing safely on the East bank. 120 | -} 121 | goal : State -> Bool 122 | goal state = 123 | List.foldl (\character result -> (Dict.get character state == Just East) && result) True characters 124 | 125 | 126 | {-| Produces new states from a given state, by attempting to move each of the 127 | characters in turn to see if that produces a valid new state. 128 | -} 129 | step : Search.Step State 130 | step node = 131 | List.filterMap (\character -> move character node) 132 | characters 133 | 134 | 135 | {-| Packages the search as an uninformed search. 136 | -} 137 | uninformed : Search.Uninformed State 138 | uninformed = 139 | { step = step 140 | , cost = \_ -> 1.0 141 | } 142 | -------------------------------------------------------------------------------- /example/RubiksCube/Search.elm: -------------------------------------------------------------------------------- 1 | module Search exposing (Previous(..), State, informed, start) 2 | 3 | 4 | dummay = 5 | "value" 6 | -------------------------------------------------------------------------------- /example/elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "3.1.0", 3 | "summary": "AI Search for Elm", 4 | "repository": "https://github.com/the-sett/ai-search.git", 5 | "license": "BSD", 6 | "source-directories": [ 7 | ".", 8 | "../src" 9 | ], 10 | "exposed-modules": [], 11 | "dependencies": { 12 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 13 | "elm-lang/html": "2.0.0 <= v < 3.0.0", 14 | "elm-community/lazy-list": "1.0.0 <= v < 2.0.0", 15 | "elm-community/maybe-extra": "3.0.0 <= v < 4.0.0", 16 | "elm-community/random-extra": "2.0.0 <= v < 3.0.0", 17 | "elm-community/list-extra": "6.1.0 <= v < 7.0.0", 18 | "eeue56/elm-all-dict": "2.0.1 <= v < 3.0.0", 19 | "TSFoster/elm-heap": "2.1.0 <= v < 3.0.0" 20 | }, 21 | "elm-version": "0.18.0 <= v < 0.19.0" 22 | } 23 | -------------------------------------------------------------------------------- /src/Search.elm: -------------------------------------------------------------------------------- 1 | module Search exposing 2 | ( Step, Uninformed, Informed, WithUninformed 3 | , SearchResult(..) 4 | , next, nextN, nextGoal 5 | , breadthFirst, depthFirst, depthBounded, costBounded, uniformCost 6 | , iterativeDeepening, iterativeCostIncreasing 7 | , aStar, greedy, fBounded, iterativeDeepeningAStar 8 | ) 9 | 10 | {-| 11 | 12 | 13 | # Input types for searches: 14 | 15 | @docs Step, Uninformed, Informed, WithUninformed 16 | 17 | 18 | # The search output type: 19 | 20 | @docs SearchResult 21 | 22 | 23 | # Helper functions for iterating searches to produce results: 24 | 25 | @docs next, nextN, nextGoal 26 | 27 | 28 | # Uninformed search strategies: 29 | 30 | @docs breadthFirst, depthFirst, depthBounded, costBounded, uniformCost 31 | @docs iterativeDeepening, iterativeCostIncreasing 32 | 33 | 34 | # Informed search strategies: 35 | 36 | @docs aStar, greedy, fBounded, iterativeDeepeningAStar 37 | 38 | -} 39 | 40 | import Heap exposing (Heap) 41 | 42 | 43 | {-| Defines the type of Nodes that searches work over. 44 | -} 45 | type alias Node state = 46 | ( state, Bool, Int ) 47 | 48 | 49 | {-| Defines the possible outcomes of a search. A search may produce the following 50 | results: 51 | 52 | - Complete. The search space has been exhausted without finding a goal state. 53 | - Goal. A goal state has been found. A function to find further results is also 54 | returned, in order that the search may be continued to find more goals. 55 | - Ongoing. A goal state has not been found yet. The state most recently examined 56 | is returned along with a function to continue to the search. 57 | 58 | -} 59 | type SearchResult state 60 | = Complete 61 | | Goal state (() -> SearchResult state) 62 | | Ongoing state (() -> SearchResult state) 63 | 64 | 65 | {-| Defines the type of the step function that produces new states from existing 66 | ones. This is how the graph over the search space is defined. The step function 67 | takes a state and provides a list of other states that can be reached from it. 68 | Each of the listed states is paired with a Bool that when true indiciates that 69 | a state is considered to be a goal of the search. 70 | -} 71 | type alias Step state = 72 | state -> List ( state, Bool ) 73 | 74 | 75 | {-| Defines the type of a bundle of operators that need to be supplied to conduct 76 | an informed (heuristic) search, as an extensible record. 77 | -} 78 | type alias WithHeuristic a state = 79 | { a | heuristic : state -> Float } 80 | 81 | 82 | {-| Defines the type of a bundle of operators that need to be supplied to conduct 83 | an uninformed (non-heuristic) search. 84 | -} 85 | type alias Uninformed state = 86 | { step : Step state 87 | , cost : state -> Float 88 | } 89 | 90 | 91 | {-| Defines the type of a bundle of operators that need to be supplied to conduct 92 | an informed (heuristic) search. 93 | -} 94 | type alias Informed state = 95 | { step : Step state 96 | , cost : state -> Float 97 | , heuristic : state -> Float 98 | } 99 | 100 | 101 | {-| Defines the type of a bundle of operators that need to be supplied to conduct 102 | an uninformed (non-heuristic) search. This is an extensible record so that 103 | heuristic searches can also have this type since they use the same cost and step 104 | functions. This makes it easy to switch from a heuristic to anon-heuristic search. 105 | -} 106 | type alias WithUninformed a state = 107 | { a 108 | | step : Step state 109 | , cost : state -> Float 110 | } 111 | 112 | 113 | {-| Defines the type of a function that compares two states and orders them. 114 | -} 115 | type alias Compare state = 116 | state -> state -> Order 117 | 118 | 119 | {-| Defines the type of a function that checks if some limit is reached on a 120 | search node. The most common limit is depth, but other limits are possible. 121 | The first argument is an Int, and will be passed the iteration numbered from 122 | zero, when performing an iterative search. For bounds that do not iteratively 123 | increase, this can be ignored. 124 | -} 125 | type alias Limit state = 126 | Int -> Node state -> Bool 127 | 128 | 129 | {-| Defines the operations needed on state buffers that hold the pending search 130 | states. 131 | -} 132 | type alias Buffer state buffer = 133 | { orelse : Node state -> buffer -> buffer 134 | , head : buffer -> Maybe ( Node state, buffer ) 135 | , init : List (Node state) -> buffer 136 | } 137 | 138 | 139 | {-| This utility function is used to convert a comparison over states into a 140 | comparison over search nodes. 141 | -} 142 | nodeCompare : Compare state -> Node state -> Node state -> Order 143 | nodeCompare compare ( state1, _, _ ) ( state2, _, _ ) = 144 | compare state1 state2 145 | 146 | 147 | {-| Converts a list of states into search Nodes. 148 | 149 | It is assumed that the start states are always at depth 0. 150 | 151 | -} 152 | makeStartNodes : List ( state, Bool ) -> List (Node state) 153 | makeStartNodes start = 154 | List.map (\( state, goal ) -> ( state, goal, 0 )) start 155 | 156 | 157 | {-| Performs an uninformed search. 158 | -} 159 | search : 160 | Buffer state buffer 161 | -> WithUninformed a state 162 | -> Maybe (Limit state) 163 | -> Int 164 | -> List ( state, Bool ) 165 | -> SearchResult state 166 | search buffer uninformed maybeLimit iteration start = 167 | let 168 | step = 169 | uninformed.step 170 | 171 | examineHead : buffer -> SearchResult state 172 | examineHead queue = 173 | let 174 | expand depth state expandQueue = 175 | \() -> 176 | examineHead <| 177 | List.foldl (\( nextState, isGoal ) remQueue -> buffer.orelse ( nextState, isGoal, depth + 1 ) remQueue) expandQueue (step state) 178 | 179 | notExpand expandQueue = 180 | \() -> examineHead expandQueue 181 | in 182 | case buffer.head queue of 183 | Nothing -> 184 | Complete 185 | 186 | Just ( headNode, pendingStates ) -> 187 | let 188 | nextStep state depth = 189 | case maybeLimit of 190 | Nothing -> 191 | expand depth state pendingStates 192 | 193 | Just limit -> 194 | if limit iteration ( state, False, depth ) then 195 | notExpand pendingStates 196 | 197 | else 198 | expand depth state pendingStates 199 | in 200 | case headNode of 201 | ( state, True, depth ) -> 202 | Goal state <| nextStep state depth 203 | 204 | ( state, False, depth ) -> 205 | Ongoing state <| nextStep state depth 206 | in 207 | examineHead <| buffer.init (makeStartNodes start) 208 | 209 | 210 | {-| Performs an uninformed and unbounded search. 211 | -} 212 | unboundedSearch : 213 | Buffer state buffer 214 | -> WithUninformed a state 215 | -> List ( state, Bool ) 216 | -> SearchResult state 217 | unboundedSearch buffer uninformed = 218 | search buffer uninformed Nothing 0 219 | 220 | 221 | {-| Performs an ordered search. 222 | -} 223 | orderedSearch : 224 | (WithUninformed a state -> Compare state) 225 | -> WithUninformed a state 226 | -> Maybe (Limit state) 227 | -> List ( state, Bool ) 228 | -> SearchResult state 229 | orderedSearch comparison basicSearch maybeLimit = 230 | search (ordered <| comparison basicSearch) basicSearch maybeLimit 0 231 | 232 | 233 | {-| Performs an ordered and unbounded search. 234 | -} 235 | unboundedOrderedSearch : 236 | (WithUninformed a state -> Compare state) 237 | -> WithUninformed a state 238 | -> List ( state, Bool ) 239 | -> SearchResult state 240 | unboundedOrderedSearch comparison basicSearch = 241 | search (ordered <| comparison basicSearch) basicSearch Nothing 0 242 | 243 | 244 | {-| Performs an iterative search. Every time the search reaches Complete 245 | (due to the specified limit being reach), a new search is started from the 246 | beginning at the next iteration. 247 | -} 248 | iterativeSearch : 249 | Buffer state buffer 250 | -> WithUninformed a state 251 | -> Limit state 252 | -> List ( state, Bool ) 253 | -> SearchResult state 254 | iterativeSearch buffer basicSearch limit start = 255 | let 256 | iteration count = 257 | evaluate count (search buffer basicSearch (Just limit) count start) 258 | 259 | evaluate : Int -> SearchResult state -> SearchResult state 260 | evaluate count result = 261 | case result of 262 | Complete -> 263 | iteration (count + 1) 264 | 265 | Goal state cont -> 266 | Goal state cont 267 | 268 | Ongoing state cont -> 269 | Ongoing state (\() -> evaluate count (cont ())) 270 | in 271 | iteration 0 272 | 273 | 274 | {-| Implements a first-in first-out buffer using Lists. 275 | -} 276 | fifo : Buffer state (List (Node state)) 277 | fifo = 278 | { orelse = \node list -> node :: list 279 | , head = 280 | \list -> 281 | case list of 282 | [] -> 283 | Nothing 284 | 285 | x :: xs -> 286 | Just ( x, xs ) 287 | , init = \list -> list 288 | } 289 | 290 | 291 | {-| Implements a last-in first-out buffer using Lists and appending at to the end. 292 | -} 293 | lifo : Buffer state (List (Node state)) 294 | lifo = 295 | { fifo 296 | | orelse = \node list -> list ++ [ node ] 297 | } 298 | 299 | 300 | {-| Implements an order buffer using a heap. A state comparison function is 301 | supplied to construct the buffer on. 302 | -} 303 | ordered : Compare state -> Buffer state (Heap (Node state)) 304 | ordered compare = 305 | { orelse = \node heap -> Heap.push node heap 306 | , head = \heap -> Heap.pop heap 307 | , init = \list -> Heap.fromList (Heap.smallest |> Heap.using (nodeCompare compare)) list 308 | } 309 | 310 | 311 | compareH : Informed state -> Compare state 312 | compareH informed = 313 | \state1 state2 -> 314 | compare (informed.heuristic state1) (informed.heuristic state2) 315 | 316 | 317 | compareC : WithUninformed a state -> Compare state 318 | compareC informed = 319 | \state1 state2 -> 320 | compare (informed.cost state1) (informed.cost state2) 321 | 322 | 323 | compareF : Informed state -> Compare state 324 | compareF informed = 325 | \state1 state2 -> 326 | compare 327 | (informed.heuristic state1 + informed.cost state1) 328 | (informed.heuristic state2 + informed.cost state2) 329 | 330 | 331 | {-| Performs an unbounded depth first search. Depth first searches can easily 332 | fall into infinite loops. 333 | -} 334 | depthFirst : WithUninformed a state -> List ( state, Bool ) -> SearchResult state 335 | depthFirst = 336 | unboundedSearch fifo 337 | 338 | 339 | {-| Performs an unbounded breadth first search. Breadth first searches store 340 | a lot of pending nodes in the buffer, so quickly run out of space. 341 | -} 342 | breadthFirst : WithUninformed a state -> List ( state, Bool ) -> SearchResult state 343 | breadthFirst = 344 | unboundedSearch lifo 345 | 346 | 347 | {-| Performs an A\* search. This is one that always follows the search node that 348 | has the highest f value (f = heuristic + cost). 349 | The seach will only be optimal if the heuristic function is monotonic. 350 | -} 351 | aStar : Informed state -> List ( state, Bool ) -> SearchResult state 352 | aStar = 353 | unboundedOrderedSearch compareF 354 | 355 | 356 | {-| Performs a greedy heuristic search. This is one that always follows the 357 | search node that has the highest h value (h = heuristic). 358 | -} 359 | greedy : Informed state -> List ( state, Bool ) -> SearchResult state 360 | greedy = 361 | unboundedOrderedSearch compareH 362 | 363 | 364 | {-| Performs a uniform-cost search. This always follows the search node that 365 | has the lowest path cost. It is called a uniform cost search because the 366 | boundary of the search will have a roughly uniform cost as the search 367 | space is searched by increasing cost. 368 | -} 369 | uniformCost : WithUninformed a state -> List ( state, Bool ) -> SearchResult state 370 | uniformCost = 371 | unboundedOrderedSearch compareC 372 | 373 | 374 | {-| Implements a depth limit on search nodes. This is a fixed limit, not iterative. 375 | -} 376 | depthLimit : Int -> Limit state 377 | depthLimit maxDepth _ ( _, _, depth ) = 378 | depth >= maxDepth 379 | 380 | 381 | {-| Implements a cost limit on search nodes for basic searches. This is a fixed 382 | limit, not iterative. 383 | -} 384 | costLimit : WithUninformed a state -> Float -> Limit state 385 | costLimit basicSearch maxCost _ ( state, _, _ ) = 386 | basicSearch.cost state >= maxCost 387 | 388 | 389 | {-| Implements an f-limit on search nodes for heuristic searches (f = cost + heuristic). 390 | This is a fixed limit, not iterative. 391 | -} 392 | fLimit : Informed state -> Float -> Limit state 393 | fLimit informed maxF _ ( state, _, _ ) = 394 | informed.heuristic state + informed.cost state >= maxF 395 | 396 | 397 | {-| Implements an uninformed search that is bounded to a specified maximum depth. 398 | -} 399 | depthBounded : WithUninformed a state -> Int -> List ( state, Bool ) -> SearchResult state 400 | depthBounded basicSearch maxDepth = 401 | search fifo basicSearch (Just <| depthLimit maxDepth) 0 402 | 403 | 404 | {-| Implements a cost bounded search. This search will proceed depth first. 405 | -} 406 | costBounded : WithUninformed a state -> Float -> List ( state, Bool ) -> SearchResult state 407 | costBounded basicSearch maxCost = 408 | search fifo basicSearch (Just <| costLimit basicSearch maxCost) 0 409 | 410 | 411 | {-| Implements an f value (f = heuristic + cost) bounded search. This search will 412 | proceed depth first. 413 | -} 414 | fBounded : Informed state -> Float -> List ( state, Bool ) -> SearchResult state 415 | fBounded informed maxF = 416 | search fifo informed (Just <| fLimit informed maxF) 0 417 | 418 | 419 | {-| Implements a depth limit on search nodes. This is an iterative limit. The 420 | iteration number is multiplied by a specified multiple to calculate the 421 | maximum depth allowed at a given iteration. 422 | -} 423 | iterativeDepthLimit : Int -> Limit state 424 | iterativeDepthLimit multiple iteration ( _, _, depth ) = 425 | depth >= (iteration + 1) * multiple 426 | 427 | 428 | {-| Implements a cost limit on search nodes for basic searches. This is an 429 | iterative limit. The iteration number is multiplied by a specified multiple 430 | to calculate the maximum cost allowed at a given iteration. 431 | -} 432 | iterativeCostLimit : WithUninformed a state -> Float -> Limit state 433 | iterativeCostLimit basicSearch multiple iteration ( state, _, _ ) = 434 | basicSearch.cost state >= toFloat (iteration + 1) * multiple 435 | 436 | 437 | {-| Implements an f-limit on search nodes for basic searches (f = cost + heuristic). 438 | This is an iterative limit. The iteration number is multiplied by a specified multiple 439 | to calculate the maximum cost allowed at a given iteration. 440 | -} 441 | iterativeFLimit : Informed state -> Float -> Limit state 442 | iterativeFLimit informed multiple iteration ( state, _, _ ) = 443 | informed.heuristic state + informed.cost state >= toFloat (iteration + 1) * multiple 444 | 445 | 446 | {-| Implements an iterative deepening search. This search proceed depth first 447 | but repeats at progressively larger depth limits. The iteration number is 448 | multiplied by a specified multiple to calculate the maximum depth allowed 449 | at a given iteration. 450 | -} 451 | iterativeDeepening : Int -> WithUninformed a state -> List ( state, Bool ) -> SearchResult state 452 | iterativeDeepening multiple basicSearch = 453 | iterativeSearch fifo basicSearch (iterativeDepthLimit multiple) 454 | 455 | 456 | {-| Implements an iterative cost increasing search. This search proceed depth first 457 | but repeats at progressively larger cost limits. The iteration number is 458 | multiplied by a specified multiple to calculate the maximum cost allowed 459 | at a given iteration. 460 | -} 461 | iterativeCostIncreasing : Float -> WithUninformed a state -> List ( state, Bool ) -> SearchResult state 462 | iterativeCostIncreasing multiple basicSearch = 463 | iterativeSearch fifo basicSearch (iterativeCostLimit basicSearch multiple) 464 | 465 | 466 | {-| Implements an iterative deepding A-star search. This search proceed depth 467 | first but repeats at progressively larger f-limits (f = cost + heuristic). The 468 | iteration number is multiplied by a specified multiple to calculate the maximum 469 | cost allowed at a given iteration. 470 | 471 | Like the A-star search, this search will find the optimal soluation given an 472 | admissable heuristic. As this search progresses depth first rather than sleecting 473 | the most promising nodes to follow, its memory requirements are lower than A-star. 474 | 475 | Note that to find the optimal solution, the search will need to be run until it 476 | completes an entire iteration, as when progressing depth first a less than optimal 477 | solution may be found first within the current iteration. There is currently no way 478 | to signal the completion of an iteration. 479 | 480 | -} 481 | iterativeDeepeningAStar : Float -> Informed state -> List ( state, Bool ) -> SearchResult state 482 | iterativeDeepeningAStar multiple informed = 483 | iterativeSearch fifo informed (iterativeFLimit informed multiple) 484 | 485 | 486 | 487 | -- ida-star 488 | 489 | 490 | {-| Steps a search result, to produce the next result. 491 | 492 | - The result of this function may be an Ongoing search. This will provide the 493 | current head search node and a continuation to run the remainder of the search. 494 | 495 | -} 496 | next : SearchResult state -> SearchResult state 497 | next result = 498 | case result of 499 | Complete -> 500 | Complete 501 | 502 | Goal state cont -> 503 | cont () 504 | 505 | Ongoing _ cont -> 506 | cont () 507 | 508 | 509 | {-| Continues a search result, to produce the next search goal up to a limited 510 | number of iterations. 511 | 512 | - This function will recursively apply the search until either a Goal state 513 | is found or the walk over the search space is Complete, or the iteration 514 | count is exhausted in which case an Ongoing search may be returned. 515 | 516 | -} 517 | nextN : Int -> SearchResult state -> SearchResult state 518 | nextN count result = 519 | case result of 520 | Complete -> 521 | Complete 522 | 523 | Goal state cont -> 524 | Goal state cont 525 | 526 | Ongoing _ cont -> 527 | if count > 0 then 528 | cont () |> nextN (count - 1) 529 | 530 | else 531 | cont () 532 | 533 | 534 | {-| Continues a search result, to produce the next search goal. 535 | 536 | - The result of this function will never be an Ongoing search. This 537 | function will recursively apply the search until either a Goal state is 538 | found or the walk over the search space is Complete. 539 | - If the search is insufficiently constrained and no goal can ever be found, 540 | this function may infnite loop. 541 | 542 | -} 543 | nextGoal : SearchResult state -> SearchResult state 544 | nextGoal result = 545 | case result of 546 | Complete -> 547 | Complete 548 | 549 | Goal state cont -> 550 | Goal state cont 551 | 552 | Ongoing _ cont -> 553 | cont () |> nextGoal 554 | --------------------------------------------------------------------------------