Acyclic Examples

AcyclicMoand.hs

module AcyclicMonad (dag, singleton, edgeTo) where
-- Only export dag, singleton and edgeTo.

import Control.Monad.Trans.State.Strict

type Vertex = Int

newtype DAG = DAG DAG' deriving Show

-- eg. Edges 4 [2, 3] (Edges 3 [1] (Edges 2 [1] (Edges 1 [] Nil)))
-- represents 4 * 2 + 4 * 3 + 3 * 1 + 2 * 1 + 1
data DAG'
  = Cons Vertex
         [DAG']
         DAG'
  | Nil
  deriving (Show)

-- A simple helper function
vertex (Cons i _ _) = i
vertex Nil = 0

-- A State monad creating a singleton
singleton = modify (\s -> Cons (1 + vertex s) [] s) >> get

-- A State monad resulting in proper edges
edgeTo es = modify (\s -> Cons (1 + vertex s) es s) >> get

-- A simple function to run the state to get DAG in return
dag = DAG . snd . flip runState Nil

-- The result : DAG 3 [1..DAG,2..DAG] (DAG 2 [] (DAG 1 [] Nil))
dagTest =
  dag $ do
    v1 <- singleton
    v2 <- singleton
    edgeTo [v1, v2]

Doesn't the current implementation need quadratic space? For example

    v1 <- singleton
    v2 <- edgeTo [v1]
    v3 <- edgeTo [v2, v1]
    v4 <- edgeTo [v3]
    v5 <- edgeTo [v4, v3, v1]
    edgeTo [v5, v1]

results in

DAG (Cons 6 [Cons 5 [Cons 4 [Cons 3 [Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil),Cons 1 [] Nil] (Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil))] (Cons 3 [Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil),Cons 1 [] Nil] (Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil))),Cons 3 [Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil),Cons 1 [] Nil] (Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil)),Cons 1 [] Nil] (Cons 4 [Cons 3 [Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil),Cons 1 [] Nil] (Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil))] (Cons 3 [Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil),Cons 1 [] Nil] (Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil)))),Cons 1 [] Nil] (Cons 5 [Cons 4 [Cons 3 [Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil),Cons 1 [] Nil] (Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil))] (Cons 3 [Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil),Cons 1 [] Nil] (Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil))),Cons 3 [Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil),Cons 1 [] Nil] (Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil)),Cons 1 [] Nil] (Cons 4 [Cons 3 [Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil),Cons 1 [] Nil] (Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil))] (Cons 3 [Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil),Cons 1 [] Nil] (Cons 2 [Cons 1 [] Nil] (Cons 1 [] Nil))))))

which seems to be rather big..

@anfelor
I believe underneath the representation is not huge.
If my understanding of Haskell is correct, then, Memory is allocated once and information is stored there.
When it is referenced further, underneath, Haskell would just use a pointer (of some kind) and does not allocate space again.
I might be wrong, please let me know!

If not, I think a simple way to solve this problem is something like the follows,

data DAG'
  = Cons Vertex
         [Vertex]
         DAG'
  | Nil
deriving (Show)

edgeTo es = modify (\s -> Cons (1 + vertex s) (map vertex es) s) >> get

Then something like,

    v1 <- singleton
    v2 <- edgeTo [v1]
    v3 <- edgeTo [v2, v1]
    v4 <- edgeTo [v3]
    v5 <- edgeTo [v4, v3, v1]
    edgeTo [v5, v1]

would result in,

DAG (Cons 6 [1, 5] (Cons 5 [1, 3, 4] (Cons 4 [3] (Cons 3 [2, 1] (Cons 2 [1] (Cons 1 [] Nil))))))

A few more changes are required (making Vertex a new type instead of type alias) to make it safe but I guess this should work!
Initially, this is what I made but traversing the graph is comparatively harder with this representation.

When it is referenced further, underneath, Haskell would just use a pointer (of some kind) and does not allocate space again.

You are right! In practice this would probably run in linear space.

This looks a bit like type-safe indexing into sized vectors as in Data.Vector.Sized. Maybe one could also define

data Acyclic n a = Acyclic (AdjacencyMap a) (Vector n a)
append :: a -> [Ordinal n] -> Acyclic n a -> Acyclic (S n) a

it would have the benefit of allowing the addition of new vertices outside of the "dag monad".

@anfelor

data Acyclic n a = Acyclic (AdjacencyMap a) (Vector n a)

Could you please give me a simple example?

I think one can go a step further and eliminate the "dag monad" completely? (But I don't think it's worth it.)
I try a few experiments and get back to you!