=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/lib/weight,v retrieving revision 1.11 retrieving revision 1.27 diff -u -p -r1.11 -r1.27 --- OpenXM_contrib2/asir2000/lib/weight 2003/11/28 11:10:47 1.11 +++ OpenXM_contrib2/asir2000/lib/weight 2004/01/10 14:47:01 1.27 @@ -1,6 +1,204 @@ load("solve")$ load("gr")$ +#define EPS 1E-6 +#define TINY 1E-20 +#define MAX_ITER 100 +#define ROUND_THRESHOLD 0.4 + +def rotate(A,I,J,K,L,C,S){ + + 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){ + + S=OFFDIAG=0.0; + + for(J=0;J=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 MAX_ITER) + return 0; + + for(I=0;IT){ + 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 interval2value(A,Vars){ + + B=atl(A)$ + + if(length(B)>2){ + print("bug")$ + return []$ + } + else if(length(B)==0){ + if(fop(A)==0) + return [Vars,1]$ + else + return []$ + } + else if(length(B)==1){ + + C=fargs(B[0])$ + D=vars(C)$ + E=solve(C,D)$ + + if(fop(B[0])==15) + return [Vars,E[0][1]+1]$ + else if(fop(B[0])==11) + return [Vars,E[0][1]-1]$ + else if(fop(B[0])==8) + return [Vars,E[0][1]]$ + else + return []$ + } + else{ + + C=fargs(B[0])$ + D=vars(C)$ + E=solve(C,D)$ + + C=fargs(B[1])$ + D=vars(C)$ + F=solve(C,D)$ + + return [Vars,(E[0][1]+F[0][1])/2]$ + } + +} + +def fixpointmain(F,Vars){ + + RET=[]$ + for(I=length(Vars)-1;I>=1;I--){ + + for(H=[],J=0;J 0$ } + else if (FLAG==1) + for(F=@true,I=0;I < N; I++ ) { F = F @&& A[I] @< 0$ } + + return fixpointmain(F,Vars)$ +} + def nonzerovec(A){ for(I=0;I0){ - 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$ - } + D=newvect(length(B))$ + for(I=0;I