/usr/share/axiom-20170501/src/algebra/WEIER.spad is in axiom-source 20170501-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 | )abbrev package WEIER WeierstrassPreparation
++ Author:William H. Burge
++ Date Created:Sept 1988
++ Date Last Updated:Feb 15 1992
++ Description:
++ This package implements the Weierstrass preparation
++ theorem f or multivariate power series.
++ weierstrass(v,p) where v is a variable, and p is a
++ TaylorSeries(R) in which the terms
++ of lowest degree s must include c*v**s where c is a constant,s>0,
++ is a list of TaylorSeries coefficients A[i] of the equivalent polynomial
++ A = A[0] + A[1]*v + A[2]*v**2 + ... + A[s-1]*v**(s-1) + v**s
++ such that p=A*B , B being a TaylorSeries of minimum degree 0
WeierstrassPreparation(R) : SIG == CODE where
R : Field
VarSet==>Symbol
SMP ==> Polynomial R
PS ==> InnerTaylorSeries SMP
NNI ==> NonNegativeInteger
ST ==> Stream
StS ==> Stream SMP
STPS==>StreamTaylorSeriesOperations
STTAYLOR==>StreamTaylorSeriesOperations
SUP==> SparseUnivariatePolynomial(SMP)
ST2==>StreamFunctions2
SMPS==> TaylorSeries(R)
L==>List
null ==> empty?
likeUniv ==> univariate
coef ==> coefficient$SUP
nil ==> empty
SIG ==> with
crest : (NNI->( StS-> StS))
++\spad{crest n} is used internally.
cfirst : (NNI->( StS-> StS))
++\spad{cfirst n} is used internally.
sts2stst : (VarSet,StS)->ST StS
++\spad{sts2stst(v,s)} is used internally.
clikeUniv : VarSet->(SMP->SUP)
++\spad{clikeUniv(v)} is used internally.
weierstrass : (VarSet,SMPS)->L SMPS
++\spad{weierstrass(v,ts)} where v is a variable and ts is
++ a TaylorSeries, impements the Weierstrass Preparation
++ Theorem. The result is a list of TaylorSeries that
++ are the coefficients of the equivalent series.
qqq : (NNI,SMPS,ST SMPS)->((ST SMPS)->ST SMPS)
++\spad{qqq(n,s,st)} is used internally.
CODE ==> add
import TaylorSeries(R)
import StreamTaylorSeriesOperations SMP
import StreamTaylorSeriesOperations SMPS
map1==>map$(ST2(SMP,SUP))
map2==>map$(ST2(StS,SMP))
map3==>map$(ST2(StS,StS))
transback:ST SMPS->L SMPS
transback smps==
if null smps
then nil()$(L SMPS)
else
if null first (smps:(ST StS))
then nil()$(L SMPS)
else
cons(map2(first,smps:ST StS):SMPS,
transback(map3(rest,smps:ST StS):(ST SMPS)))$(L SMPS)
clikeUniv(var)==p +-> likeUniv(p,var)
mind:(NNI,StS)->NNI
mind(n, sts)==
if null sts
then error "no mindegree"
else if first sts=0
then mind(n+1,rest sts)
else n
mindegree (sts:StS):NNI== mind(0,sts)
streamlikeUniv:(SUP,NNI)->StS
streamlikeUniv(p:SUP,n:NNI): StS ==
if n=0
then cons(coef (p,0),nil()$StS)
else cons(coef (p,n),streamlikeUniv(p,(n-1):NNI))
transpose:ST StS->ST StS
transpose(s:ST StS)==delay(
if null s
then nil()$(ST StS)
else cons(map2(first,s),transpose(map3(rest,rst s))))
zp==>map$StreamFunctions3(SUP,NNI,StS)
sts2stst(var, sts)==
zp((x,y) +-> streamlikeUniv(x,y),
map1(clikeUniv var, sts),(integers 0):(ST NNI))
tp:(VarSet,StS)->ST StS
tp(v,sts)==transpose sts2stst(v,sts)
map4==>map$(ST2 (StS,StS))
maptake:(NNI,ST StS)->ST SMPS
maptake(n,p)== map4(cfirst n,p) pretend ST SMPS
mapdrop:(NNI,ST StS)->ST SMPS
mapdrop(n,p)== map4(crest n,p) pretend ST SMPS
YSS==>Y$ParadoxicalCombinatorsForStreams(SMPS)
weier:(VarSet,StS)->ST SMPS
weier(v,sts)==
a:=mindegree sts
if a=0
then error "has constant term"
else
p:=tp(v,sts) pretend (ST SMPS)
b:StS:=rest(((first p pretend StS)),a::NNI)
c:=retractIfCan first b
c case "failed"=>_
error "the coefficient of the lowest degree of the variable _
should be a constant"
e:=recip b
f:= if e case "failed"
then error "no reciprocal"
else e::StS
q:=(YSS qqq(a,f:SMPS,rest p))
maptake(a,(p*q) pretend ST StS)
cfirst n == s +-> first(s,n)$StS
crest n == s +-> rest(s,n)$StS
qq:(NNI,SMPS,ST SMPS,ST SMPS)->ST SMPS
qq(a,e,p,c)==
cons(e,(-e)*mapdrop(a,(p*c)pretend(ST StS)))
qqq(a,e,p)== s +-> qq(a,e,p,s)
wei:(VarSet,SMPS)->ST SMPS
wei(v:VarSet,s:SMPS)==weier(v,s:StS)
weierstrass(v,smps)== transback wei (v,smps)
|