Recitation Notes #7: PS2 review and functional datastructures


Written by Alan Shieh

PS2 review

Fold & tree structured recursion

Several students asked how to implement tree recursion traversal in an efficient fashion. For instance, suppose you want to traverse a tree and generate a list of nodes from the tree in the traversal order. Here is a slower way to do this

  fun 'a enumerate(torder:P.traversal, root: 'a P.treenode):'a list = let
      fun enumerate' (t:'a P.treenode):'a list =
        case (t, torder) of
          (P.EMPTY, _) => []
        | (P.NODE(l, y, r), P.PREORDER) => [y] @ (enumerate' l) @ (enumerate' r)
        | (P.NODE(l, y, r), P.INORDER) => (enumerate' l) @ [y] @ (enumerate' r)
        | (P.NODE(l, y, r), P.POSTORDER) => (enumerate' l) @ (enumerate' r) @ [y]
  in
    enumerate' root
  end

This inefficient because there is no bound on the list lengths being combined by @. After generating the result for the left subtree, we must loop over the whole result during the @ just so we can create a new list with the remainder of the result. We can avoid this step by passing a partial result to the left recursion:

  fun 'a enumerateFaster(torder:P.traversal, root: 'a P.treenode):'a list = let
      fun enumerateFaster' (t:'a P.treenode, il:'a list):'a list =
        case (t, torder) of
          (P.EMPTY, _) => il
        | (P.NODE(l, y, r), P.PREORDER) => y::(enumerateFaster'(l, enumerateFaster'(r, il)))
        | (P.NODE(l, y, r), P.INORDER) => enumerateFaster'(l, y::enumerateFaster'(r,il))
        | (P.NODE(l, y, r), P.POSTORDER) => enumerateFaster'(l, enumerateFaster'(r,y::il))
  in
    enumerateFaster'(root,[])
  end

Note that a direct solution of tree fold, that is, one that doesn't first generate an intermediate list with the elements arranged in a preorder traversal, is naturally constrained to have the above structure:

  fun fold(torder:P.traversal) (f:'a * 'b -> 'b) (x:'b)
    ({compare, root}:'a P.bst):'b = let
      fun fold' (t:'a P.treenode) (x:'b):'b =
        case (t, torder) of
          (P.EMPTY, _) => x
        | (P.NODE(l, y, r), P.PREORDER) => fold' r (fold' l (f(y, x)))
        | (P.NODE(l, y, r), P.INORDER) => fold' r (f(y, (fold' l x)))
        | (P.NODE(l, y, r), P.POSTORDER) => f(y, fold' r (fold' l x))
  in
    fold' root x
  end

---

Recall that

  fold ORDER f acc t

computes

  f(t_n, ... f(t_1, f(t_0,acc)))

where [t_0, ..., t_n] is the traversal order. The order of f applications might seem counterintuitive. Reading left to right, it seems like the order is reversed. However, if we think of fold as looping over the tree, and f as the body of the loop, this makes sense. We first apply f to t_0, and then to the result of this iteration, and so on. So we are applying f to the nodes in the order of the traversal.

DFA

The DFA problem was designed to get you to think about applications of fold, and to factor out common functionality between tests. Here is the solution for DFA:

  fun generateReverseHistory(automaton: P.dfa, s: string): P.state list = 
      let
	  val (initialcstate, initialstate, _, transitions) = automaton
	  fun applytransition(currentstate: P.state, nextinput: char) : P.state=
	      case List.find (fn (tstate,tinput,nextstate) => 
			    tstate = currentstate andalso
			    tinput = nextinput)
			transitions of 
		  SOME((_,_,nextstate)) => nextstate
		| NONE => raise Fail(
				concat(["Could not find matching transition @ ",
					Int.toString(currentstate), " ", 
					Char.toString(nextinput), " ", 
					toString(automaton)]))
      in
	  foldl (fn (x:char, y: P.state list) => 
		    case y of
			[] => raise Fail "Impossible"
		      | laststate::_ => applytransition(laststate,x)::y)
		[initialcstate] 
		(explode s)
      end
  
  (* Requirement C: Check whether the dfa accepts s, and return the final state *)
  fun testAccept(automaton: P.dfa, s: string): bool * P.state = 
      let 
	  val (_, _, finalstates, _) = automaton
	  val finalState = 
	      case generateReverseHistory(automaton, s) of
		  [] => raise Fail "Impossible"
		| x::_ => x
      in 
	  (List.exists (fn x => x = finalState) finalstates, finalState)
      end 
  
  (* Requirement D: Check whether dfa encounters a loop in the sequence of state
     transitions *)
  fun hasloop(automaton: P.dfa, s: string) : bool = 
      let
	  val reverseHistory = generateReverseHistory(automaton, s)
      in
	  (* Is there any element of reverse history that occurs more than once? *)
	  List.exists 
	  (fn x => List.length(List.filter (fn y => y = x) reverseHistory) >= 2)
	  reverseHistory
      end
  
  (* Requirement E: Given two dfas, return the execution trace that arises when 
     both DFAs are executed in parallel *)
  
  fun parallel(a0: P.dfa, a1: P.dfa, s: string): (P.state * P.state) list = 
      let
	  val h0 = generateReverseHistory(a0,s)
	  val h1 = generateReverseHistory(a1,s)
      in
	  rev(ListPair.zip(h0,h1))
      end

