axiom-source 20170501-3 / usr / share / axiom-20170501 / src / algebra / E04AGNT.spad

)abbrev package E04AGNT e04AgentsPackage
++ Author: Brian Dupee
++ Date Created: February 1996
++ Date Last Updated: June 1996
++ 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.

e04AgentsPackage() : SIG == CODE where

  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)

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

  CODE ==> 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
        (n*d) = 1 => "simple"
        (d = 1) => "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]