Update a value in a tree

Question

I have some state that is represented as a tree

type Tree state 
  = Branch (List (Tree state))
  | Leaf state

and I have a function to update the individual leaves given some action

updateLeaf : action -> state -> state

I would like a way to represent actions in some structure

type Structure action = ...

which carries an action and some means to know precisely which leaf in the tree to update.

For example, suppose I have the following tree:

Branch 
  [ Leaf "foo"
  , Leaf "bar"
  , Branch 
      [ Leaf "baz"
      , Branch []
      , Leaf "qux"
      ]
  ]

and I get some action say, "hello" and I would like it to apply my updateLeaf function only on "baz" in such a way that I end up with

Branch 
  [ Leaf "foo"
  , Leaf "bar"
  , Branch 
      [ Leaf "bazhello"
      , Branch []
      , Leaf "qux"
      ]
  ]

assuming my updateLeaf function is just string concatenation or (++). Furthermore, I would need this to pretty generic as in the structure would somehow track the position in the tree of the leaf it wishes to update.

In essence what I am looking for is for the following function:

updateTree 
  : (action -> state -> state)
 -> Structure action
 -> Tree state
 -> Tree state 

which will figure out which leaf in the tree to apply the given update function.

Finally, I also need it to work with address forwarding. Suppose the each leaf of the tree is represented as a button

viewLeaf : Address action -> state -> Html
viewLeaf address state = 
  button 
    [ onClick address ... ]
    [ ... ]

and further suppose that the actions sent by the button on click are the ones that will update the state.

I would like to be able to define the following function

viewTree 
  : (Address action -> state -> Html)
 -> Address (Structure action) 
 -> Tree state
 -> Html