generateReverseHistory generates the sequence of states that the DFA enters. It is a helper function that solves the other problems. To detect a loop, we check for repeated states. To check for acceptance, we check whether the last state in the sequence is an accept state. To generate parallel output, we compute the result for each machine in parallel. Subsequently, we use the basis function ListPair.zip to combine both outputs into a single list.

generateReverseHistory uses foldl to loop over the input. Accumulator is the history; it is used to check the last state and compute the next state.

Recursive vs Functional

What is a functional stack, or a functional queue? It is a data structure for which the operations do not change the data structure, but rather create a new data structure, with the appropriate modifications, instead of changing it in-place. In imperative languages, data operations generally support destructive update ? ?destructive? in the sense that after the update is done, the original data structure is gone. Functional abstractions support nondestructive updates: the original value is still around, unmodified.

Recall a stack: a last-in first-out (LIFO) queue. Just like lists, the stack operations fundamentally do not care about the type of the values stored, so it is a naturally polymorphic data structure.

Here is a possible signature for functional stacks:

  signature STACK = 
    sig
      type 'a stack
      exception EmptyStack
 
      val empty : 'a stack
      val isEmpty : 'a stack -> bool
 
      val push : ('a * 'a stack) -> 'a stack
      val pop : 'a stack -> 'a stack
      val top : 'a stack -> 'a
      val map : ('a -> 'b) -> 'a stack -> 'b stack
      val app :  ('a -> unit) -> 'a stack -> unit
      (* note: app traverses from top of stack down *)
    end

This signature specifies a parameterized abstract type for stack. Notice the type variable 'a. The signature also specifies the empty stack value, and functions to check if a stack is empty, and to perform push, pop and top operations on the stack. Moreover, we specify functions map and app to walk over the values of the stack.

We also declare an exception EmptyStack to be raised by top and pop operations when the stack is empty.

Here is the simplest implementation of stacks that matches the above signature. It is implemented in terms of lists.

  structure Stack :> STACK = 
    struct
      type 'a stack = 'a list
      exception Empty
 
      val empty : 'a stack = []
      fun isEmpty (l:'a list): bool = 
        (case l of
           [] => true
         | _ => false)
 
      fun push (x:'a, l:'a stack):'a stack = x::l
      fun pop (l:'a stack):'a stack = 
        (case l of 
           [] => raise Empty
         | (x::xs) => xs)
 
      fun top (l:'a stack):'a = 
        (case l of
           [] => raise Empty
         | (x::xs) => x)
 
      fun map (f:'a -> 'b) (l:'a stack):'b stack = List.map f l
      fun app (f:'a -> unit) (l:'a stack):unit = List.app f l
    end

Let us write an example more interesting than stacks. After all, from the above, one can see that they are just lists. Consider the queue data structure, a first-in first-out data structure. Again, we consider functional queues. Here is a possible signature:

  signature QUEUE =
    sig
      type 'a queue
      exception EmptyQueue
 
      val empty : 'a queue
      val isEmpty : 'a queue -> bool
 
      val enqueue : ('a * 'a queue) -> 'a queue
      val dequeue : 'a queue -> 'a queue
      val front : 'a queue -> 'a
 
      val map : ('a -> 'b) -> 'a queue -> 'b queue
      val app : ('a -> unit) -> 'a queue -> unit      
    end

The simplest possible implementation for queues is to represent a queue via two stacks: one stack A on which to enqueue elements, and one stack B from which to dequeue elements. When dequeuing, if stack B is empty, then we reverse stack A and consider it the new stack B. [[NOTE TO INSTRUCTOR: Use a picture or two to explain this]]

Here is an implementation for such queues. It uses the stack structure Stack, which is rebound to the name S inside the structure to avoid long identifier names. [[NOTE TO INSTRUCTOR: Focus on the aspects of the code that you find more interesting.]]

  structure Queue :> QUEUE = 
    struct
      structure S = Stack
 
      type 'a queue = ('a S.stack * 'a S.stack)
      exception EmptyQueue
 
      val empty : 'a queue = (S.empty, S.empty)
      fun isEmpty ((s1,s2):'a queue) = 
        S.isEmpty (s1) andalso S.isEmpty (s2) 
 
      fun enqueue (x:'a, (s1,s2):'a queue) : 'a queue = 
        (S.push (x,s1), s2)
 
      fun rev (s:'a S.stack):'a S.stack = let
        fun loop (old:'a S.stack, new:'a S.stack):'a S.stack = 
          if (S.isEmpty (old))
            then new
          else loop (S.pop (old), S.push (S.top (old),new))
      in
        loop (s,S.empty)
      end
 
      fun dequeue ((s1,s2):'a queue) : 'a queue = 
        if (S.isEmpty (s2))
          then (S.empty, S.pop (rev (s1))) 
                    handle S.EmptyStack => raise EmptyQueue
        else (s1,S.pop (s2))
 
      fun front ((s1,s2):'a queue):'a = 
        if (S.isEmpty (s2))
          then S.top (rev (s1))
                   handle S.EmptyStack => raise EmptyQueue
        else S.top (s2)
 
      fun map (f:'a -> 'b) ((s1,s2):'a queue):'b queue = 
        (S.map f s1, S.map f s2)
 
      fun app (f:'a -> unit) ((s1,s2):'a queue):unit = 
        (S.app f s2;
         S.app f (rev (s1)))
    end