Problem 83

83_alt.hs

@@ -7,58 +7,62 @@ import Data.PQueue.Min
 type Value    = Integer
 type Distance = Integer
 type Position = (Int, Int)
-data Element = Element {
+data MElement = MElement {
     value :: Value,
-    distance :: Maybe Distance,  -- Nothing represents infinity
+    visited :: Bool
-    position :: Position
+} deriving (Eq, Show)
+data QElement = QElement {
+    distance :: Distance,
+    position :: (Int, Int)
 } deriving (Eq, Show)
-data PQE = PQE Element Distance deriving (Eq, Show)
 
-instance Ord PQE where
+instance Ord QElement where
-    PQE _ Nothing <= _ = False
+    QElement d1 p1 <= QElement d2 p2 = d1 <= d2
-    _ <= PQE _ Nothing = True
-    PQE _ (Just d1) <= PQE _ (Just d2) = d1 <= d2
 
-getNeighbours :: Matrix Element -> Element -> [Element]
+markVisited :: Position -> Matrix MElement -> Matrix MElement
-getNeighbours m e =
+markVisited pos m =
-    let (i, j) = position e
+    let MElement value _ = m ! pos
-    in  catMaybes [safeGet (i - 1) j      m,
+    in  unsafeSet (MElement value True) pos m
-                   safeGet (i + 1) j      m,
-                   safeGet  i     (j - 1) m,
-                   safeGet  i     (j + 1) m]    
 
-dijkstra :: Position -> Matrix Element -> MinQueue PQE -> Distance
+getNeighbour :: Matrix MElement -> Distance -> Position -> Maybe QElement
+getNeighbour m dist pos@(i, j) = do
+    MElement val vis <- safeGet i j m
+    if vis then Nothing
+    else return $ QElement (dist + val) pos
+
+getNeighbours :: Matrix MElement -> QElement -> [QElement]
+getNeighbours m (QElement dist (i, j)) =
+    catMaybes [getNeighbour m dist ((i - 1), j),
+               getNeighbour m dist ((i + 1), j),
+               getNeighbour m dist (i, (j - 1)),
+               getNeighbour m dist (i, (j + 1))]
+
+dijkstra :: Position -> Matrix MElement -> MinQueue QElement -> Distance
 dijkstra p m q =
-    let PQE minElement minDistance = findMin q
+    let (minElement@(QElement dist pos), newQ) = deleteFindMin q
-    in  if position minElement == p
+        neighbours = getNeighbours m minElement
-        then minDistance
+    in  if pos == p then dist
-        else let (newM, newQ) = foldr update (m, q) $ getNeighbours m minElement
+        else dijkstra p (foldr update m neighbours) (foldr insert newQ neighbours)
-             in  dijkstra p newM newQ
+        where update (QElement _ pos) = markVisited pos
-        where update neighbour (prevM, prevQ) =
-                let newDistance = minDistance + value neighbour
-                in  case distance neighbour of
-                    Nothing -> undefined
-                    Just d  -> undefined
 
-findShortestPathLength :: Matrix Element -> Distance
+findShortestPathLength :: Matrix MElement -> Distance
 findShortestPathLength m =
-    let initialElement = m ! (1, 1)
+    let MElement value _ = m ! (1, 1)
-        initialMinQ = singleton $ PQE initialElement $ value initialElement
+        initialMinQ = singleton $ QElement value (1, 1)
         lastPos = (nrows m, ncols m)
     in  dijkstra lastPos m initialMinQ
 
-
+setInitial :: Matrix MElement -> Matrix MElement
-setInitial :: Matrix Element -> Matrix Element
 setInitial m =
-    let v = value $ m ! (1, 1)
+    let MElement v _ = m ! (1, 1)
-    in unsafeSet (Element v (Just v) (1, 1)) (1, 1) m
+    in  unsafeSet (MElement v True) (1, 1) m
 
-initElement :: Matrix Integer -> Position -> Element
+initElement :: Matrix Integer -> Position -> MElement
 initElement m p =
     let value = m ! p
-    in  Element value Nothing p
+    in  MElement value False
 
-toElementMatrix :: Matrix Integer -> Matrix Element
+toElementMatrix :: Matrix Integer -> Matrix MElement
 toElementMatrix m =
     matrix (nrows m) (ncols m) (initElement m)
 

83_alt2.hs

@@ -1,76 +0,0 @@
-import Data.List.Split
-import Data.Matrix
-import Data.Maybe
-import Data.Foldable
-import Data.PQueue.Min
-
-type Value    = Integer
-type Distance = Integer
-type Position = (Int, Int)
-data MElement = MElement {
-    value :: Value,
-    visited :: Bool
-} deriving (Eq, Show)
-data QElement = QElement {
-    distance :: Distance,
-    position :: (Int, Int)
-} deriving (Eq, Show)
-
-instance Ord QElement where
-    QElement d1 p1 <= QElement d2 p2 = d1 <= d2
-
-markVisited :: Position -> Matrix MElement -> Matrix MElement
-markVisited pos m =
-    let MElement value _ = m ! pos
-    in  unsafeSet (MElement value True) pos m
-
-getNeighbour :: Matrix MElement -> Distance -> Position -> Maybe QElement
-getNeighbour m dist pos@(i, j) = do
-    MElement val vis <- safeGet i j m
-    if vis then Nothing
-    else return $ QElement (dist + val) pos
-
-getNeighbours :: Matrix MElement -> QElement -> [QElement]
-getNeighbours m (QElement dist (i, j)) =
-    catMaybes [getNeighbour m dist ((i - 1), j),
-               getNeighbour m dist ((i + 1), j),
-               getNeighbour m dist (i, (j - 1)),
-               getNeighbour m dist (i, (j + 1))]
-
-dijkstra :: Position -> Matrix MElement -> MinQueue QElement -> Distance
-dijkstra p m q =
-    let minElement@(QElement dist pos) = findMin q
-        neighbours = getNeighbours m minElement
-    in  if pos == p then dist
-        else dijkstra p (foldr update m neighbours) (foldr insert q neighbours) -- add neighbours to q
-        where update (QElement _ pos) = markVisited pos
-
-findShortestPathLength :: Matrix MElement -> Distance
-findShortestPathLength m =
-    let MElement value _ = m ! (1, 1)
-        initialMinQ = singleton $ QElement value (1, 1)
-        lastPos = (nrows m, ncols m)
-    in  dijkstra lastPos m initialMinQ
-
-setInitial :: Matrix MElement -> Matrix MElement
-setInitial m =
-    let MElement v _ = m ! (1, 1)
-    in  unsafeSet (MElement v True) (1, 1) m
-
-initElement :: Matrix Integer -> Position -> MElement
-initElement m p =
-    let value = m ! p
-    in  MElement value False
-
-toElementMatrix :: Matrix Integer -> Matrix MElement
-toElementMatrix m =
-    matrix (nrows m) (ncols m) (initElement m)
-
-main :: IO ()
-main = do
-    contents <- readFile "p083_matrix.txt"
-    let listsMatrix = fmap (fmap read . (splitOn ",")) $ lines contents :: [[Integer]]
-        valueMatrix = fromLists listsMatrix
-        unvisitedMatrix = toElementMatrix valueMatrix
-        mtrx = setInitial unvisitedMatrix
-    print $ findShortestPathLength mtrx