Документ взят из кэша поисковой машины. Адрес оригинального документа : http://theory.sinp.msu.ru/~svernov/programms/Maple/Laurent4.txt Дата изменения: Fri Sep 9 14:52:44 2005 Дата индексирования: Tue Oct 2 05:56:24 2012 Кодировка:

ellipso:=table();

ellipso[quvar]:=proc(m::integer, p)

# 10.10.2003
# This procedure constructs the first order autonomous ODE, which
# solutions tend to infinity as 1/t^p.
# The maximal degree of dy is m.

local k, j, numterm;
numterm:=0;
for k from 0 to m-1
do for j from 0 while p*j <= (p+1)*(m-k)
do numterm:=numterm+1;
od;
od;
return numterm;
end;



ellipso[equa]:=proc(a, m::integer, p, yp2, dyp2)

# 10.3.2003
# This procedure constructs the first order autonomous ODE, which
# solutions tend to infinity as 1/t^p.
# The maximal degree of dy is m.

local equ, k, j, numterm;
equ:=0;
for k from 0 to m
do for j from 0 while p*j <= (p+1)*(m-k)
do equ := equ+a[j,k]*yp2^j*dyp2^k;
od
od;
return equ;
end;



ellipso[equalaur]:=proc(a, m::integer, p::integer, Laurentmax::integer)

# 10.10.2003
# This procedure expands the first order polynomial autonomous ODE in
# the Laurent series, including terms from 1/t^Laurentmax to t^Nmax.
# The maximal degree of dy is m.

local max,equ,k,j,y,dy,equlist,t;
equ:=equa(a,m,p,yp,dyp);
y:=0;
for k from -p to Laurentmax-p do y:=y+c(k)*t^k od;
dy:=diff(y,t);
max:=quvar(m,p)+1;
if Laurentmax > max then max:=Laurentmax fi;
for k from 0 to m
do
dyp(k):=convert(taylor(eval(dy**k*t^((p+1)*m)),t,max),polynom)
od;
for k from 0 to iquo(m*(p+1),p)
do
yp(k):=convert(taylor(eval(y**k*t^((p+1)*m)),t, max),polynom)
od;
equlist:=[];
equ:=expand(eval(equ*t^(-(p+1)*m)));
for k from 1 to max
do
equlist:=[op(equlist),asubs(t=0,equ)];
equ:=diff(equ,t)/k;
od;
return equlist;
end;


ellipso[equalist]:=proc(a, m::integer, p)

# 30.10.2003
# This procedure constructs the first order autonomous ODE is a list.
# solutions tend to infinity as 1/t^p.
# The maximal degree of dy is m.

local fequlist, k, j;
fequlist:=[];
for k from 0 to m
do for j from 0 while p*j <= (p+1)*(m-k)
do fequlist:=[op(fequlist),[a[j,k],j,k]];
od
od;
return fequlist
end;


ellipso[ydegree]:=proc(c,n,j,p)

# 27.07.2004
# This procedure constructs the j-th term of the Laurent series for y^n;
# solutions tend to infinity as 1/t^p.

local sumy,k,stepp;
if n=1 then return c(j)
else sumy:=0;
if p<1 then stepp:=p else stepp:=1 fi;
for k from -p to j+p*n by stepp
do sumy:=sumy+c(k)*ydegree(c,n-1,j-k,p);
od;
return sumy;
fi;
end;

ellipso[dydegree]:=proc(c,n,j,p)

# 27.07.2004
# This procedure constructs the j-th term of the Laurent series for dy^n;
# solutions tend to infinity as 1/t^p.

local sumdy,k,stepp;
if n=1 then return (j+1)*c(j+1)
else sumdy:=0;
if p<1 then stepp:=p else stepp:=1 fi;
for k from -(p+1) to j+(p+1)*n by stepp
do sumdy:=sumdy+(k+1)*c(k+1)*dydegree(c,n-1,j-k,p);
od;
return sumdy;
fi;
end;


ellipso[monomlaur]:=proc(c,mon,j,p)

# 27.07.2003
# This procedure constructs the Laurent series for mon:=[coef,ydeg,dydeg].
# Solutions tend to infinity as 1/t^p.

local k,coef,ydeg,dydeg,sum,stepp;
coef:=op(1,mon);
ydeg:=op(2,mon);
dydeg:=op(3,mon);
if ydeg=0 then
if dydeg=0 then
if j=0 then return coef
else return 0
fi;
else return coef*dydegree(c,dydeg,j,p)
fi;
else if dydeg=0 then return coef*ydegree(c,ydeg,j,p)
else sum:=0;
if p<1 then stepp:=p else stepp:=1 fi;
for k from -p*ydeg to j+(p+1)*dydeg by stepp
do sum:=sum+ydegree(c,ydeg,k,p)*dydegree(c,dydeg,j-k,p);
od;
return coef*sum;
fi;
fi;
end;


ellipso[oneequlaur]:=proc(c, fequlist, j, p)

# 27.07.2004
# This procedure constructs the j-th term of the Laurent series of the
# first order autonomous ODE (the list fequlist).
# solutions tend to infinity as 1/t^p.

local equj,k;
equj:=0;
for k from 1 to nops(fequlist)
do equj:=equj+monomlaur(c,op(k,fequlist),j,p);
od;
return equj;
end;


