-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
bf3c30a
commit a002b1c
Showing
11 changed files
with
445 additions
and
26 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Large diffs are not rendered by default.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,21 +1,50 @@ | ||
| module Lib.Matrix (Matrix, (!), (!?), height, width) where | ||
| module Lib.Matrix (Matrix, (!), (!?), height, width, insertCol, insertRow, getRow, getCol, getCols, findColIndices, findRowIndices, Lib.Matrix.toList, findLocations) where | ||
|
|
||
| import Data.Vector (Vector) | ||
| import qualified Data.Vector as V | ||
| import Data.Foldable (toList) | ||
| import Data.List (findIndices) | ||
| import Data.Sequence (Seq) | ||
| import qualified Data.Sequence as S | ||
| import Prelude hiding (elem) | ||
|
|
||
| type Matrix a = Vector (Vector a) | ||
| type Matrix a = Seq (Seq a) | ||
|
|
||
| type Position = (Int, Int) -- x, y | ||
|
|
||
| (!) :: Position -> Matrix a -> a | ||
| (!) (x, y) mat = mat V.! y V.! x | ||
| (!) :: Matrix a -> Position -> a | ||
| mat ! (x, y) = mat `S.index` y `S.index` x | ||
|
|
||
| (!?) :: Position -> Matrix a -> Maybe a | ||
| (!?) (x, y) mat = mat V.!? y >>= (V.!? x) | ||
| (!?) (x, y) mat = mat S.!? y >>= (S.!? x) | ||
|
|
||
| height :: Matrix a -> Int | ||
| height = V.length | ||
| height = S.length | ||
|
|
||
| width :: Matrix a -> Int | ||
| width = V.length . V.head | ||
| width = S.length . (`S.index` 0) | ||
|
|
||
| insertCol :: Seq a -> Int -> Matrix a -> Matrix a | ||
| insertCol col colIdx = fmap (S.insertAt colIdx (col `S.index` colIdx)) | ||
|
|
||
| insertRow :: Seq a -> Int -> Matrix a -> Matrix a | ||
| insertRow row rowIdx = S.insertAt rowIdx row | ||
|
|
||
| getRow :: Int -> Matrix a -> Seq a | ||
| getRow = flip S.index | ||
|
|
||
| getCol :: Int -> Matrix a -> Seq a | ||
| getCol colIdx = fmap (`S.index` colIdx) | ||
|
|
||
| getCols :: Matrix a -> [Seq a] | ||
| getCols mat = [getCol colIdx mat | colIdx <- [0 .. width mat - 1]] | ||
|
|
||
| findColIndices :: (Seq a -> Bool) -> Matrix a -> [Int] | ||
| findColIndices predicate mat = findIndices predicate (getCols mat) | ||
|
|
||
| findRowIndices :: (Seq a -> Bool) -> Matrix a -> [Int] | ||
| findRowIndices = S.findIndicesL | ||
|
|
||
| toList :: Matrix a -> [[a]] | ||
| toList mat = Data.Foldable.toList $ fmap Data.Foldable.toList mat | ||
|
|
||
| findLocations :: (a -> Bool) -> Matrix a -> [(Int, Int)] | ||
| findLocations predicate mat = [(x, y) | y <- [0 .. height mat - 1], x <- [0 .. width mat - 1], predicate (mat ! (x, y))] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,83 @@ | ||
| {-# LANGUAGE TypeFamilies #-} | ||
| {-# LANGUAGE FlexibleContexts #-} | ||
|
|
||
| module Lib.SearchAlgorithms (DijkstraGraph(..), Distance(..), findShortestDistance) where | ||
|
|
||
| import Data.Heap (MinPrioHeap) | ||
| import qualified Data.Heap as H | ||
| import Data.HashMap.Strict (HashMap) | ||
| import qualified Data.HashMap.Strict as HM | ||
| import Data.Hashable (Hashable) | ||
| import Data.Maybe (fromMaybe) | ||
| import Data.HashSet (HashSet) | ||
| import qualified Data.HashSet as HS | ||
| import Data.Kind (Type) | ||
| import Data.Foldable (foldl') | ||
|
|
||
| data Distance a = Dist a | Infinity | ||
| deriving (Show, Eq) | ||
|
|
||
| instance (Ord a) => Ord (Distance a) where | ||
| Infinity <= Infinity = True | ||
| Infinity <= Dist _ = False | ||
| Dist _ <= Infinity = True | ||
| Dist x <= Dist y = x <= y | ||
|
|
||
| addDist :: (Num a) => Distance a -> Distance a -> Distance a | ||
| addDist (Dist x) (Dist y) = Dist (x + y) | ||
| addDist _ _ = Infinity | ||
|
|
||
| (!??) :: (Hashable k) => HashMap k (Distance d) -> k -> Distance d | ||
| (!??) distanceMap key = fromMaybe Infinity (HM.lookup key distanceMap) | ||
|
|
||
| class DijkstraGraph graph where | ||
| type DijkstraNode graph :: Type | ||
| type DijkstraCost graph :: Type | ||
| dijkstraEdges :: graph -> DijkstraNode graph -> [(DijkstraNode graph, DijkstraCost graph)] | ||
|
|
||
|
|
||
| data DijkstraState node cost = DijkstraState | ||
| { visitedSet :: HashSet node | ||
| , distanceMap :: HashMap node (Distance cost) | ||
| , nodeQueue :: MinPrioHeap (Distance cost) node | ||
| } | ||
|
|
||
| -- Taken from https://mmhaskell.com/blog/2022/8/22/dijkstras-algorithm-in-haskell | ||
| findShortestDistance :: | ||
| forall g. (Hashable (DijkstraNode g), Num (DijkstraCost g), Ord (DijkstraCost g), DijkstraGraph g) => g -> DijkstraNode g -> DijkstraNode g -> Distance (DijkstraCost g) | ||
| findShortestDistance graph src dest = processQueue initialState !?? dest | ||
| where | ||
| initialVisited = HS.empty | ||
| initialDistances = HM.singleton src (Dist 0) | ||
| initialQueue = H.fromList [(Dist 0, src)] | ||
| initialState = DijkstraState initialVisited initialDistances initialQueue | ||
|
|
||
| processQueue :: DijkstraState (DijkstraNode g) (DijkstraCost g) -> HashMap (DijkstraNode g) (Distance (DijkstraCost g)) | ||
| processQueue ds@(DijkstraState v0 d0 q0 ) = case H.view q0 of | ||
| -- if there is nothing left in the queue, we have processed everything and we can just return the distances | ||
| Nothing -> d0 | ||
| Just ((_, node), q1) -> | ||
| -- if we have reached the destination node, we have processed everything | ||
| if node == dest | ||
| then d0 | ||
| -- if the node is already visited, then we can immediately recurse, except plugging in the updated queue | ||
| else if HS.member node v0 then processQueue ds{ nodeQueue = q1} | ||
| -- 1. Pull a new node from our heap and consider that node “visited” | ||
| -- 2. Get all the “neighbors” of this node | ||
| -- 3. Process each neighbor and update its distance | ||
| else | ||
| let v1 = HS.insert node v0 | ||
| allNeighbors = dijkstraEdges graph node | ||
| unvisitedNeighbors = filter (\(n, _) -> not (HS.member n v1)) allNeighbors | ||
| in processQueue $ foldl' (foldNeighbor node) ds{ visitedSet=v1, nodeQueue=q1 } unvisitedNeighbors | ||
|
|
||
| -- Take the distance from the source to the current node and add it to the specific edge cost from the current to this new node. | ||
| -- Then compare this distance to the existing distance we have to the neighbor in our distance map (or Infinity if it doesn’t exist). | ||
| foldNeighbor currentNode ds@(DijkstraState _ d0 q0) (neighborNode, cost) = | ||
| let altDistance = addDist (d0 !?? currentNode) (Dist cost) | ||
| in if altDistance < d0 !?? neighborNode | ||
| -- If the alternative distance is smaller, we update the distance map by associating the neighbor node with the | ||
| -- alternative distance and return the new DijkstraState. We also insert the new distance into our queue. | ||
| then ds { distanceMap = HM.insert neighborNode altDistance d0, nodeQueue = H.insert (altDistance, neighborNode) q0 } | ||
| -- If the alternative distance is not better, we make no changes, and return the original state. | ||
| else ds |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.