)abbrev package IPRNTPK InternalPrintPackage
++ Author: Themos Tsikas
++ Date Created: 09/09/1998
++ Basic Functions:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description: A package to print strings without line-feed
++ nor carriage-return.

InternalPrintPackage() : Exports == Implementation where

  Exports ==  with
     iprint : String -> Void
       ++ \spad{iprint(s)} prints \spad{s} at the current position
       ++ of the cursor.

  Implementation == add
     iprint(s : String) ==
          PRINC(coerce(s)@Symbol)$Lisp
          FORCE_-OUTPUT()$Lisp

)abbrev package TBCMPPK TabulatedComputationPackage
++ Author: Marc Moreno Maza
++ Date Created: 09/09/1998
++ Basic Functions:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++   \spad{TabulatedComputationPackage(Key , Entry)} provides some modest support
++   for dealing with operations with type \spad{Key -> Entry}. The result of
++   such operations can be stored and retrieved with this package by using
++   a hash-table. The user does not need to worry about the management of
++   this hash-table. However, only one hash-table is built by calling
++   \spad{TabulatedComputationPackage(Key , Entry)}.
++ Version: 2.

TabulatedComputationPackage(Key , Entry) : Exports == Implementation where
  Key : SetCategory
  Entry : SetCategory
  N ==> NonNegativeInteger
  H ==> HashTable(Key, Entry, "EQUAL")
  iprintpack ==> InternalPrintPackage()

  Exports ==  with
     initTable! : () -> Void
       ++ \spad{initTable!()} initializes the hash-table.
     printInfo! : (String, String) -> Void
       ++ \spad{printInfo!(x, y)} initializes the messages to be printed
       ++ when manipulating items from the hash-table. If
       ++ a key is retrieved then \spad{x} is displayed. If an item is
       ++ stored then \spad{y} is displayed.
     startStats! : (String) -> Void
       ++ \spad{startStats!(x)} initializes the statistics process and
       ++ sets the comments to display when statistics are printed
     printStats! : () -> Void
       ++ \spad{printStats!()} prints the statistics.
     clearTable! : () -> Void
       ++ \spad{clearTable!()} clears the hash-table and assumes that
       ++ it will no longer be used.
     usingTable? : () -> Boolean
       ++ \spad{usingTable?()} returns true iff the hash-table is used
     printingInfo? : () -> Boolean
       ++ \spad{printingInfo?()} returns true iff messages are printed
       ++ when manipulating items from the hash-table.
     makingStats? : () -> Boolean
       ++ \spad{makingStats?()} returns true iff the statistics process
       ++ is running.
     extractIfCan : Key -> Union(Entry,"failed")
       ++ \spad{extractIfCan(x)} searches the item whose key is \spad{x}.
     insert! : (Key, Entry) -> Void
       ++ \spad{insert!(x, y)} stores the item whose key is \spad{x} and whose
       ++ entry is \spad{y}.

  Implementation == add
     table? : Boolean := false
     t : H := empty()
     info? : Boolean := false
     stats? : Boolean := false
     used : NonNegativeInteger := 0
     ok : String := "o"
     ko : String := "+"
     domainName : String := empty()$String

     initTable!() : Void ==
       table? := true
       t := empty()
       void()
     printInfo!(s1 : String, s2 : String) : Void ==
       (empty? s1) or (empty? s2) => void()
       not usingTable? =>
         error "in printInfo!()$TBCMPPK: not allowed to use hashtable"
       info? := true
       ok := s1
       ko := s2
       void()
     startStats!(s : String) : Void ==
       empty? s => void()
       not table? =>
         error "in startStats!()$TBCMPPK: not allowed to use hashtable"
       stats? := true
       used := 0
       domainName := s
       void()
     printStats!() : Void ==
       not table? =>
         error "in printStats!()$TBCMPPK: not allowed to use hashtable"
       not stats? =>
         error "in printStats!()$TBCMPPK: statistics not started"
       output(" ")$OutputPackage
       title : String := concat("*** ", concat(domainName," Statistics ***"))
       output(title)$OutputPackage
       n : N := #t
       output("   Table     size: ", n::OutputForm)$OutputPackage
       output("   Entries reused: ", used::OutputForm)$OutputPackage
     clearTable!() : Void ==
       not table? =>
         error "in clearTable!()$TBCMPPK: not allowed to use hashtable"
       t := empty()
       table? := false
       info? := false
       stats? := false
       domainName := empty()$String
       void()
     usingTable?() == table?
     printingInfo?() == info?
     makingStats?() == stats?
     extractIfCan(k : Key) : Union(Entry,"failed") ==
       not table? => "failed" :: Union(Entry,"failed")
       s : Union(Entry,"failed") := search(k,t)
       s case Entry =>
         if info? then iprint(ok)$iprintpack
         if stats? then used := used + 1
         return s
       "failed"
     insert!(k : Key, e : Entry) : Void ==
       not table? => void()
       t.k := e
       if info? then iprint(ko)$iprintpack
       void()

)abbrev domain SPLNODE SplittingNode
++ Author: Marc Moereno Maza
++ Date Created: 07/05/1996
++ Basic Functions:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ References:
++ Description:
++    This domain exports a modest implementation for the
++    vertices of splitting trees. These vertices are called
++    here splitting nodes. Every of these nodes store 3 informations.
++    The first one is its value, that is the current expression
++    to evaluate. The second one is its condition, that is the
++    hypothesis under which the value has to be evaluated.
++    The last one is its status, that is a boolean flag
++    which is true iff the value is the result of its
++    evaluation under its condition. Two splitting vertices
++    are equal iff they have the sane values and the same
++    conditions (so their status do not matter).