ellipso[equlaurlist]:=proc(a,m::integer,p,sernumber::integer,c)

# 27.07.2004
# This procedure constructs the Laurent or Puiseux series of the
# first order autonomous ODE
# with maximal degree of y' is equal to m.
# Solutions tend to infinity as 1/t^p.
# c(k) are the Laurent (Puiseux) series coefficients of y.
# The length of the resulting list is sernumber.

local k, laurlist, fequlist, stepp;
if p<1 then stepp:=p else stepp:=1 fi;
fequlist:=equalist(a,m,p);
for k from -m*(p+1) to -p-stepp by stepp do c(k):=0 od;
laurlist:=[];
for k from -m*(p+1) to (sernumber-1)*stepp-m*(p+1) by stepp do
laurlist:=[op(laurlist),simplify(oneequlaur(c,fequlist,k,p))] od;
return laurlist;
end;


ellipso[varlist]:=proc(a,m::integer,p::integer,simlist)

# 25.3.2004
# This procedure gives the list of remaining unknowns a[i,j].

local k, j, js, len, ad, var;
len:=nops(simlist);
var:=[];
for k from 0 to m-1
do for j from 0 while p*j <= (p+1)*(m-k)
do ad:=1;
for js from 1 to len
do if k=op([js,3], simlist) and j=op([js,2], simlist)
then ad:=0
fi;
od;
if ad=1 then var:=[op(var),a[j,k]] fi;
od;
od;
return var;
end;

ellipso[minusimp]:=proc(a,simlist)
local k, j, list3, len, term, ad;
len:=nops(simlist);
list3:=[];
for j from 1 to nops(a)
do
term:=op(j,a);
ad:=1;
for k from 1 to len
do
if op(2,term)=op([k,2],simlist) and op(3,term)=op([k,3],simlist)
then ad:=0;
fi;
od;
if ad=1 then list3:=[op(list3),term] fi;
od;
return list3;
end;


ellipso[simplequ]:=proc(m,p)

# This procedure constructs the list of the
# first order autonomous ODE coefficients, which can be exclude from the
# system of algebraic equations.
# The maximal degree of y' is equal to m.
# Solutions tend to infinity as 1/t^p.

local simplist, list2, len, pow, k,j,rr,rr2;
len:=0;
for k from 0 to m-1 do
for j from 0 while p*j <= (p+1)*(m-k) do
if len=0 then
simplist:=[[-(p*j+(p+1)*k),j,k]];
len:=1
else
list2:=[];
pow:=-(p*j+(p+1)*k);
for rr from 1 while (rr<=len) and
(op([rr,1],simplist) do list2:=[op(list2),op(rr,simplist)];
od;
if rr>len or op([rr,1],simplist)>pow
then
list2:=[op(list2),[-(p*j+(p+1)*k),j,k]];
for rr2 from rr while (rr2<=len)
do
list2:=[op(list2),op(rr2,simplist)];
od;
simplist:=list2;
len:=len+1;
fi;
fi;
od;
od;
return simplist;
end;

ellipso[simplequ2]:=proc(flist,a,m,p)


# This procedure constructs the list of the
# first order autonomous ODE coefficients, which can be exclude from the
# system of algebraic equations.
# The maximal degree of y' is equal to m.
# Solutions tend to infinity as 1/t^p.

local simplist, list2, len, pow, k,j,rr,rr2;
print(flist);
len:=0;
for k from 0 to m-1 do
for j from 0 while p*j <= (p+1)*(m-k) do
if member([a[j,k],j,k],flist)
then if len=0
then
simplist:=[[-(p*j+(p+1)*k),j,k]];
len:=1
else
list2:=[];
pow:=-(p*j+(p+1)*k);
for rr from 1 while (rr<=len) and
(op([rr,1],simplist) do list2:=[op(list2),op(rr,simplist)];
od;
if (rr>len) or (op([rr,1],simplist)>pow)
then
list2:=[op(list2),[-(p*j+(p+1)*k),j,k]];
for rr2 from rr while (rr2<=len)
do
list2:=[op(list2),op(rr2,simplist)];
od;
simplist:=list2;
len:=len+1;
fi;
fi;
fi;
od;
od;
return simplist;
end;

ellipso[avoida]:=proc(res,resgroeb,var)

local k,j,res2,dft,dfrg,term;
res2:=[];
for j from 1 to nops(res)
do
term:=op(j,res);
for k from 1 to nops(var)
do
dft:=diff(term,op(k,var));
dfrg:=diff(op(k,resgroeb),op(k,var));
if(dft*dfrg) <> 0 then term:=simplify(dft*op(k,resgroeb)-dfrg*term);
fi;
od;
res2:=[op(res2),term];
od;
return res2;
end;

ellipso[monomresidue]:=proc(c,fdeg::integer,dfdeg::integer,p::integer)

# This procedure calculates the residue of the product
# f(t)^fdeg*diff(f(t),t)^dfdeg.
# c(k) are the coefficients of the Laurent series for
# the function f(t), which tends to infinity as 1/t^p.

local k,mon;
for k from -p*fdeg-(p+1)*dfdeg to -p-1 do c(k):=0 od;
mon:=[1,fdeg,dfdeg];
return monomlaur(c,mon,-1,p);
end;