[BACK]Return to new_pd.rr CVS log [TXT][DIR] Up to [local] / OpenXM / src / asir-contrib / testing / noro

Diff for /OpenXM/src/asir-contrib/testing/noro/Attic/new_pd.rr between version 1.4 and 1.7

version 1.4, 2011/02/18 02:59:04 version 1.7, 2011/08/09 07:49:38
Line 1 
Line 1 
 /* $OpenXM: OpenXM/src/asir-contrib/testing/noro/new_pd.rr,v 1.3 2011/01/19 04:52:03 noro Exp $ */  /* $OpenXM: OpenXM/src/asir-contrib/testing/noro/new_pd.rr,v 1.6 2011/07/05 07:46:09 noro Exp $ */
 import("gr")$  import("gr")$
 module noro_pd$  module noro_pd$
 static GBCheck,F4,EProcs,Procs,SatHomo,GBRat$  static GBCheck,F4,EProcs,Procs,SatHomo,GBRat$
Line 8  localf get_lc,tomonic,aa,ideal_intersection_m,redbase$
Line 8  localf get_lc,tomonic,aa,ideal_intersection_m,redbase$
 localf para_exec,nd_gr_rat,competitive_exec,call_func$  localf para_exec,nd_gr_rat,competitive_exec,call_func$
 localf call_ideal_list_intersection$  localf call_ideal_list_intersection$
 localf call_colon,call_prime_dec$  localf call_colon,call_prime_dec$
   localf prime_dec2, prime_dec_main2$
 localf first_second$  localf first_second$
 localf third$  localf third$
 localf locsat,iso_comp_para,extract_qj,colon_prime_dec,extract_comp$  localf locsat,iso_comp_para,extract_qj,colon_prime_dec,extract_comp$
Line 35  localf complete_qdecomp, partial_qdecomp, partial_qdec
Line 36  localf complete_qdecomp, partial_qdecomp, partial_qdec
 localf partial_decomp, partial_decomp0, zprimacomp, zprimecomp$  localf partial_decomp, partial_decomp0, zprimacomp, zprimecomp$
 localf fast_gb, incremental_gb, elim_gb, ldim, make_mod_subst$  localf fast_gb, incremental_gb, elim_gb, ldim, make_mod_subst$
 localf rsgn, find_npos, gen_minipoly, indepset$  localf rsgn, find_npos, gen_minipoly, indepset$
 localf maxindep, contraction, ideal_list_intersection, ideal_intersection$  localf maxindep, maxindep2, contraction, ideal_list_intersection, ideal_intersection$
 localf radical_membership, modular_radical_membership$  localf radical_membership, modular_radical_membership$
 localf radical_membership_rep, ideal_product, saturation$  localf radical_membership_rep, ideal_product, saturation$
 localf sat, satind, sat_ind, colon, isat$  localf sat, satind, sat_ind, colon, isat$
 localf ideal_colon, ideal_sat, ideal_inclusion, qd_simp_comp, qd_remove_redundant_comp$  localf ideal_colon, ideal_sat, ideal_inclusion, qd_simp_comp, qd_remove_redundant_comp$
 localf pd_simp_comp$  localf pd_simp_comp, remove_identical_comp$
 localf pd_remove_redundant_comp, ppart, sq, gen_fctr, gen_nf, gen_gb_comp$  localf pd_remove_redundant_comp, ppart, sq, gen_fctr, gen_nf, gen_gb_comp$
 localf gen_mptop, lcfactor, compute_deg0, compute_deg, member$  localf gen_mptop, lcfactor, compute_deg0, compute_deg, member$
 localf elimination, setintersection, setminus, sep_list$  localf elimination, setintersection, setminus, sep_list$
