プログラムの説明は工事中
(q-analogue及び、q-analogueのextensionイデアルでの左除法や左Groebner基底の計算等々)



DenoCancel[ff_]:=Module[{s,bunbo,fff},
s=Length[ff];
bunbo=Table[Denominator[Together[ff[[i]][[1]]]],{i,1,s}];
If[bunbo=={},fff=1,fff=bunbo[[1]];
Do[fff=PolynomialLCM[fff,bunbo[[i]]],{i,2,s}]];
Table[{Expand[Simplify[fff*ff[[i]][[1]]]],ff[[i]][[2]]},{i,1,s}]]
s}]]




NCGroebner[generator_, monoorder_, valueorder_] :=Module[{LT2, ListPoly, 
PolyList, Polymono2, sig, PolyDiv2, S2, Groeb3, MinGroeb,RedGroeb},
If[monoorder == lex,LT2[f_] :=LT2[f] = Module[{s, lt, a}, s = Length[f]; 
lt = f[[1]]; Do[If[DeleteCases[lt[[2]] - f[[a]][[2]], 0][[1]] < 0, 
lt = f[[a]]], {a,2,s}]; lt]];If[monoorder == grlex,LT2[f_] :=LT2[f] = 
Module[{s, lt, t, sum1, sum2, a}, s = Length[f];lt = f[[1]];
t = Length[lt[[2]]];Do[sum1 = Sum[lt[[2]][[i]], {i, t}];
sum2 = Sum[f[[a]][[2]][[i]], {i, t}];If[sum1 < sum2, lt = f[[a]],
If[sum1 == sum2,If[DeleteCases[lt[[2]] - f[[a]][[2]], 0][[1]] < 0,
lt = f[[a]]]]], {a, 2, s}]; lt]];If[monoorder == grevlex,LT2[f_] :=LT2[f] = 
Module[{s, lt, t, sum1, sum2, a}, s = Length[f]; lt = f[[1]];
t = Length[lt[[2]]];Do[sum1 = Sum[lt[[2]][[i]], {i, t}];
sum2 = Sum[f[[a]][[2]][[i]], {i, t}];If[sum1 < sum2, lt = f[[a]],
If[sum1 == sum2,If[DeleteCases[lt[[2]] - f[[a]][[2]], 0][[-1]] > 0,
lt = f[[a]]]]], {a, 2, s}]; lt]]; 
If[monoorder =!= lex && monoorder =!= grlex && monoorder =!= grevlex,
LT2[f_] :=LT2[f] = Module[{s, lt, t, c, j}, s = Length[f]; lt = f[[1]];
t = Length[monoorder];Do[c = False; j = 1;While[c == False,
If[monoorder[[j]].lt[[2]] =!= monoorder[[j]].f[[i]][[2]],c = True; 
If[monoorder[[j]].lt[[2]] < monoorder[[j]].f[[i]][[2]],lt = f[[i]]]]; 
j = j + 1], {i, 2, s}]; lt]];PolyList[F_, val_] :=Module[{s, PolyListone},
PolyListone[f_, v_] :=PolyListone[f, v] = 
Module[{getcoeff, MonomialList, aa, bb, kkk, tta, cce, ii, dc}, 
getcoeff[m_, b_] := getcoeff[m, b] = Module[{a, c},If[Variables[m] =!= {}, 
a = Exponent[m, b]; c = Times @@ (b^a);If[c =!= 1, 
{Coefficient[m, Times @@ (b^a)], a}, {m, a}], {m,Table[0, {Length[b]}]}]]; 
MonomialList[aiueo_] := Module[{sasisuseso, full}, 
kakikukeko = Expand[aiueo] + sasisuseso; full = FullForm[kakikukeko]; 
DeleteCases[Table[full[[1]][[iii]], {iii, 1, Length[full[[1]]]}],sasisuseso]]; 
aa = MonomialList[f];bb = Length[aa]; tta = Table[getcoeff[aa[[i]], v], 
{i, 1, bb}]; cce = True; Do[ii = j + 1; cce = True; While[cce, 
If[tta[[j]][[2]] == tta[[ii]][[2]], cce = False; tta = ReplacePart[tta, 
{tta[[ii]][[1]] + tta[[j]][[1]],tta[[ii]][[2]]},ii]; 
tta = ReplacePart[tta, True, j]];If[ii == Length[tta], cce = False, 
ii = ii + 1]], {j, 1, Length[tta] - 1}];dc = DeleteCases[tta, True];
Table[{Expand[Simplify[dc[[iii]][[1]]]], dc[[iii]][[2]]},
{iii, 1, Length[dc]}]];s = Length[F]; Table[PolyListone[F[[i]], val], {i, s}]];
ListPoly[F_, val_] :=ListPoly[F, val] =Module[{ListPolyone, s, FF},
ListPolyone[f_, v_] :=ListPolyone[f, v] =Module[{s, ss}, s = Length[f]; 
ss = Length[v];Sum[f[[i]][[1]]*Product[v[[j]]^(f[[i]][[2]][[j]]), {j, 1, ss}], 
{i, 1, s}]];s = Length[F]; FF = {};
Do[FF = Append[FF, ListPolyone[F[[i]], val]], {i, s}];FF];
Polymono2[f_, m_] :=Polymono2[f, m] =Module[{ff, fgfg, s, c, a}, ff = f; 
s = Length[ff];If[s == 0, ff = {m},c = True; a = 1;While[c, 
If[DeleteCases[m[[2]] - ff[[a]][[2]], 0] == {}, 
fgfg = Expand[Simplify[Together[ff[[a]][[1]] + m[[1]]]]];
ff = ReplacePart[ff, {fgfg, m[[2]]}, a];If[ff[[a]][[1]] == 0,
ff = Delete[ff, a]]; c = False, a = a + 1];If[a == s + 1, ff = Append[ff, m]; 
c = False]]]; ff];sig[le_, ri_] :=Module[{s},s = Length[le] - 1;
q^(Sum[Sum[le[[b]], {b, a + 1, s}]*ri[[a]], {a, 1, s - 1}])];
PolyDiv2[f_, g_] :=PolyDiv2[f, g] =Module[{s, a, r, p, i, c, h1, h2}, 
s = Length[g]; a = {}; Do[a = Append[a, {}], {s}];r = {}; p = f;
While[p =!= {}, i = 1; c = True;While[i <= s && c, 
h1 = LT2[p][[2]] - LT2[g[[i]]][[2]];If[Select[h1, #1 < 0 &] == {},
h2 = LT2[p][[1]]/(sig[h1, LT2[g[[i]]][[2]]]*LT2[g[[i]]][[1]]);
a = ReplacePart[a, Polymono2[a[[i]], {h2, h1}], i]; gg = g[[i]];
While[gg =!= {}, p = Polymono2[p, 
{-sig[h1, LT2[gg][[2]]]*h2*LT2[gg][[1]],h1 + LT2[gg][[2]]}];
gg = Polymono2[gg, {-LT2[gg][[1]], LT2[gg][[2]]}]]; c = False,i = i + 1]];
If[c, r = Polymono2[r, LT2[p]];
p = Polymono2[p, {-LT2[p][[1]], LT2[p][[2]]}]]]; {a, r}]; 
S2[f_, g_] := S2[f, g] =
Module[{mf, mg, s, c, a, b, si1, si2, sisi, z, aa, ff, gg}, 
mf = LT2[f][[2]];mg = LT2[g][[2]]; s = Length[mf]; c = {};
Do[c = Append[c, Max[{mf[[i]], mg[[i]]}]], {i, 1, s}];
a = {1/(LT2[f][[1]]), c - mf}; b = {1/(LT2[g][[1]]), c - mg}; 
si1 = sig[a[[2]], LT2[f][[2]]]; si2 = sig[b[[2]], LT2[g][[2]]]; 
sisi = si2/si1; z = {}; aa = {};ff = f;While[ff =!= z,aa = Polymono2[aa, 
{sisi*sig[a[[2]], LT2[ff][[2]]]*a[[1]]*LT2[ff][[1]],a[[2]] + LT2[ff][[2]]}];
ff = Polymono2[ff, {-LT2[ff][[1]], LT2[ff][[2]]}]]; gg = g;While[gg =!= z,
aa = Polymono2[aa, {-sig[b[[2]], LT2[gg][[2]]]*b[[1]]*LT2[gg][[1]],
b[[2]] + LT2[gg][[2]]}];gg = Polymono2[gg, {-LT2[gg][[1]], LT2[gg][[2]]}]]; 
aa];Groeb3[F_] :=Groeb3[F] =Module[{s, B, G, t, ss, k, S},s = Length[F];B = {};
Do[Do[B = Append[B, {i, j}], {j, i + 1, s}], {i, 1, s - 1}]; G = F; t = s;
ss = Length[F[[1]][[1]][[2]]];While[B =!= {}, k = B[[1]];
S = PolyDiv2[S2[G[[k[[1]]]], G[[k[[2]]]]], G][[2]];If[S =!= {}, t = t + 1; 
G = Append[G, S];Do[B = Append[B, {tt, t}], {tt, 1, t - 1}]]; 
B = Delete[B, 1]]; G];MinGroeb[F_] :=MinGroeb[F] =
Module[{G, s, a, h, ss, t, sss, aa},G = Groeb3[F]; s = Length[G];Do[Do[
If[i =!= j && G[[j]] =!= a && G[[i]] =!= a,
h = LT2[G[[i]]][[2]] - LT2[G[[j]]][[2]];If[Select[h, #1 < 0 &] == {},
G = ReplacePart[G, a, i]]]; j = j + 1, {j, s}];i = i + 1, {i, s}];
G = DeleteCases[G, a]; ss = Length[G];Do[t = LT2[G[[k]]][[1]];If[t =!= 1, 
sss = Length[G[[k]]]; aa = G[[k]];Do[aa = ReplacePart[aa, 
{Expand[Simplify[aa[[m]][[1]]/t]], aa[[m]][[2]]}, m], {m,sss}]; 
G = ReplacePart[G, aa, k]], {k, ss}]; G];RedGroeb[F_] :=RedGroeb[F] =
Module[{G, s, k}, G = MinGroeb[F]; s = Length[G];Do[k = PolyDiv2[G[[j]], 
Delete[G, j]][[2]];G = ReplacePart[G, k, j], {j, s}];G];
Expand[Simplify[ListPoly[RedGroeb[PolyList[generator,valueorder]],
valueorder]]]]




ExtNCGroebner[generator_, monoorder_, valueorder_] :=Module[{irekae,DenoCancel
,LT2, ListPoly, 
PolyList, Polymono2, sig, PolyDiv2, S2, Groeb3, MinGroeb,RedGroeb},
irekae[m_,f_]:=Module[{s,ff},s=Length[f];
ff=Table[{sig[m,f[[i]][[2]]]*f[[i]][[1]],f[[i]][[2]]},{i,1,s}];ff]; 
DenoCancel[ff_]:=Module[{s,bunbo,fff},
s=Length[ff];
bunbo=Table[Denominator[Together[ff[[i]][[1]]]],{i,1,s}];
If[bunbo=={},fff=1,fff=bunbo[[1]];
Do[fff=PolynomialLCM[fff,bunbo[[i]]],{i,2,s}]];
Table[{Expand[Simplify[fff*ff[[i]][[1]]]],ff[[i]][[2]]},{i,1,s}]];
If[monoorder == lex,LT2[f_] :=LT2[f] = Module[{s, lt, a}, s = Length[f]; 
lt = f[[1]]; Do[If[DeleteCases[lt[[2]] - f[[a]][[2]], 0][[1]] < 0, 
lt = f[[a]]], {a,2,s}]; lt]];If[monoorder == grlex,LT2[f_] :=LT2[f] = 
Module[{s, lt, t, sum1, sum2, a}, s = Length[f];lt = f[[1]];
t = Length[lt[[2]]];Do[sum1 = Sum[lt[[2]][[i]], {i, t}];
sum2 = Sum[f[[a]][[2]][[i]], {i, t}];If[sum1 < sum2, lt = f[[a]],
If[sum1 == sum2,If[DeleteCases[lt[[2]] - f[[a]][[2]], 0][[1]] < 0,
lt = f[[a]]]]], {a, 2, s}]; lt]];If[monoorder == grevlex,LT2[f_] :=LT2[f] = 
Module[{s, lt, t, sum1, sum2, a}, s = Length[f]; lt = f[[1]];
t = Length[lt[[2]]];Do[sum1 = Sum[lt[[2]][[i]], {i, t}];
sum2 = Sum[f[[a]][[2]][[i]], {i, t}];If[sum1 < sum2, lt = f[[a]],
If[sum1 == sum2,If[DeleteCases[lt[[2]] - f[[a]][[2]], 0][[-1]] > 0,
lt = f[[a]]]]], {a, 2, s}]; lt]]; 
If[monoorder =!= lex && monoorder =!= grlex && monoorder =!= grevlex,
LT2[f_] :=LT2[f] = Module[{s, lt, t, c, j}, s = Length[f]; lt = f[[1]];
t = Length[monoorder];Do[c = False; j = 1;While[c == False,
If[monoorder[[j]].lt[[2]] =!= monoorder[[j]].f[[i]][[2]],c = True; 
If[monoorder[[j]].lt[[2]] < monoorder[[j]].f[[i]][[2]],lt = f[[i]]]]; 
j = j + 1], {i, 2, s}]; lt]];PolyList[F_, val_] :=Module[{s, PolyListone},
PolyListone[f_, v_] :=PolyListone[f, v] = 
Module[{getcoeff, MonomialList, aa, bb, kkk, tta, cce, ii, dc}, 
getcoeff[m_, b_] := getcoeff[m, b] = Module[{a, c},If[Variables[m] =!= {}, 
a = Exponent[m, b]; c = Times @@ (b^a);If[c =!= 1, 
{Coefficient[m, Times @@ (b^a)], a}, {m, a}], {m,Table[0, {Length[b]}]}]]; 
MonomialList[aiueo_] := Module[{sasisuseso, full}, 
kakikukeko = Expand[aiueo] + sasisuseso; full = FullForm[kakikukeko]; 
DeleteCases[Table[full[[1]][[iii]], {iii, 1, Length[full[[1]]]}],sasisuseso]]; 
aa = MonomialList[f];bb = Length[aa]; tta = Table[getcoeff[aa[[i]], v], 
{i, 1, bb}]; cce = True; Do[ii = j + 1; cce = True; While[cce, 
If[tta[[j]][[2]] == tta[[ii]][[2]], cce = False; tta = ReplacePart[tta, 
{tta[[ii]][[1]] + tta[[j]][[1]],tta[[ii]][[2]]},ii]; 
tta = ReplacePart[tta, True, j]];If[ii == Length[tta], cce = False, 
ii = ii + 1]], {j, 1, Length[tta] - 1}];dc = DeleteCases[tta, True];
Table[{Expand[Simplify[dc[[iii]][[1]]]], dc[[iii]][[2]]},
{iii, 1, Length[dc]}]];s = Length[F]; Table[PolyListone[F[[i]], val], {i, s}]];
ListPoly[F_, val_] :=ListPoly[F, val] =Module[{ListPolyone, s, FF},
ListPolyone[f_, v_] :=ListPolyone[f, v] =Module[{s, ss}, s = Length[f]; 
ss = Length[v];Sum[f[[i]][[1]]*Product[v[[j]]^(f[[i]][[2]][[j]]), {j, 1, ss}], 
{i, 1, s}]];s = Length[F]; FF = {};
Do[FF = Append[FF, ListPolyone[F[[i]], val]], {i, s}];FF];
Polymono2[f_, m_] :=Polymono2[f, m] =Module[{ff, fgfg, s, c, a}, ff = f; 
s = Length[ff];If[s == 0, ff = {m},c = True; a = 1;While[c, 
If[DeleteCases[m[[2]] - ff[[a]][[2]], 0] == {}, 
fgfg = Expand[Simplify[Together[ff[[a]][[1]] + m[[1]]]]];
ff = ReplacePart[ff, {fgfg, m[[2]]}, a];If[ff[[a]][[1]] == 0,
ff = Delete[ff, a]]; c = False, a = a + 1];If[a == s + 1, ff = Append[ff, m]; 
c = False]]]; ff];sig[le_, ri_] :=Module[{s},s = Length[le] - 1;
q^(Sum[Sum[le[[b]], {b, a + 1, s}]*ri[[a]], {a, 1, s - 1}])];
PolyDiv2[f_, g_] :=PolyDiv2[f, g] =Module[{s, a, r, p, i, c, h1, h2}, 
s = Length[g]; a = {}; Do[a = Append[a, {}], {s}];r = {}; p = f;
While[p =!= {}, i = 1; c = True;While[i <= s && c, 
h1 = LT2[p][[2]] - LT2[g[[i]]][[2]];If[Select[h1, #1 < 0 &] == {},
gg=PolyList[ListPoly[{irekae[Prepend[h1,0],PolyList[ListPoly[{g[[i]]},
valueorder],
Prepend[valueorder,x]][[1]]]},Prepend[valueorder,x]],valueorder][[1]];
h2 = LT2[p][[1]]/(LT2[gg][[1]]);
a = ReplacePart[a, Polymono2[a[[i]], {h2, h1}], i]; 
While[gg =!= {}, p = Polymono2[p, 
{-h2*LT2[gg][[1]],h1 + LT2[gg][[2]]}];
gg = Polymono2[gg, {-LT2[gg][[1]], LT2[gg][[2]]}]]; c = False,i = i + 1]];
If[c, r = Polymono2[r, LT2[p]];
p = Polymono2[p, {-LT2[p][[1]], LT2[p][[2]]}]]]; {a, r}];
S2[f_, g_] := S[f,g]=
Module[{fs,gs,mf, mg, s, c, a, b, aa, bb,fss,gss}, 
fs=DenoCancel[f];gs=DenoCancel[g];
mf = LT2[fs][[2]];mg = LT2[gs][[2]]; 
s = Length[mf]; c = {};
Do[c = Append[c, Max[{mf[[i]], mg[[i]]}]], {i, 1, s}];
a = c - mf; aa=Prepend[a,0];
b = c - mg; bb=Prepend[b,0];
fs=Table[{ListPoly[{irekae[aa,PolyList[{fs[[i]][[1]]},
{x,y,t}][[1]]]},{x,y,t}][[1]],fs[[i]][[2]]+a},{i,1,Length[fs]}];
gs=Table[{ListPoly[{irekae[bb,PolyList[{gs[[i]][[1]]},
{x,y,t}][[1]]]},{x,y,t}][[1]],gs[[i]][[2]]+b},{i,1,Length[gs]}];
fss=Table[{Expand[Simplify[LT2[gs][[1]]*fs[[i]][[1]]]],fs[[i]][[2]]},
{i,1,Length[fs]}];
gss=Table[{Expand[Simplify[LT2[fs][[1]]*gs[[i]][[1]]]],gs[[i]][[2]]},
{i,1,Length[gs]}];
Do[fss=Polymono2[fss,{-gss[[i]][[1]],gss[[i]][[2]]}],{i,1,Length[gss]}];fss];
Groeb3[F_] :=Groeb3[F] =Module[{s, B, G, t, ss, k, S},s = Length[F];B = {};
Do[Do[B = Append[B, {i, j}], {j, i + 1, s}], {i, 1, s - 1}]; 
G = Table[DenoCancel[F[[i]]],{i,1,Length[F]}]; t = s;
ss = Length[F[[1]][[1]][[2]]];While[B =!= {}, k = B[[1]];
S = DenoCancel[PolyDiv2[DenoCancel[S2[G[[k[[1]]]], G[[k[[2]]]]]], G][[2]]];
If[S =!= {}, t = t + 1; 
G = Append[G, S];Do[B = Append[B, {tt, t}], {tt, 1, t - 1}]]; 
B = Delete[B, 1]];G];
MinGroeb[F_] :=MinGroeb[F] =
Module[{G, s, a, h},G = Groeb3[F]; s = Length[G];Do[Do[
If[i =!= j && G[[j]] =!= a && G[[i]] =!= a,
h = LT2[G[[i]]][[2]] - LT2[G[[j]]][[2]];If[Select[h, #1 < 0 &] == {},
G = ReplacePart[G, a, i]]]; j = j + 1, {j, s}];i = i + 1, {i, s}];
G = DeleteCases[G, a]];
RedGroeb[F_] :=RedGroeb[F] =
Module[{G, s, k}, G = MinGroeb[F]; s = Length[G];
Do[k = DenoCancel[PolyDiv2[G[[j]], 
Delete[G, j]][[2]]];G = ReplacePart[G, k, j], {j, s}];G];
Expand[Simplify[ListPoly[RedGroeb[PolyList[generator,valueorder]],
valueorder]]]]



NCIdealRepr[polynomial_, generator_, valueorder_] :=
   Module[{monoorder, LT2, ListPoly, PolyList, Polymono2, sig, PolyPlus, 
   PolyTimes, PolyDiv2, S2, Groeb3, fmc, gmc, lenlen, datedate, ans, qp, 
   kake, tashi, kotae}, 
　(* 単項式順序を総次数逆辞書式に設定 *)　
　monoorder = grevlex;
   「まずここで単項式順序を総次数逆辞書式に設定する.プログラムについては     
　 NCPolyDiv内の初めの４つのIf文の３つ目を参照のこと」;
　(* 入力された多項式の組をリスト表示に変換する関数 *)
　PolyList[F_, val_] :=「省略: NCPolyDiv内のPolyListを参照のこと」;
　(* リスト表示の多項式の組を多項式に変換する関数 *)
　ListPoly[F_, val_] :=「省略: NCPolyDiv内のListPolyを参照のこと」;
　(* リスト表示の多項式にリスト表示の項を加える関数 *)
　Polymono2[f_, m_] :=「省略: NCPolyDiv内のPolymono2を参照のこと」;
　(* 2つのリスト表示の項をかけたときの sig を計算する関数 *)
　sig[le_, ri_] :=「省略: NCPolyDiv内のsigを参照のこと」;
　(* リスト表示の多項式において左除法定理を計算する関数 *)
   (* リスト表示の多項式の加法を計算する関数 *)
   PolyPlus[f_, g_] := 
　  Module[{k, ff}, 
       k = Length[g]; 
       ff = f; 
       Do[ff = Polymono2[ff, g[[i]]], {i, 1, k}]; 
       ff]; 
　 (* リスト表示の多項式の乗法を計算する関数 *)
　PolyTimes[f_, g_] := 
     Module[{k, ff, q}, 
       If[f == {} || g == {}, 
         {}, 
         m = Length[f]; 
         k = Length[g]; 
         ff[i_] := Table[
           {sig[f[[i]][[2]], g[[kk]][[2]]]*f[[i]][[1]]*g[[kk]][[1]], 
           f[[i]][[2]] + g[[kk]][[2]]}, {kk, 1, k}]; 
         q = {}; 
         Do[q = PolyPlus[q, ff[ii]], {ii, 1, m}]; 
         q]];
　(* リスト表示の多項式において左除法定理を計算する関数 *)
　PolyDiv2[f_, g_] :=「省略: NCPolyDiv内のPolyDiv2を参照のこと」;
　(* リスト表示の多項式の左S多項式を計算する関数 *)
　S2[f_, g_] := 「省略: NCGroebner内のS2を参照のこと」;
　(* リスト表示の多項式の組の左Groebner基底を計算する関数
　    (注: NCGroebner内のものとは違う) *)
　Groeb3[F_] :=Groeb3[F] =
     Module[{s, B, G, t, ss, k, S4, S, S3},
        s = Length[F];
        B = {};
        Do[Do[B = Append[B, {i, j}], {j, i + 1, s}], {i, 1, s - 1}]; 
        G = F; 
        t = s;
        ss = Length[F[[1]][[1]][[2]]];
        While[B =!= {}, 
          k = B[[1]];
          S4 = PolyDiv2[S2[G[[k[[1]]]], G[[k[[2]]]]], G];
          S = S4[[2]]; 
          S3 = S4[[1]]; 
          Do[
            If[S3[[i]] =!= {}, 
              S3 = ReplacePart[S3, 
                Table[{-S3[[i]][[j]][[1]], S3[[i]][[j]][[2]]}, 
                  {j, 1, Length[S3[[i]]]}], i]], {i, 1, Length[S4[[1]]]}]; 
          S3 = ReplacePart[S3, Polymono2[S3[[B[[1]][[1]]]], fmc], B[[1]][[1]]]; 
          S3 = ReplacePart[S3, Polymono2[S3[[B[[1]][[2]]]], gmc], B[[1]][[2]]];
          If[S =!= {}, 
            t = t + 1; 
            G = Append[G, S]; 
            datedate = Append[datedate, S3];
            Do[B = Append[B, {tt, t}], {tt, 1, t - 1}]]; 
          B = Delete[B, 1]]; 
        G];
　(* 実際に計算 *)
   lenlen = Length[generator]; 
   datedate = Table[{}, {lenlen}]; 
   datedate = Table[datedate, {lenlen}]; 
   Do[datedate = ReplacePart[datedate, 
     ReplacePart[Table[{}, {lenlen}], {{1, Table[0, {Length[valueorder]}]}}, i], i],{i, 1, lenlen}]; 
   ans = Expand[Simplify[ListPoly[Groeb3[PolyList[generator,
     valueorder]], valueorder]]]; 
   Do[
     Do[datedate = ReplacePart[datedate, 
       Join[Table[PolyPlus[PolyTimes[datedate[[i]][[k]], datedate[[j]][[i]]], 
         datedate[[j]][[k]]], {k, 1, lenlen}], 
         Table[datedate[[j]][[p]], {p, lenlen + 1, j - 1}]], j], 
       {j, i + 1, Length[ans]}], {i, lenlen + 1, Length[ans] - 1}]; 
   Do[datedate = ReplacePart[datedate, 
     Delete[datedate[[i]], Table[{j}, {j, lenlen + 1, i - 1}]], i], 
     {i, lenlen + 2, Length[ans]}]; 
   qp = PolyDiv2[PolyList[{polynomial}, valueorder][[1]], 
     PolyList[ans, valueorder]]; 
   If[qp[[2]] =!= {}, 
     False, 
     kotae = Table[kake = Table[PolyTimes[qp[[1]][[j]], datedate[[j]][[i]]], 
       {j, 1, Length[ans]}]; 
       tashi = {}; 
       Do[tashi = PolyPlus[tashi, kake[[j]]], {j, 1, Length[ans]}]; 
       tashi, {i, 1, lenlen}];
     Expand[Simplify[ListPoly[kotae, valueorder]]]]]
     
     
     
     
ExtNCInt[f_,g_]:=Module[{gr,s},gr=ExtNCGroebner[{t*f,(1-t)*g},
{{0,1},{1,1},{1,0},{0,1}},{y,t}];s=Length[gr];
Do[If[MemberQ[Variables[gr[[i]]],t],gr=ReplacePart[gr,iranai,i]],{i,1,s}];
gr=DeleteCases[gr,iranai]]




NCInt[f_,g_]:=Module[{gr,s},gr=NCGroebner[{t*f,(1-t)*g},
{{0,0,1},{1,1,1},{1,1,0},{0,1,1},{1,0,1}},{x,y,t}];s=Length[gr];
Do[If[MemberQ[Variables[gr[[i]]],t],gr=ReplacePart[gr,iranai,i]],{i,1,s}];
gr=DeleteCases[gr,iranai];If[Length[gr]==3,gr=NCGroebner[gr,lex,{x,y,t}]];
If[Exponent[gr[[1]],y]<Exponent[gr[[2]],y],{gr[[2]],gr[[1]]},gr]]




ExtNCPolyDiv[polynomial_, generator_, monoorder_, valueorder_] := 
Module[{irekae,DenoCancel,LT2, ListPoly, PolyList, Polymono2, sig, PolyDiv2, 
popo},
irekae[m_,f_]:=Module[{s,ff},s=Length[f];
ff=Table[{sig[m,f[[i]][[2]]]*f[[i]][[1]],f[[i]][[2]]},{i,1,s}];ff]; 
DenoCancel[ff_]:=Module[{s,fff},s=Length[ff];Table[fff=Together[ff[[i]]];
fff=fff*Denominator[fff];fff,{i,1,s}]];
If[monoorder == lex,LT2[f_] :=LT2[f] = Module[{s, lt, a},s = Length[f]; 
lt = f[[1]];Do[If[DeleteCases[lt[[2]] - f[[a]][[2]], 0][[1]] < 0, 
lt = f[[a]]], {a,2,s}]; lt]];If[monoorder == grlex,LT2[f_] :=LT2[f] = 
Module[{s, lt, t, sum1, sum2, a}, s = Length[f]; lt = f[[1]];
t = Length[lt[[2]]];Do[sum1 = Sum[lt[[2]][[i]], {i, t}];
sum2 = Sum[f[[a]][[2]][[i]], {i, t}];If[sum1 < sum2, lt = f[[a]],
If[sum1 == sum2,If[DeleteCases[lt[[2]] - f[[a]][[2]], 0][[1]] < 0,
lt = f[[a]]]]], {a, 2, s}]; lt]];If[monoorder == grevlex,LT2[f_] :=LT2[f] = 
Module[{s, lt, t, sum1, sum2, a}, s = Length[f]; lt = f[[1]];
t = Length[lt[[2]]];Do[sum1 = Sum[lt[[2]][[i]], {i, t}];
sum2 = Sum[f[[a]][[2]][[i]], {i, t}];If[sum1 < sum2, lt = f[[a]],
If[sum1 == sum2,If[DeleteCases[lt[[2]] - f[[a]][[2]], 0][[-1]] > 0,
t = f[[a]]]]], {a, 2, s}]; lt]]; 
If[monoorder =!= lex && monoorder =!= grlex && monoorder =!= grevlex,
LT2[f_] :=LT2[f] = Module[{s, lt, t, c, j}, s = Length[f]; lt = f[[1]];
t = Length[monoorder];Do[c = False; j  = 1;While[c == False,
If[monoorder[[j]].lt[[2]] =!= monoorder[[j]].f[[i]][[2]],c = True; 
If[monoorder[[j]].lt[[2]] < monoorder[[j]].f[[i]][[2]],lt = f[[i]]]]; 
j = j + 1], {i, 2, s}]; lt]];PolyList[F_, val_] :=Module[{s, PolyListone},
PolyListone[f_, v_] :=PolyListone[f, v] = 
Module[{getcoeff, MonomialList, aa, bb, kkk, tta, cce, ii, dc}, 
getcoeff[m_, b_] := getcoeff[m, b] = Module[{a, c},If[Variables[m] =!= {}, 
a = Exponent[m, b]; c = Times @@ (b^a);If[c =!= 1, 
{Coefficient[m, Times @@ (b^a)], a}, {m, a}], {m,Table[0, {Length[b]}]}]]; 
MonomialList[aiueo_] := Module[{sasisuseso, full}, 
kakikukeko = Expand[aiueo] + sasisuseso; full = FullForm[kakikukeko]; 
DeleteCases[Table[full[[1]][[iii]], {iii, 1, Length[full[[1]]]}],sasisuseso]]; 
aa = MonomialList[f];bb = Length[aa]; 
tta = Table[getcoeff[aa[[i]], v], {i, 1, bb}]; cce = True; Do[ii = j + 1; 
cce = True; While[cce, If[tta[[j]][[2]] == tta[[ii]][[2]], cce = False; 
tta = ReplacePart[tta, {tta[[ii]][[1]] + tta[[j]][[1]],tta[[ii]][[2]]},ii]; 
tta = ReplacePart[tta, True, j]];If[ii == Length[tta], cce = False, 
ii = ii + 1]], {j, 1, Length[tta] - 1}];dc = DeleteCases[tta, True]; 
Table[{Expand[Simplify[dc[[iii]][[1]]]], dc[[iii]][[2]]}, 
{iii, 1, Length[dc]}]];s = Length[F]; Table[PolyListone[F[[i]], val], {i, s}]];
ListPoly[F_, val_] :=ListPoly[F, val] =Module[{ListPolyone, s, FF},
ListPolyone[f_, v_] :=ListPolyone[f, v] =Module[{s, ss}, s = Length[f]; 
ss = Length[v];Sum[f[[i]][[1]]*Product[v[[j]]^(f[[i]][[2]][[j]]), {j, 1, ss}], 
{i, 1, s}]];s = Length[F]; FF = {};
Do[FF = Append[FF, ListPolyone[F[[i]], val]], {i, s}];FF];
Polymono2[f_, m_] :=Polymono2[f, m] =Module[{ff, fgfg, s, c, a}, ff = f; 
s = Length[ff];If[s == 0, ff = {m}, c = True; a = 1;While[c, 
If[DeleteCases[m[[2]] - ff[[a]][[2]], 0] == {}, 
fgfg = Expand[Simplify[Together[ff[[a]][[1]] + m[[1]]]]];
ff = ReplacePart[ff, {fgfg, m[[2]]}, a];If[ff[[a]][[1]] == 0,
ff = Delete[ff, a]]; c = False, a = a + 1];If[a == s + 1, ff = Append[ff, m]; 
c = False]]]; ff];sig[le_, ri_] :=Module[{s},s = Length[le] - 1; 
q^(Sum[Sum[le[[b]], {b, a + 1, s}]*ri[[a]], {a, 1, s - 1}])];
PolyDiv2[f_, g_] :=PolyDiv2[f, g] =Module[{s, a, r, p, i, c, h1, h2}, 
s = Length[g]; a = {}; Do[a = Append[a, {}], {s}];r = {}; p = f;
While[p =!= {}, i = 1; c = True;While[i <= s && c, 
h1 = LT2[p][[2]] - LT2[g[[i]]][[2]];If[Select[h1, #1 < 0 &] == {},
gg=PolyList[ListPoly[{irekae[Prepend[h1,0],PolyList[ListPoly[{g[[i]]},
valueorder],
Prepend[valueorder,x]][[1]]]},Prepend[valueorder,x]],valueorder][[1]];
h2 = LT2[p][[1]]/(LT2[gg][[1]]);
a = ReplacePart[a, Polymono2[a[[i]], {h2, h1}], i]; 
While[gg =!= {}, p = Polymono2[p, 
{-h2*LT2[gg][[1]],h1 + LT2[gg][[2]]}];
gg = Polymono2[gg, {-LT2[gg][[1]], LT2[gg][[2]]}]]; c = False,i = i + 1]];
If[c, r = Polymono2[r, LT2[p]];
p = Polymono2[p, {-LT2[p][[1]], LT2[p][[2]]}]]]; {a, r}];
popo = PolyDiv2[PolyList[{DenoCancel[{polynomial}][[1]]}, valueorder][[1]], 
PolyList[DenoCancel[generator], valueorder]]; 
Expand[Simplify[{ListPoly[popo[[1]], 
valueorder], ListPoly[{popo[[2]]}, valueorder][[1]]}]]]




NCPolyDiv[polynomial_, generator_, monoorder_, valueorder_] := 
Module[{LT2, ListPoly, PolyList, Polymono2, sig, PolyDiv2, popo}, 
If[monoorder == lex,LT2[f_] :=LT2[f] = Module[{s, lt, a},s = Length[f]; 
lt = f[[1]];Do[If[DeleteCases[lt[[2]] - f[[a]][[2]], 0][[1]] < 0, 
lt = f[[a]]], {a,2,s}]; lt]];If[monoorder == grlex,LT2[f_] :=LT2[f] = 
Module[{s, lt, t, sum1, sum2, a}, s = Length[f]; lt = f[[1]];
t = Length[lt[[2]]];Do[sum1 = Sum[lt[[2]][[i]], {i, t}];
sum2 = Sum[f[[a]][[2]][[i]], {i, t}];If[sum1 < sum2, lt = f[[a]],
If[sum1 == sum2,If[DeleteCases[lt[[2]] - f[[a]][[2]], 0][[1]] < 0,
lt = f[[a]]]]], {a, 2, s}]; lt]];If[monoorder == grevlex,LT2[f_] :=LT2[f] = 
Module[{s, lt, t, sum1, sum2, a}, s = Length[f]; lt = f[[1]];
t = Length[lt[[2]]];Do[sum1 = Sum[lt[[2]][[i]], {i, t}];
sum2 = Sum[f[[a]][[2]][[i]], {i, t}];If[sum1 < sum2, lt = f[[a]],
If[sum1 == sum2,If[DeleteCases[lt[[2]] - f[[a]][[2]], 0][[-1]] > 0,
t = f[[a]]]]], {a, 2, s}]; lt]]; 
If[monoorder =!= lex && monoorder =!= grlex && monoorder =!= grevlex,
LT2[f_] :=LT2[f] = Module[{s, lt, t, c, j}, s = Length[f]; lt = f[[1]];
t = Length[monoorder];Do[c = False; j  = 1;While[c == False,
If[monoorder[[j]].lt[[2]] =!= monoorder[[j]].f[[i]][[2]],c = True; 
If[monoorder[[j]].lt[[2]] < monoorder[[j]].f[[i]][[2]],lt = f[[i]]]]; 
j = j + 1], {i, 2, s}]; lt]];PolyList[F_, val_] :=Module[{s, PolyListone},
PolyListone[f_, v_] :=PolyListone[f, v] = 
Module[{getcoeff, MonomialList, aa, bb, kkk, tta, cce, ii, dc}, 
getcoeff[m_, b_] := getcoeff[m, b] = Module[{a, c},If[Variables[m] =!= {}, 
a = Exponent[m, b]; c = Times @@ (b^a);If[c =!= 1, 
{Coefficient[m, Times @@ (b^a)], a}, {m, a}], {m,Table[0, {Length[b]}]}]]; 
MonomialList[aiueo_] := Module[{sasisuseso, full}, 
kakikukeko = Expand[aiueo] + sasisuseso; full = FullForm[kakikukeko]; 
DeleteCases[Table[full[[1]][[iii]], {iii, 1, Length[full[[1]]]}],sasisuseso]]; 
aa = MonomialList[f];bb = Length[aa]; 
tta = Table[getcoeff[aa[[i]], v], {i, 1, bb}]; cce = True; Do[ii = j + 1; 
cce = True; While[cce, If[tta[[j]][[2]] == tta[[ii]][[2]], cce = False; 
tta = ReplacePart[tta, {tta[[ii]][[1]] + tta[[j]][[1]],tta[[ii]][[2]]},ii]; 
tta = ReplacePart[tta, True, j]];If[ii == Length[tta], cce = False, 
ii = ii + 1]], {j, 1, Length[tta] - 1}];dc = DeleteCases[tta, True]; 
Table[{Expand[Simplify[dc[[iii]][[1]]]], dc[[iii]][[2]]}, 
{iii, 1, Length[dc]}]];s = Length[F]; Table[PolyListone[F[[i]], val], {i, s}]];
ListPoly[F_, val_] :=ListPoly[F, val] =Module[{ListPolyone, s, FF},
ListPolyone[f_, v_] :=ListPolyone[f, v] =Module[{s, ss}, s = Length[f]; 
ss = Length[v];Sum[f[[i]][[1]]*Product[v[[j]]^(f[[i]][[2]][[j]]), {j, 1, ss}], 
{i, 1, s}]];s = Length[F]; FF = {};
Do[FF = Append[FF, ListPolyone[F[[i]], val]], {i, s}];FF];
Polymono2[f_, m_] :=Polymono2[f, m] =Module[{ff, fgfg, s, c, a}, ff = f; 
s = Length[ff];If[s == 0, ff = {m}, c = True; a = 1;While[c, 
If[DeleteCases[m[[2]] - ff[[a]][[2]], 0] == {}, 
fgfg = Expand[Simplify[Together[ff[[a]][[1]] + m[[1]]]]];
ff = ReplacePart[ff, {fgfg, m[[2]]}, a];If[ff[[a]][[1]] == 0,
ff = Delete[ff, a]]; c = False, a = a + 1];If[a == s + 1, ff = Append[ff, m]; 
c = False]]]; ff];sig[le_, ri_] :=Module[{s},s = Length[le] - 1; 
q^(Sum[Sum[le[[b]], {b, a + 1, s}]*ri[[a]], {a, 1, s - 1}])];
PolyDiv2[f_, g_] :=PolyDiv2[f, g] =Module[{s, a, r, p, i, c, h1, h2}, 
s = Length[g]; a = {}; Do[a = Append[a, {}], {s}];r = {}; p = f;
While[p =!= {}, i = 1; c = True;While[i <= s && c, 
h1 = LT2[p][[2]] - LT2[g[[i]]][[2]];If[Select[h1, #1 < 0 &] == {},
h2 = LT2[p][[1]]/(sig[h1, LT2[g[[i]]][[2]]]*LT2[g[[i]]][[1]]);
a = ReplacePart[a, Polymono2[a[[i]], {h2, h1}], i]; gg = g[[i]];
While[gg =!= {}, p = Polymono2[p, 
{-sig[h1, LT2[gg][[2]]]*h2*LT2[gg][[1]],h1 + LT2[gg][[2]]}];
gg = Polymono2[gg, {-LT2[gg][[1]], LT2[gg][[2]]}]]; c = False,i = i + 1]];
If[c, r = Polymono2[r, LT2[p]];
p = Polymono2[p, {-LT2[p][[1]], LT2[p][[2]]}]]]; {a, r}];
popo = PolyDiv2[PolyList[{polynomial}, valueorder][[1]], 
PolyList[generator, valueorder]]; Expand[Simplify[{ListPoly[popo[[1]], 
valueorder], ListPoly[{popo[[2]]}, valueorder][[1]]}]]]




ListPoly[F_, val_] :=ListPoly[F, val] =Module[{ListPolyone, s, FF},
ListPolyone[f_, v_] :=ListPolyone[f, v] =Module[{s, ss}, s = Length[f]; 
ss = Length[v];Sum[f[[i]][[1]]*Product[v[[j]]^(f[[i]][[2]][[j]]), {j, 1, ss}], 
{i, 1, s}]];s = Length[F]; FF = {};
Do[FF = Append[FF, ListPolyone[F[[i]], val]], {i, s}];FF];
Polymono2[f_, m_] :=Polymono2[f, m] =Module[{ff, fgfg, s, c, a}, ff = f; 
s = Length[ff];If[s == 0, ff = {m}, c = True; a = 1;While[c, 
If[DeleteCases[m[[2]] - ff[[a]][[2]], 0] == {}, 
fgfg = Expand[Simplify[Together[ff[[a]][[1]] + m[[1]]]]];
ff = ReplacePart[ff, {fgfg, m[[2]]}, a];If[ff[[a]][[1]] == 0,
ff = Delete[ff, a]]; c = False, a = a + 1];If[a == s + 1, ff = Append[ff, m]; 
c = False]]]; ff]




SimpleCoe[fgfg_]:=Module[{PolyList,ListPoly,DenoCancel,Pgcd,fffff,cs,pg},
PolyList[F_, val_] :=Module[{s, PolyListone},
PolyListone[f_, v_] :=PolyListone[f, v] = 
Module[{getcoeff, MonomialList, aa, bb, kkk, tta, cce, ii, dc}, 
getcoeff[m_, b_] := getcoeff[m, b] = Module[{a, c},If[Variables[m] =!= {}, 
a = Exponent[m, b]; c = Times @@ (b^a);If[c =!= 1, 
{Coefficient[m, Times @@ (b^a)], a}, {m, a}], {m,Table[0, {Length[b]}]}]]; 
MonomialList[aiueo_] := Module[{sasisuseso, full}, 
kakikukeko = Expand[aiueo] + sasisuseso; full = FullForm[kakikukeko]; 
DeleteCases[Table[full[[1]][[iii]], {iii, 1, Length[full[[1]]]}],sasisuseso]]; 
aa = MonomialList[f];bb = Length[aa]; 
tta = Table[getcoeff[aa[[i]], v], {i, 1, bb}]; cce = True; Do[ii = j + 1; 
cce = True; While[cce, If[tta[[j]][[2]] == tta[[ii]][[2]], cce = False; 
tta = ReplacePart[tta, {tta[[ii]][[1]] + tta[[j]][[1]],tta[[ii]][[2]]},ii]; 
tta = ReplacePart[tta, True, j]];If[ii == Length[tta], cce = False, 
ii = ii + 1]], {j, 1, Length[tta] - 1}];dc = DeleteCases[tta, True]; 
Table[{Expand[Simplify[dc[[iii]][[1]]]], dc[[iii]][[2]]}, 
{iii, 1, Length[dc]}]];s = Length[F]; Table[PolyListone[F[[i]], val], {i, s}]];
ListPoly[F_, val_] :=ListPoly[F, val] =Module[{ListPolyone, s, FF},
ListPolyone[f_, v_] :=ListPolyone[f, v] =Module[{s, ss}, s = Length[f]; 
ss = Length[v];Sum[f[[i]][[1]]*Product[v[[j]]^(f[[i]][[2]][[j]]), {j, 1, ss}], 
{i, 1, s}]];s = Length[F]; FF = {};
Do[FF = Append[FF, ListPolyone[F[[i]], val]], {i, s}];FF];
Polymono2[f_, m_] :=Polymono2[f, m] =Module[{ff, fgfg, s, c, a}, ff = f; 
s = Length[ff];If[s == 0, ff = {m}, c = True; a = 1;While[c, 
If[DeleteCases[m[[2]] - ff[[a]][[2]], 0] == {}, 
fgfg = Expand[Simplify[Together[ff[[a]][[1]] + m[[1]]]]];
ff = ReplacePart[ff, {fgfg, m[[2]]}, a];If[ff[[a]][[1]] == 0,
ff = Delete[ff, a]]; c = False, a = a + 1];If[a == s + 1, ff = Append[ff, m]; 
c = False]]]; ff];
DenoCancel[ff_]:=Module[{s,bunbo,fff},
s=Length[ff];
bunbo=Table[Denominator[Together[ff[[i]][[1]]]],{i,1,s}];
If[bunbo=={},fff=1,fff=bunbo[[1]];
Do[fff=PolynomialLCM[fff,bunbo[[i]]],{i,2,s}]];
Table[{Expand[Simplify[fff*ff[[i]][[1]]]],ff[[i]][[2]]},{i,1,s}]];
Pgcd[flist_]:=Module[{st,zz},st=Length[flist];
zz=flist[[1]];
Do[zz=PolynomialGCD[zz,flist[[i]]],{i,2,st}];zz];
fffff=PolyList[{fgfg},{y,t}][[1]];fffff=DenoCancel[fffff];
fffff=ListPoly[{fffff},{y,t}][[1]];
cs=CoefficientList[fffff,y];pg=Pgcd[cs];
fffff=Expand[Simplify[fffff/pg]];
Collect[fffff,y]]