예제 #1
0
파일: bnflog.c 프로젝트: jpflori/pari
/* K a bnf, compute Cl'(K) = ell-Sylow of Cl(K) / (places above ell).
 * Return [D, u, R0, U0, ordS]
 * - D: cyclic factors for Cl'(K)
 * - u: generators of cyclic factors (all coprime to ell)
 * - R0: subgroup isprincipal(<S>) (divides K.cyc)
 * - U0: generators of R0 are of the form S . U0
 * - ordS[i] = order of S[i] in CL(K)  */
static GEN
CL_prime(GEN K, GEN ell, GEN Sell)
{
  GEN g, ordS, R0, U0, U, D, u, cyc = bnf_get_cyc(K);
  long i, l, lD, lS = lg(Sell);

  g = leafcopy(bnf_get_gen(K));
  l = lg(g);
  for (i = 1; i < l; i++)
  {
    GEN A = gel(g,i), a = gcoeff(A,1,1);
    long v = Z_pvalrem(a, ell, &a);
    if (v) gel(g,i) = hnfmodid(A, a); /* make coprime to ell */
  }
  R0 = cgetg(lS, t_MAT);
  ordS = cgetg(lS, t_VEC);
  for (i = 1; i < lS; i++)
  {
    gel(R0,i) = isprincipal(K, gel(Sell,i));
    gel(ordS,i) = charorder(cyc, gel(R0,i)); /* order of Sell[i] */
  }
  R0 = shallowconcat(R0, diagonal_shallow(cyc));
  /* R0 = subgroup generated by S in Cl(K) [ divides diagonal(K.cyc) ]*/
  R0 = ZM_hnfall(R0, &U0, 2); /* [S | cyc] * U0 = R0 in HNF */
  D = ZM_snfall(R0, &U,NULL);
  D = RgM_diagonal_shallow(D);
  lD = lg(D);
  u = ZM_inv(U, gen_1); settyp(u, t_VEC);
  for (i = 1; i < lD; i++) gel(u,i) = idealfactorback(K,g,gel(u,i),1);
  setlg(U0, l);
  U0 = rowslice(U0,1,lS-1); /* restrict to 'S' part */
  return mkvec5(D, u, R0, U0, ordS);
}
예제 #2
0
파일: nffactor.c 프로젝트: BENGMN/soen490
static GEN
nf_combine_factors(nfcmbf_t *T, GEN polred, GEN p, long a, long klim)
{
  GEN res, L, listmod, famod = T->fact, nf = T->nf;
  long l, maxK = 3, nft = lg(famod)-1;
  pari_timer ti;

  if (DEBUGLEVEL>2) TIMERstart(&ti);
  T->fact = hensel_lift_fact(polred, famod, T->L->Tpk, p, T->L->pk, a);
  if (nft < 11) maxK = -1; /* few modular factors: try all posibilities */
  if (DEBUGLEVEL>2) msgTIMER(&ti, "Hensel lift");

  L = nfcmbf(T, p, a, maxK, klim);
  if (DEBUGLEVEL>2) msgTIMER(&ti, "Naive recombination");

  res     = gel(L,1);
  listmod = gel(L,2); l = lg(listmod)-1;
  famod = gel(listmod,l);
  if (maxK >= 0 && lg(famod)-1 > 2*maxK)
  {
    if (l > 1)
    {
      T->pol = gel(res,l);
      T->polbase = unifpol(nf, gel(res,l), t_COL);
    }
    L = nf_LLL_cmbf(T, p, a, maxK);
    /* remove last elt, possibly unfactored. Add all new ones. */
    setlg(res, l); res = shallowconcat(res, L);
  }
  return res;
}
예제 #3
0
파일: subfield.c 프로젝트: BENGMN/soen490
static void
append(GEN D, GEN a)
{
  long i,l = lg(D), m = lg(a);
  GEN x = D + (l-1);
  for (i=1; i<m; i++) x[i] = a[i];
  setlg(D, l+m-1);
}
예제 #4
0
파일: nffactor.c 프로젝트: BENGMN/soen490
/* We want to be able to reconstruct x, |x|^2 < C, from x mod pr^k */
static double
bestlift_bound(GEN C, long d, double alpha, GEN Npr)
{
  const double y = 1 / (alpha - 0.25); /* = 2 if alpha = 3/4 */
  double t;
  if (typ(C) != t_REAL) C = gmul(C, real_1(DEFAULTPREC));
  setlg(C, DEFAULTPREC);
  t = rtodbl(mplog(gmul2n(divrs(C,d), 4))) * 0.5 + (d-1) * log(1.5 * sqrt(y));
  return ceil((t * d) / log(gtodouble(Npr)));
}
예제 #5
0
파일: bnflog.c 프로젝트: jpflori/pari
static GEN
ellsylow(GEN cyc, GEN ell)
{
  long i, l;
  GEN d = cgetg_copy(cyc, &l);
  for (i = 1; i < l; i++)
  {
    GEN c = gel(cyc,i), a;
    if (!Z_pvalrem(c, ell, &a)) break;
    gel(d,i) = diviiexact(c, a);
  }
  setlg(d, i); return d;
}
예제 #6
0
파일: subfield.c 프로젝트: BENGMN/soen490
GEN
subfields(GEN nf, GEN d0)
{
  pari_sp av = avma;
  long N, v0, d = itos(d0);
  GEN LSB, pol, G;
  poldata PD;
  primedata S;
  blockdata B;

  pol = get_nfpol(nf, &nf); /* in order to treat trivial cases */
  v0 = varn(pol); N = degpol(pol);
  if (d == N) return gerepilecopy(av, _subfield(pol, pol_x[v0]));
  if (d == 1) return gerepilecopy(av, _subfield(pol_x[v0], pol));
  if (d < 1 || d > N || N % d) return cgetg(1,t_VEC);

  /* much easier if nf is Galois (WSS) */
  G = galoisconj4(nf? nf: pol, NULL, 1);
  if (typ(G) != t_INT)
  { /* Bingo */
    GEN L = galoissubgroups(G), F;
    long k,i, l = lg(L), o = N/d;
    F = cgetg(l, t_VEC);
    k = 1;
    for (i=1; i<l; i++)
    {
      GEN H = gel(L,i);
      if (group_order(H) == o)
        gel(F,k++) = lift_intern(galoisfixedfield(G, gel(H,1), 0, v0));
    }
    setlg(F, k);
    return gerepilecopy(av, F);
  }

  subfields_poldata(nf? nf: pol, &PD);

  B.PD = &PD;
  B.S  = &S;
  B.N  = N;
  B.d  = d;
  B.size = N/d;

  choose_prime(&S, PD.pol, PD.dis);
  LSB = subfields_of_given_degree(&B);
  (void)delete_var(); /* from choose_prime */
  avma = av;
  if (!LSB) return cgetg(1, t_VEC);
  G = gcopy(LSB); gunclone(LSB);
  return fix_var(G, v0);
}
예제 #7
0
파일: nffactor.c 프로젝트: BENGMN/soen490
static GEN
nf_DDF_roots(GEN pol, GEN polred, GEN nfpol, GEN lt, GEN init_fa, long nbf,
             long fl, nflift_t *L)
{
  long Cltx_r[] = { evaltyp(t_POL)|_evallg(4), 0,0,0 };
  long i, m;
  GEN C2ltpol, C = L->topowden;
  GEN Clt  = mul_content(C, lt);
  GEN C2lt = mul_content(C,Clt);
  GEN z;

  if (L->Tpk)
  {
    int cof = (degpol(pol) > nbf); /* non trivial cofactor ? */
    z = FqX_split_roots(init_fa, L->Tp, L->p, cof? polred: NULL);
    z = hensel_lift_fact(polred, z, L->Tpk, L->p, L->pk, L->k);
    if (cof) setlg(z, lg(z)-1); /* remove cofactor */
    z = roots_from_deg1(z);
  }
  else
    z = rootpadicfast(polred, L->p, L->k);
  Cltx_r[1] = evalsigne(1) | evalvarn(varn(pol));
  gel(Cltx_r,3) = Clt? Clt: gen_1;
  C2ltpol  = C2lt? gmul(C2lt, pol): pol;
  for (m=1,i=1; i<lg(z); i++)
  {
    GEN q, r = gel(z,i);

    r = nf_bestlift_to_pol(lt? gmul(lt,r): r, NULL, L);
    gel(Cltx_r,2) = gneg(r); /* check P(r) == 0 */
    q = RgXQX_divrem(C2ltpol, Cltx_r, nfpol, ONLY_DIVIDES); /* integral */
    if (q) { 
      C2ltpol = C2lt? gmul(Clt,q): q;
      if (Clt) r = gdiv(r, Clt);
      gel(z,m++) = r;
    }
    else if (fl == 2) return cgetg(1, t_VEC);
  }
  z[0] = evaltyp(t_VEC) | evallg(m);
  return z;
}
예제 #8
0
파일: anal.c 프로젝트: jkeuffer/pari
void
print_all_user_fun(int member)
{
  pari_sp av = avma;
  long iL = 0, lL = 1024;
  GEN L = cgetg(lL+1, t_VECSMALL);
  entree *ep;
  int i;
  for (i = 0; i < functions_tblsz; i++)
    for (ep = functions_hash[i]; ep; ep = ep->next)
    {
      const char *f;
      int is_member;
      if (EpVALENCE(ep) != EpVAR || typ((GEN)ep->value)!=t_CLOSURE) continue;
      f = ep->name;
      is_member = (f[0] == '_' && f[1] == '.');
      if (member != is_member) continue;

      if (iL >= lL)
      {
        GEN oL = L;
        long j;
        lL *= 2; L = cgetg(lL+1, t_VECSMALL);
        for (j = 1; j <= iL; j++) gel(L,j) = gel(oL,j);
      }
      L[++iL] = (long)ep;
    }
  if (iL)
  {
    setlg(L, iL+1);
    L = gen_sort(L, NULL, &cmp_epname);
    for (i = 1; i <= iL; i++)
    {
      ep = (entree*)L[i];
      pari_printf("%s =\n  %Ps\n\n", ep->name, ep->value);
    }
  }
  avma = av;
}
예제 #9
0
파일: nffactor.c 프로젝트: BENGMN/soen490
/* Naive recombination of modular factors: combine up to maxK modular
 * factors, degree <= klim and divisible by hint
 *
 * target = polynomial we want to factor
 * famod = array of modular factors.  Product should be congruent to
 * target/lc(target) modulo p^a
 * For true factors: S1,S2 <= p^b, with b <= a and p^(b-a) < 2^31 */
