- haskell version of vindinium

code_royal/src/Graph.purs

@@ -1,54 +0,0 @@
-module Graph where
-
-import Prelude
-
-import Data.List (List(..), drop, head, reverse, (:), fromFoldable, (\\))
-import Data.Map as M
-import Data.Maybe (Maybe(..), fromMaybe)
-import Data.Set as S
-import Data.Tuple (Tuple(..), fst, snd)
-
-newtype Graph v = Graph (M.Map v (List v))
-
-empty :: forall v. Graph v
-empty = Graph M.empty
-
-addNode :: forall v. Ord v => Graph v -> v -> Graph v
-addNode (Graph m) v = Graph $ M.insert v Nil m
-infixl 5 addNode as <+>
-
--- adds an Edge from Node "from" to Node "to"
--- returns the graph unmodified if "to" does not exist
-addEdge :: forall v. Ord v => Graph v -> v -> v -> Graph v
-addEdge g@(Graph m) from to = Graph $ M.update updateVal from m
-    where
-        updateVal :: List v -> Maybe (List v)
-        updateVal nodes
-            | g `contains` to = Just $ to : nodes
-            | otherwise = Just nodes
-
-toMap :: forall v. Graph v -> M.Map v (List v)
-toMap (Graph m) = m
-
-adjacentEdges :: forall v. Ord v => Graph v -> v -> List v
-adjacentEdges (Graph m) nodeId = fromMaybe Nil $ M.lookup nodeId m
-
-contains :: forall v. Ord v => Graph v -> v -> Boolean
-contains (Graph m) key = case M.lookup key m of
-    Just _  -> true
-    Nothing -> false
-
-shortestPath :: forall v. Ord v => Graph v -> v -> v -> List v
-shortestPath g@(Graph m) from to = reverse $ shortestPath' (Tuple from Nil) Nil S.empty
-    where
-        shortestPath' :: (Tuple v (List v)) -> List (Tuple v (List v)) -> S.Set v-> List v
-        shortestPath' from queue visited
-            | fst from == to = snd from
-            | otherwise  = case head $ newQueue of
-                  Just n  -> shortestPath' n newQueue (S.insert (fst from) visited)
-                  Nothing -> Nil
-            where
-                adjacent :: S.Set v
-                adjacent = S.fromFoldable $ adjacentEdges g (fst from)
-                newQueue :: List (Tuple v (List v))
-                newQueue = drop 1 queue <> ( map (\x -> Tuple x $ fst from : snd from) (fromFoldable $ S.difference adjacent visited) )

code_royal/src/Helpers.purs

@@ -3,7 +3,7 @@ module Lib where
 import Prelude
 
 import Data.Int (fromNumber, pow, toNumber)
-import Data.Maybe (fromJust)
+import Data.Maybe (Maybe(..), fromJust)
 import Math as M
 import Partial.Unsafe (unsafePartial)
 import Range (Area(..), Pos(..), Range(..))
@@ -33,4 +33,14 @@ dist p1 p2 = sqrt $ a2 + b2
         b2 = abs (p2.y - p1.y) `pow` 2
 
 toPos :: forall e. { x :: Int, y :: Int | e } -> Pos
-toPos p = Pos p.x p.y
+toPos p = Pos p.x p.y
+
+-- addNode :: forall k. Ord k => G.Graph k k -> k -> G.Graph k k
+-- addNode g v = G.insertVertex v v g
+-- infixl 5 addNode as <+>
+-- 
+-- addEdge :: forall k v. Ord k => Maybe (G.Graph k v) -> Array k -> Maybe (G.Graph k v)
+-- addEdge (Just g) [a,b] = case G.insertEdge a b g of
+--     Just g' -> Just g'
+--     Nothing -> Just g
+-- addEdge _ _ = Nothing

code_royal/test/Main.purs

@@ -5,36 +5,62 @@ import Prelude
 import Data.Array (concatMap, (..))
 import Data.Foldable (foldl)
 import Data.Int (fromNumber)