Line 1098  def prime_dec(B,V)
Line 1099  def prime_dec(B,V)
 {  {
         if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;          if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
         if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;          if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
         if ( type(NoLexDec=getopt(lexdec)) == -1 ) LexDec = 0;          if ( type(LexDec=getopt(lexdec)) == -1 ) LexDec = 0;
         if ( type(Rad=getopt(radical)) == -1 ) Rad = 0;          if ( type(Rad=getopt(radical)) == -1 ) Rad = 0;
         B = map(sq,B,Mod);          B = map(sq,B,Mod);
         if ( LexDec )          if ( LexDec )
Line 1117  def prime_dec(B,V)
Line 1118  def prime_dec(B,V)
                 if ( LexDec ) R = pd_simp_comp(R,V|first=1,mod=Mod);                  if ( LexDec ) R = pd_simp_comp(R,V|first=1,mod=Mod);
         } else {          } else {
                 G = ideal_list_intersection(R,V,0|mod=Mod);                  G = ideal_list_intersection(R,V,0|mod=Mod);
                 if ( LexDec ) R = pd_simp_comp(R,V|first=1,mod=Mod);                  if ( LexDec ) R = pd_simp_comp(R,V|mod=Mod);
         }          }
         return Rad ? [R,G] : R;          return Rad ? [R,G] : R;
 }  }
   
   def prime_dec2(B,V)
   {
           if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
           if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
           if ( type(LexDec=getopt(lexdec)) == -1 ) LexDec = 0;
           if ( type(Rad=getopt(radical)) == -1 ) Rad = 0;
           if ( type(Para=getopt(para)) == -1 || type(Para) != 4 ) Para = [];
           B = map(sq,B,Mod);
           if ( LexDec )
                   PD = lex_predec1(B,V|mod=Mod);
           else
                   PD = [B];
           if ( length(PD) > 1 ) {
                   G = ideal_list_intersection(PD,V,0|mod=Mod);
                   PD = pd_remove_redundant_comp(G,PD,V,0|mod=Mod);
           }
           R = [];
           for ( T = PD; T != []; T = cdr(T) )
                   R = append(prime_dec_main2(car(T),V|indep=Indep,mod=Mod,para=Para),R);
           if ( Indep ) {
                   G = ideal_list_intersection(map(first,R),V,0|mod=Mod);
                   R = pd_simp_comp(R,V|first=1,mod=Mod);
           } else {
                   G = ideal_list_intersection(R,V,0|mod=Mod);
                   R = pd_simp_comp(R,V|mod=Mod);
           }
           return Rad ? [R,G] : R;
   }
   
 def prime_dec_main(B,V)  def prime_dec_main(B,V)
 {  {
         if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;          if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
Line 1136  def prime_dec_main(B,V)
Line 1166  def prime_dec_main(B,V)
                 /* rad(G) subset IntP */                  /* rad(G) subset IntP */
                 /* check if IntP subset rad(G) */                  /* check if IntP subset rad(G) */
                 /* print([length(PD),length(IntP)],2); */                  /* print([length(PD),length(IntP)],2); */
                 for ( T = IntP; T != []; T = cdr(T) ) {                  for ( T = IntP; T != []; T = cdr(T) )
                         if ( (GNV = radical_membership(car(T),G,V|mod=Mod,isgb=1,dg=[DG,Ind])) ) {                          if ( (G0 = radical_membership(car(T),G,V|mod=Mod,isgb=1,dg=[DG,Ind],sat=1)) ) {
                                 F = car(T);                                  F = car(T);
                                 break;                                  break;
                         }                          }
                 }  
                 if ( T == [] ) return PD;                  if ( T == [] ) return PD;
   
                 /* GNV = [GB(<NV*F-1,G>),NV] */  
                 G1 = fast_gb(GNV[0],cons(GNV[1],V),Mod,[[0,1],[0,length(V)]]);  
                 G0 = elimination(G1,V);  
                 PD0 = zprimecomp(G0,V,Indep|mod=Mod);                  PD0 = zprimecomp(G0,V,Indep|mod=Mod);
                 if ( Indep ) {                  Int = ideal_list_intersection(Indep?map(first,PD0):PD0,V,0|mod=Mod);
                         Int = ideal_list_intersection(PD0[0],V,0|mod=Mod);                  PD = append(PD,PD0);
                         IndepSet = PD0[1];  
                         for ( PD1 = [], T = PD0[0]; T != []; T = cdr(T) )  
                                 PD1 = cons([car(T),IndepSet],PD1);  
                         PD = append(PD,reverse(PD1));  
                 } else {  
                         Int = ideal_list_intersection(PD0,V,0|mod=Mod);  
                         PD = append(PD,PD0);  
                 }  
 #if 0  #if 0
                 IntP = ideal_intersection_m(IntP,Int,V,0|mod=Mod);                  IntP = ideal_intersection_m(IntP,Int,V,0|mod=Mod);
 #else  #else
                 IntP = ideal_intersection(IntP,Int,V,0                  IntP = ideal_intersection(IntP,Int,V,0|mod=Mod,gbblock=[[0,length(IntP)]]);
                         |mod=Mod,gbblock=[[0,length(IntP)]]);  
 #endif  #endif
         }          }
 }  }
   
   def prime_dec_main2(B,V)
   {
           if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
           if ( type(Indep=getopt(indep)) == -1 ) Indep = 0;
           if ( type(Para=getopt(para)) == -1 || type(Para) != 4 ) Para = [];
           NPara = length(Para);
   
           G = fast_gb(B,V,Mod,0);
           IntP = [1];
           PD = [];
           DG = ltov(map(dp_ptod,G,V));
           for ( Ind = [], I = length(G)-1; I >= 0; I-- ) Ind = cons(I,Ind);
           if ( Mod ) DG = map(dp_mod,DG,Mod,[]);
           while ( 1 ) {
                   /* rad(G) subset IntP */
                   /* check if IntP subset rad(G) */
                   /* print([length(PD),length(IntP)],2); */
                   Sat = [];
                   IntPM = mingen(IntP,V);
                   for ( T = IntPM; T != [] && length(Sat) < 16; T = cdr(T) )
                           if ( G0 = radical_membership(car(T),G,V|mod=Mod,isgb=1,dg=[DG,Ind],sat=1) )
                                   Sat = cons(G0,Sat);
                   if ( Sat == [] ) return PD;
                   print(length(Sat),2); print("->",2);
                   Sat = remove_identical_comp(Sat|mod=Mod);
                   print(length(Sat));
                   for ( T = Sat; T != []; T = cdr(T) ) {
                           PD0 = zprimecomp(car(T),V,Indep|mod=Mod);
                           Int = ideal_list_intersection(Indep?map(first,PD0):PD0,V,0|mod=Mod);
                           PD = append(PD,PD0);
                           IntP = ideal_intersection(IntP,Int,V,0|mod=Mod,gbblock=[[0,length(IntP)]]);
                   }
           }
   }
   
 /* pre-decomposition */  /* pre-decomposition */
   
 def lex_predec1(B,V)  def lex_predec1(B,V)