static GEN
nfcmbf(nfcmbf_t *T, GEN p, long a, long maxK, long klim)
{
  GEN pol = T->pol, nf = T->nf, famod = T->fact, dn = T->dn;
  GEN bound = T->bound;
  GEN nfpol = gel(nf,1);
  long K = 1, cnt = 1, i,j,k, curdeg, lfamod = lg(famod)-1, dnf = degpol(nfpol);
  GEN res = cgetg(3, t_VEC);
  pari_sp av0 = avma;
  GEN pk = gpowgs(p,a), pks2 = shifti(pk,-1);

  GEN ind      = cgetg(lfamod+1, t_VECSMALL);
  GEN degpol   = cgetg(lfamod+1, t_VECSMALL);
  GEN degsofar = cgetg(lfamod+1, t_VECSMALL);
  GEN listmod  = cgetg(lfamod+1, t_COL);
  GEN fa       = cgetg(lfamod+1, t_COL);
  GEN lc = absi(leading_term(pol)), lt = is_pm1(lc)? NULL: lc;
  GEN C2ltpol, C = T->L->topowden, Tpk = T->L->Tpk;
  GEN Clt  = mul_content(C, lt);
  GEN C2lt = mul_content(C,Clt);
  const double Bhigh = get_Bhigh(lfamod, dnf);
  trace_data _T1, _T2, *T1, *T2;
  pari_timer ti;

  TIMERstart(&ti);

  if (maxK < 0) maxK = lfamod-1;

  C2ltpol = C2lt? gmul(C2lt,pol): pol;
  {
    GEN q = ceil_safe(sqrtr(T->BS_2));
    GEN t1,t2, ltdn, lt2dn;
    GEN trace1   = cgetg(lfamod+1, t_MAT);
    GEN trace2   = cgetg(lfamod+1, t_MAT);

    ltdn = mul_content(lt, dn);
    lt2dn= mul_content(ltdn, lt);

    for (i=1; i <= lfamod; i++)
    {
      pari_sp av = avma;
      GEN P = gel(famod,i);
      long d = degpol(P);

      degpol[i] = d; P += 2;
      t1 = gel(P,d-1);/* = - S_1 */
      t2 = gsqr(t1);
      if (d > 1) t2 = gsub(t2, gmul2n(gel(P,d-2), 1));
      /* t2 = S_2 Newton sum */
      t2 = typ(t2)!=t_INT? FpX_rem(t2, Tpk, pk): modii(t2, pk);
      if (lt)
      {
        if (typ(t2)!=t_INT) {
          t1 = FpX_red(gmul(ltdn, t1), pk);
          t2 = FpX_red(gmul(lt2dn,t2), pk);
        } else {
          t1 = remii(mulii(ltdn, t1), pk);
          t2 = remii(mulii(lt2dn,t2), pk);
        }
      }
      gel(trace1,i) = gclone( nf_bestlift(t1, NULL, T->L) );
      gel(trace2,i) = gclone( nf_bestlift(t2, NULL, T->L) ); avma = av;
    }
    T1 = init_trace(&_T1, trace1, T->L, q);
    T2 = init_trace(&_T2, trace2, T->L, q);
    for (i=1; i <= lfamod; i++) { 
      gunclone(gel(trace1,i));
      gunclone(gel(trace2,i));
    }
  }
  degsofar[0] = 0; /* sentinel */

  /* ind runs through strictly increasing sequences of length K,
   * 1 <= ind[i] <= lfamod */
nextK:
  if (K > maxK || 2*K > lfamod) goto END;
  if (DEBUGLEVEL > 3)
    fprintferr("\n### K = %d, %Z combinations\n", K,binomial(utoipos(lfamod), K));
  setlg(ind, K+1); ind[1] = 1;
  i = 1; curdeg = degpol[ind[1]];
  for(;;)
  { /* try all combinations of K factors */
    for (j = i; j < K; j++)
    {
      degsofar[j] = curdeg;
      ind[j+1] = ind[j]+1; curdeg += degpol[ind[j+1]];
    }
    if (curdeg <= klim && curdeg % T->hint == 0) /* trial divide */
    {
      GEN t, y, q, list;
      pari_sp av;

      av = avma;
      /* d - 1 test */
      if (T1)
      {
        t = get_trace(ind, T1);
        if (rtodbl(QuickNormL2(t,DEFAULTPREC)) > Bhigh)
        {
          if (DEBUGLEVEL>6) fprintferr(".");
          avma = av; goto NEXT;
        }
      }
      /* d - 2 test */
      if (T2)
      {
        t = get_trace(ind, T2);
        if (rtodbl(QuickNormL2(t,DEFAULTPREC)) > Bhigh)
        {
          if (DEBUGLEVEL>3) fprintferr("|");
          avma = av; goto NEXT;
        }
      }
      avma = av;
      y = lt; /* full computation */
      for (i=1; i<=K; i++)
      {
        GEN q = gel(famod, ind[i]);
        if (y) q = gmul(y, q);
        y = FqX_centermod(q, Tpk, pk, pks2);
      }
      y = nf_pol_lift(y, bound, T);
      if (!y)
      {
        if (DEBUGLEVEL>3) fprintferr("@");
        avma = av; goto NEXT;
      }
      /* try out the new combination: y is the candidate factor */
      q = RgXQX_divrem(C2ltpol, y, nfpol, ONLY_DIVIDES);
      if (!q)
      {
        if (DEBUGLEVEL>3) fprintferr("*");
        avma = av; goto NEXT;
      }

      /* found a factor */
      list = cgetg(K+1, t_VEC);
      gel(listmod,cnt) = list;
      for (i=1; i<=K; i++) list[i] = famod[ind[i]];

      y = Q_primpart(y);
      gel(fa,cnt++) = QXQX_normalize(y, nfpol);
      /* fix up pol */
      pol = q;
      for (i=j=k=1; i <= lfamod; i++)
      { /* remove used factors */
        if (j <= K && i == ind[j]) j++;
        else
        {
          famod[k] = famod[i];
          update_trace(T1, k, i);
          update_trace(T2, k, i);
          degpol[k] = degpol[i]; k++;
        }
      }
      lfamod -= K;
      if (lfamod < 2*K) goto END;
      i = 1; curdeg = degpol[ind[1]];

      if (C2lt) pol = Q_primpart(pol);
      if (lt) lt = absi(leading_term(pol));
      Clt  = mul_content(C, lt);
      C2lt = mul_content(C,Clt);
      C2ltpol = C2lt? gmul(C2lt,pol): pol;
      if (DEBUGLEVEL > 2)
      {
        fprintferr("\n"); msgTIMER(&ti, "to find factor %Z",y);
        fprintferr("remaining modular factor(s): %ld\n", lfamod);
      }
      continue;
    }

NEXT:
    for (i = K+1;;)
    {
      if (--i == 0) { K++; goto nextK; }
      if (++ind[i] <= lfamod - K + i)
      {
        curdeg = degsofar[i-1] + degpol[ind[i]];
        if (curdeg <= klim) break;
      }
    }
  }
END:
  if (degpol(pol) > 0)
  { /* leftover factor */
    if (signe(leading_term(pol)) < 0) pol = gneg_i(pol);

    if (C2lt && lfamod < 2*K) pol = QXQX_normalize(Q_primpart(pol), nfpol);
    setlg(famod, lfamod+1);
    gel(listmod,cnt) = shallowcopy(famod);
    gel(fa,cnt++) = pol;
  }
  if (DEBUGLEVEL>6) fprintferr("\n");
  if (cnt == 2) { 
    avma = av0; 
    gel(res,1) = mkvec(T->pol);
    gel(res,2) = mkvec(T->fact);
  }
  else
  {
    setlg(listmod, cnt); setlg(fa, cnt);
    gel(res,1) = fa;
    gel(res,2) = listmod;
    res = gerepilecopy(av0, res);
  }
  return res;
}
예제 #10
0
파일: nffactor.c 프로젝트: BENGMN/soen490
/* return the factorization of the square-free polynomial x.
   The coeffs of x are in Z_nf and its leading term is a rational integer.
   deg(x) > 1, deg(nfpol) > 1
   If fl = 1, return only the roots of x in nf
   If fl = 2, as fl=1 if pol splits, [] otherwise */
