\documentclass{article} \usepackage{open-axiom} \begin{document} \title{\$SPAD/src/algebra tree.spad} \author{William Burge} \maketitle \begin{abstract} \end{abstract} \eject \tableofcontents \eject \section{domain TREE Tree} <>= import Boolean import List )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== Join(RecursiveAggregate S,FiniteAggregate S,ShallowlyMutableAggregate S) with 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") 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: S, 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) t tree(s,lt) == [[s,lt]] tree(s: S) == [[s,[]]] tree(ls: List S) == 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] positive?(#u) => 1 + "min"/u -1 distance(t1,t2) == n := distance1(t1, t2) n >= 0 => n distance1(t2, t1) node?(t1, t2) == t1 = t2 => true t2 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] nodes t == ---buggy t case empty => empty() nl := [nodes c for c in children t] nl = empty() => [t] cons(t,"append"/nl) 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 == --buggy? t case empty => empty() u := [members 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 CoercibleTo(OutputForm) 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 positive?(k := eqMemberIndex(t, pl, 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) => 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} <>= )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 == Join(BinaryRecursiveAggregate S,FiniteAggregate S,ShallowlyMutableAggregate S) with 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) map!(f,t) == empty? t => t t.value := f(t.value) map!(f,left t) map!(f,right t) t 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} <>= )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 % 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} <>= )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 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} <>= )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 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} <>= )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 -- 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} <>= )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 == Join(BinaryRecursiveAggregate(S),CoercibleTo Tree S) with ptree : S->% ++ ptree(s) is a leaf? pendant tree ptree:(%, %)->% ++ ptree(x,y) \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} <>= --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. @ <<*>>= <> <> <> <> <> <> <> <> @ \eject \begin{thebibliography}{99} \bibitem{1} nothing \end{thebibliography} \end{document}