such that I can view all those buttons and the addresses are forwarded accordingly such that each button only affects itself. (I'm only interested in the forwarding aspect, not the visuals).

Thanks a lot for your help

Answer 1

A zipper is a way to navigate and modify a data structure. Suppose you have a tree, and you walk down the tree by choosing a branch. After 3 steps you encounter a leaf and you with to modify it. Now you want to return the modified tree, but you're 3 levels deep, how do you step back? Suppose that every time you go down a level in a tree, you leave a trail of breadcrumbs, so that you can reverse a step and reconstruct the tree. In other words, instead of just a tree you have a tuple (tree, breadcrumbs).

type Tree state = Branch (List (Tree state)) | Leaf state
-- Crumb contains 2 lists:
-- leafs/branches to the left of your focus
-- leafs/branches to the right of your focus
type Crumb state = Crumb (List (Tree state)) (List (Tree state))
type alias Zipper state = (Tree state, List (Crumb state))

tree : Tree String
tree = Branch [Leaf "foo",Leaf "bar",Branch [Leaf "baz",Branch [],Leaf "qux"]]

Every time you choose a branch, you cons the parent node and all other branches you didn't choose into breadcrumbs. Then you choose a new branch, so you cons its parent mode and all new branches you didn't choose in breadcrumbs. Therefore breadcrumbs contain all relevant information to reconstruct the previous step in reverse order. Let's implement going up and going to a leaf by name in a tree:

import Graphics.Element exposing (show)

break : (a -> Bool) -> List a -> (List a, List a)
break p xs = case (List.head xs, List.tail xs) of
  (Nothing, Nothing) -> ([], [])
  (Just x, Just xs') -> if p x
                        then ([], xs)
                        else let (ys,zs) = break p xs'
                             in (x::ys,zs)

treeInit : Tree state -> Zipper state
treeInit t = (t, [])

treeUp : Zipper state -> Zipper state
treeUp (subtree, Crumb l r::bs) = (Branch <| l++[subtree]++r, bs)

treeTo : state -> Zipper state -> Zipper state
treeTo name (Branch subtrees, bs) =
  let (l, x::r) = break (\(Leaf name') -> name == name') subtrees
  in (x, Crumb l r::bs)

main = tree |> treeInit |> treeTo "foo" |> show

But this doesn't allow to move focus from root to Leaf "baz" and doesn't allow to modify it, so let's add more functions (note that all our zipper functions can crash, we'll change this soon):

(!!) : List a -> Int -> a
xs !! i = case List.tail xs of
  Nothing -> Debug.crash "index out of bounds"
  Just xs' -> if i == 0
              then case List.head xs of Just x -> x
              else xs' !! (i-1)

treeToIndex : Int -> Zipper state -> Zipper state
treeToIndex i (Branch subtrees, bs) =
  (subtrees!!i, Crumb (List.take i subtrees) (List.drop (i+1) subtrees)::bs)

treeReplace : state -> Zipper state -> Zipper state
treeReplace new (Leaf old, bs) = (Leaf new, bs)

main = tree |> treeInit |> treeToIndex 2 |> treeTo "baz" |> treeReplace "xyzzy" |> show

This whole chain of functions can crash easily if there is an index bigger than the branch size, or you try to go up from the root, and so on. Instead we should wrap the results in Maybe, so that instead of a crash, Nothing is returned. But how do we chain functions, now that they return Maybe (Zipper state), while they still accept Zipper state? This is where you use andThen, which has the type Maybe a -> (a -> Maybe b) -> Maybe b. Full code of your zipper below:

import Graphics.Element exposing (show)
import Maybe exposing (andThen)

type Tree state = Branch (List (Tree state)) | Leaf state
-- Crumb contains 2 lists:
-- leafs/branches to the left of your focus
-- leafs/branches to the right of your focus
type Crumb state = Crumb (List (Tree state)) (List (Tree state))
type alias Zipper state = (Tree state, List (Crumb state))

tree : Tree String
tree = Branch [Leaf "foo",Leaf "bar",Branch [Leaf "baz",Branch [],Leaf "qux"]]

break : (a -> Bool) -> List a -> (List a, List a)
break p xs = case (List.head xs, List.tail xs) of
  (Nothing, Nothing) -> ([], [])
  (Just x, Just xs') -> if p x
                        then ([], xs)
                        else let (ys,zs) = break p xs'
                             in (x::ys,zs)

treeInit : Tree state -> Zipper state
treeInit t = (t, [])

treeUp : Zipper state -> Maybe (Zipper state)
treeUp (subtree, bs) = case bs of
  [] -> Nothing
  Crumb l r::bs' -> Just (Branch <| l++[subtree]++r, bs')

treeTo : state -> Zipper state -> Maybe (Zipper state)
treeTo name node = case node of
  (Branch subtrees, bs) ->
    let (l, x::r) = break (\(Leaf name') -> name == name') subtrees
    in Just (x, Crumb l r::bs)
  _ -> Nothing

(!!) : List a -> Int -> Maybe a
xs !! i = case List.tail xs of
  Nothing -> Nothing
  Just xs' -> if i == 0
              then List.head xs
              else xs' !! (i-1)

treeToIndex : Int -> Zipper state -> Maybe (Zipper state)
treeToIndex i (Branch subtrees, bs) =
  let newTree = subtrees!!i
  in case newTree of
    Nothing -> Nothing
    Just newTree ->
      let newCrumb = Crumb (List.take i subtrees) (List.drop (i+1) subtrees)
      in Just (newTree, newCrumb::bs)

treeReplace : state -> Zipper state -> Maybe (Zipper state)
treeReplace new node = case node of
  (Leaf old, bs) -> Just (Leaf new, bs)
  _ -> Nothing

-- the function you're interested in most likely
treeUpdate : (state -> state) -> Zipper state -> Maybe (Zipper state)
treeUpdate f node = case node of
  (Leaf name, bs) -> Just (Leaf (f name), bs)
  _ -> Nothing

main = (tree |> treeInit |> treeToIndex 2)
       `andThen` treeTo "baz" `andThen` treeReplace "xyzzy"
       `andThen` treeUp `andThen` treeUp |> show

(Feel absolutely free to ask questions and clarifications, and I will update and improve this answer)