version 1.6, 2003/11/15 06:28:21 |
version 1.19, 2004/01/07 06:53:11 |
|
|
load("solve")$ |
load("solve")$ |
load("gr")$ |
load("gr")$ |
|
|
def nonposdegchk(Res){ |
#define EPS 1E-6 |
|
#define TINY 1E-20 |
|
#define MAX_ITER 100 |
|
#define ROUND_THRESHOLD 0.4 |
|
|
for(I=0;I<length(Res);I++) |
def rotate(A,I,J,K,L,C,S){ |
if(Res[I][1]<=0) |
|
return 0$ |
|
|
|
return 1$ |
X=A[I][J]; |
|
Y=A[K][L]; |
|
A[I][J]=X*C-Y*S; |
|
A[K][L]=X*S+Y*C; |
|
|
|
return 1; |
} |
} |
|
|
|
def jacobi(N,A,W){ |
|
|
def notzerovec(Vec){ |
S=OFFDIAG=0.0; |
|
|
for(I=0;I<size(Vec)[0];I++) |
for(J=0;J<N;J++){ |
if(Vec[I]!=0) |
|
|
for(K=0;K<N;K++) |
|
W[J][K]=0.0; |
|
|
|
W[J][J]=1.0; |
|
S+=A[J][J]*A[J][J]; |
|
|
|
for(K=J+1;K<N;K++) |
|
OFFDIAG+=A[J][K]*A[J][K]; |
|
} |
|
|
|
TOLERANCE=EPS*EPS*(S/2+OFFDIAG); |
|
|
|
for(ITER=1;ITER<=MAX_ITER;ITER++){ |
|
|
|
OFFDIAG=0.0; |
|
for(J=0;J<N-1;J++) |
|
for(K=J+1;K<N;K++) |
|
OFFDIAG+=A[J][K]*A[J][K]; |
|
|
|
if(OFFDIAG < TOLERANCE) |
|
break; |
|
|
|
for(J=0;J<N-1;J++){ |
|
for(K=J+1;K<N;K++){ |
|
|
|
if(dabs(A[J][K])<TINY) |
|
continue; |
|
|
|
T=(A[K][K]-A[J][J])/(2.0*A[J][K]); |
|
|
|
if(T>=0.0) |
|
T=1.0/(T+dsqrt(T*T+1)); |
|
else |
|
T=1.0/(T-dsqrt(T*T+1)); |
|
|
|
C=1.0/dsqrt(T*T+1); |
|
|
|
S=T*C; |
|
|
|
T*=A[J][K]; |
|
|
|
A[J][J]-=T; |
|
A[K][K]+=T; |
|
A[J][K]=0.0; |
|
|
|
for(I=0;I<J;I++) |
|
rotate(A,I,J,I,K,C,S); |
|
|
|
for(I=J+1;I<K;I++) |
|
rotate(A,J,I,I,K,C,S); |
|
|
|
for(I=K+1;I<N;I++) |
|
rotate(A,J,I,K,I,C,S); |
|
|
|
for(I=0;I<N;I++) |
|
rotate(W,J,I,K,I,C,S); |
|
|
|
} |
|
} |
|
} |
|
|
|
if (ITER > MAX_ITER) |
|
return 0; |
|
|
|
for(I=0;I<N-1;I++){ |
|
|
|
K=I; |
|
|
|
T=A[K][K]; |
|
|
|
for(J=I+1;J<N;J++) |
|
if(A[J][J]>T){ |
|
K=J; |
|
T=A[K][K]; |
|
} |
|
|
|
A[K][K]=A[I][I]; |
|
|
|
A[I][I]=T; |
|
|
|
V=W[K]; |
|
|
|
W[K]=W[I]; |
|
|
|
W[I]=V; |
|
} |
|
|
|
return 1; |
|
} |
|
|
|
def nonzerovec(A){ |
|
|
|
for(I=0;I<size(A)[0];I++) |
|
if(A[I]!=0) |
return 1$ |
return 1$ |
|
|
return 0$ |
return 0$ |
} |
} |
|
|
def resvars(Res,Vars){ |
def junban(A,B){ |
|
return (A<B ? 1:(A>B ? -1:0))$ |
|
} |
|
|
ResVars=newvect(length(Vars),Vars)$ |
def worder(A,B){ |
for(I=0;I<length(Res);I++){ |
return (A[0]<B[0] ? 1:(A[0]>B[0] ? -1:0))$ |
|
} |
for(J=0;J<size(ResVars)[0];J++) |
|
if(Res[I][0]==ResVars[J]) |
|
break$ |
|
|
|
if(J<size(ResVars)[0]) |
def bsort(A){ |
ResVars[J]=Res[I][1]$ |
|
|
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(ResVars)$ |
return A$ |
} |
} |
|
|
def makeret1(Res,Vars){ |
def perm(I,P,TMP){ |
|
|
VarsNum=length(Vars)$ |
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$ |
|
} |
|
|
ResVec=newvect(VarsNum,Vars)$ |
return TMP$ |
|
} |
|
else{ |
|
for(TMP0=[],K=0;K<size(P)[0];K++) |
|
TMP0=cons(P[K],TMP0)$ |
|
|
|
TMP=cons(TMP0,TMP)$ |
|
return TMP$ |
|
} |
|
} |
|
|
for(F=0,I=0,M=0;I<length(Res);I++){ |
def marge(A,B){ |
|
|
for(J=0;J<VarsNum;J++) |
RET=[]$ |
if(Res[I][0]==Vars[J]) |
for(I=0;I<length(A);I++) |
break$ |
for(J=0;J<length(B);J++) |
|
RET=cons(append(A[I],B[J]),RET)$ |
|
|
if(J<VarsNum){ |
return RET$ |
ResVec[J]=Res[I][1]$ |
} |
|
|
if(F==0 && type(ResVec[J])==1){ |
def wsort(A,B,C,FLAG,ID){ |
if(M==0) |
|
M=ResVec[J]$ |
if(FLAG==0){ |
else |
D=newvect(length(B))$ |
if(ResVec[J]<M) |
for(I=0;I<length(B);I++) |
M=ResVec[J]$ |
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 [[ID,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])$ |
} |
} |
else |
|
F=1$ |
|
} |
} |
|
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([ID,TMP0,TMP1],RET)$ |
|
} |
|
|
|
return RET$ |
|
} |
|
} |
|
|
|
def nonposdegchk(Res){ |
|
|
|
for(I=0;I<length(Res);I++) |
|
if(Res[I][1]<=0) |
|
return 0$ |
|
|
|
return 1$ |
|
} |
|
|
|
def getgcd(A,B){ |
|
|
|
VarsNumA=length(A)$ |
|
VarsNumB=length(B)$ |
|
|
|
C=newvect(VarsNumB,B)$ |
|
|
|
for(I=0;I<VarsNumA;I++){ |
|
|
|
for(J=0;J<VarsNumB;J++) |
|
if(B[J]==A[I][0]) |
|
break$ |
|
|
|
if(J<VarsNumB) |
|
C[J]=A[I][1]$ |
} |
} |
|
|
if(F==0) |
D=0$ |
for(I=0;I<VarsNum;I++) |
for(I=0;I<VarsNumB;I++) |
ResVec[I]=ResVec[I]/M*1.0$ |
D=gcd(D,C[I])$ |
|
|
for(I=0;I<VarsNum;I++) |
if(D!=0){ |
for(J=0;J<length(Vars);J++) |
C=C/D$ |
ResVec[I]=subst(ResVec[I],Vars[J], |
C=map(red,C)$ |
strtov(rtostr(Vars[J])+"_deg"))$ |
} |
|
|
ResVec=cons(F,vtol(ResVec))$ |
for(L=1,D=0,I=0;I<VarsNumB;I++){ |
return ResVec$ |
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 junban(A,B){ |
def makeret(Res,Vars,FLAG){ |
|
|
for(I=0;I<size(A)[0];I++){ |
ResNum=length(Res)$ |
if(A[I]<B[I]) |
VarsNum=length(Vars)$ |
return 1$ |
|
|
ResVec=newvect(ResNum)$ |
if(A[I]>B[I]) |
|
return -1$ |
for(M=0,I=0;I<ResNum;I++){ |
|
if(member(Res[I][0],Vars)){ |
|
ResVec[I]=Res[I][1]$ |
|
|
|
if(FLAG && type(ResVec[I])==1){ |
|
if(M==0) |
|
M=ResVec[I]$ |
|
else |
|
if(ResVec[I]<M) |
|
M=ResVec[I]$ |
|
} |
|
} |
|
} |
|
|
|
if(M!=0) |
|
ResVec=ResVec/M; |
|
|
|
RET=newvect(VarsNum,Vars)$ |
|
|
|
for(I=0;I<ResNum;I++){ |
|
for(J=0;J<VarsNum;J++) |
|
if(Vars[J]==Res[I][0]) |
|
break$ |
|
|
|
if(J<VarsNum) |
|
RET[J]=ResVec[I]$ |
} |
} |
|
|
|
|
return 0$ |
for(J=0;J<length(Vars);J++) |
|
RET=map(subst,RET,Vars[J], |
|
strtov(rtostr(Vars[J])+"_deg"))$ |
|
|
|
for(I=0;I<VarsNum;I++) |
|
if(type(RET[I])!=1) |
|
return [1,RET]$ |
|
|
|
return [0,RET]$ |
} |
} |
|
|
def roundret(V){ |
def roundret(V){ |
|
|
VN=length(V)$ |
VN=size(V)[0]$ |
RET0=newvect(VN,V)$ |
|
|
|
|
RET0=V$ |
for(I=1;I<1000;I++){ |
for(I=1;I<1000;I++){ |
RET1=I*RET0$ |
RET1=I*RET0$ |
for(J=0;J<VN;J++){ |
for(J=0;J<VN;J++){ |
X=drint(RET1[J])$ |
X=drint(RET1[J])$ |
if(dabs(X-RET1[J])<0.2) |
if(dabs(X-RET1[J])<ROUND_THRESHOLD) |
RET1[J]=X$ |
RET1[J]=X$ |
else |
else |
break$ |
break$ |
Line 115 def roundret(V){ |
|
Line 370 def roundret(V){ |
|
|
|
def chkou(L,ExpMat,CHAGORD){ |
def chkou(L,ExpMat,CHAGORD){ |
|
|
P=1$ |
for(P=1,I=0;I<L;I++){ |
F=ExpMat[L]$ |
|
|
|
for(I=0;I<L;I++){ |
|
Q=ExpMat[L][CHAGORD[I]]$ |
Q=ExpMat[L][CHAGORD[I]]$ |
for(J=0;J<size(ExpMat[0])[0];J++){ |
for(J=0;J<size(ExpMat[0])[0];J++){ |
ExpMat[L][CHAGORD[J]]=red((ExpMat[I][CHAGORD[I]] |
ExpMat[L][CHAGORD[J]]=red((ExpMat[I][CHAGORD[I]] |
Line 143 def chkou(L,ExpMat,CHAGORD){ |
|
Line 395 def chkou(L,ExpMat,CHAGORD){ |
|
} |
} |
} |
} |
|
|
def qcheck0(PolyList,Vars){ |
def qcheckmain(PolyList,Vars){ |
|
|
RET=[]$ |
RET=[]$ |
PolyListNum=length(PolyList)$ |
PolyListNum=length(PolyList)$ |
Line 162 def qcheck0(PolyList,Vars){ |
|
Line 414 def qcheck0(PolyList,Vars){ |
|
for(;Poly!=0;Poly=dp_rest(Poly)){ |
for(;Poly!=0;Poly=dp_rest(Poly)){ |
ExpMat[L]=dp_etov(dp_ht(Poly))-BASE0$ |
ExpMat[L]=dp_etov(dp_ht(Poly))-BASE0$ |
L=chkou(L,ExpMat,CHAGORD)$ |
L=chkou(L,ExpMat,CHAGORD)$ |
if(L==VarsNum-1){ |
if(L==VarsNum-1) |
RET=cons(ExpMat,RET)$ |
return [L,CHAGORD,ExpMat]$ |
RET=cons(CHAGORD,RET)$ |
|
RET=cons(L,RET)$ |
|
return RET$ |
|
} |
|
} |
} |
} |
} |
|
|
RET=cons(ExpMat,RET)$ |
return [L,CHAGORD,ExpMat]$ |
RET=cons(CHAGORD,RET)$ |
|
RET=cons(L,RET)$ |
|
return RET$ |
|
} |
} |
|
|
def inner(A,B){ |
def inner(A,B){ |
Line 204 def checktd(PolyList,Vars,ResVars){ |
|
Line 449 def checktd(PolyList,Vars,ResVars){ |
|
return 1$ |
return 1$ |
} |
} |
|
|
def getgcd(A,B){ |
def qcheck(PolyList,Vars,FLAG){ |
|
|
VarsNumA=length(A)$ |
|
VarsNumB=length(B)$ |
|
|
|
C=newvect(VarsNumB,B)$ |
|
|
|
for(I=0;I<VarsNumA;I++){ |
|
|
|
for(J=0;J<VarsNumB;J++) |
|
if(C[J]==A[I][0]) |
|
break$ |
|
|
|
C[J]=A[I][1]$ |
|
} |
|
|
|
D=0$ |
|
for(I=0;I<VarsNumB;I++) |
|
D=gcd(D,C[I])$ |
|
|
|
if(D!=0){ |
|
|
|
for(I=0;I<VarsNumB;I++) |
|
C[I]=red(C[I]/D)$ |
|
|
|
} |
|
|
|
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)$ |
|
} |
|
|
|
for(I=0;I<VarsNumB;I++) |
|
C[I]=C[I]*L$ |
|
|
|
if(D!=0) |
|
for(I=0;I<VarsNumB;I++) |
|
C[I]=C[I]/D$ |
|
|
|
|
|
RET=newvect(VarsNumB)$ |
|
for(I=0;I<VarsNumB;I++){ |
|
RET[I]=newvect(2)$ |
|
RET[I][0]=B[I]$ |
|
RET[I][1]=C[I]$ |
|
} |
|
|
|
return vtol(map(vtol,RET))$ |
|
} |
|
|
|
def qcheck(PolyList,Vars){ |
|
|
|
RET=[]$ |
RET=[]$ |
Res=qcheck0(PolyList,Vars)$ |
Res=qcheckmain(PolyList,Vars)$ |
VarsNum=length(Vars)$ |
VarsNum=length(Vars)$ |
|
|
IndNum=Res[0]$ |
IndNum=Res[0]$ |
Line 276 def qcheck(PolyList,Vars){ |
|
Line 468 def qcheck(PolyList,Vars){ |
|
SolveList=cons(TMP,SolveList)$ |
SolveList=cons(TMP,SolveList)$ |
} |
} |
|
|
|
Rea=vars(SolveList)$ |
|
|
VarsList=[]$ |
VarsList=[]$ |
for(I=0;I<VarsNum;I++) |
for(I=0;I<VarsNum;I++) |
VarsList=cons(Vars[CHAGORD[I]],VarsList)$ |
if(member(Vars[CHAGORD[I]],Rea)) |
|
VarsList=cons(Vars[CHAGORD[I]],VarsList)$ |
|
|
Rea=vars(SolveList)$ |
|
Res=solve(reverse(SolveList),reverse(VarsList))$ |
Res=solve(reverse(SolveList),reverse(VarsList))$ |
|
Res=getgcd(Res,Rea)$ |
|
|
if(nonposdegchk(Res)){ |
if(nonposdegchk(Res)){ |
|
|
Res=getgcd(Res,Rea)$ |
ResVars=makeret(Res,Vars,0)$ |
ResVars=resvars(Res,Vars)$ |
|
|
|
if(checktd(PolyList,Vars,ResVars)==1){ |
if(checktd(PolyList,Vars,ResVars[1])==1){ |
|
if(ResVars[0]==0){ |
|
RET=append(RET,wsort(ResVars[1],Vars, |
|
ResVars[1],FLAG,0))$ |
|
|
for(J=0;J<length(Vars);J++) |
return RET$ |
ResVars=map(subst,ResVars,Vars[J], |
} |
strtov(rtostr(Vars[J])+"_deg"))$ |
else{ |
|
RET=append(RET,[[0,Vars,vtol(ResVars[1])]])$ |
RET=cons([vtol(ResVars),ResVars,[]],RET)$ |
return RET$ |
return cons(1,RET)$ |
} |
} |
} |
else |
else |
return cons(0,RET)$ |
return []$ |
} |
} |
else |
else |
return cons(0,RET)$ |
return []$ |
|
|
} |
} |
|
|
def leastsq(ExpMat,Vars){ |
def leastsq(NormMat,ExpMat,Vars,FLAG,ID){ |
|
|
|
RET=[]$ |
|
|
ExpMatRowNum=size(ExpMat)[0]$ |
ExpMatRowNum=size(ExpMat)[0]$ |
ExpMatColNum=size(ExpMat[0])[0]$ |
ExpMatColNum=size(ExpMat[0])[0]$ |
|
|
NormMat=newmat(ExpMatColNum,ExpMatColNum+1)$ |
if(NormMat==0){ |
|
NormMat=newmat(ExpMatColNum,ExpMatColNum)$ |
|
|
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]+=ExpMat[K][I]*ExpMat[K][J]$ |
NormMat[I][J]+= |
|
ExpMat[K][I]*ExpMat[K][J]$ |
|
} |
|
|
|
BVec=newvect(ExpMatColNum)$ |
|
|
for(I=0;I<ExpMatColNum;I++) |
for(I=0;I<ExpMatColNum;I++) |
for(J=0;J<ExpMatRowNum;J++) |
for(J=0;J<ExpMatRowNum;J++) |
NormMat[I][ExpMatColNum]+=ExpMat[J][I]$ |
BVec[I]+=ExpMat[J][I]$ |
|
|
SolveList=[]$ |
SolveList=[]$ |
for(I=0;I<ExpMatColNum;I++){ |
for(I=0;I<ExpMatColNum;I++){ |
TMP=0$ |
TMP=0$ |
for(J=0;J<ExpMatColNum;J++) |
for(J=0;J<I;J++) |
|
TMP+=NormMat[J][I]*Vars[J]$ |
|
|
|
for(J=I;J<ExpMatColNum;J++) |
TMP+=NormMat[I][J]*Vars[J]$ |
TMP+=NormMat[I][J]*Vars[J]$ |
|
|
TMP-=NormMat[I][ExpMatColNum]$ |
TMP-=BVec[I]$ |
SolveList=cons(TMP,SolveList)$ |
SolveList=cons(TMP,SolveList)$ |
} |
} |
|
|
Rea=vars(SolveList)$ |
Rea=vars(SolveList)$ |
Res=solve(SolveList,Vars)$ |
|
|
|
|
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)){ |
Res=getgcd(Res,Rea)$ |
|
TMP1=makeret1(Res,Vars); |
TMP1=makeret(Res,Vars,1)$ |
if(car(TMP1)==0){ |
|
TMP2=roundret(cdr(TMP1)); |
if(TMP1[0]==0){ |
TMP3=map(drint,cdr(TMP1))$ |
TMP=roundret(TMP1[1])$ |
return([cdr(TMP1),newvect(length(TMP3),TMP3),TMP2])$ |
|
|
RET=append(RET,wsort(TMP1[1],Vars, |
|
map(drint,TMP1[1]*1.0),FLAG,ID))$ |
|
|
|
if(TMP!=[]) |
|
RET=append(RET,wsort(TMP1[1],Vars, |
|
TMP,FLAG,ID+1))$ |
|
|
|
return RET$ |
} |
} |
else |
else{ |
return([cdr(TMP1),[],[]])$ |
RET=append(RET,[[ID,Vars,vtol(TMP1[1]*1.0)]])$ |
|
return RET$ |
|
} |
} |
} |
|
else |
|
return RET$ |
|
|
} |
} |
|
|
def weight(PolyList,Vars){ |
def unitweight(ExpMat,Vars,PolyListNum,OneMat,FLAG){ |
|
|
|
RET=[]$ |
|
|
|
ExpMatRowNum=size(ExpMat)[0]$ |
|
ExpMatColNum=size(ExpMat[0])[0]$ |
|
ExtMatColNum=ExpMatColNum+PolyListNum$ |
|
|
|
ExtVars=reverse(Vars)$ |
|
for(I=0;I<PolyListNum;I++) |
|
ExtVars=cons(uc(),ExtVars)$ |
|
|
|
ExtVars=reverse(ExtVars)$ |
|
|
|
NormMat0=newvect(ExpMatColNum)$ |
|
for(I=0;I<ExpMatColNum;I++) |
|
NormMat0[I]=newvect(ExpMatColNum)$ |
|
|
|
for(I=0;I<ExpMatColNum;I++) |
|
for(J=I;J<ExpMatColNum;J++) |
|
for(K=0;K<ExpMatRowNum;K++) |
|
NormMat0[I][J]+= |
|
ExpMat[K][I]* |
|
ExpMat[K][J]$ |
|
|
|
NormMat1=newvect(ExtMatColNum)$ |
|
for(I=0;I<ExtMatColNum;I++) |
|
NormMat1[I]=newvect(ExtMatColNum)$ |
|
|
|
|
|
WorkMat=newvect(ExtMatColNum)$ |
|
for(I=0;I<ExtMatColNum;I++) |
|
WorkMat[I]=newvect(ExtMatColNum)$ |
|
|
|
|
|
for(I=0;I<ExpMatColNum;I++) |
|
for(J=I;J<ExpMatColNum;J++) |
|
NormMat1[I][J]=NormMat0[I][J]$ |
|
|
|
for(I=0;I<ExpMatColNum;I++) |
|
for(J=0;J<PolyListNum;J++) |
|
for(K=OneMat[J];K<OneMat[J+1];K++) |
|
NormMat1[I][J+ExpMatColNum]-= |
|
ExpMat[K][I]$ |
|
|
|
for(I=0;I<PolyListNum;I++) |
|
NormMat1[I+ExpMatColNum][I+ExpMatColNum]=OneMat[I+1]-OneMat[I]$ |
|
|
|
if(jacobi(ExtMatColNum,NormMat1,WorkMat)){ |
|
|
|
Res=newvect(ExpMatColNum)$ |
|
for(I=0;I<ExpMatColNum;I++){ |
|
Res[I]=newvect(2)$ |
|
Res[I][0]=Vars[I]$ |
|
Res[I][1]=WorkMat[ExtMatColNum-1][I]$ |
|
} |
|
|
|
if(nonposdegchk(Res)){ |
|
|
|
TMP1=makeret(Res,Vars,1)$ |
|
|
|
TMP=roundret(TMP1[1])$ |
|
|
|
RET=append(RET,wsort(TMP1[1],Vars, |
|
map(drint,TMP1[1]*1.0),FLAG,1))$ |
|
|
|
if(TMP!=[]) |
|
RET=append(RET,wsort(TMP1[1],Vars, |
|
TMP,FLAG,2))$ |
|
} |
|
|
|
} |
|
|
|
return [NormMat0,RET]$ |
|
} |
|
|
|
def weight(PolyList,Vars,FLAG){ |
|
|
Vars0=vars(PolyList)$ |
Vars0=vars(PolyList)$ |
Vars1=[]$ |
Vars1=[]$ |
for(I=0;I<length(Vars);I++) |
for(I=0;I<length(Vars);I++) |
Line 360 def weight(PolyList,Vars){ |
|
Line 662 def weight(PolyList,Vars){ |
|
|
|
RET=[]$ |
RET=[]$ |
|
|
TMP=qcheck(PolyList,Vars)$ |
TMP=qcheck(PolyList,Vars,FLAG)$ |
|
|
if(car(TMP)==1){ |
if(TMP!=[]){ |
RET=cdr(TMP)$ |
RET=append(RET,TMP)$ |
RET=cons(Vars,RET)$ |
return RET$ |
RET=cons(1,RET)$ |
|
return RET$ |
|
} |
} |
|
|
dp_ord(2)$ |
dp_ord(2)$ |
|
|
PolyListNum=length(PolyList)$ |
PolyListNum=length(PolyList)$ |
VPolyList=newvect(PolyListNum,PolyList)$ |
|
|
|
|
OneMat=newvect(PolyListNum+1,[0])$ |
ExpMat=[]$ |
ExpMat=[]$ |
for(I=0;I<PolyListNum;I++) |
for(I=0;I<PolyListNum;I++){ |
for(Poly=dp_ptod(VPolyList[I],Vars); |
for(Poly=dp_ptod(PolyList[I],Vars); |
Poly!=0;Poly=dp_rest(Poly)){ |
Poly!=0;Poly=dp_rest(Poly)){ |
Exp=dp_etov(dp_ht(Poly))$ |
ExpMat=cons(dp_etov(dp_ht(Poly)),ExpMat)$ |
if(notzerovec(Exp)) |
} |
ExpMat=cons(Exp,ExpMat)$ |
OneMat[I+1]=length(ExpMat)$ |
} |
} |
|
|
ExpMat=reverse(ExpMat)$ |
ExpMat=reverse(ExpMat)$ |
ExpMat=newvect(length(ExpMat),ExpMat)$ |
ExpMat=newvect(length(ExpMat),ExpMat)$ |
|
|
/* first */ |
TMP=unitweight(ExpMat,Vars,PolyListNum,OneMat,FLAG)$ |
|
|
RET=cons(leastsq(ExpMat,Vars),RET)$ |
RET=append(RET,TMP[1])$ |
|
|
/* second */ |
RET=append(RET,leastsq(TMP[0],ExpMat,Vars,FLAG,3))$ |
|
|
ExpMat=qsort(ExpMat,junban)$ |
ExpMat=qsort(ExpMat,junban)$ |
|
|
ExpMat2=[]$ |
ExpMat2=[]$ |
for(I=0;I<size(ExpMat)[0];I++) |
for(I=0;I<size(ExpMat)[0];I++) |
if(car(ExpMat2)!=ExpMat[I]) |
if(car(ExpMat2)!=ExpMat[I]) |
Line 400 def weight(PolyList,Vars){ |
|
Line 701 def weight(PolyList,Vars){ |
|
|
|
if(size(ExpMat)[0]!=length(ExpMat2)){ |
if(size(ExpMat)[0]!=length(ExpMat2)){ |
ExpMat=newvect(length(ExpMat2),ExpMat2)$ |
ExpMat=newvect(length(ExpMat2),ExpMat2)$ |
RET=cons(leastsq(ExpMat,Vars),RET)$ |
RET=append(RET,leastsq(0,ExpMat,Vars,FLAG,5))$ |
} |
} |
|
|
RET=cons(Vars,reverse(RET))$ |
|
RET=cons(0,RET)$ |
|
return RET$ |
return RET$ |
} |
} |
|
|