-import Data.JSDate (getTime, now)
-import Data.List (List)
+import Data.JSDate (JSDate, getTime, now)
 import Data.Map (Map, showTree)
 import Data.Maybe (fromJust)
 import Effect (Effect)
 import Effect.Console (log)
-import Graph (Graph(..), addEdge, addNode, empty, shortestPath, toMap, (<+>))
+import Graph (Graph(..), addEdge, addNode, dfs, empty, pathExists, shortestPath, shortestPathList, toMap, (<+>))
 import Partial.Unsafe (unsafePartial)
 
 
 main :: Effect Unit
 main = do
-    test "graph" testCreateGraph
-    let f2 = log $ show $ shortestPath graph "[1,1]" "[8,8]"
-    test "search" f2
+    let graph = foldl addEdge' graph' $ concatMap nodeConnections nodes
 
---testCreateGraph :: forall v. Effect (Map v (List v))
-testCreateGraph = pure $ toMap $ graph
-
-test :: forall a. String -> Effect a -> Effect Unit
-test tName fn = do
     d0 <- now
-    let t0 = getTime d0
-    _ <- fn
-    d1 <- now
-    log $ "execution time of " <> tName <> ": " <> (show $ unsafePartial $ fromJust $ fromNumber $ getTime d1 - t0) <> "ms"
+    -- log $ show $ shortestPathList graph "[1,1]" "[7,7]"
+    -- log $ show $ shortestPathList graph "[1,1]" "[7,7]"
+    -- log $ show $ shortestPathList graph "[1,1]" "[7,7]"
+    -- d1 <- now
+    -- test "list search" d0 d1
 
-graph :: Graph String
--- graph = foldl addEdge' graph' [ ["[1,1]", "[2,2]"], ["[3,4]", "[4,4]"], ["[2,2]", "[4,4]"] ]
-graph = foldl addEdge' graph' $ concatMap nodeConnections nodes
+    -- log ""
+
+    -- d2 <- now
+    -- log $ show $ shortestPath graph "[1,1]" "[7,7]"
+    -- log $ show $ shortestPath graph "[1,1]" "[7,7]"
+    -- log $ show $ shortestPath graph "[1,1]" "[7,7]"
+    -- d3 <- now
+    -- test "set search" d2 d3
+
+    -- log ""
+
+    -- d4 <- now
+    -- log $ show $ pathExists graph "[1,1]" "[7,7]"
+    -- log $ show $ pathExists graph "[1,1]" "[7,7]"
+    -- log $ show $ pathExists graph "[1,1]" "[7,7]"
+    -- d5 <- now
+    -- test "exists test" d4 d5
+
+    -- log ""
+
+    d6 <- now
+    log $ show $ dfs graph "[1,1]" "[1,2]"
+    log $ show $ dfs graph "[1,1]" "[1,2]"
+    log $ show $ dfs graph "[1,1]" "[1,2]"
+    d7 <- now
+    test "dfs test" d6 d7
+
+    log ""
+
+    log $ "execution time of ALL: " <> (show $ (getTime d7 - getTime d0) / 3000.0) <> "s"
+
+test :: String -> JSDate -> JSDate -> Effect Unit
+test tName d0 d1 = do
+    let t0 = getTime d0
+    let t1 = getTime d1
+    log $ "execution time of " <> tName <> ": " <> (show $ (t1 - t0) / 3000.0) <> "s"
 
 addEdge' :: forall v. Ord v => Graph v -> Array v -> Graph v
 addEdge' g v = unsafePartial $ addEdge'' v
@@ -48,8 +74,8 @@ sNodes :: Array String
 sNodes = map (\n -> show n) nodes
 
 nodes = do
-    x <- (1..360)
-    y <- (1..250)
+    x <- (1..9)
+    y <- (1..9)
     pure $ [x, y]
 
 nodeConnections :: Array Int -> Array (Array String)