Sml folding a tree

Question

I am trying to get the product of a tree by using the fold function so far this is what I have. I am confused on how to use the fold method while transversing the tree

datatype 'a bin_tree = Leaf of 'a 
| Node of 'a bin_tree * 'a bin_tree


fun treefold g z Empty = z
| treefold g z (Node (l, x, r)) = g(x, g(treefold g z l, treefold g z r)

Answer 1

First, some pointers about what isn't quite in order in your attempt.

1. The base case of your treefold function matches against the value constructor Empty, but you don't define the bin_tree datatype to include an Empty value constructor.
2. As John Coleman points out in his comments, you've defined the Node value constructor to take a pair, but in your recursive case you match Node with a triple. Bearing in mind Simon Shine's excellent answer explaining folds over binary trees, we can probably infer the reason for this: your treefold function expects a canonical binary tree (where each node has a value and two branches) but the data structure you defined doesn't implement this structure. I'm not sure what the data structure you've defined is called, despite giving it a good google (though I think I've implemented it before!).
3. You apply g to z twice, once down the left branch and once down the right branch. This would mean the value passed in to that place will get included in the fold twice for every branch. I don't imagine that's what you intended.

(1) and (2) should both be caught by the type checker as soon as you try to compile or load your code. You should try this, if you haven't already, and make sure you understand the feedback the type checker provides. It is a very valuable tool.

(3) has to do with the nature of the function you intend to write, and it is only out of order if you didn't mean it.

Here's one way to define a fold over the data structure you defined.

structure Tree =
struct
    datatype 'a tree = Leaf of 'a
                     | Node of 'a tree * 'a tree

    fun foldl f x t =
      case t
       of Leaf y => f (x, y)              (* The base case *)
        | Node (treeL, treeR) =>
          let
              val l = foldl f x treeL     (* Recurse down the left branch *)
          in
              foldl f l treeR             (* Recurse down the right branch *)
          end
end

Notice that, having put foldl here in the Tree module, we now how have a function that mirrors the foldl function in the List structure (and elsewhere):

- List.foldl;
val it = fn : ('a * 'b -> 'b) -> 'b -> 'a list -> 'b
- Tree.foldl;
val it = fn : ('a * 'b -> 'a) -> 'a -> 'b bin_tree -> 'a

This would make it easier to parameterize over either lists or trees.

It works like so:

- foldl op+ 0 (Node (Leaf 3, Node (Node (Leaf 1, Leaf 2), Leaf 5)));
val it = 11 : int

Answer 2

When folding a binary tree,

datatype 'a tree = Leaf | Branch of 'a tree * 'a * 'a tree

you may traverse it in different ways. Among common strategies you have,

(* Pre-order *)
fun treefold_preorder f acc1 Leaf = acc1
  | treefold_preorder f acc1 (Branch (left, a, right)) =
    let val acc2 = treefold_preorder f acc1 left
        val acc3 = f (a, acc2)
        val acc4 = treefold_preorder f acc3 right
    in acc4 end

(* In-order *)
and treefold_inorder f acc1 Leaf = acc1
  | treefold_inorder f acc1 (Branch (left, a, right)) =
    let val acc2 = f (a, acc1)
        val acc3 = treefold_inorder f acc2 left
        val acc4 = treefold_inorder f acc3 right
    in acc4 end

(* Post-order *)
and treefold_postorder f acc1 Leaf = acc1
  | treefold_postorder f acc1 (Branch (left, a, right)) =
    let val acc2 = treefold_postorder f acc1 left
        val acc3 = treefold_postorder f acc2 right
        val acc4 = f (a, acc3)
    in acc4 end

which Wikipedia nicely illustrates as,

Usage

val treelist = treefold op:: []
val treeproduct = treefold op* 1
val treecount = treefold (fn (_, count) => count + 1) 0

Extra

In-order traversal isn't meaningful if each branch/node doesn't have an 'a value.

See also how to apply tail-recursion on trees to avoid stack overflows.

For some problems that involve tree traversal, it may be useful to supply the context of the traversal like paramorphisms do:

fun treecata_preorder f acc1 Leaf = acc1
  | treecata_preorder f acc1 (branch as Branch (left, a, right)) =
    let val acc2 = treecata_preorder f acc1 left
        val acc3 = f (a, branch, acc2)
        val acc4 = treecata_preorder f acc3 right
    in acc4 end

This is a slight generalisation of treefold_preorder in which f is fed the entire branch.

This lets you e.g. find people in an ancestry tree for which a predicate holds for their subtree,

fun treefilter pred =
    treecata_preorder (fn (x, xtree, acc) => if pred xtree then x::acc else acc) []

fun branchValue Leaf = NONE
  | branchValue (Branch (_, value, _)) = SOME value

fun parents Leaf = []
  | parents (Branch (left, _, right)) =
    List.mapPartial (fn xopt => xopt) [branchValue left, branchValue right]

type name = string
type age = int
datatype person = Person of name * age

fun retired (Person (_, age)) = age >= 70
fun hasRetiredParent tree = List.exists retired (parents tree)
val personsWithRetiredParents = treefilter hasRetiredParent

Another neat notion for tree traversal are zippers (LYAH chapter).