version 1.1, 2003/10/15 07:06:02 |
version 1.12, 2003/12/08 07:18:14 |
|
|
#include<defs.h> |
|
load("solve")$ |
load("solve")$ |
|
load("gr")$ |
|
|
|
def nonzerovec(A){ |
|
|
|
for(I=0;I<size(A)[0];I++) |
|
if(A[I]!=0) |
|
return 1$ |
|
|
|
return 0$ |
|
} |
|
|
|
def junban(A,B){ |
|
return (A<B ? 1:(A>B ? -1:0))$ |
|
} |
|
|
|
def worder(A,B){ |
|
return (A[0]<B[0] ? 1:(A[0]>B[0] ? -1:0))$ |
|
} |
|
|
|
def bsort(A){ |
|
|
|
K=size(A)[0]-1$ |
|
while(K>=0){ |
|
J=-1$ |
|
for(I=1;I<=K;I++) |
|
if(A[I-1][0]<A[I][0]){ |
|
J=I-1$ |
|
X=A[J]$ |
|
A[J]=A[I]$ |
|
A[I]=X$ |
|
} |
|
K=J$ |
|
} |
|
return A$ |
|
} |
|
|
|
def perm(I,P,TMP){ |
|
|
|
if(I>0){ |
|
TMP=perm(I-1,P,TMP)$ |
|
for(J=I-1;J>=0;J--){ |
|
T=P[I]$ |
|
P[I]=P[J]$ |
|
P[J]=T$ |
|
TMP=perm(I-1,P,TMP)$ |
|
T=P[I]$ |
|
P[I]=P[J]$ |
|
P[J]=T$ |
|
} |
|
|
|
return TMP$ |
|
} |
|
else{ |
|
for(TMP0=[],K=0;K<size(P)[0];K++) |
|
TMP0=cons(P[K],TMP0)$ |
|
|
|
TMP=cons(TMP0,TMP)$ |
|
return TMP$ |
|
} |
|
} |
|
|
|
def marge(A,B){ |
|
|
|
RET=[]$ |
|
for(I=0;I<length(A);I++) |
|
for(J=0;J<length(B);J++) |
|
RET=cons(append(A[I],B[J]),RET)$ |
|
|
|
return RET$ |
|
} |
|
|
|
def wsort(A,B,C,FLAG){ |
|
|
|
if(FLAG==0){ |
|
D=newvect(length(B))$ |
|
for(I=0;I<length(B);I++) |
|
D[I]=[A[I],B[I],C[I]]$ |
|
|
|
D=bsort(D)$ |
|
E=[]$ |
|
for(I=0;I<length(B);I++) |
|
E=cons(D[I][1],E)$ |
|
E=reverse(E)$ |
|
F=[]$ |
|
for(I=0;I<length(B);I++) |
|
F=cons(D[I][2],F)$ |
|
F=reverse(F)$ |
|
|
|
return [[E,F]]$ |
|
} |
|
else{ |
|
D=newvect(length(B))$ |
|
for(I=0;I<length(B);I++) |
|
D[I]=[A[I],B[I],C[I]]$ |
|
|
|
D=qsort(D,worder)$ |
|
D0=[]$ |
|
|
|
for(I=0,J=0,TMP=[],X=0;I<size(D)[0];I++){ |
|
if(X==D[I][0]) |
|
TMP=cons(cdr(D[I]),TMP)$ |
|
else{ |
|
D0=cons(TMP,D0)$ |
|
TMP=[]$ |
|
TMP=cons(cdr(D[I]),TMP)$ |
|
X=car(D[I])$ |
|
} |
|
} |
|
D0=cdr(reverse(cons(TMP,D0)))$ |
|
D0=map(ltov,D0)$ |
|
for(I=0,TMP=[[]];I<length(D0);I++){ |
|
TMP0=perm(length(D0[I])-1,D0[I],[])$ |
|
TMP=marge(TMP,TMP0)$ |
|
} |
|
|
|
RET=[]$ |
|
for(I=0;I<length(TMP);I++){ |
|
TMP0=[]$ |
|
TMP1=[]$ |
|
for(J=0;J<length(TMP[I]);J++){ |
|
TMP0=cons(TMP[I][J][0],TMP0)$ |
|
TMP1=cons(TMP[I][J][1],TMP1)$ |
|
} |
|
TMP0=reverse(TMP0)$ |
|
TMP1=reverse(TMP1)$ |
|
|
|
RET=cons([TMP0,TMP1],RET)$ |
|
} |
|
|
|
return RET$ |
|
} |
|
} |
|
|
|
def derase(A){ |
|
|
|
B=newvect(length(A),A)$ |
|
B=qsort(B,junban)$ |
|
C=[]$ |
|
for(I=0;I<size(B)[0];I++) |
|
if(car(C)!=B[I]) |
|
C=cons(B[I],C)$ |
|
|
|
return reverse(C)$ |
|
} |
|
|
def nonposdegchk(Res){ |
def nonposdegchk(Res){ |
|
|
for(I=0;I<length(Res);I++) |
for(I=0;I<length(Res);I++) |
Line 10 def nonposdegchk(Res){ |
|
Line 153 def nonposdegchk(Res){ |
|
return 1$ |
return 1$ |
} |
} |
|
|
def extmat(Mat,OneMat,N,M,I,J){ |
def getgcd(A,B){ |
|
|
if(J<N) |
VarsNumA=length(A)$ |
return Mat[I][J]$ |
VarsNumB=length(B)$ |
|
|
if(OneMat[J][0]<=I && I<=OneMat[J][1]) |
C=newvect(VarsNumB,B)$ |
if(J==M-1) |
|
return 1$ |
|
else |
|
return -1$ |
|
else |
|
return 0$ |
|
|
|
} |
for(I=0;I<VarsNumA;I++){ |
|
|
def resvars(Res,Vars){ |
for(J=0;J<VarsNumB;J++) |
|
if(C[J]==A[I][0]) |
|
break$ |
|
|
ResVars=newvect(length(Vars),Vars)$ |
if(J<VarsNumB) |
|
C[J]=A[I][1]$ |
|
} |
|
|
for(I=0;I<length(Res);I++){ |
D=0$ |
|
for(I=0;I<VarsNumB;I++) |
for(J=0;J<size(ResVars)[0];J++) |
D=gcd(D,C[I])$ |
if(Res[I][0]==ResVars[J]) |
|
break$ |
|
|
|
ResVars[J]=Res[I][1]$ |
if(D!=0){ |
|
C=C/D$ |
|
C=map(red,C)$ |
} |
} |
|
|
return(ResVars)$ |
for(L=1,D=0,I=0;I<VarsNumB;I++){ |
|
if(type(TMP=dn(C[I]))==1) |
|
L=ilcm(L,TMP)$ |
|
|
|
if(type(TMP=nm(C[I]))==1) |
|
D=igcd(D,TMP)$ |
|
} |
|
|
|
C=C*L$ |
|
if(D!=0) |
|
C=C/D$ |
|
|
|
RET=[]$ |
|
for(I=0;I<VarsNumB;I++) |
|
RET=cons([B[I],C[I]],RET)$ |
|
|
|
return RET$ |
} |
} |
|
|
def makeret(Res,Vars,B){ |
def makeret(Res,Vars,FLAG){ |
|
|
|
ResNum=length(Res)$ |
VarsNum=length(Vars)$ |
VarsNum=length(Vars)$ |
|
|
ResMat=newvect(VarsNum)$ |
ResVec=newvect(ResNum)$ |
for(I=0;I<VarsNum;I++) |
for(M=0,I=0;I<ResNum;I++){ |
ResMat[I]=newvect(2)$ |
if(member(Res[I][0],Vars)){ |
|
ResVec[I]=Res[I][1]$ |
|
|
for(I=0;I<VarsNum;I++){ |
if(FLAG && type(ResVec[I])==1){ |
ResMat[I][0]=Vars[I]$ |
if(M==0) |
ResMat[I][1]=Vars[I]$ |
M=ResVec[I]$ |
} |
else |
|
if(ResVec[I]<M) |
|
M=ResVec[I]$ |
|
} |
|
} |
|
} |
|
|
for(I=0;I<length(Res);I++){ |
if(M!=0) |
|
ResVec=ResVec/M; |
|
|
for(J=0;J<size(ResMat)[0];J++) |
RET=newvect(VarsNum,Vars)$ |
if(Res[I][0]==ResMat[J][0]) |
|
|
for(I=0;I<ResNum;I++){ |
|
for(J=0;J<VarsNum;J++) |
|
if(Vars[J]==Res[I][0]) |
break$ |
break$ |
|
|
if(J<VarsNum) |
if(J<VarsNum) |
ResMat[J][1]=Res[I][1]*B$ |
RET[J]=ResVec[I]$ |
} |
} |
|
|
|
|
|
for(J=0;J<length(Vars);J++) |
|
RET=map(subst,RET,Vars[J], |
|
strtov(rtostr(Vars[J])+"_deg"))$ |
|
|
for(I=0;I<VarsNum;I++) |
for(I=0;I<VarsNum;I++) |
for(J=0;J<length(Vars);J++) |
if(type(RET[I])!=1) |
ResMat[I][1]=subst(ResMat[I][1],Vars[J], |
return [1,RET]$ |
strtov(rtostr(Vars[J])+"_deg"))$ |
|
|
|
ResMat=map(vtol,ResMat)$ |
return [0,RET]$ |
return(vtol(ResMat))$ |
} |
|
|
|
def roundret(V){ |
|
|
|
VN=size(V)[0]$ |
|
|
|
RET0=V$ |
|
for(I=2;I<1000;I++){ |
|
RET1=I*RET0$ |
|
for(J=0;J<VN;J++){ |
|
X=drint(RET1[J])$ |
|
if(dabs(X-RET1[J])<0.2) |
|
RET1[J]=X$ |
|
else |
|
break$ |
|
} |
|
if(J==VN) |
|
break$ |
|
} |
|
|
|
if(I==1000) |
|
return []$ |
|
else |
|
return RET1$ |
} |
} |
|
|
def afo(A,B){ |
def chkou(L,ExpMat,CHAGORD){ |
|
|
for(I=0;I<size(A)[0];I++){ |
for(P=1,I=0;I<L;I++){ |
if(A[I]<B[I]) |
Q=ExpMat[L][CHAGORD[I]]$ |
return 1$ |
for(J=0;J<size(ExpMat[0])[0];J++){ |
|
ExpMat[L][CHAGORD[J]]=red((ExpMat[I][CHAGORD[I]] |
if(A[I]>B[I]) |
*ExpMat[L][CHAGORD[J]]- |
return -1$ |
Q*ExpMat[I][CHAGORD[J]])/P)$ |
|
} |
|
|
|
P=ExpMat[I][CHAGORD[I]]$ |
} |
} |
|
|
return 0$ |
for(J=0;J<size(ExpMat[0])[0];J++) |
|
if(ExpMat[L][CHAGORD[J]]!=0) |
|
break$ |
|
|
|
if(J==size(ExpMat[0])[0]) |
|
return L$ |
|
else{ |
|
TMP=CHAGORD[L]$ |
|
CHAGORD[L]=CHAGORD[J]$ |
|
CHAGORD[J]=TMP$ |
|
return (L+1)$ |
|
} |
} |
} |
|
|
def weight(PolyList,Vars){ |
def qcheckmain(PolyList,Vars){ |
|
|
dp_ord(2)$ |
RET=[]$ |
|
|
PolyListNum=length(PolyList)$ |
PolyListNum=length(PolyList)$ |
|
VarsNum=length(Vars)$ |
|
|
ExpMat=[]$ |
ExpMat=newvect(VarsNum)$ |
for(I=0;I<PolyListNum;I++) |
CHAGORD=newvect(VarsNum)$ |
for(Poly=dp_ptod(PolyList[I],Vars);Poly!=0;Poly=dp_rest(Poly)) |
for(I=0;I<VarsNum;I++) |
ExpMat=cons(dp_etov(dp_ht(Poly)),ExpMat)$ |
CHAGORD[I]=I$ |
|
|
ExpMat=reverse(ExpMat)$ |
L=0$ |
ExpMat=newvect(length(ExpMat),ExpMat)$ |
for(I=0;I<PolyListNum;I++){ |
|
Poly=dp_ptod(PolyList[I],Vars)$ |
|
BASE0=dp_etov(dp_ht(Poly))$ |
|
Poly=dp_rest(Poly)$ |
|
for(;Poly!=0;Poly=dp_rest(Poly)){ |
|
ExpMat[L]=dp_etov(dp_ht(Poly))-BASE0$ |
|
L=chkou(L,ExpMat,CHAGORD)$ |
|
if(L==VarsNum-1) |
|
return [L,CHAGORD,ExpMat]$ |
|
} |
|
} |
|
|
|
return [L,CHAGORD,ExpMat]$ |
|
} |
|
|
ExpMatRowNum=size(ExpMat)[0]$ |
def inner(A,B){ |
ExpMatColNum=size(ExpMat[0])[0]$ |
|
ExtMatRowNum=ExpMatRowNum$ |
|
ExtMatColNum=ExpMatColNum+PolyListNum$ |
|
|
|
OneMat=newmat(ExtMatColNum,2)$ |
SUM=0$ |
|
for(I=0;I<size(A)[0];I++) |
|
SUM+=A[I]*B[I]$ |
|
|
for(I=0;I<ExpMatColNum;I++){ |
return SUM$ |
OneMat[I][0]=0$ |
} |
OneMat[I][1]=ExtMatRowNum-1$ |
|
|
def checktd(PolyList,Vars,ResVars){ |
|
|
|
PolyListNum=length(PolyList)$ |
|
VarsNum=length(Vars)$ |
|
|
|
L=0$ |
|
for(I=0;I<PolyListNum;I++){ |
|
Poly=dp_ptod(PolyList[I],Vars)$ |
|
J0=inner(dp_etov(dp_ht(Poly)),ResVars)$ |
|
Poly=dp_rest(Poly)$ |
|
for(;Poly!=0;Poly=dp_rest(Poly)) |
|
if(J0!=inner(dp_etov(dp_ht(Poly)),ResVars)) |
|
return 0$ |
} |
} |
|
|
|
return 1$ |
|
} |
|
|
for(I=ExpMatColNum,SUM=0;I<ExtMatColNum;I++){ |
def qcheck(PolyList,Vars,FLAG){ |
OneMat[I][0]=SUM$ |
|
SUM=SUM+nmono(PolyList[I-ExpMatColNum])$ |
RET=[]$ |
OneMat[I][1]=SUM-1$ |
Res=qcheckmain(PolyList,Vars)$ |
|
VarsNum=length(Vars)$ |
|
|
|
IndNum=Res[0]$ |
|
CHAGORD=Res[1]$ |
|
ExpMat=Res[2]$ |
|
|
|
SolveList=[]$ |
|
for(I=0;I<IndNum;I++){ |
|
TMP=0$ |
|
for(J=0;J<VarsNum;J++) |
|
TMP+=ExpMat[I][CHAGORD[J]]*Vars[CHAGORD[J]]$ |
|
|
|
SolveList=cons(TMP,SolveList)$ |
} |
} |
|
|
NormMat=newmat(ExtMatColNum-1,ExtMatColNum)$ |
Rea=vars(SolveList)$ |
|
|
for(I=0;I<ExtMatColNum-1;I++) |
VarsList=[]$ |
for(J=0;J<ExtMatColNum-1;J++){ |
for(I=0;I<VarsNum;I++) |
ST=MAX(OneMat[I][0],OneMat[J][0])$ |
if(member(Vars[CHAGORD[I]],Rea)) |
ED=MIN(OneMat[I][1],OneMat[J][1])$ |
VarsList=cons(Vars[CHAGORD[I]],VarsList)$ |
if(ST>ED) |
|
continue$ |
Res=solve(reverse(SolveList),reverse(VarsList))$ |
for(K=ST;K<=ED;K++){ |
Res=getgcd(Res,Rea)$ |
NormMat[I][J]=NormMat[I][J]+ |
|
extmat(ExpMat,OneMat,ExpMatColNum,ExtMatColNum,K,I)* |
if(nonposdegchk(Res)){ |
extmat(ExpMat,OneMat,ExpMatColNum,ExtMatColNum,K,J)$ |
|
|
ResVars=makeret(Res,Vars,0)$ |
|
|
|
if(checktd(PolyList,Vars,ResVars[1])==1){ |
|
if(ResVars[0]==0){ |
|
RET=append(RET,wsort(ResVars[1],Vars, |
|
ResVars[1],FLAG))$ |
|
return RET$ |
} |
} |
|
else{ |
|
RET=append(RET,[[Vars,vtol(ResVars[1])]])$ |
|
return RET$ |
|
} |
} |
} |
|
else |
|
return []$ |
|
} |
|
else |
|
return []$ |
|
|
for(I=0;I<ExtMatColNum-1;I++){ |
} |
ST=MAX(OneMat[I][0],OneMat[ExtMatColNum-1][0])$ |
|
ED=MIN(OneMat[I][1],OneMat[ExtMatColNum-1][1])$ |
|
if(ST>ED) |
|
continue$ |
|
|
|
for(K=ST;K<=ED;K++){ |
def leastsq(NormMat,ExpMat,Vars,FLAG){ |
NormMat[I][ExtMatColNum-1]=NormMat[I][ExtMatColNum-1]+ |
|
extmat(ExpMat,OneMat,ExpMatColNum,ExtMatColNum,K,I)* |
RET=[]$ |
extmat(ExpMat,OneMat,ExpMatColNum,ExtMatColNum,K,ExtMatColNum-1)$ |
|
} |
ExpMatRowNum=size(ExpMat)[0]$ |
|
ExpMatColNum=size(ExpMat[0])[0]$ |
|
|
|
if(NormMat==0){ |
|
NormMat=newmat(ExpMatColNum,ExpMatColNum)$ |
|
|
|
for(I=0;I<ExpMatColNum;I++) |
|
for(J=I;J<ExpMatColNum;J++) |
|
for(K=0;K<ExpMatRowNum;K++) |
|
NormMat[I][J]+= |
|
ExpMat[K][I]*ExpMat[K][J]$ |
} |
} |
|
|
ExtVars=Vars$ |
BVec=newvect(ExpMatColNum)$ |
for(I=0;I<PolyListNum-1;I++) |
|
ExtVars=append(ExtVars,[uc()])$ |
|
|
|
|
for(I=0;I<ExpMatColNum;I++) |
|
for(J=0;J<ExpMatRowNum;J++) |
|
BVec[I]+=ExpMat[J][I]$ |
|
|
SolveList=[]$ |
SolveList=[]$ |
for(I=0;I<ExtMatColNum-1;I++){ |
for(I=0;I<ExpMatColNum;I++){ |
TMP=0$ |
TMP=0$ |
for(J=0;J<ExtMatColNum-1;J++) |
for(J=0;J<I;J++) |
TMP=TMP+NormMat[I][J]*ExtVars[J]$ |
TMP+=NormMat[J][I]*Vars[J]$ |
|
|
TMP=TMP-NormMat[I][ExtMatColNum-1]$ |
for(J=I;J<ExpMatColNum;J++) |
|
TMP+=NormMat[I][J]*Vars[J]$ |
|
|
|
TMP-=BVec[I]$ |
SolveList=cons(TMP,SolveList)$ |
SolveList=cons(TMP,SolveList)$ |
} |
} |
|
|
ReaVars=vars(SolveList)$ |
Rea=vars(SolveList)$ |
Res=solve(SolveList,reverse(ExtVars))$ |
|
|
|
|
VarsList=[]$ |
|
for(I=0;I<length(Vars);I++) |
|
if(member(Vars[I],Rea)) |
|
VarsList=cons(Vars[I],VarsList)$ |
|
|
|
Res=solve(SolveList,VarsList)$ |
|
Res=getgcd(Res,Rea)$ |
|
|
if(nonposdegchk(Res)){ |
if(nonposdegchk(Res)){ |
|
TMP1=makeret(Res,Vars,1)$ |
|
if(TMP1[0]==0){ |
|
TMP=roundret(TMP1[1]*1.0)$ |
|
if(TMP!=[]) |
|
RET=append(RET,wsort(TMP1[1],Vars,TMP,FLAG))$ |
|
|
ResVars=resvars(Res,ExtVars)$ |
RET=append(RET,wsort(TMP1[1],Vars, |
|
map(drint,TMP1[1]*1.0),FLAG))$ |
|
|
for(I=0;I<ExtMatRowNum;I++){ |
return RET$ |
TMP=0$ |
|
for(J=0;J<ExtMatColNum-1;J++) |
|
if((K=extmat(ExpMat,OneMat,ExpMatColNum,ExtMatColNum,I,J))!=0) |
|
TMP=TMP+K*ResVars[J]$ |
|
|
|
if(TMP!=extmat(ExpMat,OneMat,ExpMatColNum,ExtMatColNum,I,ExtMatColNum-1)) |
|
break$ |
|
} |
} |
|
else{ |
if(I==ExtMatRowNum){ |
RET=append(RET,[[Vars,vtol(TMP1[1]*1.0)]])$ |
print("complitely homogenized")$ |
return RET$ |
return(makeret(Res,Vars,1))$ |
|
} |
} |
else |
|
print(makeret(Res,Vars,1.0))$ |
|
} |
} |
|
else |
|
return RET$ |
|
|
ExpMat=qsort(ExpMat,afo)$ |
} |
ExpMat2=[]$ |
|
for(I=0;I<size(ExpMat)[0];I++) |
|
if(car(ExpMat2)!=ExpMat[I]) |
|
ExpMat2=cons(ExpMat[I],ExpMat2)$ |
|
|
|
ExpMat=newvect(length(ExpMat2),ExpMat2)$ |
def weightr(ExpMat,Vars,PolyListNum,OneMat,FLAG){ |
|
|
|
RET=[]$ |
|
|
ExpMatRowNum=size(ExpMat)[0]$ |
ExpMatRowNum=size(ExpMat)[0]$ |
ExpMatColNum=size(ExpMat[0])[0]$ |
ExpMatColNum=size(ExpMat[0])[0]$ |
|
ExtMatColNum=ExpMatColNum+PolyListNum$ |
|
|
NormMat=newmat(ExpMatColNum,ExpMatColNum+1)$ |
ExtVars=reverse(Vars)$ |
|
for(I=0;I<PolyListNum;I++) |
|
ExtVars=cons(uc(),ExtVars)$ |
|
|
|
ExtVars=reverse(ExtVars)$ |
|
|
|
NormMat=newmat(ExpMatColNum,ExtMatColNum)$ |
|
|
for(I=0;I<ExpMatColNum;I++) |
for(I=0;I<ExpMatColNum;I++) |
for(J=0;J<ExpMatColNum;J++) |
for(J=I;J<ExpMatColNum;J++) |
for(K=0;K<ExpMatRowNum;K++) |
for(K=0;K<ExpMatRowNum;K++) |
NormMat[I][J]=NormMat[I][J]+ExpMat[K][I]*ExpMat[K][J]$ |
NormMat[I][J]+= |
|
ExpMat[K][I]* |
|
ExpMat[K][J]$ |
|
|
for(I=0;I<ExpMatColNum;I++) |
for(I=0;I<ExpMatColNum;I++) |
for(K=0;K<ExpMatRowNum;K++) |
for(J=0;J<PolyListNum;J++) |
NormMat[I][ExpMatColNum]=NormMat[I][ExpMatColNum]+ExpMat[K][I]$ |
for(K=OneMat[J];K<OneMat[J+1];K++) |
|
NormMat[I][J+ExpMatColNum]-= |
|
ExpMat[K][I]$ |
|
|
SolveList=[]$ |
WVect=newvect(PolyListNum)$ |
for(I=0;I<ExpMatColNum;I++){ |
for(I=0;I<PolyListNum;I++) |
TMP=0$ |
WVect[I]=OneMat[I+1]-OneMat[I]$ |
for(J=0;J<ExpMatColNum;J++) |
|
TMP=TMP+NormMat[I][J]*Vars[J]$ |
|
|
|
TMP=TMP-NormMat[I][ExpMatColNum]$ |
for(F=0;F<ExtMatColNum;F++){ |
SolveList=cons(TMP,SolveList)$ |
SolveList=[]$ |
|
for(I=0;I<ExpMatColNum;I++){ |
|
if (F==I) |
|
continue$ |
|
|
|
TMP=0$ |
|
|
|
for(J=0;J<I;J++) |
|
if(J!=F) |
|
TMP+=NormMat[J][I]*ExtVars[J]$ |
|
|
|
for(J=I;J<ExtMatColNum;J++) |
|
if(J!=F) |
|
TMP+=NormMat[I][J]*ExtVars[J]$ |
|
|
|
if(F<I) |
|
TMP+=NormMat[F][I]$ |
|
else |
|
TMP+=NormMat[I][F]$ |
|
|
|
SolveList=cons(TMP,SolveList)$ |
|
} |
|
|
|
for(I=0;I<PolyListNum;I++){ |
|
if(F==(I+ExpMatColNum)) |
|
continue$ |
|
|
|
TMP=0$ |
|
for(J=0;J<ExpMatColNum;J++) |
|
if(J!=F) |
|
TMP+=NormMat[J][I+ExpMatColNum] |
|
*ExtVars[J]$ |
|
|
|
TMP+=WVect[I]*ExtVars[I+ExpMatColNum]$ |
|
|
|
if(F<ExpMatColNum) |
|
TMP+=NormMat[F][I+ExpMatColNum]$ |
|
|
|
SolveList=cons(TMP,SolveList)$ |
|
} |
|
|
|
Rea=vars(SolveList)$ |
|
|
|
SolVars=[]$ |
|
for(I=0;I<ExtMatColNum;I++) |
|
if(I!=F && member(ExtVars[I],Rea)) |
|
SolVars=cons(ExtVars[I],SolVars)$ |
|
|
|
Res=solve(SolveList,SolVars)$ |
|
Res=cons([ExtVars[F],1],Res)$ |
|
|
|
TMP=[]$ |
|
for(I=0;I<length(Rea);I++) |
|
if(member(Rea[I],Vars)) |
|
TMP=cons(Rea[I],TMP)$ |
|
|
|
TMP=cons(ExtVars[F],TMP)$ |
|
Res=getgcd(Res,TMP)$ |
|
|
|
if(nonposdegchk(Res)){ |
|
|
|
TMP1=makeret(Res,Vars,1)$ |
|
if(TMP1[0]==0){ |
|
TMP=roundret(TMP1[1]*1.0)$ |
|
if(TMP!=[]) |
|
RET=append(RET,wsort(TMP1[1],Vars, |
|
TMP,FLAG))$ |
|
|
|
RET=append(RET,wsort(TMP1[1],Vars, |
|
map(drint,TMP1[1]*1.0),FLAG))$ |
|
} |
|
else{ |
|
RET=append(RET,[[Vars,vtol(TMP1[1]*1.0)]])$ |
|
} |
|
} |
|
|
} |
} |
|
|
Res=solve(SolveList,Vars)$ |
return [NormMat,RET]$ |
if(nonposdegchk(Res)) |
} |
return(makeret(Res,Vars,1.0))$ |
|
|
|
Ret=[]$ |
def weight(PolyList,Vars,FLAG1,FLAG2){ |
|
|
|
Vars0=vars(PolyList)$ |
|
Vars1=[]$ |
for(I=0;I<length(Vars);I++) |
for(I=0;I<length(Vars);I++) |
Ret=cons([Vars[I],1.0],Ret)$ |
if(member(Vars[I],Vars0)) |
|
Vars1=cons(Vars[I],Vars1)$ |
|
|
return reverse(Ret)$ |
Vars=reverse(Vars1)$ |
|
|
|
RET=[]$ |
|
|
|
TMP=qcheck(PolyList,Vars,FLAG2)$ |
|
|
|
if(TMP!=[]){ |
|
RET=append(RET,TMP)$ |
|
return cons(1,RET)$ |
|
} |
|
|
|
dp_ord(2)$ |
|
|
|
PolyListNum=length(PolyList)$ |
|
|
|
if(FLAG1){ |
|
|
|
OneMat=newvect(PolyListNum+1,[0])$ |
|
ExpMat=[]$ |
|
for(I=0;I<PolyListNum;I++){ |
|
for(Poly=dp_ptod(PolyList[I],Vars); |
|
Poly!=0;Poly=dp_rest(Poly)){ |
|
ExpMat=cons(dp_etov(dp_ht(Poly)),ExpMat)$ |
|
} |
|
OneMat[I+1]=length(ExpMat)$ |
|
} |
|
|
|
ExpMat=reverse(ExpMat)$ |
|
ExpMat=newvect(length(ExpMat),ExpMat)$ |
|
|
|
TMP=weightr(ExpMat,Vars,PolyListNum,OneMat,FLAG2)$ |
|
RET=append(RET,TMP[1])$ |
|
RET=append(RET,leastsq(TMP[0],ExpMat,Vars,FLAG2))$ |
|
} |
|
else{ |
|
ExpMat=[]$ |
|
for(I=0;I<PolyListNum;I++){ |
|
for(Poly=dp_ptod(PolyList[I],Vars); |
|
Poly!=0;Poly=dp_rest(Poly)){ |
|
if(nonzerovec(TMP=dp_etov(dp_ht(Poly)))) |
|
ExpMat=cons(TMP,ExpMat)$ |
|
} |
|
} |
|
|
|
ExpMat=reverse(ExpMat)$ |
|
ExpMat=newvect(length(ExpMat),ExpMat)$ |
|
|
|
RET=append(RET,leastsq(0,ExpMat,Vars,FLAG2))$ |
|
} |
|
|
|
ExpMat=qsort(ExpMat,junban)$ |
|
|
|
ExpMat2=[]$ |
|
for(I=0;I<size(ExpMat)[0];I++) |
|
if(car(ExpMat2)!=ExpMat[I]) |
|
ExpMat2=cons(ExpMat[I],ExpMat2)$ |
|
|
|
if(size(ExpMat)[0]!=length(ExpMat2)){ |
|
ExpMat=newvect(length(ExpMat2),ExpMat2)$ |
|
RET=append(RET,leastsq(0,ExpMat,Vars,FLAG2))$ |
|
} |
|
|
|
RET=derase(RET)$ |
|
return cons(0,RET)$ |
} |
} |
|
|
end$ |
end$ |