path: root/src/algebra/d01weights.spad.pamphlet

\documentclass{article}
\usepackage{axiom}
\begin{document}
\title{\$SPAD/src/algebra d01weights.spad}
\author{Brian Dupee}
\maketitle
\begin{abstract}
\end{abstract}
\eject
\tableofcontents
\eject
\section{package D01WGTS d01WeightsPackage}
<<package D01WGTS d01WeightsPackage>>=
)abbrev package D01WGTS d01WeightsPackage
++ Author: Brian Dupee
++ Date Created: July 1994
++ Date Last Updated: January 1998 (Bug fix - exprHasListOfWeightsCosWXorSinWX)
++ Basic Operations: exprHasWeightCosWXorSinWX, exprHasAlgebraicWeight, 
++ exprHasLogarithmicWeights
++ Description:
++ \axiom{d01WeightsPackage} is a package for functions used to investigate
++ whether a function can be divided into a simpler function and a weight
++ function.  The types of weights investigated are those giving rise to
++ end-point singularities of the algebraico-logarithmic type, and 
++ trigonometric weights.
d01WeightsPackage(): E == I where
  LEDF	==> List Expression DoubleFloat
  KEDF	==> Kernel Expression DoubleFloat
  LKEDF	==> List Kernel Expression DoubleFloat
  EDF	==> Expression DoubleFloat
  PDF	==> Polynomial DoubleFloat
  FI	==> Fraction Integer
  LDF	==> List DoubleFloat
  DF	==> DoubleFloat
  SOCDF	==> Segment OrderedCompletion DoubleFloat
  OCDF	==> OrderedCompletion DoubleFloat
  NIA	==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF)
  INT	==> Integer
  BOP	==> BasicOperator
  URBODF	==> Union(Record(op:BasicOperator,w:DF),"failed")
  LURBODF	==> List(Union(Record(op:BasicOperator,w:DF), "failed"))
 
  E ==> with
    exprHasWeightCosWXorSinWX:NIA -> URBODF 
      ++ \axiom{exprHasWeightCosWXorSinWX} looks for trigonometric
      ++ weights in an expression of the form \axiom{cos \omega x} or
      ++ \axiom{sin \omega x}, returning the value of \omega 
      ++ (\notequal 1) and the operator. 
    exprHasAlgebraicWeight:NIA -> Union(LDF,"failed")
      ++ \axiom{exprHasAlgebraicWeight} looks for algebraic weights
      ++ giving rise to singularities of the function at the end-points.
    exprHasLogarithmicWeights:NIA -> INT
      ++ \axiom{exprHasLogarithmicWeights} looks for logarithmic weights
      ++ giving rise to singularities of the function at the end-points.
 
 
    
  I ==> add
    score:(EDF,EDF) -> FI
    kernelIsLog:KEDF -> Boolean 
    functionIsPolynomial?:EDF -> Boolean
    functionIsNthRoot?:(EDF,EDF) -> Boolean 
    functionIsQuotient:EDF -> Union(EDF,"failed")
    findCommonFactor:LEDF -> Union(LEDF,"failed")
    findAlgebraicWeight:(NIA,EDF) -> Union(DF,"failed")
    exprHasListOfWeightsCosWXorSinWX:(EDF,Symbol) -> LURBODF
    exprOfFormCosWXorSinWX:(EDF,Symbol) -> URBODF
    bestWeight:LURBODF -> URBODF
    weightIn?:(URBODF,LURBODF) -> Boolean
    inRest?:(EDF,LEDF)->Boolean
    factorIn?:(EDF,LEDF)->Boolean
    voo?:(EDF,EDF)->Boolean
   
    kernelIsLog(k:KEDF):Boolean ==
      (name k = (log :: Symbol))@Boolean
 
    factorIn?(a:EDF,l:LEDF):Boolean ==
      for i in 1..# l repeat
        (a = l.i)@Boolean => return true
      false
 
    voo?(b:EDF,a:EDF):Boolean ==
       (voo:=isTimes(b)) case LEDF and factorIn?(a,voo)
 
    inRest?(a:EDF,l:LEDF):Boolean ==
      every?( voo?(#1,a) ,l)
 
    findCommonFactor(l:LEDF):Union(LEDF,"failed") ==
      empty?(l)$LEDF => "failed"
      f := first(l)$LEDF
      r := rest(l)$LEDF
      (t := isTimes(f)$EDF) case LEDF =>
        pos:=select(inRest?(#1,r),t)
        empty?(pos) => "failed"
        pos
      "failed"
 
    exprIsLogarithmicWeight(f:EDF,Var:EDF,a:EDF,b:EDF):INT ==
      ans := 0$INT
      k := tower(f)$EDF
      lf := select(kernelIsLog,k)$LKEDF
      empty?(lf)$LKEDF => ans
      for i in 1..# lf repeat
        arg := argument lf.i
        if (arg.1 = (Var - a)) then
          ans := ans + 1
        else if (arg.1 = (b - Var)) then
          ans := ans + 2
      ans      
 
    exprHasLogarithmicWeights(args:NIA):INT ==
      ans := 1$INT
      a := getlo(args.range)$d01AgentsPackage :: EDF
      b := gethi(args.range)$d01AgentsPackage :: EDF
      Var := args.var :: EDF
      (l := isPlus numerator args.fn) case LEDF =>
        (cf := findCommonFactor l) case LEDF =>
          for j in 1..# cf repeat
            ans := ans + exprIsLogarithmicWeight(cf.j,Var,a,b)
          ans
        ans
      ans := ans + exprIsLogarithmicWeight(args.fn,Var,a,b)
 
    functionIsQuotient(expr:EDF):Union(EDF,"failed") ==
      (k := mainKernel expr) case KEDF =>
        expr = inv(f := k :: KEDF :: EDF)$EDF => f
--        one?(numerator expr) => denominator expr
        (numerator expr = 1) => denominator expr
        "failed"
      "failed"
 
    functionIsPolynomial?(f:EDF):Boolean ==
      (retractIfCan(f)@Union(PDF,"failed"))$EDF case PDF
 
    functionIsNthRoot?(f:EDF,e:EDF):Boolean ==
      (m := mainKernel f) case "failed" => false
--      (one?(# (kernels f))) 
      ((# (kernels f)) = 1) 
        and (name operator m = (nthRoot :: Symbol))@Boolean
          and (((argument m).1 = e)@Boolean)
 
    score(f:EDF,e:EDF):FI ==
      ans := 0$FI
      (t := isTimes f) case LEDF =>
        for i in 1..# t repeat
          ans := ans + score(t.i,e)
        ans
      (q := functionIsQuotient f) case EDF =>
        ans := ans - score(q,e)
      functionIsPolynomial? f =>
        g:EDF := f/e
        if functionIsPolynomial? g then
          ans := 1+score(g,e)
        else
          ans 
      (l := isPlus f) case LEDF =>
        (cf := findCommonFactor l) case LEDF =>
          factor := 1$EDF
          for i in 1..# cf repeat
            factor := factor*cf.i
          ans := ans + score(f/factor,e) + score(factor,e)
        ans
      functionIsNthRoot?(f,e) =>
        (p := isPower f) case "failed" => ans
        exp := p.exponent
        m := mainKernel f
        m case KEDF => 
          arg := argument m
          a:INT := (retract(arg.2)@INT)$EDF
          exp / a
        ans
      ans
 
    findAlgebraicWeight(args:NIA,e:EDF):Union(DF,"failed") == 
      zero?(s := score(args.fn,e)) => "failed"
      s :: DF
 
    exprHasAlgebraicWeight(args:NIA):Union(LDF,"failed") ==
      (f := functionIsContinuousAtEndPoints(args)$d01AgentsPackage) 
                                          case continuous =>"failed"
      Var := args.var :: EDF
      a := getlo(args.range)$d01AgentsPackage :: EDF
      b := gethi(args.range)$d01AgentsPackage :: EDF
      A := Var - a
      B := b - Var
      f case lowerSingular => 
        (h := findAlgebraicWeight(args,A)) case "failed" => "failed"
        [h,0] 
      f case upperSingular => 
        (g := findAlgebraicWeight(args,B)) case "failed" => "failed"
        [0,g] 
      h := findAlgebraicWeight(args,A) 
      g := findAlgebraicWeight(args,B)
      r := (h case "failed")
      s := (g case "failed")
      (r) and (s) => "failed"
      r => [0,coerce(g)@DF]
      s => [coerce(h)@DF,0]  
      [coerce(h)@DF,coerce(g)@DF]
 
    exprOfFormCosWXorSinWX(f:EDF,var:Symbol): URBODF ==
      l:LKEDF := kernels(f)$EDF
--      one?((# l)$LKEDF)$INT => 
      # l = 1 => 
        a:LEDF := argument(e:KEDF := first(l)$LKEDF)$KEDF
        empty?(a) => "failed"
        m:Union(LEDF,"failed") := isTimes(first(a)$LEDF)$EDF 
        m case LEDF => -- if it is a list, it will have at least two elements
          is?(second(m)$LEDF,var)$EDF =>
            omega:DF := retract(first(m)$LEDF)@DF
            o:BOP := operator(n:Symbol:=name(e)$KEDF)$BOP
            (n = cos@Symbol)@Boolean => [o,omega]
            (n = sin@Symbol)@Boolean => [o,omega]
            "failed"
          "failed"
        "failed"
      "failed"
 
    exprHasListOfWeightsCosWXorSinWX(f:EDF,var:Symbol): LURBODF ==
      (e := isTimes(f)$EDF) case LEDF => 
        [exprOfFormCosWXorSinWX(u,var) for u in e]
      empty?(k := kernels f) => ["failed"]
      ((first(k)::EDF) = f) => 
        [exprOfFormCosWXorSinWX(f,var)]
      ["failed"]
 
    bestWeight(l:LURBODF): URBODF ==
      empty?(l)$LURBODF => "failed"
      best := first(l)$LURBODF        --  best is first in list
      empty?(rest(l)$LURBODF) => best
      for i in 2..# l repeat          --  unless next is better
        r:URBODF := l.i
        if r case "failed" then leave
        else if best case "failed" then
          best := r
        else if r.w > best.w then
          best := r
      best
 
    weightIn?(weight:URBODF,listOfWeights:LURBODF):Boolean ==
      n := # listOfWeights
      for i in 1..n repeat                               -- cycle through list
        (weight = listOfWeights.i)@Boolean => return true -- return when found
      false
 
    exprHasWeightCosWXorSinWX(args:NIA):URBODF ==
      ans := empty()$LURBODF
      f:EDF := numerator(args.fn)$EDF
      (t:Union(LEDF,"failed") := isPlus(f)) case "failed" => 
        bestWeight(exprHasListOfWeightsCosWXorSinWX(f,args.var))
      if t case LEDF then
        e1 := first(t)$LEDF
        le1:LURBODF := exprHasListOfWeightsCosWXorSinWX(e1,args.var)
        le1 := [u for u in le1 | (not (u case "failed"))]
        empty?(le1)$LURBODF => "failed"
        test := true
        for i in 1..# le1 repeat
          le1i:URBODF := le1.i
          for j in 2..# t repeat
            if test then
              tj:LURBODF := exprHasListOfWeightsCosWXorSinWX(t.j,args.var)
              test := weightIn?(le1i,tj)
          if test then
            ans := concat([le1i],ans)
        bestWeight ans
      else "failed"

@
\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 D01WGTS d01WeightsPackage>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}