SHARE
TWEET

Broken Dijkstra

tdct Jul 21st, 2019 (edited) 102 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. {-# LANGUAGE FlexibleInstances #-}
  2. module Main where
  3.  
  4. import Control.Monad
  5. import Control.Monad.ST
  6. import Data.Ix (Ix, rangeSize)
  7. import Data.Array
  8. import Data.Array.MArray
  9. import Data.Array.ST
  10. import Data.STRef
  11. --import Data.Array.Unboxed
  12.  
  13. main :: IO ()
  14. main = return ()
  15.  
  16. data RealPlus a = Infinity | RealPlus a
  17.  
  18. instance (Eq a) => Eq (RealPlus a) where
  19.     (==) (RealPlus v1) (RealPlus v2) = v1 == v2
  20.     (==) Infinity Infinity = True
  21.     (==) _ _ = False
  22.  
  23. instance (Ord a) => Ord (RealPlus a) where
  24.     (<=) (RealPlus v1) (RealPlus v2) = v1 <= v2
  25.     (<=) Infinity (RealPlus v) = False
  26.     (<=) (RealPlus v) Infinity = True
  27.  
  28. instance Functor (RealPlus) where
  29.     fmap f Infinity = Infinity
  30.     fmap f (RealPlus x) = RealPlus . f $ x
  31.  
  32. data Edge a b = Edge { dest :: a
  33.                      , dist :: b }
  34.  
  35. data Node a b = Node  { ix     :: a
  36.                       , edgev  :: [Edge a b] -- edgevector
  37.                       , active :: Bool
  38.                       }
  39.  
  40. data Result a b = Result { target  :: a
  41.                          , resultv :: [(a, b, a)]
  42.                          }
  43.  
  44. type Graph i w = Array i ([Edge i w], Bool)
  45.  
  46.  
  47. insertSorted :: (Ix i, Ord a, Real a) => [(i, RealPlus a)] -> (i, RealPlus a) -> [(i, RealPlus a)] -- Makeshift pqueue
  48. insertSorted [] a = [a]
  49. insertSorted (h@(i1, v1) : xs) e@(i2, v2)
  50.     | i1 == i2 = (i1, min v1 v2) : xs
  51.     | v1 < v1 = h : insertSorted xs e
  52.     | v1 > v2 = e : h : xs
  53.     | v1 == v2 = e : h : xs
  54.  
  55.  
  56. graph :: (Ix i, Real w, Ord w) => (i, i) -> [Node i (RealPlus w)] -> Graph i (RealPlus w)
  57. graph r xs = array r $ map f xs where
  58.     f (Node i e x) = (i, (e, x))
  59.  
  60. -- Result i (RealPlus w)
  61. dijkstra :: (Ix i, Real w, Ord w) => i -> Graph i (RealPlus w) -> ()
  62. dijkstra t g =  let
  63.     sz = rangeSize . bounds $ g
  64.     f target result n = runSTArray $ do
  65.         result_raw <- newArray (bounds g) (Infinity, Nothing) :: ST s (STArray s i (RealPlus w, Maybe i)) -- Distance, Previous. Results hashed -> dist prev
  66.         fresh <- newArray (bounds g) True :: ST s (STArray s i Bool )                                     -- Detect if traversed previously
  67.         --writeArray fresh t False
  68.         --writeArray result_raw t (0, Nothing)
  69.         return result_raw
  70.     in ()
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top