/usr/share/axiom-20170501/src/algebra/TREE.spad

)abbrev domain TREE Tree
++ Author:W. H. Burge
++ Date Created:17 Feb 1992
++ Description:
++ \spadtype{Tree(S)} is a basic domains of tree structures.
++ Each tree is either empty or else is a node consisting of a value and
++ a list of (sub)trees.

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

  SIG ==> RecursiveAggregate(S) with

     finiteAggregate

     shallowlyMutable

     tree : (S,List %) -> %
       ++ tree(nd,ls) creates a tree with value nd, and children ls.
       ++
       ++X t1:=tree [1,2,3,4]
       ++X tree(5,[t1])

     tree : List S -> %
       ++ tree(ls) creates a tree from a list of elements of s. 
       ++
       ++X tree [1,2,3,4]

     tree : S -> %
       ++ tree(nd) creates a tree with value nd, and no children
       ++
       ++X tree 6

     cyclic? : % -> Boolean
       ++ cyclic?(t) tests if t is a cyclic tree.
       ++
       ++X t1:=tree [1,2,3,4]
       ++X cyclic? t1

     cyclicCopy : % -> %
       ++ cyclicCopy(l) makes a copy of a (possibly) cyclic tree l.
       ++
       ++X t1:=tree [1,2,3,4]
       ++X cyclicCopy t1

     cyclicEntries :    % -> List %
       ++ cyclicEntries(t) returns a list of top-level cycles in tree t.
       ++
       ++X t1:=tree [1,2,3,4]
       ++X cyclicEntries t1

     cyclicEqual? : (%, %) -> Boolean
       ++ cyclicEqual?(t1, t2) tests of two cyclic trees have 
       ++ the same structure.
       ++
       ++X t1:=tree [1,2,3,4]
       ++X t2:=tree [1,2,3,4]
       ++X cyclicEqual?(t1,t2)

     cyclicParents : % -> List %
       ++ cyclicParents(t) returns a list of cycles that are parents of t.
       ++
       ++X t1:=tree [1,2,3,4]
       ++X cyclicParents t1

  CODE ==> 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)
axiom-source 20170501-3 / usr / share / axiom-20170501 / src / algebra / TREE.spad