SplittingNode(V, C) : Exports == Implementation where

  V : Join(SetCategory, Aggregate)
  C : Join(SetCategory, Aggregate)
  Z ==> Integer
  B ==> Boolean
  O ==> OutputForm
  VT ==> Record(val : V, tower : C)
  VTB ==> Record(val : V, tower : C, flag : B)

  Exports ==  SetCategory with

     empty : () -> %
       ++ \spad{empty()} returns the same as
       ++ \spad{[empty()$V, empty()$C, false]$%}
     empty? : % -> B
       ++ \spad{empty?(n)} returns true iff the node n is \spad{empty()$%}.
     value : % -> V
       ++ \spad{value(n)} returns the value of the node n.
     condition : % -> C
       ++ \spad{condition(n)} returns the condition of the node n.
     status : % -> B
       ++ \spad{status(n)} returns the status of the node n.
     construct : (V, C, B) -> %
       ++ \spad{construct(v, t, b)} returns the non-empty node with
       ++ value v, condition t and flag b
     construct : (V, C) -> %
       ++ \spad{construct(v, t)} returns the same as
       ++ \spad{construct(v, t, false)}
     construct : VT ->  %
       ++ \spad{construct(vt)} returns the same as
       ++ \spad{construct(vt.val, vt.tower)}
     construct : List VT ->  List %
       ++ \spad{construct(lvt)} returns the same as
       ++ \spad{[construct(vt.val, vt.tower) for vt in lvt]}
     construct : (V, List C) -> List %
       ++ \spad{construct(v, lt)} returns the same as
       ++ \spad{[construct(v, t) for t in lt]}
     copy : % -> %
       ++ \spad{copy(n)} returns a copy of n.
     setValue! : (%, V) -> %
       ++ \spad{setValue!(n, v)} returns n whose value
       ++ has been replaced by v if it is not
       ++ empty, else an error is produced.
     setCondition! : (%, C) -> %
       ++ \spad{setCondition!(n, t)} returns n whose condition
       ++ has been replaced by t if it is not
       ++ empty, else an error is produced.
     setStatus! : (%, B) -> %
       ++ \spad{setStatus!(n, b)} returns n whose status
       ++ has been replaced by b if it is not
       ++ empty, else an error is produced.
     setEmpty! : % -> %
       ++ \spad{setEmpty!(n)} replaces n by \spad{empty()$%}.
     infLex? : (%, %, (V, V) -> B, (C, C) -> B) -> B
       ++ \spad{infLex?(n1, n2, o1, o2)} returns true iff
       ++ \spad{o1(value(n1), value(n2))} or
       ++ \spad{value(n1) = value(n2)} and
       ++ \spad{o2(condition(n1), condition(n2))}.
     subNode? : (%, %, (C, C) -> B) -> B
       ++ \spad{subNode?(n1, n2, o2)} returns true iff
       ++ \spad{value(n1) = value(n2)} and
       ++ \spad{o2(condition(n1), condition(n2))}

  Implementation == add

     Rep ==> VTB

     rep(n : %) : Rep == n pretend Rep
     per(r : Rep) : % == r pretend %

     empty() == per [empty()$V, empty()$C, false]$Rep
     empty?(n : %) == empty?((rep n).val)$V and  empty?((rep n).tower)$C
     value(n : %) == (rep n).val
     condition(n : %) == (rep n).tower
     status(n : %) == (rep n).flag
     construct(v : V, t : C, b : B) ==  per [v, t, b]$Rep
     construct(v : V, t : C) == [v, t, false]$%
     construct(vt : VT) == [vt.val, vt.tower]$%
     construct(lvt : List VT) == [[vt]$% for vt in lvt]
     construct(v : V, lt : List C) == [[v, t]$% for t in lt]
     copy(n : %) == per copy rep n
     setValue!(n : %, v : V) ==
        (rep n).val := v
        n
     setCondition!(n : %, t : C) ==
        (rep n).tower := t
        n
     setStatus!(n : %, b : B) ==
        (rep n).flag := b
        n
     setEmpty!(n : %) ==
        (rep n).val := empty()$V
        (rep n).tower := empty()$C
        n
     infLex?(n1, n2, o1, o2) ==
        o1((rep n1).val, (rep n2).val) => true
        (rep n1).val = (rep n2).val =>
           o2((rep n1).tower, (rep n2).tower)
        false
     subNode?(n1, n2, o2) ==
        (rep n1).val = (rep n2).val =>
           o2((rep n1).tower, (rep n2).tower)
        false
     -- sample() == empty()
     n1 : % = n2 : % ==
        (rep n1).val ~= (rep n2).val => false
        (rep n1).tower = (rep n2).tower
     n1 : % ~= n2 : % ==
        (rep n1).val = (rep n2).val => false
        (rep n1).tower ~= (rep n2).tower
     coerce(n : %) : O ==
        l1, l2, l3, l : List O
        l1 := [message("value == "), ((rep n).val)::O]
        o1 : O := blankSeparate l1
        l2 := [message(" tower == "), ((rep n).tower)::O]
        o2 : O := blankSeparate l2
        if ((rep n).flag)
          then
            o3 := message(" closed == true")
          else
            o3 := message(" closed == false")
        l := [o1, o2, o3]
        bracket l

)abbrev domain SPLTREE SplittingTree
++ Author: Marc Moereno Maza
++ Date Created: 07/05/1996
++ Basic Functions:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++      M. MORENO MAZA "Calculs de pgcd au-dessus des tours
++      d'extensions simples et resolution des systemes d'equations
++      algebriques" These, Universite P.etM. Curie, Paris, 1997.
++ Description:
++    This domain exports a modest implementation of splitting
++    trees. Splitting trees are needed when the
++    evaluation of some quantity under some hypothesis
++    requires to split the hypothesis into sub-cases.
++    For instance by adding some new hypothesis on one
++    hand and its negation on another hand. The computations
++    are terminated for a splitting tree \spad{a} when
++    \spad{status(value(a))} is \spad{true}. Thus,
++    if for the splitting tree \spad{a} the flag
++    \spad{status(value(a))} is \spad{true}, then
++    \spad{status(value(d))} is \spad{true} for any
++    subtree \spad{d} of \spad{a}. This property
++    of splitting trees is called the termination
++    condition. If no vertex in a splitting tree \spad{a}
++    is equal to another, \spad{a} is said to satisfy
++    the no-duplicates condition. The splitting
++    tree \spad{a} will satisfy this condition
++    if nodes are added to \spad{a} by means of
++    \spad{splitNodeOf!} and if \spad{construct}
++    is only used to create the root of \spad{a}
++    with no children.

