- haskell version of vindinium

code_royal/index.min.js

@@ -0,0 +1 @@
+var PS={};(function(n){"use strict";n.arrayMap=function(e){return function(n){var t=n.length;var r=new Array(t);for(var a=0;a<t;a++){r[a]=e(n[a])}return r}}})(PS["Data.Functor"]=PS["Data.Functor"]||{});(function(n){"use strict";n["Control.Semigroupoid"]=n["Control.Semigroupoid"]||{};var t=n["Control.Semigroupoid"];var r=function(n){this.compose=n};var a=new r(function(r){return function(t){return function(n){return r(t(n))}}});var e=function(n){return n.compose};t["compose"]=e;t["semigroupoidFn"]=a})(PS);(function(n){"use strict";n["Data.Functor"]=n["Data.Functor"]||{};var t=n["Data.Functor"];var r=n["Data.Functor"];var a=n["Control.Semigroupoid"];var e=function(n){this.map=n};var u=function(n){return n.map};var i=new e(a.compose(a.semigroupoidFn));var o=new e(r.arrayMap);t["Functor"]=e;t["map"]=u;t["functorFn"]=i;t["functorArray"]=o})(PS);(function(n){"use strict";n.concatArray=function(t){return function(n){if(t.length===0)return n;if(n.length===0)return t;return t.concat(n)}}})(PS["Data.Semigroup"]=PS["Data.Semigroup"]||{});(function(n){"use strict";n["Data.Semigroup"]=n["Data.Semigroup"]||{};var t=n["Data.Semigroup"];var r=n["Data.Semigroup"];var a=function(n){this.append=n};var e=new a(r.concatArray);var u=function(n){return n.append};t["Semigroup"]=a;t["append"]=u;t["semigroupArray"]=e})(PS);(function(n){"use strict";n["Control.Alt"]=n["Control.Alt"]||{};var t=n["Control.Alt"];var r=n["Data.Functor"];var a=n["Data.Semigroup"];var e=function(n,t){this.Functor0=n;this.alt=t};var u=new e(function(){return r.functorArray},a.append(a.semigroupArray));t["altArray"]=u})(PS);(function(n){"use strict";n.arrayApply=function(c){return function(n){var t=c.length;var r=n.length;var a=new Array(t*r);var e=0;for(var u=0;u<t;u++){var i=c[u];for(var o=0;o<r;o++){a[e++]=i(n[o])}}return a}}})(PS["Control.Apply"]=PS["Control.Apply"]||{});(function(n){"use strict";n["Control.Apply"]=n["Control.Apply"]||{};var t=n["Control.Apply"];var r=n["Control.Apply"];var a=n["Data.Functor"];var e=function(n,t){this.Functor0=n;this.apply=t};var u=new e(function(){return a.functorArray},r.arrayApply);t["Apply"]=e;t["applyArray"]=u})(PS);(function(n){"use strict";n["Control.Applicative"]=n["Control.Applicative"]||{};var t=n["Control.Applicative"];var r=n["Control.Apply"];var a=function(n,t){this.Apply0=n;this.pure=t};var e=function(n){return n.pure};var u=new a(function(){return r.applyArray},function(n){return[n]});t["Applicative"]=a;t["pure"]=e;t["applicativeArray"]=u})(PS);(function(n){"use strict";n["Control.Plus"]=n["Control.Plus"]||{};var t=n["Control.Plus"];var r=n["Control.Alt"];var a=function(n,t){this.Alt0=n;this.empty=t};var e=new a(function(){return r.altArray},[]);var u=function(n){return n.empty};t["empty"]=u;t["plusArray"]=e})(PS);(function(n){"use strict";n["Control.Alternative"]=n["Control.Alternative"]||{};var t=n["Control.Alternative"];var r=n["Control.Applicative"];var a=n["Control.Plus"];var e=function(n,t){this.Applicative0=n;this.Plus1=t};var u=new e(function(){return r.applicativeArray},function(){return a.plusArray});t["alternativeArray"]=u})(PS);(function(n){"use strict";n.arrayBind=function(e){return function(n){var t=[];for(var r=0,a=e.length;r<a;r++){Array.prototype.push.apply(t,n(e[r]))}return t}}})(PS["Control.Bind"]=PS["Control.Bind"]||{});(function(n){"use strict";n["Control.Bind"]=n["Control.Bind"]||{};var t=n["Control.Bind"];var r=n["Control.Bind"];var a=n["Control.Apply"];var e=function(n){this.discard=n};var u=function(n,t){this.Apply0=n;this.bind=t};var i=function(n){return n.discard};var o=new u(function(){return a.applyArray},r.arrayBind);var c=function(n){return n.bind};var l=new e(function(n){return c(n)});t["Bind"]=u;t["bind"]=c;t["discard"]=i;t["bindArray"]=o;t["discardUnit"]=l})(PS);(function(n){"use strict";n["Control.Monad"]=n["Control.Monad"]||{};var t=n["Control.Monad"];var a=n["Control.Applicative"];var e=n["Control.Bind"];var r=function(n,t){this.Applicative0=n;this.Bind1=t};var u=new r(function(){return a.applicativeArray},function(){return e.bindArray});var i=function(r){return function(t){return function(n){return e.bind(r.Bind1())(t)(function(t){return e.bind(r.Bind1())(n)(function(n){return a.pure(r.Applicative0())(t(n))})})}}};t["Monad"]=r;t["ap"]=i;t["monadArray"]=u})(PS);(function(n){"use strict";n.boolConj=function(t){return function(n){return t&&n}};n.boolDisj=function(t){return function(n){return t||n}};n.boolNot=function(n){return!n}})(PS["Data.HeytingAlgebra"]=PS["Data.HeytingAlgebra"]||{});(function(n){"use strict";n["Data.HeytingAlgebra"]=n["Data.HeytingAlgebra"]||{};var t=n["Data.HeytingAlgebra"];var r=n["Data.HeytingAlgebra"];var e=function(n,t,r,a,e,u){this.conj=n;this.disj=t;this.ff=r;this.implies=a;this.not=e;this.tt=u};var u=function(n){return n.tt};var i=function(n){return n.not};var o=function(n){return n.implies};var c=function(n){return n.ff};var l=function(n){return n.disj};var a=new e(r.boolConj,r.boolDisj,false,function(t){return function(n){return l(a)(i(a)(Line truncated

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)