![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to bfct CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / lib|
Return to bfct CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / lib |
1.1 ! noro 1: /* $OpenXM$ */
! 2: /* requires 'primdec' */
! 3:
! 4: /* annihilating ideal of F^s ? */
! 5:
! 6: def ann(F)
! 7: {
! 8: V = vars(F);
! 9: W = append([y1,y2,t],V);
! 10: N = length(V);
! 11: B = [1-y1*y2,t-y1*F];
! 12: for ( I = N-1, DV = []; I >= 0; I-- )
! 13: DV = cons(strtov("d"+rtostr(V[I])),DV);
! 14: DW = append([dy1,dy2,dt],DV);
! 15: for ( I = 0; I < N; I++ ) {
! 16: B = cons(DV[I]+y1*diff(F,V[I])*dt,B);
! 17: }
! 18: ctrl("do_weyl",1);
! 19: dp_nelim(2);
! 20: G0 = dp_gr_main(B,append(W,DW),0,0,6);
! 21: G1 = [];
! 22: for ( T = G0; T != []; T = cdr(T) ) {
! 23: E = car(T); VL = vars(E);
! 24: if ( !member(y1,VL) && !member(y2,VL) )
! 25: G1 = cons(E,G1);
! 26: }
! 27: G2 = map(subst,G1,dt,1);
! 28: G3 = map(b_subst,G2,t);
! 29: G4 = map(subst,G3,t,-1-s);
! 30: ctrl("do_weyl",0);
! 31: return G4;
! 32: }
! 33:
! 34: /* b-function of F ? */
! 35:
! 36: def bfct(F)
! 37: {
! 38: G4 = ann(F);
! 39:
! 40: ctrl("do_weyl",1);
! 41: V = vars(F);
! 42: N = length(V);
! 43: for ( I = N-1, DV = []; I >= 0; I-- )
! 44: DV = cons(strtov("d"+rtostr(V[I])),DV);
! 45:
! 46: N1 = 2*(N+1);
! 47:
! 48: M = newmat(N1+1,N1);
! 49: for ( J = N+1; J < N1; J++ )
! 50: M[0][J] = 1;
! 51: for ( J = 0; J < N+1; J++ )
! 52: M[1][J] = 1;
! 53: #if 0
! 54: for ( I = 0; I < N+1; I++ )
! 55: M[I+2][N-I] = -1;
! 56: for ( I = 0; I < N; I++ )
! 57: M[I+2+N+1][N1-1-I] = -1;
! 58: #elif 1
! 59: for ( I = 0; I < N1-1; I++ )
! 60: M[I+2][N1-I-1] = 1;
! 61: #else
! 62: for ( I = 0; I < N1-1; I++ )
! 63: M[I+2][I] = 1;
! 64: #endif
! 65: V1 = cons(s,V); DV1 = cons(ds,DV);
! 66: G5 = dp_gr_main(cons(F,G4),append(V1,DV1),0,0,M);
! 67: for ( T = G5, G6 = []; T != []; T = cdr(T) ) {
! 68: E = car(T);
! 69: if ( intersection(vars(E),DV1) == [] )
! 70: G6 = cons(E,G6);
! 71: }
! 72: ctrl("do_weyl",0);
! 73: G6_0 = remove_zero(map(z_subst,G6,V));
! 74: F0 = flatmf(cdr(fctr(dp_gr_main(G6_0,[s],0,0,0)[0])));
! 75: for ( T = F0, BF = []; T != []; T = cdr(T) ) {
! 76: FI = car(T);
! 77: for ( J = 1; ; J++ ) {
! 78: S = map(srem,map(z_subst,idealquo(G6,[FI^J],V1,0),V),FI);
! 79: for ( ; S != [] && !car(S); S = cdr(S) );
! 80: if ( S != [] )
! 81: break;
! 82: }
! 83: BF = cons([FI,J],BF);
! 84: }
! 85: return BF;
! 86: }
! 87:
! 88: def remove_zero(L)
! 89: {
! 90: for ( R = []; L != []; L = cdr(L) )
! 91: if ( car(L) )
! 92: R = cons(car(L),R);
! 93: return R;
! 94: }
! 95:
! 96: def z_subst(F,V)
! 97: {
! 98: for ( ; V != []; V = cdr(V) )
! 99: F = subst(F,car(V),0);
! 100: return F;
! 101: }
! 102:
! 103: def flatmf(L) {
! 104: for ( S = []; L != []; L = cdr(L) )
! 105: if ( type(F=car(car(L))) != NUM )
! 106: S = append(S,[F]);
! 107: return S;
! 108: }
! 109:
! 110: def member(A,L) {
! 111: for ( ; L != []; L = cdr(L) )
! 112: if ( A == car(L) )
! 113: return 1;
! 114: return 0;
! 115: }
! 116:
! 117: def intersection(A,B)
! 118: {
! 119: for ( L = []; A != []; A = cdr(A) )
! 120: if ( member(car(A),B) )
! 121: L = cons(car(A),L);
! 122: return L;
! 123: }
! 124:
! 125: def b_subst(F,V)
! 126: {
! 127: D = deg(F,V);
! 128: C = newvect(D+1);
! 129: for ( I = D; I >= 0; I-- )
! 130: C[I] = coef(F,I,V);
! 131: for ( I = 0, R = 0; I <= D; I++ )
! 132: if ( C[I] )
! 133: R += C[I]*v_factorial(V,I);
! 134: return R;
! 135: }
! 136:
! 137: def v_factorial(V,N)
! 138: {
! 139: for ( J = N-1, R = 1; J >= 0; J-- )
! 140: R *= V-J;
! 141: return R;
! 142: }
! 143: end$
! 144: