diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,7 @@ +# Changelog for jps + +## 0.1.0.0 -- 2018-08-19 + +* First version. Released on an unsuspecting world. + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * 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. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +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 +OWNER 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,33 @@ +# jps -- jump point search for Haskell + +[![Build Status](https://travis-ci.org/isovector/jps.svg?branch=master)](https://travis-ci.org/isovector/jps) | [Hackage][hackage] + +[hackage]: https://hackage.haskell.org/package/jps + +## Dedication + +> People take the longest possible paths, digress to numerous dead ends, and +> make all kinds of mistakes.Then historians come along and write summaries of +> this messy, nonlinear process and make it appear like a simple, straight line. +> +> Dean Kamen + + +## Overview + +Jump point search is a variant of A* that cuts down on the search space by +assuming you always want to continue in a straight line. As such, it runs +remarkably faster on graphs that are mostly open. + +For a fantastic introduction to how the algorithm works, check out [zerowidth +positive lookahead][jps]'s excellent explanation. + +[jps]: https://zerowidth.com/2013/05/05/jump-point-search-explained.html + +`jps` is a Haskell implementation of jump point search. It was originally +written by [Zachary Kamerling][zachary] and is maintained by [Sandy +Maguire][isovector]. + +[zachary]: https://github.com/ZacharyKamerling +[isovector]: https://github.com/isovector + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/jps.cabal b/jps.cabal new file mode 100644 --- /dev/null +++ b/jps.cabal @@ -0,0 +1,42 @@ +-- This file has been generated from package.yaml by hpack version 0.28.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 11eda881f0f345015205d0969b2080ac0c0c4175b11f5f6cd62da3bb407bfa7e + +name: jps +version: 0.1.0.0 +synopsis: Jump point search for Haskell +description: Please see the README on GitHub at +category: Algorithm +homepage: https://github.com/isovector/jps#readme +bug-reports: https://github.com/isovector/jps/issues +author: Zachary Kamerling +maintainer: Sandy Maguire +copyright: 2018 Zachary Kamerling +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 +extra-source-files: + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/isovector/jps + +library + exposed-modules: + Algorithm.Search.JumpPoint + other-modules: + Algorithm.Search.JumpPoint.Pathing + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + , containers + , fingertree + , lens + , vector + default-language: Haskell2010 diff --git a/src/Algorithm/Search/JumpPoint.hs b/src/Algorithm/Search/JumpPoint.hs new file mode 100644 --- /dev/null +++ b/src/Algorithm/Search/JumpPoint.hs @@ -0,0 +1,266 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} + +module Algorithm.Search.JumpPoint + ( JumpGrid () + , Point + , make + , closeArea + , openArea + , findPath + , isTileOpen + ) where + +import Algorithm.Search.JumpPoint.Pathing (Point, Direction(..)) +import qualified Algorithm.Search.JumpPoint.Pathing as P +import Control.Lens +#if !(MIN_VERSION_base(4,11,1)) +import Data.Semigroup +#endif +import Data.Vector (Vector) +import qualified Data.Vector as V +import Data.Word (Word16) + +{- +16 bits should be enough to encode the distance of any jump. +If you want a map larger than 65536x65536 you have a problem. +A value of 0 means there is no jump from that point. +-} +data Jumps = Jumps + { _nJumpDist :: {-# UNPACK #-} !Word16 + , _eJumpDist :: {-# UNPACK #-} !Word16 + , _sJumpDist :: {-# UNPACK #-} !Word16 + , _wJumpDist :: {-# UNPACK #-} !Word16 + } + +makeLenses ''Jumps + +instance Semigroup Jumps where + Jumps na ea sa wa <> Jumps nb eb sb wb = + Jumps (na + nb) + (ea + eb) + (sa + sb) + (wa + wb) + + +instance Monoid Jumps where + mempty = Jumps 0 0 0 0 + mappend = (<>) + + +------------------------------------------------------------------------------ +-- | The pathfinding grid. +data JumpGrid = JumpGrid + { jgWidth :: {-# UNPACK #-} !Int -- Width + , jgHeight :: {-# UNPACK #-} !Int -- Height + , jgTiles :: {-# UNPACK #-} !(Vector Bool) -- indexed by (y * w + x) + , jgJumps :: {-# UNPACK #-} !(Vector Jumps) -- indexed by (y * w + x) + } + +data JumpChange = JumpChange + !Direction + !Word16 + !(Int, Int) + + +------------------------------------------------------------------------------ +-- | Creates a 'JumpGrid' with all nodes open. +make + :: Int -- ^ Grid width + -> Int -- ^ Grid height + -> JumpGrid +make w h = JumpGrid w h vec jumps + where + jumps = V.replicate (w * h) mempty + vec = V.replicate (w * h) True + + +------------------------------------------------------------------------------ +-- | Close a square defined by two points on the 'JumpGrid'. +closeArea + :: Point -- ^ First point + -> Point -- ^ Second point + -> JumpGrid + -> JumpGrid +closeArea = changeArea False + + +------------------------------------------------------------------------------ +-- | Open a square defined by two points on the 'JumpGrid'. +openArea + :: Point -- ^ First point + -> Point -- ^ Second point + -> JumpGrid + -> JumpGrid +openArea = changeArea True + + +------------------------------------------------------------------------------ +-- | Attempt to pathfind over a 'JumpGrid'. +findPath + :: JumpGrid -- ^ Grid + -> Point -- ^ Source location + -> Point -- ^ Destination location + -> Maybe [Point] +findPath jg start goal = P.jpsPath (isTileOpen jg) (readJumpSafe jg) start goal + + +------------------------------------------------------------------------------ +-- | Returns 'True' iff a point on the grid is open. +isTileOpen + :: JumpGrid + -> Point + -> Bool +isTileOpen jg xy = + if isDefinedOn jg xy then + V.unsafeIndex (jgTiles jg) $ indexOf jg xy + else + False + + +readTranslateJumpSafe :: JumpGrid -> Direction -> Point -> Word16 -> Maybe Point +readTranslateJumpSafe jg dir xy n = + if isDefinedOn jg xy then + if n > 0 then + let jump = P.translate (fromIntegral n) dir xy in + if isDefinedOn jg jump then + Just jump + else + Nothing + -- error $ "readTranslateJumpSafe: Bad jump from " ++ show xy ++ " to " ++ show jump + else + Nothing + else + error $ "readTranslateJumpSafe: " ++ show xy ++ " is out of bounds" + +readJumpsSafe :: JumpGrid -> Point -> Jumps +readJumpsSafe jg xy = + if isDefinedOn jg xy then + readJumpsUnsafe jg xy + else + error $ "readJumpsSafe: " ++ show xy ++ " is out of bounds" + +indexOf :: JumpGrid -> Point -> Int +indexOf jg (x, y) = y * jgWidth jg + x + +readJumpsUnsafe :: JumpGrid -> Point -> Jumps +readJumpsUnsafe jg@(JumpGrid _ _ _ jumps) p = + V.unsafeIndex jumps $ indexOf jg p + +dirToLens :: Direction -> Lens' Jumps Word16 +dirToLens P.North = nJumpDist +dirToLens P.South = sJumpDist +dirToLens P.East = eJumpDist +dirToLens P.West = wJumpDist +dirToLens _ = error "dirToLens doesn't accept diagonal directions" + +readJumpSafe :: JumpGrid -> Direction -> Point -> Maybe Point +readJumpSafe jg dir xy = + if isDefinedOn jg xy then + readTranslateJumpSafe jg dir xy + . view (dirToLens dir) + $ readJumpsSafe jg xy + else + Nothing + +-- Is the point within the JumpGrid or out of bounds? +isDefinedOn :: JumpGrid -> Point -> Bool +isDefinedOn jg (x,y) = + x < jgWidth jg && y < jgHeight jg && x >= 0 && y >= 0 + +setJumpChange :: Jumps -> JumpChange -> Jumps +setJumpChange jumps (JumpChange dir dist _) = + jumps & dirToLens dir .~ dist + +incorporateJumpChanges :: JumpGrid -> [JumpChange] -> V.Vector Jumps +incorporateJumpChanges jg + = V.unsafeAccum setJumpChange (jgJumps jg) + . map (\jc@(JumpChange _ _ xy) -> (indexOf jg xy, jc)) + +-- Get the vertical or horizontal distance between two points. +-- Assumes they are aligned along a column or row. +-- Fails if they aren't aligned. +axisDist :: Point -> Point -> Int +axisDist xya@(xa,ya) xyb@(xb,yb) = + if xa == xb + then abs $ ya - yb + else + if ya == yb + then abs $ xa - xb + else error $ "axisDist failed on " ++ show xya ++ " & " ++ show xyb + +jumpChange :: Direction -> Point -> Point -> JumpChange +jumpChange dir jump xy = + let dist = fromIntegral $ axisDist xy jump in + case dir of + North -> JumpChange North dist xy + South -> JumpChange South dist xy + East -> JumpChange East dist xy + West -> JumpChange West dist xy + other -> error ("No jump for " ++ show other ++ " at " ++ show xy) + +isAxisJump :: JumpGrid -> Direction -> Point -> Bool +isAxisJump jg dir xy = P.isAxisJump dir (isTileOpen jg) xy + +accum :: JumpGrid -> Direction -> Direction -> Point -> (Maybe Point, [Point]) +accum jg jumpDir dir start = acc (P.translate 1 dir start) [] + where + acc :: Point -> [Point] -> (Maybe Point, [Point]) + acc xy xys = + if isAxisJump jg jumpDir xy then + (Just xy, xy:xys) + else + if isTileOpen jg xy then + acc (P.translate 1 dir xy) (xy:xys) + else + (Nothing, xys) + +minAndMax :: Ord a => a -> a -> (a, a) +minAndMax a b = (min a b, max a b) + +changeArea :: Bool -> Point -> Point -> JumpGrid -> JumpGrid +changeArea openOrClose (xa,ya) (xb,yb) (JumpGrid w h tiles jumps) = + JumpGrid w h newTiles fixedJumps + where + (xMin, xMax) = minAndMax xa xb + (yMin, yMax) = minAndMax ya yb + + affected = [(x,y) | x <- [xMin - 1 .. xMax + 1], y <- [yMin - 1 .. yMax + 1]] + specified = [(x,y) | x <- [xMin .. xMax], y <- [yMin .. yMax]] + newTiles = (V.//) tiles $ map (\(x,y) -> (y * w + x, openOrClose)) specified + + jg = JumpGrid w h newTiles jumps + + clearClosed :: [JumpChange] + clearClosed = do + xy <- specified + dir <- [North, South, East, West] + pure $ jumpChange dir xy xy + + correctJumps :: [JumpChange] + correctJumps = do + xy <- affected + dir <- [North, South, East, West] + correctJump jg dir xy + + fixedJumps = + incorporateJumpChanges jg $ + if openOrClose + then correctJumps + else correctJumps ++ clearClosed + +correctJump :: JumpGrid -> Direction -> Point -> [JumpChange] +correctJump jg dir xy = + case accum jg dir (P.rotate180 dir) xy of + (Just backJump, _) -> + case accum jg dir dir backJump of + (Just frwdJump, _:xs) -> map (jumpChange dir frwdJump) (backJump:xs) + (_, xs) -> map (\p -> jumpChange dir p p) (backJump:xs) + (_, lastP:_) -> + case accum jg dir dir lastP of + (Just frwdJump, _:xs) -> map (jumpChange dir frwdJump) (lastP:xs) + (_, xs) -> map (\p -> jumpChange dir p p) (lastP:xs) + _ -> [] + diff --git a/src/Algorithm/Search/JumpPoint/Pathing.hs b/src/Algorithm/Search/JumpPoint/Pathing.hs new file mode 100644 --- /dev/null +++ b/src/Algorithm/Search/JumpPoint/Pathing.hs @@ -0,0 +1,345 @@ +module Algorithm.Search.JumpPoint.Pathing + ( rotate45C + , rotate45CC + , rotate90C + , rotate90CC + , rotate135C + , rotate135CC + , rotate180 + , translate + , isAxisJump + , isDiagJump + , isPathOpenOnAxis + , Direction(..) + , JumpGetter + , IsOpen + , Point + , jpsPath + ) where + +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (catMaybes, isJust) +import Data.PriorityQueue.FingerTree (PQueue) +import qualified Data.PriorityQueue.FingerTree as PQ +import Data.Tuple (swap) + +-- | A point on the grid. +type Point = (Int, Int) + +type IsOpen = Point -> Bool + +data Direction + = North + | South + | East + | West + | Northeast + | Southeast + | Northwest + | Southwest + deriving (Show,Eq) + +rotate45C :: Direction -> Direction +rotate45C dir = case dir of + North -> Northeast + South -> Southwest + East -> Southeast + West -> Northwest + Northeast -> East + Southeast -> South + Northwest -> North + Southwest -> West + +rotate45CC :: Direction -> Direction +rotate45CC dir = case dir of + North -> Northwest + South -> Southeast + East -> Northeast + West -> Southwest + Northeast -> North + Southeast -> East + Northwest -> West + Southwest -> South + +rotate90C :: Direction -> Direction +rotate90C dir = case dir of + North -> East + South -> West + East -> South + West -> North + Northeast -> Southeast + Southeast -> Southwest + Northwest -> Northeast + Southwest -> Northwest + +rotate90CC :: Direction -> Direction +rotate90CC dir = case dir of + North -> West + South -> East + East -> North + West -> South + Northeast -> Northwest + Southeast -> Northeast + Northwest -> Southwest + Southwest -> Southeast + +rotate135C :: Direction -> Direction +rotate135C dir = case dir of + North -> Southeast + South -> Northwest + East -> Southwest + West -> Northeast + Northeast -> South + Southeast -> West + Northwest -> East + Southwest -> North + +rotate135CC :: Direction -> Direction +rotate135CC dir = case dir of + North -> Southwest + South -> Northeast + East -> Northwest + West -> Southeast + Northeast -> West + Southeast -> North + Northwest -> South + Southwest -> East + +rotate180 :: Direction -> Direction +rotate180 dir = case dir of + North -> South + South -> North + East -> West + West -> East + Northeast -> Southwest + Southeast -> Northwest + Northwest -> Southeast + Southwest -> Northeast + +push :: Ord a => PQueue a a -> a -> PQueue a a +push pq a = PQ.insert a a pq + +pop :: Ord a => PQueue a a -> Maybe (PQueue a a, a) +pop = fmap swap . PQ.minView + +translate :: Int -> Direction -> Point -> Point +translate n dir (x,y) = case dir of + North -> (x, y + n) + South -> (x, y - n) + East -> (x + n, y) + West -> (x - n, y) + Northeast -> (x + n, y + n) + Southeast -> (x + n, y - n) + Northwest -> (x - n, y + n) + Southwest -> (x - n, y - n) + +isAxisJump :: Direction -> IsOpen -> Point -> Bool +isAxisJump dir isOpen xy = + isOpen xy && isOpen e && + ((not (isOpen n) && isOpen ne) || (not (isOpen s) && isOpen se)) + where + n = translate 1 (rotate90CC dir) xy + ne = translate 1 (rotate45CC dir) xy + e = translate 1 ( dir) xy + se = translate 1 (rotate45C dir) xy + s = translate 1 (rotate90C dir) xy + + +isDiagJump :: Direction -> IsOpen -> Point -> Bool +isDiagJump dir isOpen xy = + if isOpen xy then + case (isOpen w, isOpen s) of + (False, True) -> isOpen n && isOpen nw + (True, False) -> isOpen e && isOpen se + _ -> False + else + False + where + n = translate 1 (rotate45CC dir) xy + s = translate 1 (rotate135C dir) xy + e = translate 1 (rotate45C dir) xy + w = translate 1 (rotate135CC dir) xy + nw = translate 1 (rotate90CC dir) xy + se = translate 1 (rotate90C dir) xy + +type JumpGetter = Direction -> Point -> Maybe Point + +isPathOpenOnAxis :: IsOpen -> Point -> Point -> Bool +isPathOpenOnAxis isOpen start@(sx,sy) goal@(gx,gy) = + if sx == gx then + if sy == gy then + True + else + if sy > gy then + isDirectionOpen South start + else + isDirectionOpen North start + else + if sy == gy then + if sx > gx then + isDirectionOpen West start + else + isDirectionOpen East start + else + False + where + isDirectionOpen dir xy = (xy == goal && isOpen goal) || (isOpen xy && isDirectionOpen dir (translate 1 dir xy)) + +expandNode :: IsOpen -> JumpGetter -> Point -> Point -> (Direction, Point) -> [(Direction, Point)] +expandNode isOpen jg start goal (nodeDir, xy) = + if xy == start then + startNodes + else + case nodeDir of + North -> exAxis nodeDir + South -> exAxis nodeDir + East -> exAxis nodeDir + West -> exAxis nodeDir + _ -> exDiag nodeDir + where + startNodes = concat + [ exDiag Northeast + , exDiag Southeast + , exDiag Northwest + , exDiag Southwest + ] + exAxis dir = expandAxis isOpen jg goal dir xy + exDiag dir = expandDiag isOpen jg goal dir xy + +expandAxis :: IsOpen -> JumpGetter -> Point -> Direction -> Point -> [(Direction, Point)] +expandAxis isOpen jg goal dir xy = + let n = translate 1 dir xy + e = translate 1 (rotate90C dir) xy + w = translate 1 (rotate90CC dir) xy + ne = translate 1 neDir xy + nw = translate 1 nwDir xy + nOpen = isOpen n + eOpen = isOpen e + wOpen = isOpen w + neOpen = isOpen ne + nwOpen = isOpen nw + neDir = rotate45C dir + nwDir = rotate45CC dir + forcedNE = if not eOpen && nOpen && neOpen then Just (neDir, ne) else Nothing + forcedNW = if not wOpen && nOpen && nwOpen then Just (nwDir, nw) else Nothing + naturalN = fmap (\p -> (dir, p)) $ jg dir xy in + if isOpen xy then + if isPathOpenOnAxis isOpen xy goal then + [(North, goal)] + else + catMaybes [forcedNE, forcedNW, naturalN] + else + [] + +expandDiag :: IsOpen -> JumpGetter -> Point -> Direction -> Point -> [(Direction, Point)] +expandDiag _ _ _ North _ = error "ExpandDiag N" +expandDiag _ _ _ South _ = error "ExpandDiag S" +expandDiag _ _ _ East _ = error "ExpandDiag E" +expandDiag _ _ _ West _ = error "ExpandDiag W" +expandDiag isOpen jg goal dir xy = + let n = translate 1 (rotate45CC dir) xy + s = translate 1 (rotate135C dir) xy + e = translate 1 (rotate45C dir) xy + w = translate 1 (rotate135CC dir) xy + nw = translate 1 nwDir xy + se = translate 1 seDir xy + ne = translate 1 dir xy + nwDir = rotate90CC dir + seDir = rotate90C dir + forcedNW = if not (isOpen w) && isOpen n && isOpen nw then Just (nwDir, nw) else Nothing + forcedSE = if not (isOpen s) && isOpen e && isOpen se then Just (seDir, se) else Nothing + naturalNE = nextDiagJump isOpen jg goal dir ne + naturalN = fmap (\p -> (rotate45CC dir, p)) $ jg (rotate45CC dir) xy + naturalE = fmap (\p -> (rotate45C dir, p)) $ jg (rotate45C dir) xy in + if isOpen xy then + if isPathOpenOnAxis isOpen xy goal then + [(North, goal)] + else + catMaybes [naturalNE, forcedNW, forcedSE, naturalN, naturalE] + else + [] + +nextDiagJump :: IsOpen -> JumpGetter -> Point -> Direction -> Point -> Maybe (Direction, Point) +nextDiagJump isOpen jg goal dir xy = + if isDiagJump dir isOpen xy then + Just (dir, xy) + else if isJust naturalN || isJust naturalE then + Just (dir, xy) + else if isOpen xy then + if isPathOpenOnAxis isOpen xy goal then + Just (dir, xy) + else if isOpen (translate 1 (rotate45CC dir) xy) || isOpen (translate 1 (rotate45C dir) xy) then + nextDiagJump isOpen jg goal dir $ translate 1 dir xy + else + Nothing + else + Nothing + where + naturalN = jg (rotate45CC dir) xy + naturalE = jg (rotate45C dir) xy + +data Node = Node + { _g :: !Double + , _h :: !Double + , _f :: !Double + , _dir :: !Direction + , _xy :: !Point + } deriving (Eq,Show) + +instance Ord Node where + compare n1 n2 = + if isDiag (_dir n1) && not (isDiag $ _dir n2) then + LT + else + _f n1 `compare` _f n2 + where + isDiag d = case d of + Northwest -> True + Southwest -> True + Northeast -> True + Southeast -> True + _ -> False + +jpsPath :: IsOpen -> JumpGetter -> Point -> Point -> Maybe [Point] +jpsPath isOpen jg start goal = runJPS isOpen jg (PQ.singleton startPoint startPoint) Map.empty start goal + where + dist = getDist start goal + startPoint = Node 0 dist dist North start + +getDist :: Point -> Point -> Double +getDist (x1,y1) (x2,y2) = sqrt $ fromIntegral $ (x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2) + +runJPS :: IsOpen -> JumpGetter -> PQueue Node Node -> Map Point Point -> Point -> Point -> Maybe [Point] +runJPS isOpen jg open closed start goal = + case pop open of + Nothing -> Nothing + Just (open2, node) -> + if _xy node == goal then + Just (reconstruct closed goal) + else + let neighbors = expandNode isOpen jg start goal (_dir node, _xy node) + nearby = filter (\(_, xy) -> Map.notMember xy closed) neighbors + open3 = foldl (\pq (dir, xy) -> + let adjDist = getDist xy (_xy node) + g = _g node + adjDist + h = getDist xy goal + f = g + h in + push pq $ Node { + _g = g, + _h = h, + _f = f, + _dir = dir, + _xy = xy + } + ) open2 nearby + closed2 = foldl (\clsd (_,xy2) -> Map.insert xy2 (_xy node) clsd) closed nearby in + runJPS isOpen jg open3 closed2 start goal + +reconstruct :: Map Point Point -> Point -> [Point] +reconstruct = recon [] + where + recon :: [Point] -> Map Point Point -> Point -> [Point] + recon xs im b = case Map.lookup b im of + Just ok -> recon (b : xs) im ok + Nothing -> b : xs