axiom-source 20170501-3 / usr / share / axiom-20170501 / src / algebra / BBTREE.spad

)abbrev domain BBTREE BalancedBinaryTree
++ Description:
++ \spadtype{BalancedBinaryTree(S)} is the domain of balanced
++ binary trees (bbtree). A balanced binary tree of \spad{2**k} leaves,
++ for some \spad{k > 0}, is symmetric, that is, the left and right
++ subtree of each interior node have identical shape.
++ In general, the left and right subtree of a given node can differ
++ by at most leaf node.

BalancedBinaryTree(S) : SIG == CODE where
  S : SetCategory

  SIG ==> BinaryTreeCategory(S) with

    finiteAggregate

    shallowlyMutable

--  BUG: applies wrong fnct for balancedBinaryTree(0,[1,2,3,4])
--    balancedBinaryTree: (S, List S) -> %
--      ++ balancedBinaryTree(s, ls) creates a balanced binary tree with
--      ++ s at the interior nodes and elements of ls at the
--      ++ leaves.

    balancedBinaryTree : (NonNegativeInteger, S) -> %
      ++ balancedBinaryTree(n, s) creates a balanced binary tree with
      ++ n nodes each with value s.
      ++
      ++X balancedBinaryTree(4, 0)

    setleaves_! : (%, List S) -> %
      ++ setleaves!(t, ls) sets the leaves of t in left-to-right order
      ++ to the elements of ls.
      ++
      ++X t1:=balancedBinaryTree(4, 0)
      ++X setleaves!(t1,[1,2,3,4])

    mapUp_! : (%, (S,S) -> S) -> S
      ++ mapUp!(t,f) traverses balanced binary tree t in an "endorder"
      ++ (left then right then node) fashion returning t with the value
      ++ at each successive interior node of t replaced by
      ++ f(l,r) where l and r are the values at the immediate
      ++ left and right nodes.
      ++
      ++X T1:=BalancedBinaryTree Integer
      ++X t2:=balancedBinaryTree(4, 0)$T1
      ++X setleaves!(t2,[1,2,3,4]::List(Integer))
      ++X adder(a:Integer,b:Integer):Integer == a+b
      ++X mapUp!(t2,adder)
      ++X t2

    mapUp_! : (%, %, (S,S,S,S) -> S) -> %
      ++ mapUp!(t,t1,f) traverses balanced binary tree t in an "endorder"
      ++ (left then right then node) fashion returning t with the value
      ++ at each successive interior node of t replaced by
      ++ f(l,r,l1,r1) where l and r are the values at the immediate
      ++ left and right nodes. Values l1 and r1 are values at the
      ++ corresponding nodes of a balanced binary tree t1, of identical
      ++ shape at t.
      ++
      ++X T1:=BalancedBinaryTree Integer
      ++X t2:=balancedBinaryTree(4, 0)$T1
      ++X setleaves!(t2,[1,2,3,4]::List(Integer))
      ++X adder4(i:INT,j:INT,k:INT,l:INT):INT == i+j+k+l
      ++X mapUp!(t2,t2,adder4)
      ++X t2

    mapDown_! : (%,S,(S,S) -> S) -> %
      ++ mapDown!(t,p,f) returns t after traversing t in "preorder"
      ++ (node then left then right) fashion replacing the successive
      ++ interior nodes as follows. The root value x is
      ++ replaced by q := f(p,x). The mapDown!(l,q,f) and
      ++ mapDown!(r,q,f) are evaluated for the left and right subtrees
      ++ l and r of t.
      ++
      ++X T1:=BalancedBinaryTree Integer
      ++X t2:=balancedBinaryTree(4, 0)$T1
      ++X setleaves!(t2,[1,2,3,4]::List(Integer))
      ++X adder(i:Integer,j:Integer):Integer == i+j
      ++X mapDown!(t2,4::INT,adder)
      ++X t2

    mapDown_! : (%,S, (S,S,S) -> List S) -> %
      ++ mapDown!(t,p,f) returns t after traversing t in "preorder"
      ++ (node then left then right) fashion replacing the successive
      ++ interior nodes as follows. Let l and r denote the left and
      ++ right subtrees of t. The root value x of t is replaced by p.
      ++ Then f(value l, value r, p), where l and r denote the left
      ++ and right subtrees of t, is evaluated producing two values
      ++ pl and pr. Then \spad{mapDown!(l,pl,f)} and \spad{mapDown!(l,pr,f)}
      ++ are evaluated.
      ++
      ++X T1:=BalancedBinaryTree Integer
      ++X t2:=balancedBinaryTree(4, 0)$T1
      ++X setleaves!(t2,[1,2,3,4]::List(Integer))
      ++X adder3(i:Integer,j:Integer,k:Integer):List Integer == [i+j,j+k]
      ++X mapDown!(t2,4::INT,adder3)
      ++X t2

  CODE ==> BinaryTree(S) add

    Rep := BinaryTree(S)

    leaf? x ==
      empty? x => false
      empty? left x and empty? right x

    setleaves_!(t, u) ==
      n := #u
      n = 0 =>
        empty? t => t
        error "the tree and list must have the same number of elements"
      n = 1 =>
        setvalue_!(t,first u)
        t
      m := n quo 2
      acc := empty()$(List S)
      for i in 1..m repeat
        acc := [first u,:acc]
        u := rest u
      setleaves_!(left t, reverse_! acc)
      setleaves_!(right t, u)
      t

    balancedBinaryTree(n: NonNegativeInteger, val: S) ==
      n = 0 => empty()
      n = 1 => node(empty(),val,empty())
      m := n quo 2
      node(balancedBinaryTree(m, val), val,
           balancedBinaryTree((n - m) pretend NonNegativeInteger, val))

    mapUp_!(x,fn) ==
      empty? x => error "mapUp! called on a null tree"
      leaf? x  => x.value
      x.value := fn(mapUp_!(x.left,fn),mapUp_!(x.right,fn))

    mapUp_!(x,y,fn) ==
      empty? x  => error "mapUp! is called on a null tree"
      leaf? x  =>
        leaf? y => x
        error "balanced binary trees are incompatible"
      leaf? y  =>  error "balanced binary trees are incompatible"
      mapUp_!(x.left,y.left,fn)
      mapUp_!(x.right,y.right,fn)
      x.value := fn(x.left.value,x.right.value,y.left.value,y.right.value)
      x

    mapDown_!(x: %, p: S, fn: (S,S) -> S ) ==
      empty? x => x
      x.value := fn(p, x.value)
      mapDown_!(x.left, x.value, fn)
      mapDown_!(x.right, x.value, fn)
      x

    mapDown_!(x: %, p: S, fn: (S,S,S) -> List S) ==
      empty? x => x
      x.value := p
      leaf? x => x
      u := fn(x.left.value, x.right.value, p)
      mapDown_!(x.left, u.1, fn)
      mapDown_!(x.right, u.2, fn)
      x