Line 1228  def complete_qdecomp(GD,V,Mod)
Line 1279  def complete_qdecomp(GD,V,Mod)
         NV = ttttt;          NV = ttttt;
         M = gen_minipoly(cons(NV-U,GQ),cons(NV,V),PV,0,NV,Mod);          M = gen_minipoly(cons(NV-U,GQ),cons(NV,V),PV,0,NV,Mod);
         M = ppart(M,NV,Mod);          M = ppart(M,NV,Mod);
         MF = Mod ? modfctr(M) : fctr(M);          MF = Mod ? modfctr(M,Mod) : fctr(M);
         R = [];          R = [];
         for ( T = cdr(MF); T != []; T = cdr(T) ) {          for ( T = cdr(MF); T != []; T = cdr(T) ) {
                 S = car(T);                  S = car(T);
Line 1325  def complete_decomp(GD,V,Mod)
Line 1376  def complete_decomp(GD,V,Mod)
         NV = ttttt;          NV = ttttt;
         M = gen_minipoly(cons(NV-U,G),cons(NV,V),PV,0,NV,Mod);          M = gen_minipoly(cons(NV-U,G),cons(NV,V),PV,0,NV,Mod);
         M = ppart(M,NV,Mod);          M = ppart(M,NV,Mod);
         MF = Mod ? modfctr(M) : fctr(M);          MF = Mod ? modfctr(M,Mod) : fctr(M);
         if ( length(MF) == 2 ) return [G];          if ( length(MF) == 2 ) return [G];
         R = [];          R = [];
         for ( T = cdr(MF); T != []; T = cdr(T) ) {          for ( T = cdr(MF); T != []; T = cdr(T) ) {
Line 1441  def zprimecomp(G,V,Indep) {
Line 1492  def zprimecomp(G,V,Indep) {
         for ( T = PD; T != []; T = cdr(T) ) {          for ( T = PD; T != []; T = cdr(T) ) {
                 U = contraction(car(T),V0|mod=Mod);                  U = contraction(car(T),V0|mod=Mod);
                 U = nd_gr(U,V,Mod,0);                  U = nd_gr(U,V,Mod,0);
                 R = cons(U,R);                  R = cons(Indep?[U,W]:U,R);
         }          }
         if ( Indep ) return [R,W];          return R;
         else return R;  
 }  }
   
 def fast_gb(B,V,Mod,Ord)  def fast_gb(B,V,Mod,Ord)
Line 1569  def find_npos(GD,V,PV,Mod)
Line 1619  def find_npos(GD,V,PV,Mod)
 {  {
         N = length(V); PN = length(PV);          N = length(V); PN = length(PV);
         G = GD[0]; D = GD[1]; LD = D[N];          G = GD[0]; D = GD[1]; LD = D[N];
           DH = map(dp_dtop,map(dp_ht,map(dp_ptod,D,V)),V);
         Ord0 = dp_ord(); dp_ord(0);          Ord0 = dp_ord(); dp_ord(0);
         HC = map(dp_hc,map(dp_ptod,G,V));          HC = map(dp_hc,map(dp_ptod,G,V));
         dp_ord(Ord0);          dp_ord(Ord0);
Line 1582  def find_npos(GD,V,PV,Mod)
Line 1633  def find_npos(GD,V,PV,Mod)
         NV = ttttt;          NV = ttttt;
         for ( B = 2; ; B++ ) {          for ( B = 2; ; B++ ) {
                 for ( J = N-2; J >= 0; J-- ) {                  for ( J = N-2; J >= 0; J-- ) {
                         for ( U = 0, K = J; K < N; K++ )                          for ( U = 0, K = J; K < N; K++ ) {
                                   if ( DH[K] == V[K] ) continue;
                                 U += rsgn()*((random()%B+1))*V[K];                                  U += rsgn()*((random()%B+1))*V[K];
                           }
   #if 0
                         M = minipolym(G,V,0,U,NV,Mod);                          M = minipolym(G,V,0,U,NV,Mod);
   #else
                           M = gen_minipoly(cons(NV-U,G),cons(NV,V),PV,0,NV,Mod);
   #endif
                         if ( deg(M,NV) == LD ) return U;                          if ( deg(M,NV) == LD ) return U;
                 }                  }
         }          }
Line 1592  def find_npos(GD,V,PV,Mod)
Line 1649  def find_npos(GD,V,PV,Mod)
   
 def gen_minipoly(G,V,PV,Ord,VI,Mod)  def gen_minipoly(G,V,PV,Ord,VI,Mod)
 {  {
           O0 = dp_ord();
         if ( PV == [] ) {          if ( PV == [] ) {
                 NV = sssss;                  NV = sssss;
                 if ( Mod )                  if ( Mod )
                         M = minipolym(G,V,Ord,VI,NV,Mod);                          M = minipolym(G,V,Ord,VI,NV,Mod);
                 else                  else
                         M = minipoly(G,V,Ord,VI,NV);                          M = minipoly(G,V,Ord,VI,NV);
                   dp_ord(O0);
                 return subst(M,NV,VI);                  return subst(M,NV,VI);
         }          }
         W = setminus(V,[VI]);          W = setminus(V,[VI]);
Line 1615  def gen_minipoly(G,V,PV,Ord,VI,Mod)
Line 1674  def gen_minipoly(G,V,PV,Ord,VI,Mod)
                         G = elimination(G,cdr(V1));                          G = elimination(G,cdr(V1));
                 }                  }
         }          }
 #elif 1  #elif 0
         if ( Mod ) {          if ( Mod ) {
                 V1 = append(W,PV1);                  V1 = append(W,PV1);
                 G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]);                  G = nd_gr(G,V1,Mod,[[0,length(W)],[0,length(PV1)]]);
Line 1640  def gen_minipoly(G,V,PV,Ord,VI,Mod)
Line 1699  def gen_minipoly(G,V,PV,Ord,VI,Mod)
                 G = nd_gr_trace(G,PV1,1,GBCheck,[[0,1],[0,length(PV)]]|nora=1);                  G = nd_gr_trace(G,PV1,1,GBCheck,[[0,1],[0,length(PV)]]|nora=1);
         for ( M = car(G), T = cdr(G); T != []; T = cdr(T) )          for ( M = car(G), T = cdr(G); T != []; T = cdr(T) )
                 if ( deg(car(T),VI) < deg(M,VI) ) M = car(T);                  if ( deg(car(T),VI) < deg(M,VI) ) M = car(T);
           dp_ord(O0);
         return M;          return M;
 }  }
   
Line 1685  def maxindep(B,V,O)
Line 1745  def maxindep(B,V,O)
         return R;          return R;
 }  }
   
   def maxindep2(B,V,O)
   {
           if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
           G = fast_gb(B,V,Mod,O);
           Old = dp_ord();
           dp_ord(O);
           H = map(dp_dtop,map(dp_ht,map(dp_ptod,G,V)),V);
           H = map(sq,H,0);
           H = nd_gr(H,V,0,0);
           H = monodec0(H,V);
           N = length(V);
           Dep = [];
           for ( T = H, Len = N+1; T != []; T = cdr(T) ) {
                   M = length(car(T));
                   if ( M < Len ) {
                           Dep = [car(T)];
                           Len = M;
                   } else if ( M == Len )
                           Dep = cons(car(T),Dep);
           }
           R = [];
           for ( T = Dep; T != []; T = cdr(T) )
                   R = cons(setminus(V,car(T)),R);
           dp_ord(Old);
           return reverse(R);
   }
   
   
 /* ideal operations */  /* ideal operations */
 def contraction(G,V)  def contraction(G,V)
 {  {
Line 1808  def radical_membership(F,G,V) {
Line 1896  def radical_membership(F,G,V) {
         if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;          if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
         if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;          if ( type(IsGB=getopt(isgb)) == -1 ) IsGB = 0;
         if ( type(L=getopt(dg)) == -1 ) L = 0;          if ( type(L=getopt(dg)) == -1 ) L = 0;
           if ( type(Sat=getopt(sat)) == -1 ) Sat = 0;
         dp_ord(0);          dp_ord(0);
         if ( L ) { DG = L[0]; Ind = L[1]; }          if ( L ) { DG = L[0]; Ind = L[1]; }
         else {          else {
Line 1830  def radical_membership(F,G,V) {
Line 1919  def radical_membership(F,G,V) {
                         |gbblock=[[0,length(G)]]);                          |gbblock=[[0,length(G)]]);
         else          else
                 T = nd_gr(append(G,[NV*F-1]),cons(NV,V),Mod,0);                  T = nd_gr(append(G,[NV*F-1]),cons(NV,V),Mod,0);
         if ( type(car(T)) != 1 ) return [T,NV];          if ( type(car(T)) == 1 ) return 0;
         else return 0;          else if ( Sat ) {
                   G1 = fast_gb(T,cons(NV,V),Mod,[[0,1],[0,length(V)]]);
                   G0 = elimination(G1,V);
                   return G0;
           } else return [T,NV];
 }  }
   
 def modular_radical_membership(F,G,V) {  def modular_radical_membership(F,G,V) {
Line 2209  def pd_remove_redundant_comp(G,P,V,Ord)
Line 2302  def pd_remove_redundant_comp(G,P,V,Ord)
                         Pre = ideal_intersection(Pre,First?A[I][0]:A[I],V,Ord|mod=Mod);                          Pre = ideal_intersection(Pre,First?A[I][0]:A[I],V,Ord|mod=Mod);
         }          }
         for ( T = [], I = 0; I < N; I++ ) if ( A[I] ) T = cons(A[I],T);          for ( T = [], I = 0; I < N; I++ ) if ( A[I] ) T = cons(A[I],T);
           return reverse(T);
   }
   
   def remove_identical_comp(L)
   {
           if ( type(Mod=getopt(mod)) == -1 ) Mod = 0;
           if ( length(L) == 1 )  return L;
   
           A = ltov(L); N = length(A);
           for ( I = 0; I < N; I++ ) {
                   if ( !A[I] ) continue;
                   for ( J = I+1; J < N; J++ )
                           if ( A[J] &&
                                   gen_gb_comp(A[I],A[J],Mod) ) A[J] = 0;
           }
           for ( I = 0, T = []; I < N; I++ ) if ( A[I] ) T = cons(A[I],T);
         return reverse(T);          return reverse(T);
 }  }
   
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.7
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>