static GEN
nfsqff(GEN nf, GEN pol, long fl)
{
  long n, nbf, dpol = degpol(pol);
  GEN pr, C0, polbase, init_fa = NULL;
  GEN N2, rep, polmod, polred, lt, nfpol = gel(nf,1);
  nfcmbf_t T;
  nflift_t L;
  pari_timer ti, ti_tot;

  if (DEBUGLEVEL>2) { TIMERstart(&ti); TIMERstart(&ti_tot); }
  n = degpol(nfpol);
  polbase = unifpol(nf, pol, t_COL);
  if (typ(polbase) != t_POL) pari_err(typeer, "nfsqff");
  polmod  = lift_intern( unifpol(nf, pol, t_POLMOD) );
  if (dpol == 1) return mkvec(QXQX_normalize(polmod, nfpol));
  /* heuristic */
  if (dpol*3 < n) 
  {
    GEN z, t;
    long i;
    if (DEBUGLEVEL>2) fprintferr("Using Trager's method\n");
    z = (GEN)polfnf(polmod, nfpol)[1];
    if (fl) {
      long l = lg(z);
      for (i = 1; i < l; i++)
      {
        t = gel(z,i); if (degpol(t) > 1) break;
        gel(z,i) = gneg(gdiv(gel(t,2), gel(t,3)));
      }
      setlg(z, i);
      if (fl == 2 && i != l) return cgetg(1,t_VEC);
    }
    return z;
  }

  nbf = nf_pick_prime(5, nf, polbase, fl, &lt, &init_fa, &pr, &L.Tp);
  if (fl == 2 && nbf < dpol) return cgetg(1,t_VEC);
  if (nbf <= 1)
  {
    if (!fl) return mkvec(QXQX_normalize(polmod, nfpol)); /* irreducible */
    if (!nbf) return cgetg(1,t_VEC); /* no root */
  }

  if (DEBUGLEVEL>2) {
    msgTIMER(&ti, "choice of a prime ideal");
    fprintferr("Prime ideal chosen: %Z\n", pr);
  }

  pol = simplify_i(lift(polmod));
  L.tozk = gel(nf,8);
  L.topow= Q_remove_denom(gel(nf,7), &L.topowden);
  T.ZC = L2_bound(nf, L.tozk, &(T.dn));
  T.Br = nf_root_bounds(pol, nf); if (lt) T.Br = gmul(T.Br, lt);

  if (fl) C0 = normlp(T.Br, 2, n);
  else    C0 = nf_factor_bound(nf, polbase); /* bound for T_2(Q_i), Q | P */
  T.bound = mulrr(T.ZC, C0); /* bound for |Q_i|^2 in Z^n on chosen Z-basis */

  N2 = mulsr(dpol*dpol, normlp(T.Br, 4, n)); /* bound for T_2(lt * S_2) */
  T.BS_2 = mulrr(T.ZC, N2); /* bound for |S_2|^2 on chosen Z-basis */

  if (DEBUGLEVEL>2) {
    msgTIMER(&ti, "bound computation");
    fprintferr("  1) T_2 bound for %s: %Z\n", fl?"root":"factor", C0);
    fprintferr("  2) Conversion from T_2 --> | |^2 bound : %Z\n", T.ZC);
    fprintferr("  3) Final bound: %Z\n", T.bound);
  }

  L.p = gel(pr,1);
  if (L.Tp && degpol(L.Tp) == 1) L.Tp = NULL;
  bestlift_init(0, nf, pr, T.bound, &L);
  if (DEBUGLEVEL>2) TIMERstart(&ti);
  polred = ZqX_normalize(polbase, lt, &L); /* monic */

  if (fl) {
    GEN z = nf_DDF_roots(pol, polred, nfpol, lt, init_fa, nbf, fl, &L);
    if (lg(z) == 1) return cgetg(1, t_VEC);
    return z;
  }

  {
    pari_sp av = avma;
    if (L.Tp)
      rep = FqX_split_all(init_fa, L.Tp, L.p);
    else
    {
      long d;
      rep = cgetg(dpol + 1, t_VEC); gel(rep,1) = FpX_red(polred,L.p);
      d = FpX_split_Berlekamp((GEN*)(rep + 1), L.p);
      setlg(rep, d + 1);
    }
    T.fact  = gerepilecopy(av, sort_vecpol(rep, &cmp_pol));
  }
  if (DEBUGLEVEL>2) msgTIMER(&ti, "splitting mod %Z", pr);
  T.pr = pr;
  T.L  = &L;
  T.polbase = polbase;
  T.pol   = pol;
  T.nf    = nf;
  T.hint  = 1; /* useless */

  rep = nf_combine_factors(&T, polred, L.p, L.k, dpol-1);
  if (DEBUGLEVEL>2)
    fprintferr("Total Time: %ld\n===========\n", TIMER(&ti_tot));
  return rep;
}
예제 #11
0
파일: subfield.c 프로젝트: BENGMN/soen490
static GEN
print_block_system(blockdata *B, GEN Y, GEN SB)
{
  long i, j, l, ll, lp, u, v, ns, r = lg(Y), N = B->N;
  long *k, *n, **e, *t;
  GEN D, De, Z, cyperm, perm, VOID = cgetg(1, t_VECSMALL);

  if (DEBUGLEVEL>5) fprintferr("Y = %Z\n",Y);
  n = new_chunk(N+1);
  D = cget1(N+1, t_VEC);
  t = new_chunk(r+1);
  k = new_chunk(r+1);
  Z = cgetg(r+1, t_VEC);
  for (ns=0,i=1; i<r; i++)
  {
    GEN Yi = gel(Y,i);
    long ki = 0, si = lg(Yi)-1;

    for (j=1; j<=si; j++) { n[j] = lg(Yi[j])-1; ki += n[j]; }
    ki /= B->size;
    De = cgetg(ki+1,t_VEC);
    for (j=1; j<=ki; j++) gel(De,j) = VOID;
    for (j=1; j<=si; j++)
    {
      GEN cy = gel(Yi,j);
      for (l=1,lp=0; l<=n[j]; l++)
      {
        lp++; if (lp > ki) lp = 1;
        gel(De,lp) = vecsmall_append(gel(De,lp), cy[l]);
      }
    }
    append(D, De);
    if (si>1 && ki>1)
    {
      GEN p1 = cgetg(si,t_VEC);
      for (j=2; j<=si; j++) p1[j-1] = Yi[j];
      ns++;
      t[ns] = si-1;
      k[ns] = ki-1;
      gel(Z,ns) = p1;
    }
  }
  if (DEBUGLEVEL>2) fprintferr("\nns = %ld\n",ns);
  if (!ns) return test_block(B, SB, D);

  setlg(Z, ns+1);
  e = (long**)new_chunk(ns+1);
  for (i=1; i<=ns; i++)
  {
    e[i] = new_chunk(t[i]+1);
    for (j=1; j<=t[i]; j++) e[i][j] = 0;
  }
  cyperm= cgetg(N+1,t_VECSMALL);
  perm  = cgetg(N+1,t_VECSMALL); i = ns;
  do
  {
    pari_sp av = avma;
    for (u=1; u<=N; u++) perm[u] = u;
    for (u=1; u<=ns; u++)
      for (v=1; v<=t[u]; v++)
	perm_mul_i(perm, cycle_power_to_perm(cyperm, gmael(Z,u,v), e[u][v]));
    SB = test_block(B, SB, im_block_by_perm(D,perm));
    avma = av;

    /* i = 1..ns, j = 1..t[i], e[i][j] loop through 0..k[i].
     * TODO: flatten to 1-dimensional loop */
    if (++e[ns][t[ns]] > k[ns])
    {
      j = t[ns]-1;
      while (j>=1 && e[ns][j] == k[ns]) j--;
      if (j >= 1) { e[ns][j]++; for (l=j+1; l<=t[ns]; l++) e[ns][l] = 0; }
      else
      {
	i = ns-1;
	while (i>=1)
	{
	  j = t[i];
	  while (j>=1 && e[i][j] == k[i]) j--;
	  if (j<1) i--;
          else
	  {
	    e[i][j]++;
	    for (l=j+1; l<=t[i]; l++) e[i][l] = 0;
	    for (ll=i+1; ll<=ns; ll++)
              for (l=1; l<=t[ll]; l++) e[ll][l] = 0;
            break;
	  }
	}
      }
    }
  }
  while (i > 0);
  return SB;
}
예제 #12
0
파일: subfield.c 프로젝트: BENGMN/soen490
/* Computation of potential block systems of given size d associated to a
 * rational prime p: give a row vector of row vectors containing the
 * potential block systems of imprimitivity; a potential block system is a
 * vector of row vectors (enumeration of the roots). */
