Skip to content

Instantly share code, notes, and snippets.

@rayshih
Last active September 30, 2018 14:50
Show Gist options
  • Save rayshih/f22d511fbfbe3ebed2290c3067e5c1b0 to your computer and use it in GitHub Desktop.
Save rayshih/f22d511fbfbe3ebed2290c3067e5c1b0 to your computer and use it in GitHub Desktop.
DFS/BFS by Writer
module Main where
import Prelude
import Data.String (joinWith)
import Control.Monad.Eff.Console (logShow)
import Data.List (List(..), fromFoldable)
import Data.Monoid (class Monoid)
import Control.Monad.Writer (execWriter, tell)
import TryPureScript (render, withConsole)
type Id = Int
data Vertex = Vertex Id (Array Vertex)
tree :: Vertex
tree =
Vertex 0 [
Vertex 1 [Vertex 3 []],
Vertex 2 [],
Vertex 3 [Vertex 4 [Vertex 5 []]]
]
instance showVertex :: Show Vertex where
show (Vertex id children) = "Vertex " <> show id <> "[" <> childrenString <> "]"
where childrenString = joinWith "," $ map show children
data MaybeFirst a = Nothing | First a
instance showMaybeFirst :: Show a => Show (MaybeFirst a) where
show Nothing = "Nothing"
show (First a) = "(First " <> show a <> ")"
derive instance functorFirst :: Functor MaybeFirst
instance applyMaybeFirst :: Apply MaybeFirst where
apply (First f) (First x) = First (f x)
apply _ _ = Nothing
instance applicativeMaybeFirst :: Applicative MaybeFirst where
pure = First
instance semigroupMaybeFirst :: Semigroup (MaybeFirst a) where
append Nothing x = x
append a@(First _) _ = a
instance monoidMaybeFirst :: Monoid (MaybeFirst a) where
mempty = Nothing
type Enqueue = Array Vertex -> List Vertex -> List Vertex
search :: forall m
. Monoid (m Vertex)
=> Applicative m
=> Enqueue
-> Id
-> Vertex
-> m Vertex
search enqueue id v = execWriter $ go (pure v)
where
go Nil = pure unit
go (Cons v@(Vertex x children) vs) = do
when (x == id) do
tell $ pure v
go (enqueue children vs)
dfs :: forall m
. Monoid (m Vertex)
=> Applicative m
=> Id
-> Vertex
-> m Vertex
dfs = search prepend
where prepend children vs = fromFoldable children <> vs
bfs :: forall m
. Monoid (m Vertex)
=> Applicative m
=> Id
-> Vertex
-> m Vertex
bfs = search append
where append children vs = vs <> fromFoldable children
main = render =<< withConsole do
logShow $ (dfs 3 tree :: List Vertex)
logShow $ (bfs 3 tree :: List Vertex)
logShow $ (dfs 3 tree :: MaybeFirst Vertex)
logShow $ (bfs 3 tree :: MaybeFirst Vertex)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment