\documentclass{article}
\usepackage{open-axiom}
\begin{document}
\title{\$SPAD/src/algebra e04agents.spad}
\author{Brian Dupee}
\maketitle
\begin{abstract}
\end{abstract}
\eject
\tableofcontents
\eject
\section{package E04AGNT e04AgentsPackage}
<<package E04AGNT e04AgentsPackage>>=
)abbrev package E04AGNT e04AgentsPackage
++ Author: Brian Dupee
++ Date Created: February 1996
++ Date Last Updated: June 1996
++ Basic Operations: simple? linear?, quadratic?, nonLinear?
++ Description:
++ \axiomType{e04AgentsPackage} is a package of numerical agents to be used
++ to investigate attributes of an input function so as to decide the
++ \axiomFun{measure} of an appropriate numerical optimization routine.
MDF	==> Matrix DoubleFloat
VEDF	==> Vector Expression DoubleFloat
EDF	==> Expression DoubleFloat
EFI	==> Expression Fraction Integer
PFI	==> Polynomial Fraction Integer
FI	==> Fraction Integer
F	==> Float
DF	==> DoubleFloat
OCDF	==> OrderedCompletion DoubleFloat
LOCDF	==> List OrderedCompletion DoubleFloat
LEDF	==> List Expression DoubleFloat
PDF	==> Polynomial DoubleFloat
LDF	==> List DoubleFloat
INT	==> Integer
NNI	==> NonNegativeInteger
LS	==> List Symbol
EF2	==> ExpressionFunctions2
NOA	==> Record(fn:EDF, init:LDF, lb:LOCDF, cf:LEDF, ub:LOCDF)
LSA	==> Record(lfn:LEDF, init:LDF)

