Initial population.

1 files changed, 694 insertions, 0 deletions

diff --git a/src/algebra/tree.spad.pamphlet b/src/algebra/tree.spad.pamphlet
new file mode 100644
index 00000000..ff8ba34c
--- /dev/null
+++ b/src/algebra/tree.spad.pamphlet
@@ -0,0 +1,694 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/algebra tree.spad}
+\author{William Burge}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{domain TREE Tree}
+<<domain TREE Tree>>=
+)abbrev domain TREE Tree
+++ Author:W. H. Burge
+++ Date Created:17 Feb 1992
+++ Date Last Updated:
+++ Basic Operations:
+++ Related Domains:
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ Examples:
+++ References:
+++ Description: \spadtype{Tree(S)} is a basic domains of tree structures.
+++ Each tree is either empty or else is a {\it node} consisting of a value and
+++ a list of (sub)trees.
+Tree(S: SetCategory): T==C where
+ T== RecursiveAggregate(S) with
+     finiteAggregate
+     shallowlyMutable
+     tree: (S,List %) -> %
+       ++ tree(nd,ls) creates a tree with value nd, and children
+       ++ ls.
+     tree: List S -> %
+       ++ tree(ls) creates a tree from a list of elements of s. 
+     tree: S -> %
+       ++ tree(nd) creates a tree with value nd, and no children
+     cyclic?: % -> Boolean
+       ++ cyclic?(t) tests if t is a cyclic tree.
+     cyclicCopy: % -> %
+      ++ cyclicCopy(l) makes a copy of a (possibly) cyclic tree l.
+     cyclicEntries:    % -> List %
+       ++ cyclicEntries(t) returns a list of top-level cycles in tree t.
+     cyclicEqual?: (%, %) -> Boolean
+       ++ cyclicEqual?(t1, t2) tests of two cyclic trees have 
+       ++ the same structure.
+     cyclicParents: % -> List %
+       ++ cyclicParents(t) returns a list of cycles that are parents of t.
+ C== add
+    cycleTreeMax ==> 5
+
+    Rep := Union(node:Record(value: S, args: List %),empty:"empty")
+    t:%
+    br:%
+    s: S
+    ls: List S
+    empty? t == t case empty
+    empty()  == ["empty"]
+    children t == 
+      t case empty => error "cannot take the children of an empty tree" 
+      (t.node.args)@List(%)
+    setchildren_!(t,lt) == 
+      t case empty => error "cannot set children of an empty tree"
+      (t.node.args:=lt;t pretend %)
+    setvalue_!(t,s) == 
+      t case empty => error "cannot set value of an empty tree"
+      (t.node.value:=s;s)
+    count(n, t) == 
+      t case empty => 0
+      i := +/[count(n, c) for c in children t]
+      value t = n => i + 1
+      i
+    count(fn: S -> Boolean, t: %): NonNegativeInteger ==
+      t case empty => 0
+      i := +/[count(fn, c) for c in children t]
+      fn value t => i + 1
+      i
+    map(fn, t) == 
+      t case empty => t
+      tree(fn value t,[map(fn, c) for c in children t])
+    map_!(fn, t) == 
+      t case empty => t
+      setvalue_!(t, fn value t)
+      for c in children t repeat map_!(fn, c)
+    tree(s,lt) == [[s,lt]]
+    tree(s) == [[s,[]]]
+    tree(ls) ==
+      empty? ls => empty()
+      tree(first ls, [tree s for s in rest ls])
+    value t ==
+      t case empty => error "cannot take the value of an empty tree" 
+      t.node.value
+    child?(t1,t2) == 
+      empty? t2 => false
+      "or"/[t1 = t for t in children t2]
+    distance1(t1: %, t2: %): Integer ==
+      t1 = t2 => 0
+      t2 case empty => -1
+      u := [n for t in children t2 | (n := distance1(t1,t)) >= 0]
+      #u > 0 => 1 + "min"/u 
+      -1 
+    distance(t1,t2) == 
+      n := distance1(t1, t2)
+      n >= 0 => n
+      distance1(t2, t1)
+    node?(t1, t2) ==
+      t1 = t2 => true
+      t case empty => false
+      "or"/[node?(t1, t) for t in children t2]
+    leaf? t == 
+      t case empty => false
+      empty? children t
+    leaves t == 
+      t case empty => empty()
+      leaf? t => [value t]
+      "append"/[leaves c for c in children t]
+    less? (t, n) == # t < n
+    more?(t, n) == # t > n
+    nodes t ==       ---buggy
+      t case empty => empty()
+      nl := [nodes c for c in children t]
+      nl = empty() => [t]
+      cons(t,"append"/nl)
+    size? (t, n) == # t = n
+    any?(fn, t) ==  ---bug fixed
+      t case empty => false
+      fn value t or "or"/[any?(fn, c) for c in children t]
+    every?(fn, t) == 
+      t case empty => true
+      fn value t and "and"/[every?(fn, c) for c in children t]
+    member?(n, t) == 
+      t case empty => false
+      n = value t or "or"/[member?(n, c) for c in children t]
+    members t == parts t
+    parts t == --buggy?
+      t case empty => empty()
+      u := [parts c for c in children t]
+      u = empty() => [value t]
+      cons(value t,"append"/u)
+ 
+    ---Functions that guard against cycles: =, #, copy-------------
+
+    -----> =   
+    equal?: (%, %, %, %, Integer) -> Boolean
+
+    t1 = t2 == equal?(t1, t2, t1, t2, 0) 
+
+    equal?(t1, t2, ot1, ot2, k) ==
+      k = cycleTreeMax and (cyclic? ot1 or cyclic? ot2) => 
+        error "use cyclicEqual? to test equality on cyclic trees"
+      t1 case empty => t2 case empty
+      t2 case empty => false
+      value t1 = value t2 and (c1 := children t1) = (c2 := children t2) and
+        "and"/[equal?(x,y,ot1, ot2,k + 1) for x in c1 for y in c2]
+
+    -----> #
+    treeCount: (%, %, NonNegativeInteger) -> NonNegativeInteger    
+    # t == treeCount(t, t, 0)
+    treeCount(t, origTree, k) ==
+      k = cycleTreeMax and cyclic? origTree => 
+        error "# is not defined on cyclic trees"
+      t case empty => 0
+      1 + +/[treeCount(c, origTree, k + 1) for c in children t]
+ 
+    -----> copy
+    copy1: (%, %, Integer) -> %
+    copy t == copy1(t, t, 0)
+    copy1(t, origTree, k) == 
+      k = cycleTreeMax and cyclic? origTree => 
+        error "use cyclicCopy to copy a cyclic tree"
+      t case empty  => t
+      empty? children t => tree value t
+      tree(value t, [copy1(x, origTree, k + 1) for x in children t])
+      
+    -----------Functions that allow cycles---------------
+    --local utility functions:
+    eqUnion: (List %, List %) -> List %
+    eqMember?: (%, List %) -> Boolean
+    eqMemberIndex: (%, List %, Integer) -> Integer
+    lastNode: List % -> List %
+    insert: (%, List %) -> List %
+
+    -----> coerce to OutputForm
+    if S has SetCategory then
+      multipleOverbar: (OutputForm, Integer, List %) -> OutputForm
+      coerce1: (%, List %, List %) -> OutputForm
+
+      coerce(t:%): OutputForm == coerce1(t, empty()$(List %), cyclicParents t)
+
+      coerce1(t,parents, pl) ==
+        t case empty => empty()@List(S)::OutputForm
+        eqMember?(t, parents) => 
+          multipleOverbar((".")::OutputForm,eqMemberIndex(t, pl,0),pl)
+        empty? children t => value t::OutputForm
+        nodeForm := (value t)::OutputForm
+        if (k := eqMemberIndex(t, pl, 0)) > 0 then
+           nodeForm := multipleOverbar(nodeForm, k, pl)
+        prefix(nodeForm, 
+          [coerce1(br,cons(t,parents),pl) for br in children t])
+
+      multipleOverbar(x, k, pl) ==
+        k < 1 => x
+        #pl = 1 => overbar x
+        s : String := "abcdefghijklmnopqrstuvwxyz"
+        c := s.(1 + ((k - 1) rem 26))
+        overlabel(c::OutputForm, x)
+ 
+    -----> cyclic?
+    cyclic2?: (%, List %) -> Boolean
+
+    cyclic? t == cyclic2?(t, empty()$(List %))
+
+    cyclic2?(x,parents) ==  
+      empty? x => false
+      eqMember?(x, parents) => true
+      for y in children x repeat
+        cyclic2?(y,cons(x, parents)) => return true
+      false
+ 
+    -----> cyclicCopy
+    cyclicCopy2: (%, List %) -> %
+    copyCycle2: (%, List %) -> %
+    copyCycle4: (%, %, %, List %) -> %
+
+    cyclicCopy(t) == cyclicCopy2(t, cyclicEntries t)
+
+    cyclicCopy2(t, cycles) ==
+      eqMember?(t, cycles) => return copyCycle2(t, cycles)
+      tree(value t, [cyclicCopy2(c, cycles) for c in children t])
+   
+    copyCycle2(cycle, cycleList) == 
+      newCycle := tree(value cycle, nil)
+      setchildren!(newCycle,
+        [copyCycle4(c,cycle,newCycle, cycleList) for c in children cycle])
+      newCycle
+
+    copyCycle4(t, cycle, newCycle, cycleList) == 
+      empty? cycle => empty()
+      eq?(t, cycle) => newCycle
+      eqMember?(t, cycleList) => copyCycle2(t, cycleList)
+      tree(value t,
+           [copyCycle4(c, cycle, newCycle, cycleList) for c in children t])
+
+    -----> cyclicEntries
+    cyclicEntries3: (%, List %, List %) -> List %
+
+    cyclicEntries(t) == cyclicEntries3(t, empty()$(List %), empty()$(List %))
+
+    cyclicEntries3(t, parents, cl) ==
+      empty? t => cl
+      eqMember?(t, parents) => insert(t, cl)
+      parents := cons(t, parents)
+      for y in children t repeat
+        cl := cyclicEntries3(t, parents, cl)
+      cl
+   
+    -----> cyclicEqual?
+    cyclicEqual4?: (%, %, List %, List %) -> Boolean
+
+    cyclicEqual?(t1, t2) ==
+      cp1 := cyclicParents t1
+      cp2 := cyclicParents t2
+      #cp1 ^= #cp2 or null cp1 => t1 = t2
+      cyclicEqual4?(t1, t2, cp1, cp2)
+
+    cyclicEqual4?(t1, t2, cp1, cp2) == 
+      t1 case empty => t2 case empty
+      t2 case empty => false
+      0 ^= (k := eqMemberIndex(t1, cp1, 0)) => eq?(t2, cp2 . k)
+      value t1 = value t2 and 
+        "and"/[cyclicEqual4?(x,y,cp1,cp2) 
+                 for x in children t1 for y in children t2]
+
+    -----> cyclicParents t
+    cyclicParents3: (%, List %, List %) -> List %
+
+    cyclicParents t == cyclicParents3(t, empty()$(List %), empty()$(List %))
+
+    cyclicParents3(x, parents, pl) ==
+      empty? x => pl
+      eqMember?(x, parents) => 
+        cycleMembers := [y for y in parents while not eq?(x,y)]
+        eqUnion(cons(x, cycleMembers), pl)
+      parents := cons(x, parents)
+      for y in children x repeat 
+        pl := cyclicParents3(y, parents, pl)
+      pl
+
+    insert(x, l) ==
+      eqMember?(x, l) => l
+      cons(x, l)
+
+    lastNode l ==
+      empty? l => error "empty tree has no last node"
+      while not empty? rest l repeat l := rest l
+      l
+
+    eqMember?(y,l) ==
+      for x in l repeat eq?(x,y) => return true
+      false
+
+    eqMemberIndex(x, l, k) ==
+      null l => k
+      k := k + 1
+      eq?(x, first l) => k
+      eqMemberIndex(x, rest l, k)
+
+    eqUnion(u, v) ==
+      null u => v
+      x := first u
+      newV :=
+        eqMember?(x, v) => v
+        cons(x, v)
+      eqUnion(rest u, newV)
+
+@
+\section{category BTCAT BinaryTreeCategory}
+<<category BTCAT BinaryTreeCategory>>=
+)abbrev category BTCAT BinaryTreeCategory
+++ Author:W. H. Burge
+++ Date Created:17 Feb 1992
+++ Date Last Updated:
+++ Basic Operations:
+++ Related Domains:
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ Examples:
+++ References:
+++ Description: \spadtype{BinaryTreeCategory(S)} is the category of
+++ binary trees: a tree which is either empty or else is a \spadfun{node} consisting
+++ of a value and a \spadfun{left} and \spadfun{right}, both binary trees. 
+BinaryTreeCategory(S: SetCategory): Category == BinaryRecursiveAggregate(S) with
+   shallowlyMutable
+     ++ Binary trees have updateable components
+   finiteAggregate
+     ++ Binary trees have a finite number of components
+   node: (%,S,%) -> %
+     ++ node(left,v,right) creates a binary tree with value \spad{v}, a binary
+     ++ tree \spad{left}, and a binary tree \spad{right}.
+ add
+     cycleTreeMax ==> 5
+
+     copy t ==
+       empty? t => empty()
+       node(copy left t, value t, copy right t)
+     if % has shallowlyMutable then
+       map_!(f,t) ==
+         empty? t => t
+         t.value := f(t.value)
+         map_!(f,left t)
+         map_!(f,right t)
+         t
+     if % has finiteAggregate then
+       treeCount : (%, NonNegativeInteger) -> NonNegativeInteger
+       #t == treeCount(t,0)
+       treeCount(t,k) ==
+         empty? t => k
+         k := k + 1
+         k = cycleTreeMax and cyclic? t => error "cyclic binary tree"
+         k := treeCount(left t,k)
+         treeCount(right t,k)
+
+@
+\section{domain BTREE BinaryTree}
+<<domain BTREE BinaryTree>>=
+)abbrev domain BTREE BinaryTree
+++ Description: \spadtype{BinaryTree(S)} is the domain of all
+++ binary trees. A binary tree over \spad{S} is either empty or has
+++ a \spadfun{value} which is an S and a \spadfun{right}
+++ and \spadfun{left} which are both binary trees.
+BinaryTree(S: SetCategory): Exports == Implementation where
+  Exports == BinaryTreeCategory(S) with
+     binaryTree: S -> %
+       ++ binaryTree(v) is an non-empty binary tree
+       ++ with value v, and left and right empty.
+     binaryTree: (%,S,%) -> %    
+       ++ binaryTree(l,v,r) creates a binary tree with
+       ++ value v with left subtree l and right subtree r.
+  Implementation == add
+     Rep := List Tree S
+     t1 = t2 == (t1::Rep) =$Rep (t2::Rep)
+     empty()== [] pretend %
+     empty()== [] pretend %
+     node(l,v,r) == cons(tree(v,l:Rep),r:Rep)
+     binaryTree(l,v,r) == node(l,v,r)
+     binaryTree(v:S) == node(empty(),v,empty())
+     empty? t == empty?(t)$Rep
+     leaf? t  == empty? t or empty? left t and empty? right t
+     right t ==
+       empty? t => error "binaryTree:no right"
+       rest t
+     left t ==
+       empty? t => error "binaryTree:no left"
+       children first t
+     value t==
+       empty? t => error "binaryTree:no value"
+       value first t
+     setvalue_! (t,nd)==
+       empty? t => error "binaryTree:no value to set"
+       setvalue_!(first(t:Rep),nd)
+       nd
+     setleft_!(t1,t2) ==
+       empty? t1 => error "binaryTree:no left to set"
+       setchildren_!(first(t1:Rep),t2:Rep)
+       t1
+     setright_!(t1,t2) ==
+       empty? t1 => error "binaryTree:no right to set"
+       setrest_!(t1:List Tree S,t2)
+
+@
+\section{domain BSTREE BinarySearchTree}
+<<domain BSTREE BinarySearchTree>>=
+)abbrev domain BSTREE BinarySearchTree
+++ Description: BinarySearchTree(S) is the domain of
+++ a binary trees where elements are ordered across the tree.
+++ A binary search tree is either empty or has
+++ a value which is an S, and a
+++ right and left which are both BinaryTree(S)
+++ Elements are ordered across the tree.
+BinarySearchTree(S: OrderedSet): Exports == Implementation where
+  Exports == BinaryTreeCategory(S) with
+    shallowlyMutable
+    finiteAggregate
+    binarySearchTree: List S -> %
+	++ binarySearchTree(l) \undocumented
+    insert_!: (S,%) -> %
+      ++ insert!(x,b) inserts element x as leaves into binary search tree b.
+    insertRoot_!: (S,%) -> %
+      ++ insertRoot!(x,b) inserts element x as a root of binary search tree b.
+    split:      (S,%) -> Record(less: %, greater: %)
+      ++ split(x,b) splits binary tree b into two trees, one with elements greater
+      ++ than x, the other with elements less than x.
+  Implementation == BinaryTree(S) add
+    Rep := BinaryTree(S)
+    binarySearchTree(u:List S) ==
+      null u => empty()
+      tree := binaryTree(first u)
+      for x in rest u repeat insert_!(x,tree)
+      tree
+    insert_!(x,t) ==
+      empty? t => binaryTree(x)
+      x >= value t =>
+        setright_!(t,insert_!(x,right t))
+        t
+      setleft_!(t,insert_!(x,left t))
+      t
+    split(x,t) ==
+      empty? t => [empty(),empty()]
+      x > value t =>
+        a := split(x,right t)
+        [node(left t, value t, a.less), a.greater]
+      a := split(x,left t)
+      [a.less, node(a.greater, value t, right t)]
+    insertRoot_!(x,t) ==
+      a := split(x,t)
+      node(a.less, x, a.greater)
+
+@
+\section{domain BTOURN BinaryTournament}
+<<domain BTOURN BinaryTournament>>=
+)abbrev domain BTOURN BinaryTournament
+++ Description: \spadtype{BinaryTournament(S)} is the domain of
+++ binary trees where elements are ordered down the tree.
+++ A binary search tree is either empty or is a node containing a
+++ \spadfun{value} of type \spad{S}, and a \spadfun{right}
+++ and a \spadfun{left} which are both \spadtype{BinaryTree(S)}
+BinaryTournament(S: OrderedSet): Exports == Implementation where
+  Exports == BinaryTreeCategory(S) with
+    shallowlyMutable
+    binaryTournament: List S -> %
+      ++ binaryTournament(ls) creates a binary tournament with the
+      ++ elements of ls as values at the nodes.
+    insert_!: (S,%) -> %
+      ++ insert!(x,b) inserts element x as leaves into binary tournament b.
+  Implementation == BinaryTree(S) add
+    Rep := BinaryTree(S)
+    binaryTournament(u:List S) ==
+      null u => empty()
+      tree := binaryTree(first u)
+      for x in rest u repeat insert_!(x,tree)
+      tree
+    insert_!(x,t) ==
+      empty? t => binaryTree(x)
+      x > value t =>
+        setleft_!(t,copy t)
+        setvalue_!(t,x)
+        setright_!(t,empty())
+      setright_!(t,insert_!(x,right t))
+      t
+
+@
+\section{domain BBTREE BalancedBinaryTree}
+<<domain BBTREE BalancedBinaryTree>>=
+)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: SetCategory): Exports == Implementation where
+  Exports == 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.
+    setleaves_!: (%, List S) -> %
+      ++ setleaves!(t, ls) sets the leaves of t in left-to-right order
+      ++ to the elements of ls.
+    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.
+    mapUp_!: (%, %, (S,S,S,S) -> S) -> %
+      ++ mapUp!(t,t1,f) traverses 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.
+    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.
+    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.
+  Implementation == BinaryTree(S) add
+    Rep := BinaryTree(S)
+    leaf? x ==
+      empty? x => false
+      empty? left x and empty? right x
+--    balancedBinaryTree(x: S, u: List S) ==
+--      n := #u
+--      n = 0 => empty()
+--      setleaves_!(balancedBinaryTree(n, x), u)
+    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
+
+@
+\section{domain PENDTREE PendantTree}
+<<domain PENDTREE PendantTree>>=
+)abbrev domain PENDTREE PendantTree
+++ A PendantTree(S)is either a leaf? and is an S or has
+++ a left and a right both PendantTree(S)'s
+PendantTree(S: SetCategory): T == C where
+ T == BinaryRecursiveAggregate(S) with
+     ptree : S->%
+       ++ ptree(s) is a leaf? pendant tree
+     ptree:(%, %)->%
+	++ ptree(x,y) \undocumented
+     coerce:%->Tree S
+	++ coerce(x) \undocumented
+
+ 
+ C == add
+     Rep := Tree S
+     import Tree S
+     coerce (t:%):Tree S == t pretend Tree S
+     ptree(n) == tree(n,[])$Rep pretend %
+     ptree(l,r) == tree(value(r:Rep)$Rep,cons(l,children(r:Rep)$Rep)):%
+     leaf? t == empty?(children(t)$Rep)
+     t1=t2 == (t1:Rep) = (t2:Rep)
+     left b ==
+       leaf? b => error "ptree:no left"
+       first(children(b)$Rep)
+     right b ==
+       leaf? b => error "ptree:no right"
+       tree(value(b)$Rep,rest (children(b)$Rep))
+     value b ==
+       leaf? b => value(b)$Rep
+       error "the pendant tree has no value"
+     coerce(b:%): OutputForm ==
+       leaf? b => value(b)$Rep :: OutputForm
+       paren blankSeparate [left b::OutputForm,right b ::OutputForm]
+
+@
+\section{License}
+<<license>>=
+--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+--All rights reserved.
+--
+--Redistribution and use in source and binary forms, with or without
+--modification, are permitted provided that the following conditions are
+--met:
+--
+--    - Redistributions of source code must retain the above copyright
+--      notice, this list of conditions and the following disclaimer.
+--
+--    - Redistributions in binary form must reproduce the above copyright
+--      notice, this list of conditions and the following disclaimer in
+--      the documentation and/or other materials provided with the
+--      distribution.
+--
+--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--      names of its contributors may be used to endorse or promote products
+--      derived from this software without specific prior written permission.
+--
+--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+@
+<<*>>=
+<<license>>
+ 
+<<domain TREE Tree>>
+<<category BTCAT BinaryTreeCategory>>
+<<domain BTREE BinaryTree>>
+<<domain BBTREE BalancedBinaryTree>>
+<<domain BSTREE BinarySearchTree>>
+<<domain BTOURN BinaryTournament>>
+<<domain PENDTREE PendantTree>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}