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

)abbrev domain ROUTINE RoutinesTable
++ Author: Brian Dupee
++ Date Created: August 1994
++ Date Last Updated: December 1997
++ Description:
++ \axiomType{RoutinesTable} implements a database and associated tuning
++ mechanisms for a set of known NAG routines

RoutinesTable() : SIG == CODE where

  F  ==> Float
  ST  ==> String
  LST  ==> List String
  Rec  ==> Record(key:Symbol,entry:Any)
  RList  ==> List(Record(key:Symbol,entry:Any))
  IFL  ==> List(Record(ifail:Integer,instruction:ST))
  Entry  ==> Record(chapter:ST, type:ST, domainName: ST, 
                     defaultMin:F, measure:F, failList:IFL, explList:LST)

  SIG ==> TableAggregate(Symbol,Any) with

    concat : (%,%) -> %
      ++ concat(x,y) merges two tables x and y

    routines : () -> %
      ++ routines() initialises a database of known NAG routines

    selectIntegrationRoutines : % -> % 
      ++ selectIntegrationRoutines(R) chooses only those routines from 
      ++ the database which are for integration

    selectOptimizationRoutines : % -> % 
      ++ selectOptimizationRoutines(R) chooses only those routines from 
      ++ the database which are for integration

    selectPDERoutines : % -> % 
      ++ selectPDERoutines(R) chooses only those routines from the 
      ++ database which are for the solution of PDE's

    selectODEIVPRoutines : % -> % 
      ++ selectODEIVPRoutines(R) chooses only those routines from the 
      ++ database which are for the solution of ODE's

    selectFiniteRoutines : % -> % 
      ++ selectFiniteRoutines(R) chooses only those routines from the 
      ++ database which are designed for use with finite expressions

    selectSumOfSquaresRoutines : % -> % 
      ++ selectSumOfSquaresRoutines(R) chooses only those routines from the 
      ++ database which are designed for use with sums of squares

    selectNonFiniteRoutines : % -> % 
      ++ selectNonFiniteRoutines(R) chooses only those routines from the 
      ++ database which are designed for use with non-finite expressions.

    selectMultiDimensionalRoutines : % -> %
      ++ selectMultiDimensionalRoutines(R) chooses only those routines from 
      ++ the database which are designed for use with multi-dimensional
      ++ expressions

    changeThreshhold : (%,Symbol,F) -> %
      ++ changeThreshhold(R,s,newValue) changes the value below which, 
      ++ given a NAG routine generating a higher measure, the routines will 
      ++ make no attempt to generate a measure.

    changeMeasure : (%,Symbol,F) -> %
      ++ changeMeasure(R,s,newValue) changes the maximum value for a 
      ++ measure of the given NAG routine.

    getMeasure : (%,Symbol) -> F
      ++ getMeasure(R,s) gets the current value of the maximum measure for 
      ++ the given NAG routine.

    getExplanations : (%,ST) -> LST
      ++ getExplanations(R,s) gets explanations of the output parameters for 
      ++ the given NAG routine.

    deleteRoutine! : (%,Symbol) -> %
      ++ deleteRoutine!(R,s) destructively deletes the given routine from 
      ++ the current database of NAG routines

    showTheRoutinesTable : () -> %
      ++ showTheRoutinesTable() returns the current table of NAG routines.

    recoverAfterFail : (%,ST,Integer) ->  Union(ST,"failed")
      ++ recoverAfterFail(routs,routineName,ifailValue) acts on the 
      ++ instructions given by the ifail list

    finiteAggregate

  CODE ==> Result add

    Rep := Result
    import Rep

    theRoutinesTable:% := routines()

    showTheRoutinesTable():% == theRoutinesTable

    integrationRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
        elt(a,chapter) = "Integration"
      false

    selectIntegrationRoutines(R:%):% == select(integrationRoutine?,R)
     
    optimizationRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
        elt(a,chapter) = "Optimization"
      false

    selectOptimizationRoutines(R:%):% == select(optimizationRoutine?,R)
     
    PDERoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
        elt(a,chapter) = "PDE"
      false

    selectPDERoutines(R:%):% == select(PDERoutine?,R)
     
    ODERoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
        elt(a,chapter) = "ODE"
      false

    selectODEIVPRoutines(R:%):% == select(ODERoutine?,R)
     
    sumOfSquaresRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
        elt(a,type) = "SS"
      false

    selectSumOfSquaresRoutines(R:%):% == select(sumOfSquaresRoutine?,R)

    finiteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
        elt(a,type) = "One-dimensional finite"
      false

    selectFiniteRoutines(R:%):% == select(finiteRoutine?,R)

    infiniteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
        elt(a,type) = "One-dimensional infinite"
      false

    semiInfiniteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
        elt(a,type) = "One-dimensional semi-infinite"
      false

    nonFiniteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
      (semiInfiniteRoutine?(r) or infiniteRoutine?(r))

    selectNonFiniteRoutines(R:%):% == select(nonFiniteRoutine?,R)

    multiDimensionalRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
        elt(a,type) = "Multi-dimensional"
      false

    selectMultiDimensionalRoutines(R:%):% == select(multiDimensionalRoutine?,R)

    concat(a:%,b:%):% ==
      membersOfa := (members(a)@List(Record(key:Symbol,entry:Any)))
      membersOfb := (members(b)@List(Record(key:Symbol,entry:Any)))
      allMembers:=
        concat(membersOfa,membersOfb)$List(Record(key:Symbol,entry:Any))
      construct(allMembers)

    changeThreshhold(R:%,s:Symbol,newValue:F):% ==
      (a := search(s,R)) case Any =>
        e := retract(a)$AnyFunctions1(Entry)
        e.defaultMin := newValue
        a := coerce(e)$AnyFunctions1(Entry)
        insert!([s,a],R)
      error("changeThreshhold",_
            "Cannot find routine of that name")$ErrorFunctions
      
    changeMeasure(R:%,s:Symbol,newValue:F):% ==
      (a := search(s,R)) case Any =>
        e := retract(a)$AnyFunctions1(Entry)
        e.measure := newValue
        a := coerce(e)$AnyFunctions1(Entry)
        insert!([s,a],R)
      error("changeMeasure","Cannot find routine of that name")$ErrorFunctions
      
    getMeasure(R:%,s:Symbol):F ==
      (a := search(s,R)) case Any =>
        e := retract(a)$AnyFunctions1(Entry)
        e.measure
      error("getMeasure","Cannot find routine of that name")$ErrorFunctions

    deleteRoutine!(R:%,s:Symbol):% ==
      (a := search(s,R)) case Any =>
        e:Record(key:Symbol,entry:Any) := [s,a]
        remove!(e,R)
      error("deleteRoutine!","Cannot find routine of that name")$ErrorFunctions

    routines():% ==
      f := "One-dimensional finite"
      s := "One-dimensional semi-infinite"
      i := "One-dimensional infinite"
      m := "Multi-dimensional"
      int := "Integration"
      ode := "ODE"
      pde := "PDE"
      opt := "Optimization"
      d01ajfExplList:LST := _
       ["result:  Calculated value of the integral",_
"iw:  iw(1) contains the actual number of sub-intervals used, the rest is workspace",_
"w:  contains the end-points of the sub-intervals used along with the integral contributions and error estimates over the sub-intervals",_
        "abserr:  the estimate of the absolute error of the result",_
        "ifail:  the error warning parameter",_
        "method:  details of the method used and measures of all methods",_
"attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
      d01asfExplList:LST := 
        ["result:  Calculated value of the integral",_
"iw:  iw(1) contains the actual number of sub-intervals used, the rest is workspace",_
         "lst:  contains the actual number of sub-intervals used",_
         "erlst:  contains the error estimates over the sub-intervals",_
         "rslst:  contains the integral contributions of the sub-intervals",_
     "ierlst:  contains the error flags corresponding to the values in rslst",_
         "abserr:  the estimate of the absolute error of the result",_
         "ifail:  the error warning parameter",_
         "method:  details of the method used and measures of all methods",_
"attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
      d01fcfExplList:LST := _
       ["result:  Calculated value of the integral",_
        "acc:  the estimate of the relative error of the result",_
        "minpts:  the number of integrand evaluations",_
        "ifail:  the error warning parameter",_
        "method:  details of the method used and measures of all methods",_
"attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
      d01transExplList:LST := 
       ["result:  Calculated value of the integral",_
        "abserr:  the estimate of the absolute error of the result",_
"method:  details of the method and transformation used and measures of all methods",_
        "d01***AnnaTypeAnswer:  the individual results from the routines",_
"attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
      d02bhfExplList:LST := _
       ["x:  the value of x at the end of the calculation",_
        "y:  the computed values of Y\[1\]..Y\[n\] at x",_
         "tol:  the (possible) estimate of the error; this is not guarunteed",_
         "ifail:  the error warning parameter",_
         "method:  details of the method used and measures of all methods",_
"intensityFunctions:  a list of the attributes and values pertaining to the ODE which had some bearing on the choice of method"]
      d02bbfExplList:LST := concat([_
       "result:  the computed values of the solution at the required points"],_
        d02bhfExplList)$LST
      d03eefExplList:LST := 
       ["See the NAG On-line Documentation for D03EEF/D03EDF",_
         "u:  the computed solution u[i][j] is returned in u(i+(j-1)*ngx),_
          for i = 1,2,..ngx; j = 1,2,..ngy"]
      e04fdfExplList:LST := ["x:  the position of the minimum",_
        "objf:  the value of the objective function at x",_
        "ifail:  the error warning parameter",_
        "method:  details of the method used and measures of all methods",_
         "attributes:  a list of the attributes pertaining to the function or _
          functions which had some bearing on the choice of method"]
      e04dgfExplList:LST := concat(e04fdfExplList,_
        ["objgrd:  the values of the derivatives at x",_
         "iter:  the number of iterations performed"])$LST
      e04jafExplList:LST := concat(e04fdfExplList,_
         ["bu:  the values of the upper bounds used",_
          "bl:  the values of the lower bounds used"])$LST
      e04ucfExplList:LST := concat(e04dgfExplList,_
       ["istate:  the status of every constraint at x",_
        "clamda:  the QP multipliers for the last QP sub-problem",_
 "For other output parameters see the NAG On-line Documentation for E04UCF"]_
        )$LST
      e04mbfExplList:LST := concat(e04fdfExplList,_
       ["istate:  the status of every constraint at x",_
        "clamda:  the Lagrange multipliers for each constraint"])$LST
      d01ajfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
        [4,"delete"], [5,"delete"], [6,"delete"]]
      d01akfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
        [4,"delete"]]
      d01alfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
        [4,"delete"], [5,"delete"], [6,"delete"], [7,"delete"]]
      d01amfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
        [4,"delete"], [5,"delete"], [6,"delete"]]
      d01anfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
        [4,"delete"], [5,"delete"], [6,"delete"], [7,"delete"]]
      d01apfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
        [4,"delete"], [5,"delete"]]
      d01aqfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
        [4,"delete"], [5,"delete"]]
      d01asfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
        [4,"delete"], [5,"delete"], [6,"delete"], [7,"delete"], _
        [8,"delete"], [9,"delete"]]
      d01fcfIfail:IFL := [[1,"delete"], [2,"incrFunEvals"], [3,"delete"]]
      d01gbfIfail:IFL := [[1,"delete"], [2,"incrFunEvals"]]
      d02bbfIfail:IFL := 
        [[1,"delete"], [2,"decrease tolerance"], [3,"increase tolerance"],
         [4,"delete"], [5,"delete"], [6,"delete"], [7,"delete"]]
      d02bhfIfail:IFL := 
        [[1,"delete"], [2,"decrease tolerance"], [3,"increase tolerance"],
         [4,"no action"], [5,"delete"], [6,"delete"], [7,"delete"]]
      d02cjfIfail:IFL := 
        [[1,"delete"], [2,"decrease tolerance"], [3,"increase tolerance"],
         [4,"delete"], [5,"delete"], [6,"no action"], [7,"delete"]]
      d02ejfIfail:IFL := 
        [[1,"delete"], [2,"decrease tolerance"], [3,"increase tolerance"],
         [4,"delete"], [5,"delete"], [6,"no action"], [7,"delete"], _
         [8,"delete"], [9,"delete"]]
      e04dgfIfail:IFL := [[3,"delete"], [4,"no action"], [6,"delete"], 
                          [7,"delete"], [8,"delete"], [9,"delete"]]
      e04fdfIfail:IFL := 
        [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], 
          [5,"no action"], [6,"no action"], [7,"delete"], [8,"delete"]]
      e04gcfIfail:IFL := [[1,"delete"], [2,"delete"], [3,"delete"], _
        [4,"delete"], [5,"no action"], [6,"no action"], [7,"delete"], _
        [8,"delete"], [9,"delete"]]
      e04jafIfail:IFL := [[1,"delete"], [2,"delete"], [3,"delete"], _
        [4,"delete"], [5,"no action"], [6,"no action"], [7,"delete"], _
        [8,"delete"], [9,"delete"]]
      e04mbfIfail:IFL := 
        [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], [5,"delete"]]
      e04nafIfail:IFL := 
        [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], [5,"delete"],
          [6,"delete"], [7,"delete"], [8,"delete"], [9,"delete"]]
      e04ucfIfail:IFL := [[1,"delete"], [2,"delete"], [3,"delete"], _
        [4,"delete"], [5,"delete"], [6,"delete"], [7,"delete"], _
        [8,"delete"], [9,"delete"]]
      d01ajfEntry:Entry := 
        [int, f, "d01ajfAnnaType",0.4,0.4,d01ajfIfail,d01ajfExplList]
      d01akfEntry:Entry := 
        [int, f, "d01akfAnnaType",0.6,1.0,d01akfIfail,d01ajfExplList]
      d01alfEntry:Entry := 
        [int, f, "d01alfAnnaType",0.6,0.6,d01alfIfail,d01ajfExplList]
      d01amfEntry:Entry := 
        [int, i, "d01amfAnnaType",0.5,0.5,d01amfIfail,d01ajfExplList]
      d01anfEntry:Entry := 
        [int, f, "d01anfAnnaType",0.6,0.9,d01anfIfail,d01ajfExplList]
      d01apfEntry:Entry := 
        [int, f, "d01apfAnnaType",0.7,0.7,d01apfIfail,d01ajfExplList]
      d01aqfEntry:Entry := 
        [int, f, "d01aqfAnnaType",0.6,0.7,d01aqfIfail,d01ajfExplList]
      d01asfEntry:Entry := 
        [int, s, "d01asfAnnaType",0.6,0.9,d01asfIfail,d01asfExplList]
      d01transEntry:Entry:=
        [int, i, "d01TransformFunctionType",0.6,0.9,[],d01transExplList]
      d01gbfEntry:Entry := 
        [int, m, "d01gbfAnnaType",0.6,0.6,d01gbfIfail,d01fcfExplList]
      d01fcfEntry:Entry := 
        [int, m, "d01fcfAnnaType",0.5,0.5,d01fcfIfail,d01fcfExplList]
      d02bbfEntry:Entry := 
        [ode, "IVP", "d02bbfAnnaType",0.7,0.5,d02bbfIfail,d02bbfExplList]
      d02bhfEntry:Entry := 
        [ode, "IVP", "d02bhfAnnaType",0.7,0.49,d02bhfIfail,d02bhfExplList]
      d02cjfEntry:Entry := 
        [ode, "IVP", "d02cjfAnnaType",0.7,0.5,d02cjfIfail,d02bbfExplList]
      d02ejfEntry:Entry := 
        [ode, "IVP", "d02ejfAnnaType",0.7,0.5,d02ejfIfail,d02bbfExplList]
      d03eefEntry:Entry := 
        [pde, "2", "d03eefAnnaType",0.6,0.5,[],d03eefExplList]
      e04dgfEntry:Entry := 
        [opt, "CGA", "e04dgfAnnaType",0.4,0.4,e04dgfIfail,e04dgfExplList]
      e04fdfEntry:Entry := 
        [opt, "SS", "e04fdfAnnaType",0.7,0.7,e04fdfIfail,e04fdfExplList]
      e04gcfEntry:Entry := 
        [opt, "SS", "e04gcfAnnaType",0.8,0.8,e04gcfIfail,e04fdfExplList]
      e04jafEntry:Entry := 
        [opt, "QNA", "e04jafAnnaType",0.5,0.5,e04jafIfail,e04jafExplList]
      e04mbfEntry:Entry := 
        [opt, "LP", "e04mbfAnnaType",0.7,0.7,e04mbfIfail,e04mbfExplList]
      e04nafEntry:Entry := 
        [opt, "QP", "e04nafAnnaType",0.7,0.7,e04nafIfail,e04mbfExplList]
      e04ucfEntry:Entry := 
        [opt, "SQP", "e04ucfAnnaType",0.6,0.6,e04ucfIfail,e04ucfExplList]
      rl:RList :=
        [["d01apf" :: Symbol, coerce(d01apfEntry)$AnyFunctions1(Entry)],_
         ["d01aqf" :: Symbol, coerce(d01aqfEntry)$AnyFunctions1(Entry)],_
         ["d01alf" :: Symbol, coerce(d01alfEntry)$AnyFunctions1(Entry)],_
         ["d01anf" :: Symbol, coerce(d01anfEntry)$AnyFunctions1(Entry)],_
         ["d01akf" :: Symbol, coerce(d01akfEntry)$AnyFunctions1(Entry)],_
         ["d01ajf" :: Symbol, coerce(d01ajfEntry)$AnyFunctions1(Entry)],_
         ["d01asf" :: Symbol, coerce(d01asfEntry)$AnyFunctions1(Entry)],_
         ["d01amf" :: Symbol, coerce(d01amfEntry)$AnyFunctions1(Entry)],_
         ["d01transform"::Symbol, coerce(d01transEntry)$AnyFunctions1(Entry)],_
         ["d01gbf" :: Symbol, coerce(d01gbfEntry)$AnyFunctions1(Entry)],_
         ["d01fcf" :: Symbol, coerce(d01fcfEntry)$AnyFunctions1(Entry)],_
         ["d02bbf" :: Symbol, coerce(d02bbfEntry)$AnyFunctions1(Entry)],_
         ["d02bhf" :: Symbol, coerce(d02bhfEntry)$AnyFunctions1(Entry)],_
         ["d02cjf" :: Symbol, coerce(d02cjfEntry)$AnyFunctions1(Entry)],_
         ["d02ejf" :: Symbol, coerce(d02ejfEntry)$AnyFunctions1(Entry)],_
         ["d03eef" :: Symbol, coerce(d03eefEntry)$AnyFunctions1(Entry)],_
         ["e04dgf" :: Symbol, coerce(e04dgfEntry)$AnyFunctions1(Entry)],_
         ["e04fdf" :: Symbol, coerce(e04fdfEntry)$AnyFunctions1(Entry)],_
         ["e04gcf" :: Symbol, coerce(e04gcfEntry)$AnyFunctions1(Entry)],_
         ["e04jaf" :: Symbol, coerce(e04jafEntry)$AnyFunctions1(Entry)],_
         ["e04mbf" :: Symbol, coerce(e04mbfEntry)$AnyFunctions1(Entry)],_
         ["e04naf" :: Symbol, coerce(e04nafEntry)$AnyFunctions1(Entry)],_
         ["e04ucf" :: Symbol, coerce(e04ucfEntry)$AnyFunctions1(Entry)]]
      construct(rl)

    getIFL(s:Symbol,l:%):Union(IFL,"failed") ==
      o := search(s,l)$%
      o case "failed" => "failed"
      e := retractIfCan(o)$AnyFunctions1(Entry)
      e case "failed" => "failed"
      e.failList

    getInstruction(l:IFL,ifailValue:Integer):Union(ST,"failed") ==
      output := empty()$ST
      for i in 1..#l repeat
        if ((l.i).ifail=ifailValue)@Boolean then 
          output := (l.i).instruction
      empty?(output)$ST => "failed"
      output

    recoverAfterFail(routs:%,routineName:ST,
                      ifailValue:Integer):Union(ST,"failed") ==
      name := routineName :: Symbol
      failedList := getIFL(name,routs)
      failedList case "failed" => "failed"
      empty? failedList => "failed"
      instr := getInstruction(failedList,ifailValue)
      instr case "failed" => concat(routineName," failed")$ST
      (instr = "delete")@Boolean => 
        deleteRoutine!(routs,name)
        concat(routineName," failed - trying alternatives")$ST
      instr

    getExplanations(R:%,routineName:ST):LST ==
      name := routineName :: Symbol
      (a := search(name,R)) case Any => 
        e := retract(a)$AnyFunctions1(Entry)
        e.explList
      empty()$LST