# [Haskell-cafe] Test on identity?

Olaf Klinke olf at aatal-apotheke.de
Wed Jul 8 21:26:11 UTC 2020

```> Dear CafĂ©,
>
> I'm trying to build a DAG from a binary tree. I don't think there's a
> big trouble.
> Nevertheless, I do even some transformations. Thus, I would like to
> know it is still a
> DAG, not adding, accidentally, a node.
>
> Is there any way, if I have data like
>
> data Ex
>   = Val Int
>   | Add Ex Ex
>
> so that I can test that some value Val i === Val i ? I mean, the
> pointers go to the
> same data box? I could do that via some IORefs, AFAIK, but I don't
> think it is
> feasible. Maybe to tune the algorithm...
>
> Best regards,
>
> Dusan

So the binary tree is a value e :: Ex, right? And the DAG (directed
acyclic graph) is an explicit representation of the internal pointer
structure in e? Did I understand you right?
This sounds like you should represent Ex as a fixed point and then
invoke some fixed point magic like catamorphisms. Your transformation
might have to be re-written as a cata/ana/hylomorphism, too. Below is a
recipe to turn any element of any fixed point type into a graph, that
is, into a list of nodes and edges. Of course this will loop if your
data was not a finite DAG, e.g. due to self-reference.

-- make type recursion for your type Ex explicit
data ExF x = Val Int | Add x x deriving (Show)
instance Functor ExF where
fmap f (Val i) = Val i
fmap f (Add x y) = Add (f x) (f y)
instance Foldable ExF where
foldMap _ (Val _) = mempty
foldMap f (Add x y) = f x <> f y
instance Traversable ExF where
traverse f (Val i) = pure (Val i)
traverse f (Add x y) = Add <\$> (f x) <*> (f y)

-- represent Ex via the general
-- Fix :: (* -> *) -> *
-- See e.g. package data-fix or recursion-schemes
-- cataM below taken from the data-fix package
type Ex = Fix ExF -- = Fix {unFix :: ExF (Fix ExF)}

-- Add () () tells you the node is internal
type ExNode = ExF ()

data GraphElem f = Node Int (f ()) | Edge Int Int
instance Show (GraphElem ExF) where
show (Node n (Val i))   = show n ++ ":Val " ++ show i
show (Node n (Add _ _)) = show n ++ ":Add"
show (Edge i j) = show i ++ " -> " ++ show j
type Graph = [GraphElem ExF]
type GraphM = StateT Int (Writer Graph)

structure :: (Traversable f,
MonadWriter [GraphElem f] m) =>
f Int -> m Int
structure fi = do
this <- get
tell [Node this (void fi)]
traverse (\child -> tell [Edge this child]) fi
put (this+1)
return this

-- depth-first traversal. More generally dag has type
-- (Traversable f) => Fix f -> [GraphElem f]
-- and the Traversable instance determines the order
-- of the traversal.
dag :: Ex -> Graph
dag = snd . runWriter . flip evalStateT 0 . cataM structure

-- Cheers, Olaf

```