Ticket #165: COHO2COHO1.Kernel.Workaround.sng

LIB "ncall.lib";

ring r1 = (3),(c_2_1,c_2_2,a_1_0,a_1_1),(M(2,2,1,1,-1,-1,0,0,-1,0,0,0,0,0,-1,0),C);
def R1 = SuperCommutative(3,4);
setring R1;
qring Q1 = twostd( ideal(a_1_0^2,a_1_1^2) );
ring r2 = (3),(a_2_0,a_2_1,b_2_2,c_2_3,a_4_5,a_6_10,c_6_11,a_1_0,a_1_1,a_3_4,a_3_5,a_5_9),(M(2,2,2,2,4,6,6,1,1,3,3,5,0,0,0,-1,0,0,-1,0,0,0,0,0,-1,-1,0,0,-1,-1,0,-1,-1,-1,-1,-1,-1,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,0),C);
def R2 = SuperCommutative(8,12);
setring R2;
qring Q2 = twostd( ideal(a_1_0*a_1_1,a_2_0*a_1_0,a_2_1*a_1_0-a_2_0*a_1_1,a_2_1*a_1_1+a_2_0*a_1_1,b_2_2*a_1_0,a_2_0^2,a_2_0*a_2_1,a_1_0*a_3_4,a_1_0*a_3_5-a_2_1^2,a_1_1*a_3_4-a_2_1^2,a_2_0*b_2_2-a_2_1^2,a_2_1*b_2_2-a_1_1*a_3_5+a_2_1^2,a_2_0*a_3_4,a_2_1*a_3_4-a_2_0*a_3_5,a_2_1*a_3_5+a_2_0*a_3_5,a_4_5*a_1_0,a_4_5*a_1_1-a_2_0*a_3_5,b_2_2*a_3_4,a_2_0*a_1_1*a_3_5,a_2_1^3,a_2_0*a_4_5,a_2_1*a_4_5,a_1_0*a_5_9,a_3_4*a_3_5,b_2_2*a_4_5-a_1_1*a_5_9-b_2_2*a_1_1*a_3_5+a_2_1^2*c_2_3,a_2_0*a_5_9,a_4_5*a_3_4,a_4_5*a_3_5+a_2_1*a_5_9-a_2_0*c_2_3*a_3_5,a_6_10*a_1_0,a_6_10*a_1_1-a_2_1*a_5_9,a_2_0*a_6_10,a_2_1*a_6_10,a_4_5^2,a_3_4*a_5_9,b_2_2*a_6_10-a_3_5*a_5_9-b_2_2^2*a_1_1*a_3_5-c_2_3*a_1_1*a_5_9-b_2_2*c_2_3*a_1_1*a_3_5+a_2_1^2*c_2_3^2,a_2_1^2*a_5_9,a_4_5*a_5_9-a_1_1*a_3_5*a_5_9,a_6_10*a_3_4,a_6_10*a_3_5+a_2_1*c_2_3*a_5_9-a_2_0*c_6_11*a_1_1-a_2_0*c_2_3^2*a_3_5,a_4_5*a_6_10,a_6_10*a_5_9-b_2_2*a_1_1*a_3_5*a_5_9-c_2_3*a_1_1*a_3_5*a_5_9,a_6_10^2,a_1_0^2,a_1_1^2,a_3_4^2,a_3_5^2,a_5_9^2) );
map phi = Q1, 0,-b_2_2,-a_1_0,-a_1_1;


proc my_general_kernel(def br, def f)
"USAGE:      general_kernel(R,f); R a graded commutative ring or quotient ring, f a map from R to basering
RETURN:     the kernel of f is put into an ideal with the name @my_kernel@ in R
"
{ // setting up various rings
  def imageR = basering;
  setring br;
  def L = ringlist(br);
  for (int i=1; i<=size(L[2]); i++)
    { L[2][i] = "@"+L[2][i]; }
  def auxR = ring(L);

  def R = imageR+auxR;

  // the ideals of generators of br, and their images
  setring br;
  ideal varI = maxideal(1);
  setring auxR;
  ideal varI = maxideal(1);
  setring imageR;
  ideal varI = maxideal(1);
  ideal ImageI = f(varI);

  setring R;
  ideal G = groebner(ideal( imap(auxR,varI) - imap(imageR,ImageI) ));
  
  // we will pick the groebner basis elements that only contain variables from auxR
  // ideal filter = NF(G,std(imap(imageR,varI))); // doesn't work, bug in Singular!
  ideal tmp;
  if (nvars(auxR)>1)
    { tmp[nvars(imageR)+1..nvars(imageR)+nvars(auxR)] = imap(auxR,varI); }
  else
    { tmp[nvars(imageR)+1] = var(nvars(R)); } // yet another bug in Singular...
  map tmpF = R, tmp;
  ideal filter = tmpF(G); // this should be the same as killing imap(imageR,varI)

  ideal OUT;
  for (i=1;i<=ncols(G);i++)
    { if (filter[i]==G[i]) // i.e., there is no variable from ImageR in it
        { OUT = OUT, G[i];
        }
    }
  setring auxR;
  ideal OUT = imap(R, OUT);
  setring br;
  if (defined(@my_kernel@))
    { @my_kernel@ = groebner(fetch(auxR, OUT)); }
  else 
    { ideal @my_kernel@ = groebner(fetch(auxR, OUT)); }
  export(@my_kernel@);
}


my_general_kernel(Q1, phi); setring Q1; @my_kernel@;

$$$