/* $OpenXM: OpenXM/src/k097/lib/minimal/minimal.k,v 1.2 2000/05/03 07:50:38 takayama Exp $ */ #define DEBUG 1 /* #define ORDINARY 1 */ /* Test sequences. Use load["minimal.k"];; a=Sminimal(v); b=a[0]; b[1]*b[0]: b[2]*b[1]: a = test0(); b = a[0]; b[1]*b[0]: b[2]*b[1]: a = Sminimal(b[0]); a = test1(); b=a[0]; b[1]*b[0]: b[2]*b[1]: */ load("cohom.k"); def load_tower() { if (Boundp("k0-tower.sm1.loaded")) { }else{ sm1(" [(parse) (k0-tower.sm1) pushfile ] extension "); sm1(" /k0-tower.sm1.loaded 1 def "); } } load_tower(); SonAutoReduce = true; def Factor(f) { sm1(f, " fctr /FunctionValue set"); } def Reverse(f) { sm1(f," reverse /FunctionValue set"); } def Sgroebner(f) { sm1(" [f] groebner /FunctionValue set"); } def test0() { local f; Sweyl("x,y,z"); f = [x^2+y^2+z^2, x*y+x*z+y*z, x*z^2+y*z^2, y^3-x^2*z - x*y*z+y*z^2, -y^2*z^2 + x*z^3 + y*z^3, -z^4]; frame=SresolutionFrame(f); Println(frame); /* return(frame); */ return(SlaScala(f)); } def test1() { local f; Sweyl("x,y,z"); f = [x^2+y^2+z^2, x*y+x*z+y*z, x*z^2+y*z^2, y^3-x^2*z - x*y*z+y*z^2, -y^2*z^2 + x*z^3 + y*z^3, -z^4]; return(Sminimal(f)); } def Sweyl(v,w) { /* extern WeightOfSweyl ; */ local ww,i,n; if(Length(Arglist) == 1) { sm1(" [v s_ring_of_differential_operators 0 [(schreyer) 1]] define_ring "); sm1(" define_ring_variables "); sm1(" [ v to_records pop ] /ww set "); n = Length(ww); WeightOfSweyl = NewArray(n*4); for (i=0; i< n; i++) { WeightOfSweyl[2*i] = ww[i]; WeightOfSweyl[2*i+1] = 1; } for (i=0; i< n; i++) { WeightOfSweyl[2*n+2*i] = AddString(["D",ww[i]]); WeightOfSweyl[2*n+2*i+1] = 1; } }else{ sm1(" [v s_ring_of_differential_operators w s_weight_vector 0 [(schreyer) 1]] define_ring "); sm1(" define_ring_variables "); WeightOfSweyl = w[0]; } } def Spoly(f) { sm1(f, " toString tparse /FunctionValue set "); } def SreplaceZeroByZeroPoly(f) { if (IsArray(f)) { return(Map(f,"SreplaceZeroByZeroPoly")); }else{ if (IsInteger(f)) { return(Poly(ToString(f))); }else{ return(f); } } } def Shomogenize(f) { f = SreplaceZeroByZeroPoly(f); if (IsArray(f)) { sm1(f," sHomogenize2 /FunctionValue set "); /* sm1(f," {sHomogenize2} map /FunctionValue set "); */ /* Is it correct? Double check.*/ }else{ sm1(f, " sHomogenize /FunctionValue set "); } } def StoTower() { sm1(" [(AvoidTheSameRing)] pushEnv [ [(AvoidTheSameRing) 0] system_variable (mmLarger) (tower) switch_function ] pop popEnv "); } def SsetTower(tower) { sm1(" [(AvoidTheSameRing)] pushEnv [ [(AvoidTheSameRing) 0] system_variable [(gbListTower) tower (list) dc] system_variable ] pop popEnv "); } def SresolutionFrameWithTower(g,opt) { local gbTower, ans, ff, count, startingGB, opts, skelton,withSkel, autof, gbasis; if (Length(Arglist) >= 2) { if (IsInteger(opt)) count = opt; }else{ count = -1; } sm1(" setupEnvForResolution "); /* If I do not put this macro, homogenization make a strange behavior. For example, [(2*x*Dx + 3*y*Dy+6) (0)] homogenize returns [(2*x*Dx*h + 3*y*Dy*h+6*h^3) (0)]. 4/19, 2000. */ sm1(" (mmLarger) (matrix) switch_function "); g = Map(g,"Shomogenize"); if (SonAutoReduce) { sm1("[ (AutoReduce) ] system_variable /autof set "); sm1("[ (AutoReduce) 1 ] system_variable "); } gbasis = Sgroebner(g); g = gbasis[0]; if (SonAutoReduce) { sm1("[ (AutoReduce) autof] system_variable "); } g = Init(g); /* sm1(" setupEnvForResolution-sugar "); */ /* -sugar is fine? */ sm1(" setupEnvForResolution "); Println(g); startingGB = g; /* ans = [ SzeroMap(g) ]; It has not been implemented. see resol1.withZeroMap */ ans = [ ]; gbTower = [ ]; skelton = [ ]; while (true) { /* sm1(g," res0Frame /ff set "); */ withSkel = Sres0FrameWithSkelton(g); ff = withSkel[0]; ans = Append(ans, ff[0]); gbTower = Join([ ff[1] ], gbTower); skelton = Join([ withSkel[1] ], skelton); g = ff[0]; if (Length(g) == 0) break; SsetTower( gbTower ); if (count == 0) break; count = count - 1; } return([ans,Reverse(gbTower),Join([ [ ] ], Reverse(skelton)),gbasis]); } HelpAdd(["SresolutionFrameWithTower", ["It returs [resolution of the initial, gbTower, skelton, gbasis]", "Example: Sweyl(\"x,y\");", " a=SresolutionFrameWithTower([x^3,x*y,y^3-1]);"]]); def SresolutionFrame(f,opt) { local ans; ans = SresolutionFrameWithTower(f); return(ans[0]); } /* ---------------------------- */ def ToGradedPolySet(g) { sm1(g," (gradedPolySet) dc /FunctionValue set "); } def NewPolynomialVector(size) { sm1(size," (integer) dc newPolyVector /FunctionValue set "); } def SturnOffHomogenization() { sm1(" [(Homogenize)] system_variable 1 eq { (Warning: Homogenization and ReduceLowerTerms options are automatically turned off.) message [(Homogenize) 0] system_variable [(ReduceLowerTerms) 0] system_variable } { } ifelse "); } def SturnOnHomogenization() { sm1(" [(Homogenize)] system_variable 0 eq { (Warning: Homogenization and ReduceLowerTerms options are automatically turned ON.) message [(Homogenize) 1] system_variable [(ReduceLowerTerms) 1] system_variable } { } ifelse "); } def SschreyerSkelton(g) { sm1(" [(schreyerSkelton) g] gbext /FunctionValue set "); } def Stoes(g) { if (IsArray(g)) { sm1(g," {toes} map /FunctionValue set "); }else{ sm1(g," toes /FunctionValue set "); } } def Stoes_vec(g) { sm1(g," toes /FunctionValue set "); } def Sres0Frame(g) { local ans; ans = Sres0FrameWithSkelton(g); return(ans[0]); } def Sres0FrameWithSkelton(g) { local t_syz, nexttower, m, t_gb, skel, betti, gg, k, i, j, pair, tmp, si, sj, grG, syzAll, gLength; SturnOffHomogenization(); g = Stoes(g); skel = SschreyerSkelton(g); /* Print("Skelton is "); sm1_pmat(skel); */ betti = Length(skel); gLength = Length(g); grG = ToGradedPolySet(g); syzAll = NewPolynomialVector(betti); for (k=0; k ans) ans = tt; }else{ if (a[i] > ans) ans = a[i]; } } }else{ if (a > ans) ans = a; } return(ans); } def SlaScala(g) { local rf, tower, reductionTable, skel, redundantTable, bases, strategy, maxOfStrategy, height, level, n, i, freeRes,place, f, reducer,pos, redundant_seq,bettiTable,freeResV,ww, redundantTable_ordinary, redundant_seq_ordinary; /* extern WeightOfSweyl; */ ww = WeightOfSweyl; Print("WeghtOfSweyl="); Println(WeightOfSweyl); rf = SresolutionFrameWithTower(g); redundant_seq = 1; redundant_seq_ordinary = 1; tower = rf[1]; reductionTable = SgenerateTable(tower); skel = rf[2]; redundantTable = SnewArrayOfFormat(rf[1]); redundantTable_ordinary = SnewArrayOfFormat(rf[1]); reducer = SnewArrayOfFormat(rf[1]); freeRes = SnewArrayOfFormat(rf[1]); bettiTable = SsetBettiTable(rf[1],g); strategy = SminOfStrategy( reductionTable ); maxOfStrategy = SmaxOfStrategy( reductionTable ); height = Length(reductionTable); while (strategy <= maxOfStrategy) { for (level = 0; level < height; level++) { n = Length(reductionTable[level]); for (i=0; i f[5]) { /* Zero in the gr-module */ Print("v-degree of [org,remainder] = "); Println([f[4],f[5]]); Print("[level,i] = "); Println([level,i]); redundantTable[level-1,place] = 0; }else{ redundantTable[level-1,place] = redundant_seq; redundant_seq++; } #endif redundantTable_ordinary[level-1,place] =redundant_seq_ordinary; redundant_seq_ordinary++; bases[i] = SunitOfFormat(place,f[1])-f[1]; /* syzygy */ redundantTable[level,i] = 0; redundantTable_ordinary[level,i] = 0; /* i must be equal to f[2], I think. Double check. */ freeRes[level] = bases; bases = freeRes[level-1]; bases[place] = f[0]; freeRes[level-1] = bases; reducer[level-1,place] = f[1]; }else{ redundantTable[level,i] = 0; bases = freeRes[level]; bases[i] = f[1]; /* Put the syzygy. */ freeRes[level] = bases; } } } /* end of level >= 1 */ } } } strategy++; } n = Length(freeRes); freeResV = SnewArrayOfFormat(freeRes); for (i=0; i= 1 in SpairAndReduction."); p = skel[level,ii]; myindex = p[0]; i = myindex[0]; j = myindex[1]; bases = freeRes[level-1]; Println(["p and bases ",p,bases]); if (IsNull(bases[i]) || IsNull(bases[j])) { Println([level,i,j,bases[i],bases[j]]); Error("level, i, j : bases[i], bases[j] must not be NULL."); } tower2 = StowerOf(tower,level-1); SsetTower(tower2); /** sm1(" show_ring "); */ gi = Stoes_vec(bases[i]); gj = Stoes_vec(bases[j]); ssp = Sspolynomial(gi,gj); si = ssp[0,0]; sj = ssp[0,1]; syzHead = si*es^i; /* This will be the head term, I think. But, double check. */ Println([si*es^i,sj*es^j]); Print("[gi, gj] = "); Println([gi,gj]); sm1(" [(Homogenize)] system_variable message "); Print("Reduce the element "); Println(si*gi+sj*gj); Print("by "); Println(bases); tmp = Sreduction(si*gi+sj*gj, bases); Print("result is "); Println(tmp); vdeg = SvDegree(si*gi+sj*gj,tower,level-1,ww); vdeg_reduced = SvDegree(tmp[0],tower,level-1,ww); Print("vdegree of the original = "); Println(vdeg); Print("vdegree of the remainder = "); Println(vdeg_reduced); t_syz = tmp[2]; si = si*tmp[1]+t_syz[i]; sj = sj*tmp[1]+t_syz[j]; t_syz[i] = si; t_syz[j] = sj; pos = SwhereInTower(syzHead,tower[level]); pos2 = SwhereInTower(tmp[0],tower[level-1]); ans = [tmp[0],t_syz,pos,pos2,vdeg,vdeg_reduced]; /* pos is the place to put syzygy at level. */ /* pos2 is the place to put a new GB at level-1. */ Println(ans); return(ans); } def Sreduction(f,myset) { local n, indexTable, set2, i, j, tmp, t_syz; n = Length(myset); indexTable = NewArray(n); set2 = [ ]; j = 0; for (i=0; i 0 && size == -1) { if (size == -1) { sm1(f," (array) dc /ans set"); return(ans); } } /* Coefficients(x^2-1,x): [ [ 2 , 0 ] , [ 1 , -1 ] ] */ if (Degree(f,myee) > 0) { c = Coefficients(f,myee); }else{ c = Coefficients(f,myes); } if (size < 0) { size = c[0,0]+1; } ans = NewArray(size); for (i=0; i 1) { giveSize = true; }else{ giveSize = false; } n = Length(bases); newbases = NewArray(n); for (i=0; i 1) { seq--; for (level = 0; level < maxLevel; level++) { betti = Length(freeRes[level]); for (q = 0; q ans) { ans = bases[i]; } } } } return(ans); } def Stetris(freeRes,redundantTable) { local level, i, j, resLength, minRes, bases, newbases, newbases2; minRes = SnewArrayOfFormat(freeRes); resLength = Length( freeRes ); for (level=0; level 0) { /* Delete columns */ newbases = Transpose(bases); betti = Length(newbases); j = 0; newbases2 = SnewArrayOfFormat(newbases); for (i=0; i The betti numbers are 3, 2. a=Sannfs2("x^3-y^2-x"); : it causes an error. It should be fixed. */