[Haskell-cafe] Test on identity?

[Olaf Klinke]

> 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, 
    MonadState Int m, 
    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