[BACK]Return to minimal.k CVS log [TXT][DIR] Up to [local] / OpenXM / src / k097 / lib / minimal

Annotation of OpenXM/src/k097/lib/minimal/minimal.k, Revision 1.20

1.20    ! takayama    1: /* $OpenXM: OpenXM/src/k097/lib/minimal/minimal.k,v 1.19 2000/07/31 01:21:41 takayama Exp $ */
1.1       takayama    2: #define DEBUG 1
1.19      takayama    3: Sordinary = false;
1.4       takayama    4: /* If you run this program on openxm version 1.1.2 (FreeBSD),
                      5:    make a symbolic link by the command
                      6:    ln -s /usr/bin/cpp /lib/cpp
                      7: */
1.6       takayama    8: #define OFFSET 0
                      9: /* #define OFFSET 20*/
1.1       takayama   10: /* Test sequences.
                     11:    Use load["minimal.k"];;
                     12:
                     13:    a=Sminimal(v);
                     14:    b=a[0];
                     15:    b[1]*b[0]:
                     16:    b[2]*b[1]:
                     17:
                     18:    a = test0();
                     19:    b = a[0];
                     20:    b[1]*b[0]:
                     21:    b[2]*b[1]:
                     22:    a = Sminimal(b[0]);
                     23:
                     24:    a = test1();
                     25:    b=a[0];
                     26:    b[1]*b[0]:
                     27:    b[2]*b[1]:
                     28:
                     29: */
                     30:
                     31:
                     32: load("cohom.k");
                     33: def load_tower() {
                     34:   if (Boundp("k0-tower.sm1.loaded")) {
                     35:   }else{
                     36:     sm1(" [(parse) (k0-tower.sm1) pushfile ] extension ");
                     37:     sm1(" /k0-tower.sm1.loaded 1 def ");
                     38:   }
1.7       takayama   39:   sm1(" oxNoX ");
1.1       takayama   40: }
                     41: load_tower();
                     42: SonAutoReduce = true;
                     43: def Factor(f) {
                     44:    sm1(f, " fctr /FunctionValue set");
                     45: }
                     46: def Reverse(f) {
                     47:    sm1(f," reverse /FunctionValue set");
                     48: }
                     49: def Sgroebner(f) {
                     50:    sm1(" [f] groebner /FunctionValue set");
                     51: }
1.19      takayama   52:
                     53:
                     54: def Error(s) {
                     55:   sm1(" s error ");
                     56: }
                     57:
                     58: def IsNull(s) {
                     59:   if (Stag(s) == 0) return(true);
                     60:   else return(false);
                     61: }
                     62:
                     63: def MonomialPart(f) {
                     64:   sm1(" [(lmonom) f] gbext /FunctionValue set ");
                     65: }
                     66:
                     67: def Warning(s) {
                     68:   Print("Warning: ");
                     69:   Println(s);
                     70: }
                     71: def RingOf(f) {
                     72:   local r;
                     73:   if (IsPolynomial(f)) {
                     74:     if (f != Poly("0")) {
                     75:       sm1(f," (ring) dc /r set ");
                     76:     }else{
                     77:       sm1(" [(CurrentRingp)] system_variable /r set ");
                     78:     }
                     79:   }else{
                     80:     Warning("RingOf(f): the argument f must be a polynomial. Return the current ring.");
                     81:     sm1(" [(CurrentRingp)] system_variable /r set ");
                     82:   }
                     83:   return(r);
                     84: }
                     85:
                     86: /*  End of standard functions that should be moved to standard libraries. */
