\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} <>= )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 "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))) 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 => 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} <>= --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. @ <<*>>= <> <> @ \eject \begin{thebibliography}{99} \bibitem{1} nothing \end{thebibliography} \end{document}