e04AgentsPackage(): E == I where
  E ==> with
    finiteBound:(LOCDF,DF) -> LDF 
      ++ finiteBound(l,b) repaces all instances of an infinite entry in
      ++ \axiom{l} by a finite entry \axiom{b} or \axiom{-b}.
    sortConstraints:NOA -> NOA
      ++ sortConstraints(args) uses a simple bubblesort on the list of
      ++ constraints using the degree of the expression on which to sort.
      ++ Of course, it must match the bounds to the constraints.
    sumOfSquares:EDF -> Union(EDF,"failed")
      ++ sumOfSquares(f) returns either an expression for which the square is
      ++ the original function of "failed".
    splitLinear:EDF -> EDF 
      ++ splitLinear(f) splits the linear part from an expression which it
      ++ returns.
    simpleBounds?:LEDF -> Boolean
      ++ simpleBounds?(l) returns true if the list of expressions l are
      ++ simple.
    linear?:LEDF -> Boolean
      ++ linear?(l) returns true if all the bounds l are either linear or
      ++ simple.
    linear?:EDF -> Boolean
      ++ linear?(e) tests if \axiom{e} is a linear function.
    linearMatrix:(LEDF, NNI) -> MDF
      ++ linearMatrix(l,n) returns a matrix of coefficients of the linear
      ++ functions in \axiom{l}.  If l is empty, the matrix has at least one
      ++ row.
    linearPart:LEDF -> LEDF
      ++ linearPart(l) returns the list of linear functions of \axiom{l}.
    nonLinearPart:LEDF -> LEDF
      ++ nonLinearPart(l) returns the list of non-linear functions of \axiom{l}.
    quadratic?:EDF -> Boolean
      ++ quadratic?(e) tests if \axiom{e} is a quadratic function.
    variables:LSA -> LS
      ++ variables(args) returns the list of variables in \axiom{args.lfn}
    varList:(EDF,NNI) -> LS
      ++ varList(e,n) returns a list of \axiom{n} indexed variables with name
      ++ as in \axiom{e}.
    changeNameToObjf:(Symbol,Result) -> Result
      ++ changeNameToObjf(s,r) changes the name of item \axiom{s} in \axiom{r}
      ++ to objf.
    expenseOfEvaluation:LSA -> F
      ++ expenseOfEvaluation(o) returns the intensity value of the 
      ++ cost of evaluating the input set of functions.  This is in terms 
      ++ of the number of ``operational units''.  It returns a value 
      ++ in the range [0,1].
    optAttributes:Union(noa:NOA,lsa:LSA) -> List String
      ++ optAttributes(o) is a function for supplying a list of attributes
      ++ of an optimization problem.

  I ==> add

    import ExpertSystemToolsPackage, ExpertSystemContinuityPackage

    sumOfSquares2:EFI -> Union(EFI,"failed")
    nonLinear?:EDF -> Boolean
    finiteBound2:(OCDF,DF) -> DF 
    functionType:EDF -> String

    finiteBound2(a:OCDF,b:DF):DF ==
      not finite?(a) =>
        positive?(a) => b
        -b
      retract(a)@DF

    finiteBound(l:LOCDF,b:DF):LDF == [finiteBound2(i,b) for i in l]

    sortConstraints(args:NOA):NOA ==
      Args := copy args
      c:LEDF := Args.cf
      l:LOCDF := Args.lb
      u:LOCDF := Args.ub
      m:INT := (# c) - 1      
      n:INT := (# l) - m
      for j in m..1 by -1 repeat
        for i in 1..j repeat
          s:EDF := c.i
          t:EDF := c.(i+1)
          if linear?(t) and (nonLinear?(s) or quadratic?(s)) then
            swap!(c,i,i+1)$LEDF
            swap!(l,n+i-1,n+i)$LOCDF
            swap!(u,n+i-1,n+i)$LOCDF
      Args
        
    changeNameToObjf(s:Symbol,r:Result):Result ==
      a := remove!(s,r)$Result
      a case Any =>
        insert!([objf@Symbol,a],r)$Result
        r
      r

    sum(a:EDF,b:EDF):EDF == a+b

    variables(args:LSA): LS == variables(reduce(sum,(args.lfn)))

    sumOfSquares(f:EDF):Union(EDF,"failed") ==
      e := edf2efi(f)
      s:Union(EFI,"failed") := sumOfSquares2(e)
      s case EFI =>
        map(fi2df,s)$EF2(FI,DF)
      "failed"

    sumOfSquares2(f:EFI):Union(EFI,"failed") ==
      p := retractIfCan(f)@Union(PFI,"failed")
      p case PFI => 
        r := squareFreePart(p)$PFI
        (p=r)@Boolean => "failed"
        tp := totalDegree(p)$PFI
        tr := totalDegree(r)$PFI
        t := tp quo tr
        found := false
        q := r
        for i in 2..t by 2 repeat
          s := q**2
          (s=p)@Boolean => 
            found := true
            leave
          q := r**i
        if found then 
          q :: EFI
        else
          "failed"
      "failed"

    splitLinear(f:EDF):EDF ==
      out := 0$EDF
      (l := isPlus(f)$EDF) case LEDF =>
        for i in l repeat
          if not quadratic? i then
            out := out + i
        out
      out

    edf2pdf(f:EDF):PDF == (retract(f)@PDF)$EDF

    varList(e:EDF,n:NNI):LS ==
      s := name(first(variables(edf2pdf(e))$PDF)$LS)$Symbol
      [subscript(s,[t::OutputForm]) for t in expand([1..n])$Segment(Integer)]

    functionType(f:EDF):String ==
      n := #(variables(f))$EDF
      p := (retractIfCan(f)@Union(PDF,"failed"))$EDF
      p case PDF =>
        d := totalDegree(p)$PDF
        one?(n*d) => "simple"
        one?(d) => "linear"
        (d=2)@Boolean => "quadratic"
        "non-linear"
      "non-linear"
     
    simpleBounds?(l: LEDF):Boolean ==
      a := true
      for e in l repeat
        not (functionType(e) = "simple")@Boolean => 
          a := false
          leave
      a

    simple?(e:EDF):Boolean == (functionType(e) = "simple")@Boolean

    linear?(e:EDF):Boolean == (functionType(e) = "linear")@Boolean

    quadratic?(e:EDF):Boolean == (functionType(e) = "quadratic")@Boolean

    nonLinear?(e:EDF):Boolean == (functionType(e) = "non-linear")@Boolean

    linear?(l: LEDF):Boolean ==
      a := true
      for e in l repeat
        s := functionType(e)
        (s = "quadratic")@Boolean or (s = "non-linear")@Boolean => 
          a := false
          leave
      a

    simplePart(l:LEDF):LEDF == [i for i in l | simple?(i)]

    linearPart(l:LEDF):LEDF == [i for i in l | linear?(i)]

    nonLinearPart(l:LEDF):LEDF ==
      [i for i in l | not linear?(i) and not simple?(i)]

    linearMatrix(l:LEDF, n:NNI):MDF ==
      empty?(l) => mat([],n)
      L := linearPart l
      M := zero(max(1,# L)$NNI,n)$MDF
      vars := varList(first(l)$LEDF,n)
      row:INT := 1
      for a in L repeat
        for j in monomials(edf2pdf(a))$PDF repeat
          col:INT := 1
          for c in vars repeat
            if ((first(variables(j)$PDF)$LS)=c)@Boolean then
              M(row,col):= first(coefficients(j)$PDF)$LDF
            col := col+1
        row := row + 1
      M

    expenseOfEvaluation(o:LSA):F ==
      expenseOfEvaluation(vector(copy o.lfn)$VEDF)

    optAttributes(o:Union(noa:NOA,lsa:LSA)):List String ==
      o case noa =>
        n := o.noa
        s1:String := "The object function is " functionType(n.fn)
        if empty?(n.lb) then
          s2:String := "There are no bounds on the variables" 
        else
          s2:String := "There are simple bounds on the variables"
        c := n.cf
        if empty?(c) then
          s3:String := "There are no constraint functions"
        else
          t := #(c)
          lin := #(linearPart(c))
          nonlin := #(nonLinearPart(c))
          s3:String := "There are " string(lin)$String " linear and "_
                          string(nonlin)$String " non-linear constraints"
        [s1,s2,s3]
      l := o.lsa
      s:String := "non-linear"
      if linear?(l.lfn) then
        s := "linear"
      ["The object functions are " s]

@
\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>>

<<package E04AGNT e04AgentsPackage>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}