jps (empty) → 0.1.0.0
raw patch · 7 files changed
+725/−0 lines, 7 filesdep +basedep +containersdep +fingertreesetup-changed
Dependencies added: base, containers, fingertree, lens, vector
Files
- ChangeLog.md +7/−0
- LICENSE +30/−0
- README.md +33/−0
- Setup.hs +2/−0
- jps.cabal +42/−0
- src/Algorithm/Search/JumpPoint.hs +266/−0
- src/Algorithm/Search/JumpPoint/Pathing.hs +345/−0
+ ChangeLog.md view
@@ -0,0 +1,7 @@+# Changelog for jps++## 0.1.0.0 -- 2018-08-19++* First version. Released on an unsuspecting world.++## Unreleased changes
+ LICENSE view
@@ -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.
+ README.md view
@@ -0,0 +1,33 @@+# jps -- jump point search for Haskell++[](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+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ jps.cabal view
@@ -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 <https://github.com/isovector/jps#readme>+category: Algorithm+homepage: https://github.com/isovector/jps#readme+bug-reports: https://github.com/isovector/jps/issues+author: Zachary Kamerling+maintainer: Sandy Maguire <sandy@sandymaguire.me>+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
+ src/Algorithm/Search/JumpPoint.hs view
@@ -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)+ _ -> []+
+ src/Algorithm/Search/JumpPoint/Pathing.hs view
@@ -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