SplittingTree(V, C) : Exports == Implementation where

  V : Join(SetCategory, Aggregate)
  C : Join(SetCategory, Aggregate)
  B ==> Boolean
  O ==> OutputForm
  NNI ==> NonNegativeInteger
  VT ==> Record(val : V, tower : C)
  VTB ==> Record(val : V, tower : C, flag : B)
  S ==> SplittingNode(V, C)
  A ==> Record(root : S, subTrees : List(%))

  Exports ==  Join(RecursiveAggregate(S), shallowlyMutable, _
       finiteAggregate) with
     extractSplittingLeaf : % -> Union(%,"failed")
       ++ \spad{extractSplittingLeaf(a)} returns the left
       ++ most leaf (as a tree) whose status is false
       ++ if any, else "failed" is returned.
     updateStatus! : % -> %
       ++ \spad{updateStatus!(a)} returns a where the status
       ++ of the vertices are updated to satisfy
       ++ the "termination condition".
     construct : S -> %
       ++ \spad{construct(s)} creates a splitting tree
       ++ with value (i.e. root vertex) given by
       ++ \spad{s} and no children. Thus, if the
       ++ status of \spad{s} is false, \spad{[s]}
       ++ represents the starting point of the
       ++ evaluation \spad{value(s)} under the
       ++ hypothesis \spad{condition(s)}.
     construct : (V, C, List %) -> %
       ++ \spad{construct(v, t, la)} creates a splitting tree
       ++ with value (i.e. root vertex) given by
       ++ \spad{[v, t]$S} and with \spad{la} as
       ++ children list.
     construct : (V, C, List S) -> %
       ++ \spad{construct(v, t, ls)} creates a splitting tree
       ++ with value (i.e. root vertex) given by
       ++ \spad{[v, t]$S} and with children list given by
       ++ \spad{[[s]$% for s in ls]}.
     construct : (V, C, V, List C) -> %
       ++ \spad{construct(v1, t, v2, lt)} creates a splitting tree
       ++ with value (i.e. root vertex) given by
       ++ \spad{[v, t]$S} and with children list given by
       ++ \spad{[[[v, t]$S]$% for s in ls]}.
     conditions : % -> List C
       ++ \spad{conditions(a)} returns the list of the conditions
       ++ of the leaves of a
     result : % -> List VT
       ++ \spad{result(a)} where \spad{ls} is the leaves list of \spad{a}
       ++ returns \spad{[[value(s), condition(s)]$VT for s in ls]}
       ++ if the computations are terminated in \spad{a} else
       ++ an error is produced.
     nodeOf? : (S, %) -> B
       ++ \spad{nodeOf?(s, a)} returns true iff some node of \spad{a}
       ++ is equal to \spad{s}
     subNodeOf? : (S, %, (C, C) -> B) -> B
       ++ \spad{subNodeOf?(s, a, sub?)} returns true iff for some node
       ++ \spad{n} in \spad{a} we have \spad{s = n} or
       ++ \spad{status(n)} and \spad{subNode?(s, n, sub?)}.
     remove : (S, %) -> %
       ++ \spad{remove(s, a)} returns the splitting tree obtained
       ++ from a by removing every sub-tree \spad{b} such
       ++ that \spad{value(b)} and \spad{s} have the same
       ++ value, condition and status.
     remove! : (S, %) -> %
       ++ \spad{remove!(s, a)} replaces a by remove(s, a)
     splitNodeOf! : (%, %, List(S)) -> %
       ++ \spad{splitNodeOf!(l, a, ls)} returns \spad{a} where the children
       ++ list of \spad{l} has been set to
       ++ \spad{[[s]$% for s in ls | not nodeOf?(s, a)]}.
       ++ Thus, if \spad{l} is not a node of \spad{a}, this
       ++ latter splitting tree is unchanged.
     splitNodeOf! : (%, %, List(S), (C, C) -> B) -> %
       ++ \spad{splitNodeOf!(l, a, ls, sub?)} returns \spad{a} where the children
       ++ list of \spad{l} has been set to
       ++ \spad{[[s]$% for s in ls | not subNodeOf?(s, a, sub?)]}.
       ++ Thus, if \spad{l} is not a node of \spad{a}, this
       ++ latter splitting tree is unchanged.


  Implementation == add

     Rep ==> A

     rep(n : %) : Rep == n pretend Rep
     per(r : Rep) : % == r pretend %

     construct(s : S) ==
        per [s, []]$A
     construct(v : V, t : C, la : List(%)) ==
        per [[v, t]$S, la]$A
     construct(v : V, t : C, ls : List(S)) ==
        per [[v, t]$S, [[s]$% for s in ls]]$A
     construct(v1 : V, t : C, v2 : V, lt : List(C)) ==
        [v1, t, ([v2, lt]$S)@(List S)]$%

     empty?(a : %) == empty?((rep a).root) and empty?((rep a).subTrees)
     empty() == [empty()$S]$%

     remove(s : S, a : %) ==
       empty? a => a
       (s = value(a)) and (status(s) = status(value(a))) => empty()$%
       la := children(a)
       lb : List % := []
       while (not empty? la) repeat
          lb := cons(remove(s, first la), lb)
          la := rest la
       lb := reverse remove(empty?, lb)
       [value(value(a)), condition(value(a)), lb]$%

     remove!(s : S, a : %) ==
       empty? a => a
       (s = value(a)) and (status(s) = status(value(a))) =>
         (rep a).root := empty()$S
         (rep a).subTrees := []
         a
       la := children(a)
       lb : List % := []
       while (not empty? la) repeat
          lb := cons(remove!(s, first la), lb)
          la := rest la
       lb := reverse remove(empty()$%, lb)
       setchildren!(a, lb)

     value(a : %) ==
        (rep a).root
     children(a : %) ==
        (rep a).subTrees
     leaf?(a : %) ==
        empty? a => false
        empty? (rep a).subTrees
     setchildren!(a : %, la : List(%)) ==
        (rep a).subTrees := la
        a
     setvalue!(a : %, s : S) ==
        (rep a).root := s
        s
     cyclic?(a : %) == false
     map(foo : (S -> S), a : %) ==
       empty? a => a
       b : % := [foo(value(a))]$%
       leaf? a => b
       setchildren!(b, [map(foo, c) for c in children(a)])
     map!(foo : (S -> S), a : %) ==
       empty? a => a
       setvalue!(a, foo(value(a)))
       leaf? a => a
       setchildren!(a, [map!(foo, c) for c in children(a)])
     copy(a : %) ==
       map(copy, a)
     eq?(a1 : %, a2 : %) ==
       error "in eq? from SPLTREE : unimplemented"
     nodes(a : %) ==
       empty? a => []
       leaf? a => [a]
       cons(a, concat([nodes(c) for c in children(a)]))
     leaves(a : %) ==
       empty? a => []
       leaf? a => [value(a)]
       concat([leaves(c) for c in children(a)])
     members(a : %) ==
       empty? a => []
       leaf? a => [value(a)]
       cons(value(a), concat([members(c) for c in children(a)]))
     #(a : %) ==
       empty? a => 0$NNI
       leaf? a => 1$NNI
       reduce("+",[#c for c in children(a)],1$NNI)$(List NNI)
     a1 : % = a2 : % ==
       empty? a1 => empty? a2
       empty? a2 => false
       leaf? a1 =>
         not leaf? a2 => false
         value(a1) =$S value(a2)
       leaf? a2 => false
       value(a1) ~=$S value(a2) => false
       children(a1) = children(a2)
     -- sample() == [sample()$S]$%
     localCoerce(a : %, k : NNI) : O ==
       s : String
       if k = 1 then  s := "* " else s := "-> "
       for i in 2..k repeat s := concat("-+",s)$String
       ro : O := left(hconcat(message(s)$O, value(a)::O)$O)$O
       leaf? a => ro
       lo : List O := [localCoerce(c, k+1) for c in children(a)]
       lo := cons(ro, lo)
       vconcat(lo)$O
     coerce(a : %) : O ==
       empty? a => vconcat(message(" ")$O,message("* []")$O)
       vconcat(message(" ")$O,localCoerce(a,1))

     extractSplittingLeaf(a : %) ==
       empty? a => "failed"::Union(%,"failed")
       status(value(a))$S => "failed"::Union(%,"failed")
       la := children(a)
       empty? la => a
       while (not empty? la) repeat
          esl := extractSplittingLeaf(first la)
          (esl case %) => return(esl)
          la := rest la
       "failed"

     updateStatus!(a : %) ==
       la := children(a)
       (empty? la) or (status(value(a))$S) => a
       done := true
       while (not empty? la) and done repeat
          done := done and status(value(updateStatus! first la))
          la := rest la
       setStatus!(value(a), done)$S
       a

     result(a : %) ==
       empty? a => []
       not status(value(a))$S =>
          error"in result from SLPTREE : mad cow!"
       ls : List S := leaves(a)
       [[value(s), condition(s)]$VT for s in ls]

     conditions(a : %) ==
       empty? a => []
       ls : List S := leaves(a)
       [condition(s) for s in ls]

     nodeOf?(s : S, a : %) ==
       empty? a => false
       s =$S value(a) => true
       la := children(a)
       while (not empty? la) and (not nodeOf?(s, first la)) repeat
          la := rest la
       not empty? la

     subNodeOf?(s : S, a : %, sub? : ((C, C) -> B)) ==
       empty? a => false
       -- s =$S value(a) => true
       status(value(a)$%)$S and subNode?(s, value(a), sub?)$S => true
       la := children(a)
       while (not empty? la) and (not subNodeOf?(s, first la, sub?)) repeat
          la := rest la
       not empty? la

     splitNodeOf!(l : %, a : %, ls : List(S)) ==
       ln := removeDuplicates ls
       la : List % := []
       while not empty? ln repeat
          if not nodeOf?(first ln, a)
            then
              la := cons([first ln]$%, la)
          ln := rest ln
       la := reverse la
       setchildren!(l, la)$%
       if empty? la then (rep l).root := [empty()$V, empty()$C, true]$S
       updateStatus!(a)

     splitNodeOf!(l : %, a : %, ls : List(S), sub? : ((C, C) -> B)) ==
       ln := removeDuplicates ls
       la : List % := []
       while not empty? ln repeat
          if not subNodeOf?(first ln, a, sub?)
            then
              la := cons([first ln]$%, la)
          ln := rest ln
       la := reverse la
       setchildren!(l, la)$%
       if empty? la then (rep l).root := [empty()$V, empty()$C, true]$S
       updateStatus!(a)

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