)abbrev domain TREE Tree
++ Author: W. H. Burge
++ Date Created: 17 Feb 1992
++ Basic Operations:
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ Examples:
++ References:
++ Description: \spadtype{Tree(S)} is a basic domain of tree structures.
++ Each tree is either empty or has a {\it node} consisting of a value and
++ a list of (sub)trees.
Tree(S : SetCategory) : T==C where
 T== Join(RecursiveAggregate(S), finiteAggregate, shallowlyMutable) 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.
 C== add
    Rep := Union(node:Record(value: S, args: List %),empty:"empty")

    import from Record(value: S, args: List %)

    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 : S, lt : List %) == [[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
      member?(t1, 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
      t2 case empty => false
      any?((t : %) : Boolean +-> node?(t1, t), children t2)
    any?(fn, t) ==  ---bug fixed
      t case empty => false
      fn value t => true
      for c in children t | any?(fn, c) repeat return true
      false
    every?(fn, t) ==
      t case empty => true
      not fn value t => false
      for c in children t | not every?(fn, c) repeat return false
      true
    member?(n, t) ==
      t case empty => false
      n = value t or any?((c : %) : Boolean +-> member?(n, c), children 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)
    hashUpdate!(s : HashState, t : %) : HashState ==
      t case empty => s
      s := hashUpdate!(s, value t)
      for subt in children t repeat
          s := hashUpdate!(s, subt)
      s

    t1 = t2 ==
        empty? t1 => empty? t2
        value t1 = value t2 and children t1 = children t2

    # t ==
        empty? t => 0
        1 + "+"/[# c for c in children t]

    copy t ==
        empty? t => empty()
        tree(value t, [copy c for c in children t])

    coerce(t : %) : OutputForm ==
        empty? t => empty()@List(S)::OutputForm
        nodeForm := (value t)::OutputForm
        empty? children t => nodeForm
        prefix(nodeForm, [coerce(c) for c in children t])

)abbrev category BTCAT BinaryTreeCategory
++ Author: W. H. Burge
++ Date Created: 17 Feb 1992
++ 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 has a \spadfun{node} consisting
++ of a value and a \spadfun{left} and \spadfun{right} which are both binary trees.
BinaryTreeCategory(S : SetCategory) : Category ==
     Join(BinaryRecursiveAggregate(S), shallowlyMutable, finiteAggregate) with
   node : (%, S, %) -> %
     ++ node(l, v, r) creates a binary tree with value \spad{v},
     ++ left subtree \spad{l}, and right subtree \spad{r}.
 add
     copy t ==
       empty? t => empty()
       node(copy left t, value t, copy right t)
     map(f ,t) ==
       empty? t => empty()
       node(map(f, left t), f value t, map(f, right t))
     map!(f, t) ==
         empty? t => t
         t.value := f(t.value)
         map!(f, left t)
         map!(f, right t)
         t

     # t ==
         empty? t => 0
         1 + # left t + # right t

     distance1(t1 : %, t2 : %) : Integer ==
       t1 = t2 => 0
       empty? t2 => -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)
     hashUpdate!(s : HashState, t : %) : HashState ==
       empty? t => s
       s := hashUpdate!(s, value t)
       s := hashUpdate!(s, left t)
       hashUpdate!(s, right t)

)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 BinaryTree(S).
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 and left subtree l and right subtree r.
  Implementation == add
     Rep := List Tree S

     t1 = t2 == (t1::Rep) =$Rep (t2::Rep)
     empty()== ([] ::Rep):: %
     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
     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 :: Rep, t2)

)abbrev domain BSTREE BinarySearchTree
++ Description: BinarySearchTree(S) is the domain of
++ 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
++ left and a right which are both BinarySearchTree(S).
BinarySearchTree(S : OrderedSet) : Exports == Implementation where
  Exports == BinaryTreeCategory(S) with
    binarySearchTree : List S -> %
      ++ binarySearchTree(l) constructs a binary search tree
      ++ with elements from list l.
    insert! : (S, %) -> %
      ++ insert!(x, b) inserts element x as a leave into binary search tree b.
    insertRoot! : (S, %) -> %
      ++ insertRoot!(x, b) inserts element x as the root of
      ++ binary search tree b.
    split : (S, %) -> Record(less : %, greater : %)
      ++ split(x, b) splits binary search tree b into two trees,
      ++ one with elements less than x, the other with elements
      ++ greater than or equal to x.
  Implementation == BinaryTree(S) add
    Rep := BinaryTree(S)
    binarySearchTree(u : List S) ==
      empty?(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)

)abbrev domain BTOURN BinaryTournament
++ Description: \spadtype{BinaryTournament(S)} is the domain of
++ binary trees where elements are ordered down the tree.
++ A binary tournament is either empty or is a node containing a
++ \spadfun{value} of type \spad{S}, and a \spadfun{left}
++ and a \spadfun{right} 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 of the nodes.
    insert! : (S, %) -> %
      ++ insert!(x, b) inserts element x as a leave into binary tournament b.
  Implementation == BinaryTree(S) add
    Rep := BinaryTree(S)
    binaryTournament(u : List S) ==
      empty?(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

)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 one 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)
--    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 := cons(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(qcoerce(n - m)@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 or empty? y => 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

)abbrev domain PENDTREE PendantTree
++ A PendantTree(S) is either a leaf? and is an S or has
++ a left and a right are both PendantTree(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 from 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]

--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.