static GEN
calc_block(blockdata *B, GEN Z, GEN Y, GEN SB)
{
  long r = lg(Z), lK, i, j, t, tp, T, u, nn, lnon, lY;
  GEN K, n, non, pn, pnon, e, Yp, Zp, Zpp;
  pari_sp av0 = avma;

  if (DEBUGLEVEL>3)
  {
    fprintferr("lg(Z) = %ld, lg(Y) = %ld\n", r,lg(Y));
    if (DEBUGLEVEL > 5)
    {
      fprintferr("Z = %Z\n",Z);
      fprintferr("Y = %Z\n",Y);
    }
  }
  lnon = min(BIL, r);
  e    = new_chunk(BIL);
  n    = new_chunk(r);
  non  = new_chunk(lnon);
  pnon = new_chunk(lnon);
  pn   = new_chunk(lnon);

  Zp   = cgetg(lnon,t_VEC);
  Zpp  = cgetg(lnon,t_VEC); nn = 0;
  for (i=1; i<r; i++) { n[i] = lg(Z[i])-1; nn += n[i]; }
  lY = lg(Y); Yp = cgetg(lY+1,t_VEC);
  for (j=1; j<lY; j++) Yp[j] = Y[j];

  {
    pari_sp av = avma;
    long k = nn / B->size;
    for (j = 1; j < r; j++) 
      if (n[j] % k) break;
    if (j == r)
    {
      gel(Yp,lY) = Z;
      SB = print_block_system(B, Yp, SB);
      avma = av;
    }
  }
  gel(Yp,lY) = Zp;

  K = divisors(utoipos(n[1])); lK = lg(K);
  for (i=1; i<lK; i++)
  {
    long ngcd = n[1], k = itos(gel(K,i)), dk = B->size*k, lpn = 0;
    for (j=2; j<r; j++)
      if (n[j]%k == 0)
      {
        if (++lpn >= BIL) pari_err(talker,"overflow in calc_block");
        pn[lpn] = n[j]; pnon[lpn] = j;
        ngcd = cgcd(ngcd, n[j]);
      }
    if (dk % ngcd) continue;
    T = 1<<lpn;
    if (lpn == r-2)
    {
      T--; /* done already above --> print_block_system */
      if (!T) continue;
    }

    if (dk == n[1])
    { /* empty subset, t = 0. Split out for clarity */
      Zp[1] = Z[1]; setlg(Zp, 2);
      for (u=1,j=2; j<r; j++) Zpp[u++] = Z[j];
      setlg(Zpp, u);
      SB = calc_block(B, Zpp, Yp, SB);
    }

    for (t = 1; t < T; t++)
    { /* loop through all non-empty subsets of [1..lpn] */
      for (nn=n[1],tp=t, u=1; u<=lpn; u++,tp>>=1)
      {
        if (tp&1) { nn += pn[u]; e[u] = 1; } else e[u] = 0;
      }
      if (dk != nn) continue;

      for (j=1; j<r; j++) non[j]=0;
      Zp[1] = Z[1];
      for (u=2,j=1; j<=lpn; j++)
        if (e[j]) { Zp[u] = Z[pnon[j]]; non[pnon[j]] = 1; u++; }
      setlg(Zp, u);
      for (u=1,j=2; j<r; j++)
        if (!non[j]) Zpp[u++] = Z[j];
      setlg(Zpp, u);
      SB = calc_block(B, Zpp, Yp, SB);
    }
  }
  avma = av0; return SB;
}