How do I code a tree of objects in Haskell with po

Question

I've got the following problem: I have a tree of objects of different classes where an action in the child class invalidates the parent. In imperative languages, it is trivial to do. For example, in Java:

public class A {
    private List<B> m_children = new LinkedList<B>();
    private boolean m_valid = true;

    public void invalidate() {
        m_valid = false;
    }

    public void addChild(B child) {
        m_children.add(child);
        child.m_parent = this;
    }
}

public class B {
    public A m_parent = null;
    private int m_data = 0;

    public void setData(int data) {
        m_data = 0;
        m_parent.invalidate();
    }
}

public class Main {
    public static void main(String[] args) {
        A a = new A();
        B b = new B();
        b.setData(0); //invalidates A
    }
}

How do I do the above in Haskell? I cannot wrap my mind around this, since once I construct an object in Haskell, it cannot be changed.

I would be much obliged if the relevant Haskell code is posted.

EDIT: the problem I am trying to solve is the following:

I have an application that edits documents. A document is a hierarchy of objects. When properties of children objects are modified, the document needs to be set to an invalid state, so as that the user knows that the document needs to be validated.

Answer 1

Here is some zipper code that demonstrates easy modification of the data a cursor points at as well as a "global" property of the tree. We build a tree, move the cursor to the node initially containing a 1, change it to a 3, and are left with a cursor pointing at that node in a fully updated tree.

import Data.Maybe (fromJust)
import Data.Tree
import Data.Tree.Zipper

type NodeData = Either Bool Int
type TreePath a = [TreePos Full a -> TreePos Full a]

firstChild' = fromJust . firstChild
parent'     = fromJust . parent
prev'       = fromJust . prev
next'       = fromJust . next

-- Determine the path from the root of the tree to the cursor.
pathToMe :: TreePos Full NodeData -> TreePath NodeData
pathToMe t | isRoot t  = []
           | isFirst t = firstChild' : pathToMe (parent' t)
           | otherwise = next' : pathToMe (prev' t)

-- Mark a tree as invalid, but leave the cursor in the same place.
invalidate :: TreePos Full NodeData -> TreePos Full NodeData
invalidate t = foldr ($) (setLabel (Left False) (root t)) (pathToMe t)

-- Set a node's internal data.
setData :: Int -> TreePos Full NodeData -> TreePos Full NodeData
setData = (invalidate . ) . setLabel . Right

main = let tree1 = Node (Left True) [Node (Right 1) [], Node (Right 2) []]
           Just cursor = firstChild (fromTree tree1)
           tree2 = setData 3 cursor
       in do putStrLn (drawTree (fmap show tree1))
             putStrLn (drawTree (fmap show (toTree tree2)))
             putStrLn $ "Cursor at "++show (label tree2)

Output:

Left True
|
+- Right 1
|
`- Right 2

Left False
|
+- Right 3
|
`- Right 2

Cursor at Right 3

Answer 2

I don't have much experience with Haskell, but as far as I know it's not possible to have circles in the reference graph in pure functional languages. That means that:

1. You can't have a 2-way lists, children in trees pointing to their parents, etc.*
2. It is usually not enough to change just one node. Any node that is changed requires changes in every node starting from the "root" of the data structures all the way to the node you wish to change.

The bottom line is, I wouldn't try to take a Java (or any other imperative language) algorithm and try to convert it to Haskell. Instead, try to find a more functional algorithm (and maybe even a different data structure) to solve the problem.

EDIT:

From your clarification it's not entirely clear whether or not you need to invalidate only the direct parent of the object that changed or all its ancestors in the hierarchy, but that doesn't actually matter that much. Since invalidating an object basically means changing it and that's not possible, you basically have to create a modified duplicate of that object, and then you have to make its parent point to it to, so you have to create a new object for that as well. This goes on until you get to the root. If you have some recursion to traverse the tree in order to "modify" your object, then you can recreate the path from that object to the root on your way out of the recursion.

Hope that made sense. :s

*As pointed out in the comments by jberryman and in other answers, it is possible to create circular reference graphs in Haskell using lazy evaluation.

Answer 3

To answer the question in your title: Yes, you can create nodes which have links to their parents as well as their children. Example:

--               parent       children
data Tree = Node (Maybe Tree) [Tree]
root = Node Nothing [a,b] -- I can "forward reference" a and b because haskell is lazy
a = Node (Just root) []
b = Node (Just root) []

The question is whether that's useful for your particular use-case (often times it isn't).

Now the question in your body: You're right, you can't change a value after it's been created. So once you have a valid tree, you'll always have a valid tree as long as the variable referencing that tree is in scope.

You didn't really describe what problem you're trying to solve, so I can't tell you how to functionally model what you're trying to do, but I'm sure there's a way without mutating the tree.

Answer 4

Couldn't laziness take care of making sure validation doesn't happen too often? That way, you don't need to store the m_valid field.

For example, if you only validate on save, then you can edit the objects to your hearts content, without revalidating all the time; only when the user presses the 'Save' button is the value of validateDoc computed. Since I don't know for sure what your notion of valid means and what you need it for, I might be totally of the mark.

Untried & incomplete code:

data Document = Document { subDocs :: [SubDoc] }
data SubDoc = SubDoc { content :: String }

addSubDoc :: SubDoc -> (Document -> Document)
addSubDoc = error "not yet implemented: addSubDoc"

modifySubDoc :: Int -> (SubDoc -> SubDoc) -> (Document -> Document)
modifySubDoc = error "not yet implemented: modifySubDoc"


validateDoc :: Document -> Bool
validateDoc = all validateSubDoc . subDocs

validateSubDoc :: SubDoc -> Bool
validateSubDoc = not . null . contents

I'm assuming the overall validity of the document depends only on the subdocuments (simulated here by ensuring that they contain a non-empty string).

By the way, I think you forgot a a.addChild(b); in main.

Answer 5

Modifying a tree which might require frequent excursions up the path to the root and back seems like the perfect job for a variant of the Zipper data structure with "scars", in the terminology of the original paper by Huet; the code samples from the paper also suggest a name of "memorising zipper". Of course, with some care, a regular zipper could also be used, but the augmented version might be more convenient and/or efficient to use.

The basic idea is the same as that behind a regular zipper, which already allows one to move up and down a tree in a purely functional manner (without any explicit back-pointers), but a "go up" operation followed by a "go down" operation becomes a no-op, leaving the focus at the original node (whereas with the regular zipper it would move it to the leftmost sibling of the original node).

Here's a link to the paper: Gérard Huet, Functional Pearl: The Zipper. It's just six pages, but the ideas contained therein are of great usefulness to any functional programmer.

Answer 6

Look into using the Functor instance of the Maybe type.

For example, maybe your problem is something like this: you want to insert an element into a binary tree, but only if it isn't already present. You could do that with something like:

data Tree a = Node a (Tree a) (Tree a)
            | Tip

maybeInsert :: a -> Tree a -> Maybe (Tree a)
maybeInsert a Tip = Just $ Node a Tip Tip
maybeInsert a (Node a' l r)
    | a == a' = Nothing
    | a < a'  = fmap (\l'-> Node a' l' r) (maybeInsert a l)
    | a > a'  = fmap (\r'-> Node a' l r') (maybeInsert a r)

So the function will return Nothing if we found the element to be already present, or return Just the new tree with the element inserted.

Hopefully that is relevant to whatever you are trying to do.