1.1       takayama   87: def test0() {
                     88:   local f;
                     89:   Sweyl("x,y,z");
                     90:   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,
                     91:        -y^2*z^2 + x*z^3 + y*z^3, -z^4];
                     92:   frame=SresolutionFrame(f);
                     93:   Println(frame);
                     94:   /* return(frame); */
                     95:   return(SlaScala(f));
                     96: }
                     97: def test1() {
                     98:   local f;
                     99:   Sweyl("x,y,z");
                    100:   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,
                    101:        -y^2*z^2 + x*z^3 + y*z^3, -z^4];
                    102:   return(Sminimal(f));
                    103: }
                    104:
                    105:
                    106:
                    107: def Sweyl(v,w) {
                    108:   /* extern WeightOfSweyl ; */
                    109:   local ww,i,n;
                    110:   if(Length(Arglist) == 1) {
                    111:     sm1(" [v s_ring_of_differential_operators 0 [(schreyer) 1]] define_ring ");
                    112:     sm1(" define_ring_variables ");
                    113:
                    114:     sm1(" [ v to_records pop ] /ww set ");
                    115:     n = Length(ww);
                    116:     WeightOfSweyl = NewArray(n*4);
                    117:     for (i=0; i< n; i++) {
                    118:       WeightOfSweyl[2*i] = ww[i];
                    119:       WeightOfSweyl[2*i+1] = 1;
                    120:     }
                    121:     for (i=0; i< n; i++) {
                    122:       WeightOfSweyl[2*n+2*i] = AddString(["D",ww[i]]);
                    123:       WeightOfSweyl[2*n+2*i+1] = 1;
                    124:     }
                    125:
                    126:   }else{
                    127:     sm1(" [v s_ring_of_differential_operators w s_weight_vector 0 [(schreyer) 1]] define_ring ");
                    128:     sm1(" define_ring_variables ");
                    129:     WeightOfSweyl = w[0];
                    130:   }
                    131: }
                    132:
                    133:
                    134: def Spoly(f) {
                    135:   sm1(f, " toString tparse /FunctionValue set ");
                    136: }
                    137:
                    138: def SreplaceZeroByZeroPoly(f) {
                    139:   if (IsArray(f)) {
                    140:      return(Map(f,"SreplaceZeroByZeroPoly"));
                    141:   }else{
                    142:      if (IsInteger(f)) {
                    143:        return(Poly(ToString(f)));
                    144:      }else{
                    145:        return(f);
                    146:      }
                    147:   }
                    148: }
                    149: def Shomogenize(f) {
                    150:   f = SreplaceZeroByZeroPoly(f);
                    151:   if (IsArray(f)) {
                    152:     sm1(f," sHomogenize2  /FunctionValue set ");
                    153:     /* sm1(f," {sHomogenize2} map  /FunctionValue set ");  */
                    154:     /* Is it correct? Double check.*/
                    155:   }else{
                    156:     sm1(f, " sHomogenize /FunctionValue set ");
                    157:   }
                    158: }
                    159:
                    160: def StoTower() {
                    161:   sm1("  [(AvoidTheSameRing)] pushEnv [ [(AvoidTheSameRing) 0] system_variable (mmLarger) (tower) switch_function ] pop popEnv ");
                    162: }
                    163:
                    164: def SsetTower(tower) {
                    165: sm1(" [(AvoidTheSameRing)] pushEnv
                    166:       [ [(AvoidTheSameRing) 0] system_variable
                    167:         [(gbListTower) tower (list) dc] system_variable
                    168:       ] pop popEnv ");
1.14      takayama  169:       /* sm1("(hoge) message show_ring "); */
1.1       takayama  170: }
                    171:
                    172: def SresolutionFrameWithTower(g,opt) {
                    173:   local gbTower, ans, ff, count, startingGB, opts, skelton,withSkel, autof,
1.19      takayama  174:         gbasis, nohomog,i,n;
                    175:   /* extern Sordinary */
1.15      takayama  176:   nohomog = false;
1.19      takayama  177:   count = -1;  Sordinary = false; /* default value for options. */
1.1       takayama  178:   if (Length(Arglist) >= 2) {
1.19      takayama  179:     if (IsArray(opt)) {
                    180:       n = Length(opt);
                    181:       for (i=0; i<n; i++) {
                    182:         if (IsInteger(opt[i])) {
                    183:           count = opt[i];
                    184:         }
                    185:         if (IsString(opt[i])) {
                    186:           if (opt[i] == "homogenized") {
                    187:             nohomog = true;
                    188:           }else if (opt[i] == "Sordinary") {
                    189:             Sordinary = true;
                    190:           }else{
                    191:             Println("Warning: unknown option");
                    192:             Println(opt);
                    193:           }
                    194:         }
1.15      takayama  195:       }
1.19      takayama  196:     }else{
                    197:       Println("Warning: option should be given by an array.");
1.15      takayama  198:     }
1.1       takayama  199:   }
                    200:
                    201:   sm1(" setupEnvForResolution ");
                    202:   /* If I do not put this macro, homogenization
                    203:      make a strange behavior. For example,
                    204:      [(2*x*Dx + 3*y*Dy+6) (0)] homogenize returns
                    205:      [(2*x*Dx*h + 3*y*Dy*h+6*h^3) (0)].
                    206:      4/19, 2000.
                    207:   */
                    208:
                    209:   sm1(" (mmLarger) (matrix) switch_function ");
1.15      takayama  210:   if (! nohomog) {
                    211:     Println("Automatic homogenization.");
                    212:     g = Map(g,"Shomogenize");
                    213:   }else{
                    214:     Println("No automatic homogenization.");
                    215:   }
1.1       takayama  216:   if (SonAutoReduce) {
                    217:     sm1("[ (AutoReduce) ] system_variable /autof set ");
                    218:     sm1("[ (AutoReduce) 1 ] system_variable ");
                    219:   }
                    220:   gbasis = Sgroebner(g);
                    221:   g = gbasis[0];
                    222:   if (SonAutoReduce) {
                    223:     sm1("[ (AutoReduce) autof] system_variable  ");
                    224:   }
                    225:
                    226:   g = Init(g);
                    227:
                    228: /*  sm1(" setupEnvForResolution-sugar "); */
                    229:   /* -sugar is fine? */
                    230:   sm1(" setupEnvForResolution ");
                    231:
                    232:   Println(g);
                    233:   startingGB = g;
                    234:   /* ans = [ SzeroMap(g) ];  It has not been implemented. see resol1.withZeroMap */
                    235:   ans = [ ];
                    236:   gbTower = [ ];
                    237:   skelton = [ ];
                    238:   while (true) {
                    239:     /* sm1(g," res0Frame /ff set "); */
                    240:     withSkel = Sres0FrameWithSkelton(g);
                    241:     ff = withSkel[0];
                    242:     ans = Append(ans, ff[0]);
                    243:     gbTower = Join([ ff[1] ], gbTower);
                    244:     skelton = Join([ withSkel[1] ], skelton);
                    245:     g = ff[0];
                    246:     if (Length(g) == 0) break;
                    247:     SsetTower( gbTower );
                    248:     if (count == 0) break;
                    249:     count = count - 1;
                    250:   }
                    251:   return([ans,Reverse(gbTower),Join([ [ ] ], Reverse(skelton)),gbasis]);
                    252: }
                    253: HelpAdd(["SresolutionFrameWithTower",
                    254: ["It returs [resolution of the initial, gbTower, skelton, gbasis]",
1.15      takayama  255:  "option: \"homogenized\" (no automatic homogenization) ",
1.1       takayama  256:  "Example: Sweyl(\"x,y\");",
                    257:  "         a=SresolutionFrameWithTower([x^3,x*y,y^3-1]);"]]);
                    258:
                    259: def SresolutionFrame(f,opt) {
                    260:   local ans;
1.15      takayama  261:   ans = SresolutionFrameWithTower(f,opt);
1.1       takayama  262:   return(ans[0]);
                    263: }
                    264: /* ---------------------------- */
                    265: def ToGradedPolySet(g) {
                    266:   sm1(g," (gradedPolySet) dc /FunctionValue set ");
                    267: }
                    268:
                    269: def NewPolynomialVector(size) {
                    270:   sm1(size," (integer) dc newPolyVector /FunctionValue set ");
                    271: }
                    272:
                    273: def  SturnOffHomogenization() {
                    274:   sm1("
                    275:     [(Homogenize)] system_variable 1 eq
                    276:     { (Warning: Homogenization and ReduceLowerTerms options are automatically turned off.) message
                    277:       [(Homogenize) 0] system_variable
                    278:       [(ReduceLowerTerms) 0] system_variable
                    279:     } {  } ifelse
                    280:   ");
                    281: }
                    282: def  SturnOnHomogenization() {
                    283:   sm1("
                    284:     [(Homogenize)] system_variable 0 eq
                    285:     { (Warning: Homogenization and ReduceLowerTerms options are automatically turned ON.) message
                    286:       [(Homogenize) 1] system_variable
                    287:       [(ReduceLowerTerms) 1] system_variable
                    288:     } {  } ifelse
                    289:   ");
                    290: }
                    291:
                    292: def SschreyerSkelton(g) {
                    293:   sm1(" [(schreyerSkelton) g] gbext /FunctionValue set ");
                    294: }
                    295: def Stoes(g) {
                    296:   if (IsArray(g)) {
                    297:     sm1(g," {toes} map /FunctionValue set ");
                    298:   }else{
                    299:     sm1(g," toes /FunctionValue set ");
                    300:   }
                    301: }
                    302: def Stoes_vec(g) {
                    303:     sm1(g," toes /FunctionValue set ");
                    304: }
                    305:
                    306: def Sres0Frame(g) {
                    307:   local ans;
                    308:   ans = Sres0FrameWithSkelton(g);
                    309:   return(ans[0]);
                    310: }
                    311: def Sres0FrameWithSkelton(g) {
                    312:   local t_syz, nexttower, m, t_gb, skel, betti,
                    313:         gg, k, i, j, pair, tmp, si, sj, grG, syzAll, gLength;
                    314:
                    315:   SturnOffHomogenization();
                    316:
                    317:   g = Stoes(g);
                    318:   skel = SschreyerSkelton(g);
                    319:   /* Print("Skelton is ");
                    320:   sm1_pmat(skel); */
                    321:   betti = Length(skel);
                    322:
                    323:   gLength = Length(g);
                    324:   grG = ToGradedPolySet(g);
                    325:   syzAll = NewPolynomialVector(betti);
                    326:   for (k=0; k<betti; k++) {
                    327:     pair = skel[k];
                    328:     i = pair[0,0];
                    329:     j = pair[0,1];
                    330:     si = pair[1,0];
                    331:     sj = pair[1,1];
                    332:     /* si g[i] + sj g[j] + \sum tmp[2][k] g[k] = 0 in res0 */
                    333:     Print(".");
                    334:
                    335:     t_syz = NewPolynomialVector(gLength);
                    336:     t_syz[i] = si;
                    337:     t_syz[j] = sj;
                    338:     syzAll[k] = t_syz;
                    339:   }
                    340:   t_syz = syzAll;
                    341:   Print("Done. betti="); Println(betti);
                    342:   /* Println(g);  g is in a format such as
                    343:     [e_*x^2 , e_*x*y , 2*x*Dx*h , ...]
                    344:     [e_*x^2 , e_*x*y , 2*x*Dx*h , ...]
                    345:     [y-es*x , 3*es^4*y*Dy-es^5*x , 3*es^5*y*Dy-es^6*x , ...]
                    346:     [3*es^3*y*Dy-es^5*x ]
                    347:   */
                    348:   nexttower = Init(g);
                    349:   SturnOnHomogenization();
                    350:   return([[t_syz, nexttower],skel]);
                    351: }
                    352:
                    353:
                    354: def StotalDegree(f) {
1.14      takayama  355:   local d0;
                    356:   sm1(" [(grade) f] gbext (universalNumber) dc /d0 set ");
                    357:   /* Print("degree of "); Print(f); Print(" is "); Println(d0); */
                    358:   return(d0);
1.1       takayama  359: }
                    360:
1.20    ! takayama  361: HelpAdd(["Sord_w",
        !           362: ["Sord_w(f,w) returns the w-order of f",
        !           363:  "Example: Sord_w(x^2*Dx*Dy,[x,-1,Dx,1]):"]]);
1.1       takayama  364: /* Sord_w(x^2*Dx*Dy,[x,-1,Dx,1]); */
                    365: def Sord_w(f,w) {
                    366:   local neww,i,n;
                    367:   n = Length(w);
                    368:   neww = NewArray(n);
                    369:   for (i=0; i<n; i=i+2) {
                    370:     neww[i] = ToString(w[i]);
                    371:   }
                    372:   for (i=1; i<n; i=i+2) {
                    373:     neww[i] = IntegerToSm1Integer(w[i]);
                    374:   }
                    375:   sm1(" f neww ord_w (universalNumber) dc /FunctionValue set ");
                    376: }
                    377:
                    378:
                    379: /* This is not satisfactory. */
                    380: def SinitOfArray(f) {
                    381:   local p,pos,top;
                    382:   if (IsArray(f)) {
                    383:      sm1(f," toes init /p set ");
                    384:      sm1(p," (es). degree (universalNumber) dc /pos set ");
                    385:      return([Init(f[pos]),pos]);
                    386:   } else {
                    387:      return(Init(f));
                    388:   }
                    389: }
                    390:
                    391: def test_SinitOfArray() {
                    392:   local f, frame,p,tower,i,j,k;
                    393:   Sweyl("x,y,z");
                    394:   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,
                    395:        -y^2*z^2 + x*z^3 + y*z^3, -z^4];
                    396:   p=SresolutionFrameWithTower(f);
                    397:   sm1_pmat(p);
                    398:   sm1_pmat(SgenerateTable(p[1]));
                    399:   return(p);
                    400:   frame = p[0];
                    401:   sm1_pmat(p[1]);
                    402:   sm1_pmat(frame);
                    403:   sm1_pmat(Map(frame[0],"SinitOfArray"));
                    404:   sm1_pmat(Map(frame[1],"SinitOfArray"));
                    405:   return(p);
                    406: }
                    407:
                    408: /* f is assumed to be a monomial with toes. */
                    409: def Sdegree(f,tower,level) {
1.6       takayama  410:   local i,ww, wd;
                    411:   /* extern WeightOfSweyl; */
                    412:   ww = WeightOfSweyl;
1.5       takayama  413:   f = Init(f);
1.1       takayama  414:   if (level <= 1) return(StotalDegree(f));
                    415:   i = Degree(f,es);
1.6       takayama  416:   return(StotalDegree(f)+Sdegree(tower[level-2,i],tower,level-1));
                    417:
1.1       takayama  418: }
                    419:
                    420: def SgenerateTable(tower) {
                    421:   local height, n,i,j, ans, ans_at_each_floor;
1.16      takayama  422:
                    423:   /*
                    424:   Print("SgenerateTable: tower=");Println(tower);
                    425:   sm1(" print_switch_status "); */
1.1       takayama  426:   height = Length(tower);
                    427:   ans = NewArray(height);
                    428:   for (i=0; i<height; i++) {
                    429:     n = Length(tower[i]);
                    430:     ans_at_each_floor=NewArray(n);
                    431:     for (j=0; j<n; j++) {
1.6       takayama  432:       ans_at_each_floor[j] = Sdegree(tower[i,j],tower,i+1)-(i+1)
                    433:                             + OFFSET;
1.1       takayama  434:       /* Println([i,j,ans_at_each_floor[j]]); */
                    435:     }
                    436:     ans[i] = ans_at_each_floor;
                    437:   }
                    438:   return(ans);
                    439: }
                    440: Sweyl("x,y,z");
                    441: v=[[2*x*Dx + 3*y*Dy+6, 0],
                    442:    [3*x^2*Dy + 2*y*Dx, 0],
                    443:    [0,  x^2+y^2],
                    444:    [0,  x*y]];
                    445: /*  SresolutionFrameWithTower(v); */
                    446:
                    447: def SnewArrayOfFormat(p) {
                    448:   if (IsArray(p)) {
                    449:      return(Map(p,"SnewArrayOfFormat"));
                    450:   }else{
                    451:      return(null);
                    452:   }
                    453: }
1.4       takayama  454: def ScopyArray(a) {
                    455:   local n, i,ans;
                    456:   n = Length(a);
                    457:   ans = NewArray(n);
                    458:   for (i=0; i<n; i++) {
                    459:     ans[i] = a[i];
                    460:   }
                    461:   return(ans);
                    462: }
1.1       takayama  463: def SminOfStrategy(a) {
                    464:   local n,i,ans,tt;
                    465:   ans = 100000; /* very big number */
                    466:   if (IsArray(a)) {
                    467:     n = Length(a);
                    468:     for (i=0; i<n; i++) {
                    469:       if (IsArray(a[i])) {
                    470:         tt = SminOfStrategy(a[i]);
                    471:         if (tt < ans) ans = tt;
                    472:       }else{
                    473:         if (a[i] < ans) ans = a[i];
                    474:       }
                    475:     }
                    476:   }else{
                    477:      if (a < ans) ans = a;
                    478:   }
                    479:   return(ans);
                    480: }
                    481: def SmaxOfStrategy(a) {
                    482:   local n,i,ans,tt;
                    483:   ans = -100000; /* very small number */
                    484:   if (IsArray(a)) {
                    485:     n = Length(a);
                    486:     for (i=0; i<n; i++) {
                    487:       if (IsArray(a[i])) {
                    488:         tt = SmaxOfStrategy(a[i]);
                    489:         if (tt > ans) ans = tt;
                    490:       }else{
                    491:         if (a[i] > ans) ans = a[i];
                    492:       }
                    493:     }
                    494:   }else{
                    495:      if (a > ans) ans = a;
                    496:   }
                    497:   return(ans);
                    498: }
                    499:
                    500:
1.15      takayama  501: def SlaScala(g,opt) {
1.1       takayama  502:   local rf, tower, reductionTable, skel, redundantTable, bases,
                    503:         strategy, maxOfStrategy, height, level, n, i,
                    504:         freeRes,place, f, reducer,pos, redundant_seq,bettiTable,freeResV,ww,
1.4       takayama  505:         redundantTable_ordinary, redundant_seq_ordinary,
                    506:         reductionTable_tmp;
1.1       takayama  507:   /* extern WeightOfSweyl; */
                    508:   ww = WeightOfSweyl;
1.6       takayama  509:   Print("WeightOfSweyl="); Println(WeightOfSweyl);
1.15      takayama  510:   rf = SresolutionFrameWithTower(g,opt);
1.14      takayama  511:   Print("rf="); sm1_pmat(rf);
1.1       takayama  512:   redundant_seq = 1;   redundant_seq_ordinary = 1;
                    513:   tower = rf[1];
1.16      takayama  514:
                    515:   Println("Generating reduction table which gives an order of reduction.");
                    516:   Print("WeghtOfSweyl="); Println(WeightOfSweyl);
                    517:   Print("tower"); Println(tower);
1.1       takayama  518:   reductionTable = SgenerateTable(tower);
1.16      takayama  519:   Print("reductionTable="); sm1_pmat(reductionTable);
                    520:
1.1       takayama  521:   skel = rf[2];
                    522:   redundantTable = SnewArrayOfFormat(rf[1]);
                    523:   redundantTable_ordinary = SnewArrayOfFormat(rf[1]);
                    524:   reducer = SnewArrayOfFormat(rf[1]);
                    525:   freeRes = SnewArrayOfFormat(rf[1]);
                    526:   bettiTable = SsetBettiTable(rf[1],g);
                    527:
                    528:   strategy = SminOfStrategy( reductionTable );
                    529:   maxOfStrategy = SmaxOfStrategy( reductionTable );
                    530:   height = Length(reductionTable);
                    531:   while (strategy <= maxOfStrategy) {
                    532:     for (level = 0; level < height; level++) {
                    533:       n = Length(reductionTable[level]);
1.4       takayama  534:       reductionTable_tmp = ScopyArray(reductionTable[level]);
                    535:       while (SthereIs(reductionTable_tmp,strategy)) {
                    536:         i = SnextI(reductionTable_tmp,strategy,redundantTable,
                    537:                    skel,level,freeRes);
                    538:         Println([level,i]);
                    539:         reductionTable_tmp[i] = -200000;
1.1       takayama  540:         if (reductionTable[level,i] == strategy) {
1.16      takayama  541:            Print("Processing [level,i]= "); Print([level,i]);
1.1       takayama  542:            Print("   Strategy = "); Println(strategy);
                    543:            if (level == 0) {
                    544:              if (IsNull(redundantTable[level,i])) {
                    545:                bases = freeRes[level];
                    546:                /* Println(["At floor : GB=",i,bases,tower[0,i]]); */
                    547:                pos = SwhereInGB(tower[0,i],rf[3,0]);
                    548:                bases[i] = rf[3,0,pos];
                    549:                redundantTable[level,i] = 0;
                    550:                redundantTable_ordinary[level,i] = 0;
                    551:                freeRes[level] = bases;
                    552:                /* Println(["GB=",i,bases,tower[0,i]]); */
                    553:              }
                    554:            }else{ /* level >= 1 */
                    555:              if (IsNull(redundantTable[level,i])) {
                    556:                bases = freeRes[level];
                    557:                f = SpairAndReduction(skel,level,i,freeRes,tower,ww);
                    558:                if (f[0] != Poly("0")) {
                    559:                   place = f[3];
                    560:                   /* (level-1, place) is the place for f[0],
                    561:                      which is a newly obtained  GB. */
1.19      takayama  562: if (Sordinary) {
1.1       takayama  563:                   redundantTable[level-1,place] = redundant_seq;
                    564:                   redundant_seq++;
1.19      takayama  565: }else{
1.1       takayama  566:                   if (f[4] > f[5]) {
                    567:                     /* Zero in the gr-module */
                    568:                     Print("v-degree of [org,remainder] = ");
                    569:                     Println([f[4],f[5]]);
                    570:                     Print("[level,i] = "); Println([level,i]);
                    571:                     redundantTable[level-1,place] = 0;
                    572:                   }else{
                    573:                     redundantTable[level-1,place] = redundant_seq;
                    574:                     redundant_seq++;
                    575:                   }
1.19      takayama  576: }
1.1       takayama  577:                   redundantTable_ordinary[level-1,place]
                    578:                      =redundant_seq_ordinary;
                    579:                   redundant_seq_ordinary++;
                    580:                   bases[i] = SunitOfFormat(place,f[1])-f[1];  /* syzygy */
                    581:                   redundantTable[level,i] = 0;
                    582:                   redundantTable_ordinary[level,i] = 0;
                    583:                   /* i must be equal to f[2], I think. Double check. */
                    584:                   freeRes[level] = bases;
                    585:                   bases = freeRes[level-1];
                    586:                   bases[place] = f[0];
                    587:                   freeRes[level-1] = bases;
                    588:                   reducer[level-1,place] = f[1];
                    589:                }else{
                    590:                   redundantTable[level,i] = 0;
                    591:                   bases = freeRes[level];
                    592:                   bases[i] = f[1];  /* Put the syzygy. */
                    593:                   freeRes[level] = bases;
                    594:                }
                    595:              }
                    596:            } /* end of level >= 1 */
                    597:         }
                    598:       }
                    599:     }
                    600:     strategy++;
                    601:   }
                    602:   n = Length(freeRes);
                    603:   freeResV = SnewArrayOfFormat(freeRes);
                    604:   for (i=0; i<n; i++) {
                    605:     bases = freeRes[i];
                    606:     bases = Sbases_to_vec(bases,bettiTable[i]);
                    607:     freeResV[i] = bases;
                    608:   }
1.17      takayama  609:   return([freeResV, redundantTable,reducer,bettiTable,redundantTable_ordinary,rf]);
1.1       takayama  610: }
1.4       takayama  611:
                    612: def SthereIs(reductionTable_tmp,strategy) {
                    613:   local n,i;
                    614:   n = Length(reductionTable_tmp);
                    615:   for (i=0; i<n; i++) {
                    616:     if (reductionTable_tmp[i] == strategy) {
                    617:       return(true);
                    618:     }
                    619:   }
                    620:   return(false);
                    621: }
                    622:
                    623: def SnextI(reductionTable_tmp,strategy,redundantTable,
                    624:                                   skel,level,freeRes)
                    625: {
                    626:    local ii,n,p,myindex,i,j,bases;
                    627:    n = Length(reductionTable_tmp);
                    628:    if (level == 0) {
                    629:      for (ii=0; ii<n; ii++) {
                    630:        if (reductionTable_tmp[ii] == strategy) {
                    631:           return(ii);
                    632:         }
                    633:       }
                    634:    }else{
                    635:      for (ii=0; ii<n; ii++) {
                    636:        if (reductionTable_tmp[ii] == strategy) {
                    637:          p = skel[level,ii];
                    638:          myindex = p[0];
                    639:          i = myindex[0]; j = myindex[1];
                    640:          bases = freeRes[level-1];
                    641:          if (IsNull(bases[i]) || IsNull(bases[j])) {
                    642:
                    643:          }else{
                    644:            return(ii);
                    645:          }
                    646:        }
                    647:      }
                    648:    }
1.5       takayama  649:    Print("reductionTable_tmp=");
1.4       takayama  650:    Println(reductionTable_tmp);
1.5       takayama  651:    Println("See also reductionTable, strategy, level,i");
1.4       takayama  652:    Error("SnextI: bases[i] or bases[j] is null for all combinations.");
                    653: }
                    654:
                    655:
1.1       takayama  656:
                    657: def SsetBettiTable(freeRes,g) {
                    658:   local level,i, n,bases,ans;
                    659:   ans = NewArray(Length(freeRes)+1);
                    660:   n = Length(freeRes);
                    661:   if (IsArray(g[0])) {
                    662:     ans[0] = Length(g[0]);
                    663:   }else{
                    664:     ans[0] = 1;
                    665:   }
                    666:   for (level=0; level<n; level++) {
                    667:     bases = freeRes[level];
                    668:     if (IsArray(bases)) {
                    669:       ans[level+1] = Length(bases);
                    670:     }else{
                    671:       ans[level+1] = 1;
                    672:     }
                    673:   }
                    674:   return(ans);
                    675: }
                    676:
                    677: def SwhereInGB(f,tower) {
                    678:   local i,n,p,q;
                    679:   n = Length(tower);
                    680:   for (i=0; i<n; i++) {
                    681:     p = MonomialPart(tower[i]);
                    682:     q = MonomialPart(f);
                    683:     if (p == q) return(i);
                    684:   }
                    685:   Println([f,tower]);
                    686:   Error("whereInGB : [f,myset]: f could not be found in the myset.");
                    687: }
                    688: def SunitOfFormat(pos,forms) {
                    689:   local ans,i,n;
                    690:   n = Length(forms);
                    691:   ans = NewArray(n);
                    692:   for (i=0; i<n; i++) {
                    693:     if (i != pos) {
                    694:       ans[i] = Poly("0");
                    695:     }else{
                    696:       ans[i] = Poly("1");
                    697:     }
                    698:   }
                    699:   return(ans);
                    700: }
                    701:
                    702:
                    703: def StowerOf(tower,level) {
                    704:   local ans,i;
                    705:   ans = [ ];
                    706:   if (level == 0) return([[]]);
                    707:   for (i=0; i<level; i++) {
                    708:     ans = Append(ans,tower[i]);
                    709:   }
                    710:   return(Reverse(ans));
                    711: }
                    712:
                    713: def Sspolynomial(f,g) {
                    714:   if (IsArray(f)) {
                    715:     f = Stoes_vec(f);
                    716:   }
                    717:   if (IsArray(g)) {
                    718:     g = Stoes_vec(g);
                    719:   }
                    720:   sm1("f g spol /FunctionValue set");
                    721: }
                    722:
                    723:
1.14      takayama  724: /* WARNING:
                    725:   When you use SwhereInTower, you have to change gbList
                    726:   as below. Ofcourse, you should restrore the gbList
                    727:   SsetTower(StowerOf(tower,level));
                    728:   pos = SwhereInTower(syzHead,tower[level]);
                    729: */
1.1       takayama  730: def SwhereInTower(f,tower) {
                    731:   local i,n,p,q;
                    732:   if (f == Poly("0")) return(-1);
                    733:   n = Length(tower);
                    734:   for (i=0; i<n; i++) {
                    735:     p = MonomialPart(tower[i]);
                    736:     q = MonomialPart(f);
                    737:     if (p == q) return(i);
                    738:   }
                    739:   Println([f,tower]);
                    740:   Error("[f,tower]: f could not be found in the tower.");
                    741: }
                    742:
                    743: def Stag(f) {
                    744:   sm1(f," tag (universalNumber) dc /FunctionValue set");
                    745: }
                    746:
                    747: def SpairAndReduction(skel,level,ii,freeRes,tower,ww) {
                    748:   local i, j, myindex, p, bases, tower2, gi, gj,
                    749:        si, sj, tmp, t_syz, pos, ans, ssp, syzHead,pos2,
                    750:        vdeg,vdeg_reduced;
                    751:   Println("SpairAndReduction:");
                    752:
                    753:   if (level < 1) Error("level should be >= 1 in SpairAndReduction.");
                    754:   p = skel[level,ii];
                    755:   myindex = p[0];
                    756:   i = myindex[0]; j = myindex[1];
                    757:   bases = freeRes[level-1];
                    758:   Println(["p and bases ",p,bases]);
                    759:   if (IsNull(bases[i]) || IsNull(bases[j])) {
                    760:     Println([level,i,j,bases[i],bases[j]]);
                    761:     Error("level, i, j : bases[i], bases[j]  must not be NULL.");
                    762:   }
                    763:
                    764:   tower2 = StowerOf(tower,level-1);
                    765:   SsetTower(tower2);
1.14      takayama  766:   Println(["level=",level]);
                    767:   Println(["tower2=",tower2]);
1.1       takayama  768:   /** sm1(" show_ring ");   */
                    769:
                    770:   gi = Stoes_vec(bases[i]);
                    771:   gj = Stoes_vec(bases[j]);
                    772:
                    773:   ssp = Sspolynomial(gi,gj);
                    774:   si = ssp[0,0];
                    775:   sj = ssp[0,1];
                    776:   syzHead = si*es^i;
                    777:   /* This will be the head term, I think. But, double check. */
                    778:   Println([si*es^i,sj*es^j]);
                    779:
                    780:   Print("[gi, gj] = "); Println([gi,gj]);
                    781:   sm1(" [(Homogenize)] system_variable message ");
                    782:   Print("Reduce the element "); Println(si*gi+sj*gj);
                    783:   Print("by  "); Println(bases);
                    784:
                    785:   tmp = Sreduction(si*gi+sj*gj, bases);
                    786:
                    787:   Print("result is "); Println(tmp);
                    788:
1.3       takayama  789:   /* This is essential part for V-minimal resolution. */
                    790:   /* vdeg = SvDegree(si*gi+sj*gj,tower,level-1,ww); */
                    791:   vdeg = SvDegree(si*gi,tower,level-1,ww);
1.1       takayama  792:   vdeg_reduced = SvDegree(tmp[0],tower,level-1,ww);
                    793:   Print("vdegree of the original = "); Println(vdeg);
                    794:   Print("vdegree of the remainder = "); Println(vdeg_reduced);
                    795:
                    796:   t_syz = tmp[2];
                    797:   si = si*tmp[1]+t_syz[i];
                    798:   sj = sj*tmp[1]+t_syz[j];
                    799:   t_syz[i] = si;
                    800:   t_syz[j] = sj;
1.14      takayama  801:
                    802:   SsetTower(StowerOf(tower,level));
1.1       takayama  803:   pos = SwhereInTower(syzHead,tower[level]);
1.14      takayama  804:
                    805:   SsetTower(StowerOf(tower,level-1));
1.1       takayama  806:   pos2 = SwhereInTower(tmp[0],tower[level-1]);
                    807:   ans = [tmp[0],t_syz,pos,pos2,vdeg,vdeg_reduced];
                    808:   /* pos is the place to put syzygy at level. */
                    809:   /* pos2 is the place to put a new GB at level-1. */
                    810:   Println(ans);
                    811:   return(ans);
                    812: }
                    813:
                    814: def Sreduction(f,myset) {
                    815:   local n, indexTable, set2, i, j, tmp, t_syz;
                    816:   n = Length(myset);
                    817:   indexTable = NewArray(n);
                    818:   set2 = [ ];
                    819:   j = 0;
                    820:   for (i=0; i<n; i++) {
                    821:     if (IsNull(myset[i])) {
                    822:       indexTable[i] = -1;
                    823: /*    }else if (myset[i] == Poly("0")) {
                    824:       indexTable[i] = -1;  */
                    825:     }else{
                    826:       set2 = Append(set2,Stoes_vec(myset[i]));
                    827:       indexTable[i] = j;
                    828:       j++;
                    829:     }
                    830:   }
                    831:   sm1(" f toes set2 (gradedPolySet) dc reduction /tmp set ");
                    832:   t_syz = NewArray(n);
                    833:   for (i=0; i<n; i++) {
                    834:     if (indexTable[i] != -1) {
                    835:       t_syz[i] = tmp[2, indexTable[i]];
                    836:     }else{
                    837:       t_syz[i] = Poly("0");
                    838:     }
                    839:   }
                    840:   return([tmp[0],tmp[1],t_syz]);
                    841: }
                    842:
                    843:
                    844: def Sfrom_es(f,size) {
                    845:   local c,ans, i, d, myes, myee, j,n,r,ans2;
                    846:   if (Length(Arglist) < 2) size = -1;
                    847:   if (IsArray(f)) return(f);
                    848:   r = RingOf(f);
                    849:   myes = PolyR("es",r);
                    850:   myee = PolyR("e_",r);
                    851:   if (Degree(f,myee) > 0 && size == -1) {
                    852:     if (size == -1) {
                    853:        sm1(f," (array) dc /ans set");
                    854:        return(ans);
                    855:     }
                    856:   }
                    857:
                    858: /*
                    859:     Coefficients(x^2-1,x):
                    860:     [    [    2 , 0 ]  , [    1 , -1 ]  ]
                    861: */
                    862:   if (Degree(f,myee) > 0) {
                    863:     c = Coefficients(f,myee);
                    864:   }else{
                    865:     c = Coefficients(f,myes);
                    866:   }
                    867:   if (size < 0) {
                    868:     size = c[0,0]+1;
                    869:   }
                    870:   ans = NewArray(size);
                    871:   for (i=0; i<size; i++) {ans[i] = 0;}
                    872:   n = Length(c[0]);
                    873:   for (j=0; j<n; j++) {
                    874:     d = c[0,j];
                    875:     ans[d] = c[1,j];
                    876:   }
                    877:   return(ans);
                    878: }
                    879:
                    880: def Sbases_to_vec(bases,size) {
                    881:   local n, giveSize, newbases,i;
                    882:   /*  bases = [1+es*x, [1,2,3*x]] */
                    883:   if (Length(Arglist) > 1) {
                    884:     giveSize = true;
                    885:   }else{
                    886:     giveSize = false;
                    887:   }
                    888:   n = Length(bases);
                    889:   newbases = NewArray(n);
                    890:   for (i=0; i<n; i++) {
                    891:      if (giveSize) {
                    892:        newbases[i] = Sfrom_es(bases[i], size);
                    893:      }else{
                    894:        newbases[i] = Sfrom_es(bases[i]);
                    895:      }
                    896:   }
                    897:   return(newbases);
                    898: }
                    899:
1.14      takayama  900: HelpAdd(["Sminimal",
1.18      takayama  901: ["It constructs the V-minimal free resolution by LaScala's algorithm",
1.15      takayama  902:  "option: \"homogenized\" (no automatic homogenization ",
1.19      takayama  903:  "      : \"Sordinary\"   (no (u,v)-minimal resolution)",
                    904:  "Options should be given as an array.",
1.14      takayama  905:  "Example:  Sweyl(\"x,y\",[[\"x\",-1,\"y\",-1,\"Dx\",1,\"Dy\",1]]);",
                    906:  "          v=[[2*x*Dx + 3*y*Dy+6, 0],",
                    907:  "             [3*x^2*Dy + 2*y*Dx, 0],",
                    908:  "             [0,  x^2+y^2],",
                    909:  "             [0,  x*y]];",
                    910:  "         a=Sminimal(v);",
                    911:  "         Sweyl(\"x,y\",[[\"x\",-1,\"y\",-1,\"Dx\",1,\"Dy\",1]]);",
                    912:  "         b = ReParse(a[0]); sm1_pmat(b); ",
                    913:  "         IsExact_h(b,[x,y]):",
                    914:  "Note:  a[0] is the V-minimal resolution. a[3] is the Schreyer resolution."]]);
                    915:
1.15      takayama  916: def Sminimal(g,opt) {
1.1       takayama  917:   local r, freeRes, redundantTable, reducer, maxLevel,
                    918:         minRes, seq, maxSeq, level, betti, q, bases, dr,
1.14      takayama  919:         betti_levelplus, newbases, i, j,qq, tminRes;
1.16      takayama  920:   if (Length(Arglist) < 2) {
                    921:      opt = null;
                    922:   }
1.19      takayama  923:   /* Sordinary is set in SlaScala(g,opt) --> SresolutionFrameWithTower */
                    924:
1.16      takayama  925:   ScheckIfSchreyer("Sminimal:0");
1.15      takayama  926:   r = SlaScala(g,opt);
1.1       takayama  927:   /* Should I turn off the tower?? */
1.16      takayama  928:   ScheckIfSchreyer("Sminimal:1");
1.1       takayama  929:   freeRes = r[0];
                    930:   redundantTable = r[1];
                    931:   reducer = r[2];
                    932:   minRes = SnewArrayOfFormat(freeRes);
                    933:   seq = 0;
                    934:   maxSeq = SgetMaxSeq(redundantTable);
                    935:   maxLevel = Length(freeRes);
                    936:   for (level = 0; level < maxLevel; level++) {
                    937:     minRes[level] = freeRes[level];
                    938:   }
                    939:   seq=maxSeq+1;
                    940:   while (seq > 1) {
                    941:     seq--;
                    942:     for (level = 0; level < maxLevel; level++) {
                    943:       betti = Length(freeRes[level]);
                    944:       for (q = 0; q<betti; q++) {
                    945:         if (redundantTable[level,q] == seq) {
                    946:           Print("[seq,level,q]="); Println([seq,level,q]);
                    947:           if (level < maxLevel-1) {
                    948:             bases = freeRes[level+1];
                    949:             dr = reducer[level,q];
                    950:             dr[q] = -1;
                    951:             newbases = SnewArrayOfFormat(bases);
                    952:             betti_levelplus = Length(bases);
                    953:             /*
                    954:                bases[i,j] ---> bases[i,j]+bases[i,q]*dr[j]
                    955:             */
                    956:             for (i=0; i<betti_levelplus; i++) {
                    957:               newbases[i] = bases[i] + bases[i,q]*dr;
                    958:             }
                    959:             Println(["level, q =", level,q]);
                    960:             Println("bases="); sm1_pmat(bases);
                    961:             Println("dr="); sm1_pmat(dr);
                    962:             Println("newbases="); sm1_pmat(newbases);
                    963:             minRes[level+1] = newbases;
                    964:             freeRes = minRes;
                    965: #ifdef DEBUG
                    966:             for (qq=0; qq<betti; qq++) {
                    967:               if ((redundantTable[level,qq] >= seq) &&
                    968:                   (redundantTable[level,qq] <= maxSeq)) {
                    969:                 for (i=0; i<betti_levelplus; i++) {
                    970:                   if (!IsZero(newbases[i,qq])) {
                    971:                     Println(["[i,qq]=",[i,qq]," is not zero in newbases."]);
                    972:                     Print("redundantTable ="); sm1_pmat(redundantTable[level]);
                    973:                     Error("Stop in Sminimal for debugging.");
                    974:                   }
                    975:                 }
                    976:               }
                    977:             }
                    978: #endif
                    979:           }
                    980:         }
                    981:       }
                    982:     }
                    983:    }
1.14      takayama  984:    tminRes = Stetris(minRes,redundantTable);
                    985:    return([SpruneZeroRow(tminRes), tminRes,
1.17      takayama  986:           [ minRes, redundantTable, reducer,r[3],r[4]],r[0],r[5]]);
1.1       takayama  987:   /* r[4] is the redundantTable_ordinary */
1.3       takayama  988:   /* r[0] is the freeResolution */
1.17      takayama  989:   /* r[5] is the skelton */
1.1       takayama  990: }
                    991:
                    992:
                    993: def IsZero(f) {
                    994:   if (IsPolynomial(f)) {
                    995:     return( f == Poly("0"));
                    996:   }else if (IsInteger(f)) {
                    997:     return( f == 0);
                    998:   }else if (IsSm1Integer(f)) {
                    999:     return( f == true );
                   1000:   }else if (IsDouble(f)) {
                   1001:     return( f == 0.0 );
                   1002:   }else if (IsRational(f)) {
                   1003:     return(IsZero(Denominator(f)));
                   1004:   }else{
                   1005:     Error("IsZero: cannot deal with this data type.");
                   1006:   }
                   1007: }
                   1008: def SgetMaxSeq(redundantTable) {
                   1009:    local level,i,n,ans, levelMax,bases;
                   1010:    levelMax = Length( redundantTable );
                   1011:    ans = 0;
                   1012:    for (level = 0; level < levelMax; level++) {
                   1013:      bases = redundantTable[level];
                   1014:      n = Length(bases);
                   1015:      for (i=0; i<n; i++) {
                   1016:        if (IsInteger( bases[i] )) {
                   1017:           if (bases[i] > ans) {
                   1018:              ans = bases[i];
                   1019:           }
                   1020:        }
                   1021:      }
                   1022:    }
                   1023:    return(ans);
                   1024: }
                   1025:
                   1026: def Stetris(freeRes,redundantTable) {
                   1027:   local level, i, j, resLength, minRes,
                   1028:         bases, newbases, newbases2;
                   1029:   minRes = SnewArrayOfFormat(freeRes);
                   1030:   resLength = Length( freeRes );
                   1031:   for (level=0; level<resLength; level++) {
                   1032:     bases = freeRes[level];
                   1033:     newbases = SnewArrayOfFormat(bases);
                   1034:     betti = Length(bases); j = 0;
                   1035:     /* Delete rows */
                   1036:     for (i=0; i<betti; i++) {
                   1037:       if (redundantTable[level,i] < 1) {
                   1038:          newbases[j] = bases[i];
                   1039:          j++;
                   1040:       }
                   1041:     }
                   1042:     bases = SfirstN(newbases,j);
                   1043:     if (level > 0) {
                   1044:       /* Delete columns */
                   1045:       newbases = Transpose(bases);
                   1046:       betti = Length(newbases); j = 0;
                   1047:       newbases2 = SnewArrayOfFormat(newbases);
                   1048:       for (i=0; i<betti; i++) {
                   1049:         if (redundantTable[level-1,i] < 1) {
                   1050:            newbases2[j] = newbases[i];
                   1051:            j++;
                   1052:         }
                   1053:       }
                   1054:       newbases = Transpose(SfirstN(newbases2,j));
                   1055:     }else{
                   1056:       newbases = bases;
                   1057:     }
                   1058:     Println(["level=", level]);
                   1059:     sm1_pmat(bases);
                   1060:     sm1_pmat(newbases);
                   1061:
                   1062:     minRes[level] = newbases;
                   1063:   }
                   1064:   return(minRes);
                   1065: }
                   1066:
                   1067: def SfirstN(bases,k) {
                   1068:    local ans,i;
                   1069:    ans = NewArray(k);
                   1070:    for (i=0; i<k; i++) {
                   1071:      ans[i] = bases[i];
                   1072:    }
                   1073:    return(ans);
                   1074: }
                   1075:
                   1076:
                   1077: /* usage:  tt is tower. ww is weight.
                   1078:     a = SresolutionFrameWithTower(v);
                   1079:     tt = a[1];
                   1080:     ww = [x,1,y,1,Dx,1,Dy,1];
                   1081:     SvDegree(x*es,tt,1,ww):
                   1082:
                   1083: In(17)=tt:
                   1084: [[2*x*Dx , e_*x^2 , e_*x*y , 3*x^2*Dy , e_*y^3 , 9*x*y*Dy^2 , 27*y^2*Dy^3 ]  ,
                   1085:  [es*y , 3*es^3*y*Dy , 3*es^5*y*Dy , 3*x*Dy , es^2*y^2 , 9*y*Dy^2 ]  ,
                   1086:  [3*es^3*y*Dy ]  ]
                   1087: In(18)=SvDegree(x*es,tt,1,ww):
                   1088: 3
                   1089: In(19)=SvDegree(x*es^3,tt,1,ww):
                   1090: 4
                   1091: In(20)=SvDegree(x,tt,2,ww):
                   1092: 4
                   1093:
                   1094: */
                   1095: def SvDegree(f,tower,level,w) {
                   1096:   local i,ans;
                   1097:   if (IsZero(f)) return(null);
1.3       takayama 1098:   f = Init(f);
1.1       takayama 1099:   if (level <= 0) {
                   1100:     return(Sord_w(f,w));
                   1101:   }
                   1102:   i = Degree(f,es);
                   1103:   ans = Sord_w(f,w) +
                   1104:         SvDegree(tower[level-1,i],tower,level-1,w);
                   1105:   return(ans);
                   1106: }
                   1107:
1.2       takayama 1108: def Sannfs(f,v) {
                   1109:   local f2;
                   1110:   f2 = ToString(f);
                   1111:   if (IsArray(v)) {
                   1112:      v = Map(v,"ToString");
                   1113:   }
                   1114:   sm1(" [f2 v] annfs /FunctionValue set ");
                   1115: }
                   1116:
                   1117: /* Sannfs2("x^3-y^2"); */
                   1118: def Sannfs2(f) {
                   1119:   local p,pp;
                   1120:   p = Sannfs(f,"x,y");
1.6       takayama 1121:   sm1(" p 0 get { [(x) (y) (Dx) (Dy)] laplace0 } map /p set ");
                   1122:   Sweyl("x,y",[["x",-1,"y",-1,"Dx",1,"Dy",1]]);
                   1123:   pp = Map(p,"Spoly");
1.18      takayama 1124:   return(Sminimal(pp));
1.6       takayama 1125: }
                   1126:
1.10      takayama 1127: HelpAdd(["Sannfs2",
                   1128: ["Sannfs2(f) constructs the V-minimal free resolution for the weight (-1,1)",
                   1129:  "of the Laplace transform of the annihilating ideal of the polynomial f in x,y.",
1.18      takayama 1130:  "See also Sminimal, Sannfs3.",
1.10      takayama 1131:  "Example: a=Sannfs2(\"x^3-y^2\");",
                   1132:  "         b=a[0]; sm1_pmat(b);",
                   1133:  "         b[1]*b[0]:",
                   1134:  "Example: a=Sannfs2(\"x*y*(x-y)*(x+y)\");",
                   1135:  "         b=a[0]; sm1_pmat(b);",
                   1136:  "         b[1]*b[0]:"
                   1137: ]]);
1.18      takayama 1138: /* Some samples.
                   1139:   The betti numbers of most examples are 2,1. (0-th and 1-th).
                   1140:   a=Sannfs2("x*y*(x+y-1)"); ==> The betti numbers are 3, 2.
                   1141:   a=Sannfs2("x^3-y^2-x");
                   1142:   a=Sannfs2("x*y*(x-y)");
                   1143: */
1.10      takayama 1144:
1.11      takayama 1145:
1.3       takayama 1146: def Sannfs3(f) {
                   1147:   local p,pp;
                   1148:   p = Sannfs(f,"x,y,z");
1.6       takayama 1149:   sm1(" p 0 get { [(x) (y) (z) (Dx) (Dy) (Dz)] laplace0 } map /p set ");
1.3       takayama 1150:   Sweyl("x,y,z",[["x",-1,"y",-1,"z",-1,"Dx",1,"Dy",1,"Dz",1]]);
1.6       takayama 1151:   pp = Map(p,"Spoly");
1.18      takayama 1152:   return(Sminimal(pp));
1.3       takayama 1153: }
                   1154:
1.10      takayama 1155: HelpAdd(["Sannfs3",
                   1156: ["Sannfs3(f) constructs the V-minimal free resolution for the weight (-1,1)",
                   1157:  "of the Laplace transform of the annihilating ideal of the polynomial f in x,y,z.",
1.18      takayama 1158:  "See also Sminimal, Sannfs2.",
1.10      takayama 1159:  "Example: a=Sannfs3(\"x^3-y^2*z^2\");",
                   1160:  "         b=a[0]; sm1_pmat(b);",
                   1161:  "         b[1]*b[0]: b[2]*b[1]:"]]);
                   1162:
1.2       takayama 1163:
1.6       takayama 1164:
                   1165: /* Sannfs2("x*y*(x-y)*(x+y)"); is a test problem */
1.10      takayama 1166: /* x y (x+y-1)(x-2),  x^3-y^2, x^3 - y^2 z^2,
                   1167:    x y z (x+y+z-1) seems to be interesting, because the first syzygy
                   1168:   contains 1.
                   1169: */
                   1170:
                   1171: def CopyArray(m) {
                   1172:   local ans,i,n;
                   1173:   if (IsArray(m)) {
                   1174:      n = Length(m);
                   1175:      ans = NewArray(n);
                   1176:      for (i=0; i<n; i++) {
                   1177:        ans[i] = CopyArray(m[i]);
                   1178:      }
                   1179:      return(ans);
                   1180:   }else{
                   1181:      return(m);
                   1182:   }
                   1183: }
                   1184: HelpAdd(["CopyArray",
                   1185: ["It duplicates the argument array recursively.",
                   1186:  "Example: m=[1,[2,3]];",
                   1187:  "         a=CopyArray(m); a[1] = \"Hello\";",
                   1188:  "         Println(m); Println(a);"]]);
                   1189:
                   1190: def IsZeroVector(m) {
                   1191:   local n,i;
                   1192:   n = Length(m);
                   1193:   for (i=0; i<n; i++) {
                   1194:     if (!IsZero(m[i])) {
                   1195:       return(false);
                   1196:     }
                   1197:   }
                   1198:   return(true);
                   1199: }
                   1200:
                   1201: def SpruneZeroRow(res) {
                   1202:   local minRes, n,i,j,m, base,base2,newbase,newbase2, newMinRes;
                   1203:
                   1204:   minRes = CopyArray(res);
                   1205:   n = Length(minRes);
                   1206:   for (i=0; i<n; i++) {
                   1207:     base = minRes[i];
                   1208:     m = Length(base);
                   1209:     if (i != n-1) {
                   1210:       base2 = minRes[i+1];
                   1211:       base2 = Transpose(base2);
                   1212:     }
                   1213:     newbase = [ ];
                   1214:     newbase2 = [ ];
                   1215:     for (j=0; j<m; j++) {
                   1216:       if (!IsZeroVector(base[j])) {
                   1217:         newbase = Append(newbase,base[j]);
                   1218:         if (i != n-1) {
                   1219:           newbase2 = Append(newbase2,base2[j]);
                   1220:         }
                   1221:       }
                   1222:     }
                   1223:     minRes[i] = newbase;
                   1224:     if (i != n-1) {
                   1225:       if (newbase2 == [ ]) {
                   1226:         minRes[i+1] = [ ];
                   1227:       }else{
                   1228:         minRes[i+1] = Transpose(newbase2);
                   1229:       }
                   1230:     }
                   1231:   }
                   1232:
                   1233:   newMinRes = [ ];
                   1234:   n = Length(minRes);
                   1235:   i = 0;
                   1236:   while (i < n ) {
                   1237:     base = minRes[i];
                   1238:     if (base == [ ]) {
                   1239:       i = n; /* break; */
                   1240:     }else{
                   1241:       newMinRes = Append(newMinRes,base);
                   1242:     }
                   1243:     i++;
                   1244:   }
                   1245:   return(newMinRes);
                   1246: }
                   1247:
                   1248: def testAnnfs2(f) {
                   1249:   local a,i,n;
                   1250:   a = Sannfs2(f);
                   1251:   b=a[0];
                   1252:   n = Length(b);
                   1253:   Println("------ V-minimal free resolution -----");
                   1254:   sm1_pmat(b);
                   1255:   Println("----- Is it complex?  ---------------");
                   1256:   for (i=0; i<n-1; i++) {
                   1257:     Println(b[i+1]*b[i]);
                   1258:   }
                   1259:   return(a);
                   1260: }
                   1261: def testAnnfs3(f) {
                   1262:   local a,i,n;
                   1263:   a = Sannfs3(f);
                   1264:   b=a[0];
                   1265:   n = Length(b);
                   1266:   Println("------ V-minimal free resolution -----");
                   1267:   sm1_pmat(b);
                   1268:   Println("----- Is it complex?  ---------------");
                   1269:   for (i=0; i<n-1; i++) {
                   1270:     Println(b[i+1]*b[i]);
                   1271:   }
1.11      takayama 1272:   return(a);
                   1273: }
                   1274:
                   1275: def ToString_array(p) {
                   1276:   local ans;
                   1277:   if (IsArray(p)) {
                   1278:     ans = Map(p,"ToString_array");
                   1279:   }else{
                   1280:     ans = ToString(p);
                   1281:   }
                   1282:   return(ans);
                   1283: }
                   1284:
                   1285: /* sm1_res_div([[x],[y]],[[x^2],[x*y],[y^2]],[x,y]): */
                   1286:
                   1287: def sm1_res_div(I,J,V) {
                   1288:   I = ToString_array(I);
                   1289:   J = ToString_array(J);
                   1290:   V = ToString_array(V);
                   1291:   sm1(" [[ I J]  V ] res*div /FunctionValue set ");
                   1292: }
                   1293:
                   1294: /* It has not yet been working */
                   1295: def sm1_res_kernel_image(m,n,v) {
                   1296:   m = ToString_array(m);
                   1297:   n = ToString_array(n);
                   1298:   v = ToString_array(v);
                   1299:   sm1(" [m n v] res-kernel-image /FunctionValue set ");
                   1300: }
                   1301: def Skernel(m,v) {
                   1302:   m = ToString_array(m);
                   1303:   v = ToString_array(v);
                   1304:   sm1(" [ m v ] syz /FunctionValue set ");
                   1305: }
                   1306:
                   1307:
                   1308: def sm1_gb(f,v) {
                   1309:   f =ToString_array(f);
                   1310:   v = ToString_array(v);
                   1311:   sm1(" [f v] gb /FunctionValue set ");
1.13      takayama 1312: }
                   1313:
1.11      takayama 1314:
1.12      takayama 1315: def SisComplex(a) {
                   1316:   local n,i,j,k,b,p,q;
                   1317:   n = Length(a);
                   1318:   for (i=0; i<n-1; i++) {
                   1319:     if (Length(a[i+1]) != 0) {
                   1320:       b = a[i+1]*a[i];
                   1321:       p = Length(b); q = Length(b[0]);
                   1322:       for (j=0; j<p; j++) {
                   1323:         for (k=0; k<q; k++) {
                   1324:           if (!IsZero(b[j,k])) {
                   1325:              Print("Is is not complex at ");
                   1326:              Println([i,j,k]);
                   1327:              return(false);
                   1328:           }
                   1329:         }
                   1330:       }
                   1331:     }
                   1332:   }
                   1333:   return(true);
1.14      takayama 1334: }
                   1335:
                   1336: def IsExact_h(c,v) {
                   1337:   local a;
                   1338:   v = ToString_array(v);
                   1339:   a = [c,v];
                   1340:   sm1(a," isExact_h /FunctionValue set ");
                   1341: }
                   1342: HelpAdd(["IsExact_h",
                   1343: ["IsExact_h(complex,var): bool",
                   1344:  "It checks the given complex is exact or not in D<h> (homogenized Weyl algebra)",
                   1345:  "cf. ReParse"
                   1346: ]]);
                   1347:
                   1348: def ReParse(a) {
                   1349:   local c;
                   1350:   if (IsArray(a)) {
                   1351:     c = Map(a,"ReParse");
                   1352:   }else{
                   1353:     sm1(a," toString . /c set");
                   1354:   }
                   1355:   return(c);
                   1356: }
                   1357: HelpAdd(["ReParse",
                   1358: ["Reparse(obj): obj",
                   1359:  "It parses the given object in the current ring.",
                   1360:  "Outputs from SlaScala, Sschreyer may cause a trouble in other functions,",
                   1361:  "because it uses the Schreyer order.",
                   1362:  "In this case, ReParse the outputs from these functions.",
                   1363:  "cf. IsExaxt_h"
                   1364: ]]);
1.16      takayama 1365:
                   1366: def ScheckIfSchreyer(s) {
                   1367:   local ss;
                   1368:   sm1(" (report) (grade) switch_function /ss set ");
                   1369:   if (ss != "module1v") {
                   1370:      Print("ScheckIfSchreyer: from "); Println(s);
                   1371:      Error("grade is not module1v");
                   1372:   }
                   1373:   /*
                   1374:   sm1(" (report) (mmLarger) switch_function /ss set ");
                   1375:   if (ss != "tower") {
                   1376:      Print("ScheckIfSchreyer: from "); Println(s);
                   1377:      Error("mmLarger is not tower");
                   1378:   }
                   1379:   */
                   1380:   sm1(" [(Schreyer)] system_variable (universalNumber) dc /ss set ");
                   1381:   if (ss != 1) {
                   1382:      Print("ScheckIfSchreyer: from "); Println(s);
                   1383:      Error("Schreyer order is not set.");
                   1384:   }
                   1385:   /* More check will be necessary. */
                   1386:   return(true);
                   1387: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>