| version 1.2, 2003/10/17 14:36:25 |
version 1.24, 2004/01/08 14:45:05 |
|
|
| load("solve")$
|
load("solve")$ |
|
|
load("gr")$ |
| def nonposdegchk(Res){
|
|
|
|
#define EPS 1E-6 |
| for(I=0;I<length(Res);I++)
|
#define TINY 1E-20 |
| if(Res[I][1]<=0)
|
#define MAX_ITER 100 |
| return 0$
|
#define ROUND_THRESHOLD 0.4 |
|
|
|
| return 1$
|
def rotate(A,I,J,K,L,C,S){ |
| }
|
|
|
|
X=A[I][J]; |
| def resvars(Res,Vars){
|
Y=A[K][L]; |
|
|
A[I][J]=X*C-Y*S; |
| ResVars=newvect(length(Vars),Vars)$
|
A[K][L]=X*S+Y*C; |
|
|
|
| for(I=0;I<length(Res);I++){
|
return 1; |
|
|
} |
| for(J=0;J<size(ResVars)[0];J++)
|
|
| if(Res[I][0]==ResVars[J])
|
def jacobi(N,A,W){ |
| break$
|
|
|
|
S=OFFDIAG=0.0; |
| ResVars[J]=Res[I][1]$
|
|
| }
|
for(J=0;J<N;J++){ |
|
|
|
| return(ResVars)$
|
for(K=0;K<N;K++) |
| }
|
W[J][K]=0.0; |
|
|
|
| def makeret(Res,Vars,B){
|
W[J][J]=1.0; |
|
|
S+=A[J][J]*A[J][J]; |
| VarsNum=length(Vars)$
|
|
|
|
for(K=J+1;K<N;K++) |
| ResMat=newvect(VarsNum)$
|
OFFDIAG+=A[J][K]*A[J][K]; |
| for(I=0;I<VarsNum;I++)
|
} |
| ResMat[I]=newvect(2)$
|
|
|
|
TOLERANCE=EPS*EPS*(S/2+OFFDIAG); |
| for(I=0;I<VarsNum;I++){
|
|
| ResMat[I][0]=Vars[I]$
|
for(ITER=1;ITER<=MAX_ITER;ITER++){ |
| ResMat[I][1]=Vars[I]$
|
|
| }
|
OFFDIAG=0.0; |
|
|
for(J=0;J<N-1;J++) |
| for(F=0,L=1,D=0,M=1,I=0;I<length(Res);I++){
|
for(K=J+1;K<N;K++) |
|
|
OFFDIAG+=A[J][K]*A[J][K]; |
| for(J=0;J<size(ResMat)[0];J++)
|
|
| if(Res[I][0]==ResMat[J][0])
|
if(OFFDIAG < TOLERANCE) |
| break$
|
break; |
|
|
|
| if(J<VarsNum){
|
for(J=0;J<N-1;J++){ |
| K=Res[I][1]$
|
for(K=J+1;K<N;K++){ |
| ResMat[J][1]=K$
|
|
|
|
if(dabs(A[J][K])<TINY) |
| if(F==0 && type(K)==1){
|
continue; |
| if(B==2){
|
|
| L=ilcm(L,dn(K))$
|
T=(A[K][K]-A[J][J])/(2.0*A[J][K]); |
| D=igcd(D,nm(K))$
|
|
| }
|
if(T>=0.0) |
| else{
|
T=1.0/(T+dsqrt(T*T+1)); |
| if(K<M)
|
else |
| M=K$
|
T=1.0/(T-dsqrt(T*T+1)); |
| }
|
|
| }
|
C=1.0/dsqrt(T*T+1); |
| else
|
|
| F=1$
|
S=T*C; |
|
|
|
| }
|
T*=A[J][K]; |
| }
|
|
|
|
A[J][J]-=T; |
| if(F==0)
|
A[K][K]+=T; |
| if(B==2)
|
A[J][K]=0.0; |
| for(I=0;I<VarsNum;I++)
|
|
| ResMat[I][1]=ResMat[I][1]*L/D$
|
for(I=0;I<J;I++) |
| else
|
rotate(A,I,J,I,K,C,S); |
| for(I=0;I<VarsNum;I++)
|
|
| ResMat[I][1]=ResMat[I][1]/M*1.0$
|
for(I=J+1;I<K;I++) |
|
|
rotate(A,J,I,I,K,C,S); |
| for(I=0;I<VarsNum;I++)
|
|
| for(J=0;J<length(Vars);J++)
|
for(I=K+1;I<N;I++) |
| ResMat[I][1]=subst(ResMat[I][1],Vars[J],
|
rotate(A,J,I,K,I,C,S); |
| strtov(rtostr(Vars[J])+"_deg"))$
|
|
|
|
for(I=0;I<N;I++) |
| ResMat=map(vtol,ResMat)$
|
rotate(W,J,I,K,I,C,S); |
| return(vtol(ResMat))$
|
|
|
|
} |
| }
|
} |
|
|
} |
| def afo(A,B){
|
|
|
|
if (ITER > MAX_ITER) |
| for(I=0;I<size(A)[0];I++){
|
return 0; |
| if(A[I]<B[I])
|
|
| return 1$
|
for(I=0;I<N-1;I++){ |
|
|
|
| if(A[I]>B[I])
|
K=I; |
| return -1$
|
|
| }
|
T=A[K][K]; |
|
|
|
| return 0$
|
for(J=I+1;J<N;J++) |
| }
|
if(A[J][J]>T){ |
|
|
K=J; |
| def weight(PolyList,Vars){
|
T=A[K][K]; |
|
|
} |
| dp_ord(2)$
|
|
|
|
A[K][K]=A[I][I]; |
| PolyListNum=length(PolyList)$
|
|
|
|
A[I][I]=T; |
| ExpMat=[]$
|
|
| for(I=0;I<PolyListNum;I++)
|
V=W[K]; |
| for(Poly=dp_ptod(PolyList[I],Vars);Poly!=0;Poly=dp_rest(Poly))
|
|
| ExpMat=cons(dp_etov(dp_ht(Poly)),ExpMat)$
|
W[K]=W[I]; |
|
|
|
| ExpMat=reverse(ExpMat)$
|
W[I]=V; |
| ExpMat=newvect(length(ExpMat),ExpMat)$
|
} |
|
|
|
| ExpMatRowNum=size(ExpMat)[0]$
|
return 1; |
| ExpMatColNum=size(ExpMat[0])[0]$
|
} |
| ExtMatColNum=ExpMatColNum+PolyListNum$
|
|
|
|
def interval2value(A,Vars){ |
| OneMat=newvect(PolyListNum+1,[0])$
|
|
| for(I=0,SUM=0;I<PolyListNum;I++){
|
B=atl(A)$ |
| SUM+=nmono(PolyList[I])$
|
|
| OneMat[I+1]=SUM$
|
if(length(B)>2){ |
| }
|
print("bug")$ |
|
|
return []$ |
| RevOneMat=newvect(ExpMatRowNum)$
|
} |
| for(I=0;I<PolyListNum;I++)
|
|
| for(J=OneMat[I];J<OneMat[I+1];J++)
|
if(length(B)==0){ |
| RevOneMat[J]=I$
|
if(A) |
|
|
return [Vars,1]$ |
| NormMat=newmat(ExpMatColNum,ExtMatColNum)$
|
else |
|
|
return []$ |
| for(I=0;I<ExpMatColNum;I++)
|
} |
| for(J=0;J<ExpMatColNum;J++)
|
else if(length(B)==1){ |
| for(K=0;K<ExpMatRowNum;K++)
|
|
| NormMat[I][J]+=ExpMat[K][I]*ExpMat[K][J]$
|
C=fargs(B[0])$ |
|
|
D=vars(C)$ |
| for(I=0;I<ExpMatColNum;I++)
|
E=solve(C,D)$ |
| for(J=0;J<PolyListNum-1;J++)
|
|
| for(K=OneMat[J];K<OneMat[J+1];K++)
|
if(fop(B[0])==15) |
| NormMat[I][J+ExpMatColNum]-=ExpMat[K][I]$
|
return [Vars,E[0][1]+1]$ |
|
|
else if(fop(B[0])==11) |
| for(I=0;I<ExpMatColNum;I++)
|
return [Vars,E[0][1]-1]$ |
| for(J=OneMat[PolyListNum-1];J<OneMat[PolyListNum];J++)
|
else |
| NormMat[I][ExtMatColNum-1]+=ExpMat[J][I]$
|
return []$ |
|
|
} |
| NormMat2=newmat(PolyListNum-1,ExpMatColNum+1)$
|
else{ |
|
|
|
| for(I=0;I<PolyListNum-1;I++)
|
C=fargs(B[0])$ |
| for(J=0;J<ExpMatColNum;J++)
|
D=vars(C)$ |
| for(K=OneMat[I];K<OneMat[I+1];K++)
|
E=solve(C,D)$ |
| NormMat2[I][J]-=ExpMat[K][J]$
|
|
|
|
C=fargs(B[1])$ |
| for(I=0;I<PolyListNum-1;I++)
|
D=vars(C)$ |
| NormMat2[I][ExpMatColNum]=OneMat[I+1]-OneMat[I]$
|
F=solve(C,D)$ |
|
|
|
| ExtVars=Vars$
|
return [Vars,(E[0][1]+F[0][1])/2]$ |
| for(I=0;I<PolyListNum-1;I++)
|
} |
| ExtVars=append(ExtVars,[uc()])$
|
|
|
|
} |
| SolveList=[]$
|
|
| for(I=0;I<ExpMatColNum;I++){
|
def fixpointmain(F,Vars){ |
| TMP=0$
|
|
| for(J=0;J<ExtMatColNum-1;J++)
|
RET=[]$ |
| TMP+=NormMat[I][J]*ExtVars[J]$
|
for(I=length(Vars)-1;I>=1;I--){ |
|
|
|
| TMP-=NormMat[I][ExtMatColNum-1]$
|
for(H=[],J=0;J<I;J++) |
| SolveList=cons(TMP,SolveList)$
|
H=cons(Vars[J],H)$ |
| }
|
|
|
|
G=interval2value(qe(ex(H,F)),Vars[I])$ |
| for(I=0;I<PolyListNum-1;I++){
|
|
| TMP=0$
|
if(G==[]) |
| for(J=0;J<ExpMatColNum;J++)
|
return RET$ |
| TMP+=NormMat2[I][J]*ExtVars[J]$
|
else |
|
|
RET=cons(G,RET)$ |
| TMP+=NormMat2[I][ExpMatColNum]*ExtVars[I+ExpMatColNum]$
|
|
|
|
F=subf(F,G[0],G[1])$ |
| SolveList=cons(TMP,SolveList)$
|
} |
| }
|
|
|
|
G=interval2value(simpl(F),Vars[0])$ |
| ReaVars=vars(SolveList)$
|
|
| Res=solve(SolveList,reverse(ExtVars))$
|
if(G==[]) |
|
|
return RET$ |
| RET=[]$
|
else |
| if(nonposdegchk(Res)){
|
RET=cons(G,RET)$ |
|
|
|
| ResVars=resvars(Res,ExtVars)$
|
return RET$ |
| ResVars=append(vtol(ResVars),[1])$
|
} |
|
|
|
| for(I=0;I<ExpMatRowNum;I++){
|
|
| TMP=0$
|
def fixedpoint(A,FLAG){ |
| for(J=0;J<ExpMatColNum;J++)
|
|
| TMP+=ExpMat[I][J]*ResVars[J]$
|
Vars=vars(A)$ |
|
|
|
| TMP-=ResVars[RevOneMat[I]+ExpMatColNum]$
|
N=length(A)$ |
|
|
|
| if(TMP!=0)
|
if (FLAG==0) |
| break$
|
for(F=@true,I=0;I < N; I++ ) { F = F @&& A[I] @> 0$ } |
| }
|
else if (FLAG==1) |
|
|
for(F=@true,I=0;I < N; I++ ) { F = F @&& A[I] @< 0$ } |
| if(I==ExpMatRowNum){
|
|
| print("complitely homogenized")$
|
return fixpointmain(F,Vars)$ |
| return([makeret(Res,Vars,2)])$
|
} |
| }
|
|
| else
|
def nonzerovec(A){ |
| RET=cons(makeret(Res,Vars,1),RET)$
|
|
| }
|
for(I=0;I<size(A)[0];I++) |
|
|
if(A[I]!=0) |
| ExpMat=qsort(ExpMat,afo)$
|
return 1$ |
| ExpMat2=[]$
|
|
| for(I=0;I<size(ExpMat)[0];I++)
|
return 0$ |
| if(car(ExpMat2)!=ExpMat[I])
|
} |
| ExpMat2=cons(ExpMat[I],ExpMat2)$
|
|
|
|
def junban(A,B){ |
| ExpMat=newvect(length(ExpMat2),ExpMat2)$
|
return (A<B ? 1:(A>B ? -1:0))$ |
| ExpMatRowNum=size(ExpMat)[0]$
|
} |
| ExpMatColNum=size(ExpMat[0])[0]$
|
|
|
|
def worder(A,B){ |
| NormMat=newmat(ExpMatColNum,ExpMatColNum+1)$
|
return (A[0]<B[0] ? 1:(A[0]>B[0] ? -1:0))$ |
|
|
} |
| for(I=0;I<ExpMatColNum;I++)
|
|
| for(J=0;J<ExpMatColNum;J++)
|
def bsort(A){ |
| for(K=0;K<ExpMatRowNum;K++)
|
|
| NormMat[I][J]+=ExpMat[K][I]*ExpMat[K][J]$
|
K=size(A)[0]-1$ |
|
|
while(K>=0){ |
| for(I=0;I<ExpMatColNum;I++)
|
J=-1$ |
| for(J=0;J<ExpMatRowNum;J++)
|
for(I=1;I<=K;I++) |
| NormMat[I][ExpMatColNum]+=ExpMat[J][I]$
|
if(A[I-1][0]<A[I][0]){ |
|
|
J=I-1$ |
| SolveList=[]$
|
X=A[J]$ |
| for(I=0;I<ExpMatColNum;I++){
|
A[J]=A[I]$ |
| TMP=0$
|
A[I]=X$ |
| for(J=0;J<ExpMatColNum;J++)
|
} |
| TMP+=NormMat[I][J]*Vars[J]$
|
K=J$ |
|
|
} |
| TMP-=NormMat[I][ExpMatColNum]$
|
return A$ |
| SolveList=cons(TMP,SolveList)$
|
} |
| }
|
|
|
|
def perm(I,P,TMP){ |
| Res=solve(SolveList,Vars)$
|
|
|
|
if(I>0){ |
| if(nonposdegchk(Res))
|
TMP=perm(I-1,P,TMP)$ |
| RET=cons(makeret(Res,Vars,1),RET)$
|
for(J=I-1;J>=0;J--){ |
|
|
T=P[I]$ |
| return reverse(RET)$
|
P[I]=P[J]$ |
| }
|
P[J]=T$ |
|
|
TMP=perm(I-1,P,TMP)$ |
| end$
|
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,ID){ |
| |
|
| |
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 [[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])$ |
| |
} |
| |
} |
| |
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]$ |
| |
} |
| |
|
| |
D=0$ |
| |
for(I=0;I<VarsNumB;I++) |
| |
D=gcd(D,C[I])$ |
| |
|
| |
if(D!=0){ |
| |
C=C/D$ |
| |
C=map(red,C)$ |
| |
} |
| |
|
| |
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,FLAG){ |
| |
|
| |
ResNum=length(Res)$ |
| |
VarsNum=length(Vars)$ |
| |
|
| |
ResVec=newvect(ResNum)$ |
| |
|
| |
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]$ |
| |
} |
| |
|
| |
|
| |
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){ |
| |
|
| |
VN=size(V)[0]$ |
| |
|
| |
RET0=V$ |
| |
for(I=1;I<1000;I++){ |
| |
RET1=I*RET0$ |
| |
for(J=0;J<VN;J++){ |
| |
X=drint(RET1[J])$ |
| |
if(dabs(X-RET1[J])<ROUND_THRESHOLD) |
| |
RET1[J]=X$ |
| |
else |
| |
break$ |
| |
} |
| |
if(J==VN) |
| |
break$ |
| |
} |
| |
|
| |
if(I==1000) |
| |
return []$ |
| |
else |
| |
return RET1$ |
| |
} |
| |
|
| |
def chkou(L,ExpMat,CHAGORD){ |
| |
|
| |
for(P=1,I=0;I<L;I++){ |
| |
Q=ExpMat[L][CHAGORD[I]]$ |
| |
for(J=0;J<size(ExpMat[0])[0];J++){ |
| |
ExpMat[L][CHAGORD[J]]=red((ExpMat[I][CHAGORD[I]] |
| |
*ExpMat[L][CHAGORD[J]]- |
| |
Q*ExpMat[I][CHAGORD[J]])/P)$ |
| |
} |
| |
|
| |
P=ExpMat[I][CHAGORD[I]]$ |
| |
} |
| |
|
| |
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 qcheckmain(PolyList,Vars){ |
| |
|
| |
RET=[]$ |
| |
PolyListNum=length(PolyList)$ |
| |
VarsNum=length(Vars)$ |
| |
|
| |
ExpMat=newvect(VarsNum)$ |
| |
CHAGORD=newvect(VarsNum)$ |
| |
for(I=0;I<VarsNum;I++) |
| |
CHAGORD[I]=I$ |
| |
|
| |
L=0$ |
| |
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]$ |
| |
} |
| |
|
| |
def inner(A,B){ |
| |
|
| |
SUM=0$ |
| |
for(I=0;I<size(A)[0];I++) |
| |
SUM+=A[I]*B[I]$ |
| |
|
| |
return SUM$ |
| |
} |
| |
|
| |
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$ |
| |
} |
| |
|
| |
def value2(Vars,Ans){ |
| |
|
| |
N=length(Vars)$ |
| |
Res=newvect(N)$ |
| |
for(I=0;I<N;I++){ |
| |
Res[I]=newvect(2)$ |
| |
Res[I][0]=Vars[I]$ |
| |
Res[I][1]=Ans[I]$ |
| |
} |
| |
|
| |
Res=getgcd(Res,Vars)$ |
| |
|
| |
if(nonposdegchk(Res)){ |
| |
TMP1=makeret(Res,Vars,1)$ |
| |
return vtol(TMP1[1])$ |
| |
} |
| |
else |
| |
return []$ |
| |
} |
| |
|
| |
def qcheck(PolyList,Vars,FLAG){ |
| |
|
| |
RET=[]$ |
| |
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)$ |
| |
} |
| |
|
| |
Rea=vars(SolveList)$ |
| |
|
| |
VarsList=[]$ |
| |
for(I=0;I<VarsNum;I++) |
| |
if(member(Vars[CHAGORD[I]],Rea)) |
| |
VarsList=cons(Vars[CHAGORD[I]],VarsList)$ |
| |
|
| |
Res=solve(reverse(SolveList),reverse(VarsList))$ |
| |
Res=getgcd(Res,Rea)$ |
| |
|
| |
if(nonposdegchk(Res)){ |
| |
|
| |
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,0))$ |
| |
|
| |
return RET$ |
| |
} |
| |
else{ |
| |
|
| |
TMP=vtol(ResVars[1])$ |
| |
|
| |
/* |
| |
RET=append(RET,[[0,Vars,TMP]])$ |
| |
*/ |
| |
|
| |
if((TMP0=fixedpoint(TMP,0))!=[]){ |
| |
|
| |
for(I=0;I<length(TMP0);I++) |
| |
TMP=map(subst,TMP,TMP0[I][0], |
| |
TMP0[I][1])$ |
| |
|
| |
TMP=value2(Vars,TMP)$ |
| |
|
| |
if(TMP!=[]) |
| |
RET=append(RET,wsort(TMP,Vars, |
| |
TMP,FLAG,1/10))$ |
| |
} |
| |
else if((TMP0=fixedpoint(TMP,1))!=[]){ |
| |
|
| |
for(I=0;I<length(TMP0);I++) |
| |
TMP=map(subst,TMP,TMP0[I][0], |
| |
TMP0[I][1])$ |
| |
|
| |
TMP=value2(Vars,TMP)$ |
| |
|
| |
if(TMP!=[]) |
| |
RET=append(RET,wsort(TMP,Vars, |
| |
TMP,FLAG,1/10))$ |
| |
} |
| |
|
| |
return RET$ |
| |
} |
| |
} |
| |
else |
| |
return []$ |
| |
} |
| |
else |
| |
return []$ |
| |
|
| |
} |
| |
|
| |
def leastsq(NormMat,ExpMat,Vars,FLAG,ID){ |
| |
|
| |
RET=[]$ |
| |
|
| |
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]$ |
| |
} |
| |
|
| |
BVec=newvect(ExpMatColNum)$ |
| |
|
| |
for(I=0;I<ExpMatColNum;I++) |
| |
for(J=0;J<ExpMatRowNum;J++) |
| |
BVec[I]+=ExpMat[J][I]$ |
| |
|
| |
SolveList=[]$ |
| |
for(I=0;I<ExpMatColNum;I++){ |
| |
TMP=0$ |
| |
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-=BVec[I]$ |
| |
SolveList=cons(TMP,SolveList)$ |
| |
} |
| |
|
| |
Rea=vars(SolveList)$ |
| |
|
| |
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)){ |
| |
|
| |
TMP1=makeret(Res,Vars,1)$ |
| |
|
| |
if(TMP1[0]==0){ |
| |
|
| |
TMP=roundret(TMP1[1])$ |
| |
|
| |
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{ |
| |
|
| |
TMP=vtol(TMP1[1])$ |
| |
|
| |
/* |
| |
RET=append(RET,[[ID,Vars,vtol(TMP1[1])]])$ |
| |
*/ |
| |
|
| |
if((TMP0=fixedpoint(TMP1[1],0))!=[]){ |
| |
|
| |
for(I=0;I<length(TMP0);I++) |
| |
TMP=map(subst,TMP,TMP0[I][0],TMP0[I][1])$ |
| |
|
| |
TMP=value2(Vars,TMP)$ |
| |
|
| |
if(TMP!=[]) |
| |
RET=append(RET, |
| |
wsort(TMP,Vars,TMP,FLAG,ID+1/10))$ |
| |
|
| |
} |
| |
else if((TMP0=fixedpoint(TMP1[1],1))!=[]){ |
| |
|
| |
for(I=0;I<length(TMP0);I++) |
| |
TMP=map(subst,TMP,TMP0[I][0],TMP0[I][1])$ |
| |
|
| |
TMP=value2(Vars,TMP)$ |
| |
|
| |
if(TMP!=[]) |
| |
RET=append(RET, |
| |
wsort(TMP,Vars,TMP,FLAG,ID+1/10))$ |
| |
} |
| |
|
| |
return RET$ |
| |
} |
| |
} |
| |
else |
| |
return RET$ |
| |
|
| |
} |
| |
|
| |
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)$ |
| |
Vars1=[]$ |
| |
for(I=0;I<length(Vars);I++) |
| |
if(member(Vars[I],Vars0)) |
| |
Vars1=cons(Vars[I],Vars1)$ |
| |
|
| |
Vars=reverse(Vars1)$ |
| |
|
| |
RET=[]$ |
| |
|
| |
TMP=qcheck(PolyList,Vars,FLAG)$ |
| |
|
| |
if(TMP!=[]){ |
| |
RET=append(RET,TMP)$ |
| |
return RET$ |
| |
} |
| |
|
| |
dp_ord(2)$ |
| |
|
| |
PolyListNum=length(PolyList)$ |
| |
|
| |
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=unitweight(ExpMat,Vars,PolyListNum,OneMat,FLAG)$ |
| |
|
| |
RET=append(RET,TMP[1])$ |
| |
|
| |
TMP0=leastsq(TMP[0],ExpMat,Vars,FLAG,3)$ |
| |
|
| |
RET=append(RET,TMP0)$ |
| |
|
| |
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,FLAG,5))$ |
| |
} |
| |
else{ |
| |
TMP0=map(ltov,TMP0)$ |
| |
|
| |
for(I=0;I<length(TMP0);I++) |
| |
if(TMP0[I][0]==3) |
| |
TMP0[I][0]=5$ |
| |
else if(TMP0[I][0]==4) |
| |
TMP0[I][0]=6$ |
| |
|
| |
TMP0=map(vtol,TMP0)$ |
| |
|
| |
RET=append(RET,TMP0)$ |
| |
} |
| |
|
| |
return RET$ |
| |
} |
| |
|
| |
end$ |
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to weight CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / lib