[BACK]Return to ecart.sm1 CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Doc

Annotation of OpenXM/src/kan96xx/Doc/ecart.sm1, Revision 1.11

1.11    ! takayama    1: % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.10 2003/08/23 02:28:40 takayama Exp $
1.1       takayama    2: %[(parse) (hol.sm1) pushfile] extension
                      3: %[(parse) (appell.sm1) pushfile] extension
                      4:
                      5: (ecart.sm1 : ecart division for D, 2003/07/25 ) message-quiet
                      6: /ecart.begin { beginEcart } def
                      7: /ecart.end   { endEcart } def
                      8: /ecart.autoHomogenize 1 def
                      9: /ecart.needSyz 0 def
1.8       takayama   10: /ecartd.begin {
                     11:   ecart.begin
                     12:   [(EcartAutomaticHomogenization) 1] system_variable
                     13: } def
                     14: /ecartd.end {
                     15:   ecart.end
                     16:   [(EcartAutomaticHomogenization) 0] system_variable
                     17: } def
1.1       takayama   18:
                     19: /ecart.dehomogenize {
                     20:  /arg1 set
                     21:  [/in.ecart.dehomogenize /ll /rr] pushVariables
                     22:  [
                     23:    /ll arg1 def
                     24:    ll tag 6 eq {
                     25:      ll { ecart.dehomogenize } map /ll set
                     26:    } {
                     27:      ll (0). eq {
                     28:      } {
                     29:        ll getRing /rr set
                     30:        ll [ [ (H) rr ,, (1) rr ,, ]
                     31:             [ (h) rr ,, (1) rr ,, ]] replace
                     32:        /ll set
                     33:      } ifelse
                     34:    } ifelse
                     35:    /arg1 ll def
                     36:  ] pop
                     37:  popVariables
                     38:  arg1
                     39: } def
                     40: [(ecart.dehomogenize)
                     41:  [(obj ecart.dehomogenize r)
                     42:   (h->1, H->1)
                     43: ]] putUsages
                     44:
                     45: /ecart.dehomogenizeH {
                     46:  /arg1 set
                     47:  [/in.ecart.dehomogenize /ll /rr] pushVariables
                     48:  [
                     49:    /ll arg1 def
                     50:    ll tag 6 eq {
                     51:      ll { ecart.dehomogenize } map /ll set
                     52:    } {
                     53:      ll (0). eq {
                     54:      } {
                     55:        ll getRing /rr set
                     56:        ll [ [ (H) rr ,, (1) rr ,, ] ] replace
                     57:        /ll set
                     58:      } ifelse
                     59:    } ifelse
                     60:    /arg1 ll def
                     61:  ] pop
                     62:  popVariables
                     63:  arg1
                     64: } def
                     65: [(ecart.dehomogenizeH)
                     66:  [(obj ecart.dehomogenizeH r)
                     67:   (H->1, h is not changed.)
                     68: ]] putUsages
                     69:
                     70: /ecart.homogenize01 {
                     71:  /arg1 set
1.11    ! takayama   72:  [/in.ecart.homogenize01 /ll /ll0] pushVariables
1.1       takayama   73:  [
                     74:    /ll arg1 def
1.11    ! takayama   75:    ll tag ArrayP eq {
        !            76:      ll 0 get tag ArrayP eq not {
        !            77:        [(degreeShift) [ ] ll ] homogenize   /arg1 set
        !            78:      } {
        !            79:        ll { ecart.homogenize01 } map /arg1 set
        !            80:      } ifelse
        !            81:    } {
        !            82:        [(degreeShift) [ ] ll ] homogenize   /arg1 set
        !            83:    }
1.1       takayama   84:  ] pop
                     85:  popVariables
                     86:  arg1
                     87: } def
                     88: [(ecart.homogenize01)
                     89:  [(obj ecart.homogenize01 r)
                     90:   (Example:  )
                     91:   (  [(x1,x2) ring_of_differential_operators )
                     92:   (   [[(H) 1 (h) 1 (x1) 1 (x2) 1] )
                     93:   (    [(h) 1 (Dx1) 1 (Dx2) 1] )
                     94:   (    [(Dx1) 1 (Dx2) 1]   )
                     95:   (    [(x1) -1 (x2) -1])
                     96:   (   ] weight_vector )
                     97:   (   0  )
1.11    ! takayama   98:   (   [(weightedHomogenization) 1 (degreeShift) [[0 0 0]]])
1.1       takayama   99:   (  ] define_ring)
                    100:   ( ecart.begin)
                    101:   ( [[1 -4 -2 5]] appell4 0 get /eqs set)
                    102:   ( eqs { . [[(x1). (x1+2).] [(x2). (x2+4).]] replace} map )
1.11    ! takayama  103:   ( {ecart.homogenize01} map /eqs2 set)
1.1       takayama  104:   ( [eqs2] groebner )
                    105: ]] putUsages
                    106:
                    107: /ecart.homogenize01_with_shiftVector {
                    108:  /arg2.set
                    109:  /arg1 set
1.11    ! takayama  110:  [/in.ecart.homogenize01 /ll /sv /ll0] pushVariables
1.1       takayama  111:  [
                    112:    /sv arg2 def
                    113:    /ll arg1 def
1.11    ! takayama  114:    ll tag ArrayP eq {
        !           115:      ll 0 get tag ArrayP eq not {
        !           116:        [(degreeShift) sv ll ] homogenize   /arg1 set
        !           117:      } {
        !           118:        ll { ecart.homogenize01_with_shiftVector } map /arg1 set
        !           119:      } ifelse
        !           120:    } {
        !           121:        [(degreeShift) sv ll ] homogenize   /arg1 set
        !           122:    }
1.1       takayama  123:  ] pop
                    124:  popVariables
                    125:  arg1
                    126: } def
                    127: [(ecart.dehomogenize01_with_degreeShift)
                    128:  [(obj shift-vector ecart.dehomogenize01_with_degreeShift r)
1.11    ! takayama  129:   (cf. homogenize)
1.1       takayama  130: ]] putUsages
                    131:
                    132: %% Aux functions to return the default weight vectors.
                    133: /ecart.wv1 {
                    134:   /arg1 set
                    135:   [/in.ecart.wv1 /v] pushVariables
                    136:   [
                    137:     /v arg1 def
                    138:     [(H) (h) v to_records pop] /v set
                    139:     v { 1 } map /v set
                    140:     /arg1 v def
                    141:   ] pop
                    142:   popVariables
                    143:   arg1
                    144: } def
                    145: /ecart.wv2 {
                    146:   /arg1 set
                    147:   [/in.ecart.wv2 /v] pushVariables
                    148:   [
                    149:     /v arg1 def
                    150:     [v to_records pop] /v set
                    151:     v { [ @@@.Dsymbol 3 -1 roll ] cat 1 } map /v set
                    152:     [(h) 1 ] v join /v set
                    153:     /arg1 v def
                    154:   ] pop
                    155:   popVariables
                    156:   arg1
                    157: } def
                    158:
1.7       takayama  159: /ecart.gb {ecartd.gb}  def
                    160:
                    161: [(ecart.gb)
                    162:  [(a ecart.gb b)
                    163:   (array a; array b;)
                    164:   $b : [g ii];  array g; array in; g is a standard (Grobner) basis of f$
                    165:   (             in the ring of differential operators.)
                    166:   (The computation is done by using Ecart division algorithm and )
                    167:   (the double homogenization.)
                    168:   (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
                    169:    $            ii is the initial ideal in case of w is given or <<a>> belongs$
                    170:    $            to a ring. In the other cases, it returns the initial monominal.$
                    171:   (a : [f ];    array f;  f is a set of generators of an ideal in a ring.)
                    172:   (a : [f v];   array f; string v;  v is the variables. )
                    173:   (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
                    174:   (a : [f v w ds]; array f; string v; array of array w; w is the weight matirx.)
1.11    ! takayama  175:   (                array ds; ds is the degree shift for the ring. )
        !           176:   (a : [f v w ds hdShift]; array f; string v; array of array w; w is the weight matirx.)
        !           177:   (        array ds; ds is the degree shift for the ring. )
        !           178:   (        array hsShift is the degree shift for the homogenization. cf.homogenize )
        !           179:   $a : [f v w ds (no)]; array f; string v; array of array w; w is the weight matirx.$
        !           180:   (       No automatic homogenization.)
1.7       takayama  181:   (  )
                    182:   $cf. ecarth.gb (homogenized),  ecartd.gb (dehomogenize) $
                    183:   ( )
                    184:   $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
                    185:   $             [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $
                    186:   (Example 2: )
                    187:   $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
1.9       takayama  188:   $   [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecart.gb  /ff set ff pmat ;$
                    189:   (To set the current ring to the ring in which ff belongs )
                    190:   (      ff getRing ring_def  )
1.7       takayama  191:   (  )
                    192:   $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) (  x y Dx Dy -1)] (x,y) $
                    193:   $             [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $
1.10      takayama  194:   (   This example will cause an error on order.)
1.7       takayama  195:   (  )
                    196:   $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
                    197:   $             [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $
1.10      takayama  198:   (   This example will cause an error on order.)
1.7       takayama  199:   (  )
                    200:   $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
                    201:   $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ]  [[0 1] [-3 1] ] ] ecart.gb pmat ; $
                    202:   (  )
                    203:   (cf. gb, groebner, ecarth.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
                    204:   (    ecart.dehomogenize, ecart.dehomogenizeH)
                    205:   ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
                    206:   (                                                          define_ring )
                    207:   (/ecart.autoHomogenize 0 def )
                    208:   (               not to dehomogenize and homogenize)
                    209: ]] putUsages
                    210:
1.1       takayama  211: /ecart.gb.verbose 1 def
1.7       takayama  212: /ecarth.gb {
1.1       takayama  213:   /arg1 set
1.7       takayama  214:   [/in-ecarth.gb /aa /typev /setarg /f /v
1.1       takayama  215:    /gg /wv /vec /ans /rr /mm
                    216:    /degreeShift  /env2 /opt /ans.gb
                    217:   ] pushVariables
                    218:   [(CurrentRingp) (KanGBmessage)] pushEnv
                    219:   [
                    220:     /aa arg1 def
                    221:     aa isArray { } { ( << array >> gb) error } ifelse
                    222:     /setarg 0 def
                    223:     /wv 0 def
                    224:     /degreeShift 0 def
                    225:     /opt [(weightedHomogenization) 1] def
                    226:     aa { tag } map /typev set
                    227:     typev [ ArrayP ] eq
                    228:     {  /f aa 0 get def
                    229:        /v gb.v def
                    230:        /setarg 1 def
                    231:     } { } ifelse
                    232:     typev [ArrayP StringP] eq
                    233:     {  /f aa 0 get def
                    234:        /v aa 1 get def
                    235:        /setarg 1 def
                    236:     } { } ifelse
                    237:     typev [ArrayP RingP] eq
                    238:     {  /f aa 0 get def
                    239:        /v aa 1 get def
                    240:        /setarg 1 def
                    241:     } { } ifelse
                    242:     typev [ArrayP ArrayP] eq
                    243:     {  /f aa 0 get def
                    244:        /v aa 1 get from_records def
                    245:        /setarg 1 def
                    246:     } { } ifelse
                    247:     typev [ArrayP StringP ArrayP] eq
                    248:     {  /f aa 0 get def
                    249:        /v aa 1 get def
                    250:        /wv aa 2 get def
                    251:        /setarg 1 def
                    252:     } { } ifelse
                    253:     typev [ArrayP ArrayP ArrayP] eq
                    254:     {  /f aa 0 get def
                    255:        /v aa 1 get from_records def
                    256:        /wv aa 2 get def
                    257:        /setarg 1 def
                    258:     } { } ifelse
                    259:     typev [ArrayP StringP ArrayP ArrayP] eq
                    260:     {  /f aa 0 get def
                    261:        /v aa 1 get def
                    262:        /wv aa 2 get def
                    263:        /degreeShift aa 3 get def
                    264:        /setarg 1 def
                    265:     } { } ifelse
                    266:     typev [ArrayP ArrayP ArrayP ArrayP] eq
                    267:     {  /f aa 0 get def
                    268:        /v aa 1 get from_records def
                    269:        /wv aa 2 get def
                    270:        /degreeShift aa 3 get def
                    271:        /setarg 1 def
                    272:     } { } ifelse
                    273:
                    274:     /env1 getOptions def
                    275:
                    276:     setarg { } { (ecart.gb : Argument mismatch) error } ifelse
                    277:
                    278:     [(KanGBmessage) ecart.gb.verbose ] system_variable
                    279:
                    280:     %%% Start of the preprocess
                    281:     v tag RingP eq {
                    282:        /rr v def
                    283:     }{
                    284:       f getRing /rr set
                    285:     } ifelse
                    286:     %% To the normal form : matrix expression.
                    287:     f gb.toMatrixOfString /f set
                    288:     /mm gb.itWasMatrix def
                    289:
                    290:     rr tag 0 eq {
                    291:       %% Define our own ring
                    292:       v isInteger {
                    293:         (Error in gb: Specify variables) error
                    294:       } {  } ifelse
                    295:       wv isInteger {
                    296:         [v ring_of_differential_operators
1.6       takayama  297: %         [ v ecart.wv1 v ecart.wv2 ] weight_vector
1.3       takayama  298:          gb.characteristic
1.1       takayama  299:          opt
                    300:         ] define_ring
                    301:       }{
                    302:        degreeShift isInteger {
                    303:          [v ring_of_differential_operators
1.6       takayama  304: %          [v ecart.wv1 v ecart.wv2] wv join weight_vector
                    305:           wv weight_vector
1.3       takayama  306:           gb.characteristic
1.1       takayama  307:           opt
                    308:          ] define_ring
                    309:
                    310:        }{
                    311:          [v ring_of_differential_operators
1.6       takayama  312: %          [v ecart.wv1 v ecart.wv2] wv join weight_vector
                    313:           wv  weight_vector
1.3       takayama  314:           gb.characteristic
1.1       takayama  315:           [(degreeShift) degreeShift] opt join
                    316:           ] define_ring
                    317:
                    318:        } ifelse
                    319:       } ifelse
                    320:     } {
                    321:       %% Use the ring structre given by the input.
                    322:       v isInteger not {
                    323:         gb.warning {
                    324:          (Warning : the given ring definition is not used.) message
                    325:         } { } ifelse
                    326:       } {  } ifelse
                    327:       rr ring_def
                    328:       /wv rr gb.getWeight def
                    329:
                    330:     } ifelse
                    331:     %%% Enf of the preprocess
                    332:
                    333:     ecart.gb.verbose {
1.6       takayama  334:       (The first and the second weight vectors for automatic homogenization: )
1.1       takayama  335:        message
                    336:        v ecart.wv1 message
                    337:        v ecart.wv2 message
                    338:        degreeShift isInteger { }
                    339:        {
                    340:          (The degree shift is ) messagen
                    341:          degreeShift message
                    342:        } ifelse
                    343:     } { } ifelse
                    344:
1.5       takayama  345:     %%BUG: case of v is integer
                    346:     v ecart.checkOrder
                    347:
1.1       takayama  348:     ecart.begin
                    349:
                    350:     ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
                    351:     ecart.autoHomogenize {
                    352:       (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
                    353:       message
                    354:     } { } ifelse
                    355:     ecart.autoHomogenize {
                    356:       f { {. ecart.dehomogenize} map} map /f set
                    357:       f ecart.homogenize01 /f set
                    358:     }{
                    359:       f { {. } map } map /f set
                    360:     } ifelse
                    361:     ecart.needSyz {
                    362:       [f [(needSyz)] gb.options join ] groebner /gg set
                    363:     } {
                    364:       [f gb.options] groebner 0 get /gg set
                    365:     } ifelse
                    366:
                    367:     ecart.needSyz {
                    368:       mm {
                    369:        gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
1.11    ! takayama  370:        } { /ans.gb gg 0 get def } ifelse
        !           371:        /ans [gg 2 get , ans.gb , gg 1 get , f ] def
        !           372: %      ans pmat ;
1.1       takayama  373:     } {
                    374:       wv isInteger {
                    375:         /ans [gg gg {init} map] def
                    376:       }{
1.10      takayama  377:        degreeShift isInteger {
                    378:          /ans [gg gg {wv 0 get weightv init} map] def
                    379:        } {
                    380:          /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
                    381:        } ifelse
1.1       takayama  382:       }ifelse
                    383:
                    384:       %% Postprocess : recover the matrix expression.
                    385:       mm {
                    386:         ans { /tmp set [mm tmp] toVectors } map
                    387:         /ans set
                    388:       }{ }
                    389:       ifelse
                    390:     } ifelse
                    391:
                    392:     ecart.end
                    393:
                    394:     %%
                    395:     env1 restoreOptions  %% degreeShift changes "grade"
                    396:
                    397:     /arg1 ans def
                    398:   ] pop
                    399:   popEnv
                    400:   popVariables
                    401:   arg1
                    402: } def
1.7       takayama  403: (ecarth.gb ) messagen-quiet
1.1       takayama  404:
1.7       takayama  405: [(ecarth.gb)
                    406:  [(a ecarth.gb b)
1.1       takayama  407:   (array a; array b;)
                    408:   $b : [g ii];  array g; array in; g is a standard (Grobner) basis of f$
                    409:   (             in the ring of differential operators.)
                    410:   (The computation is done by using Ecart division algorithm and )
                    411:   (the double homogenization.)
                    412:   (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
                    413:    $            ii is the initial ideal in case of w is given or <<a>> belongs$
                    414:    $            to a ring. In the other cases, it returns the initial monominal.$
                    415:   (a : [f ];    array f;  f is a set of generators of an ideal in a ring.)
                    416:   (a : [f v];   array f; string v;  v is the variables. )
                    417:   (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
                    418:   (a : [f v w ds]; array f; string v; array of array w; w is the weight matirx.)
                    419:   (                array ds; ds is the degree shift )
                    420:   (  )
                    421:   (/ecart.autoHomogenize 0 def )
                    422:   (               not to dehomogenize and homogenize)
                    423:   ( )
                    424:   $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
1.7       takayama  425:   $             [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $
1.1       takayama  426:   (Example 2: )
                    427:   (To put H and h=1, type in, e.g., )
                    428:   $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
1.7       takayama  429:   $   [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecarth.gb /gg set gg ecart.dehomogenize pmat ;$
1.1       takayama  430:   (  )
                    431:   $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) (  x y Dx Dy -1)] (x,y) $
1.7       takayama  432:   $             [ [ (Dx) 1 (Dy) 1] ] ] ecarth.gb pmat ; $
1.1       takayama  433:   (  )
                    434:   $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
1.7       takayama  435:   $             [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $
1.1       takayama  436:   (  )
                    437:   $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
1.7       takayama  438:   $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ]  [[0 1] [-3 1] ] ] ecarth.gb pmat ; (buggy infinite loop)$
1.1       takayama  439:   (  )
1.7       takayama  440:   (cf. gb, groebner, ecart.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
1.1       takayama  441:   (    ecart.dehomogenize, ecart.dehomogenizeH)
                    442:   ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
                    443:   (                                                          define_ring )
                    444: ]] putUsages
                    445:
                    446: %% BUG:  " f weight init " works well in case of vectors with degree shift ?
                    447:
                    448: /ecart.syz {
                    449:   /arg1 set
                    450:   [/in-ecart.syz /ecart.save.needSyz /ff /ff.ans] pushVariables
                    451:   [
                    452:     /ff arg1 def
                    453:     /ecart.save.needSyz ecart.needSyz def
                    454:     /ecart.needSyz 1 def
                    455:     ff ecart.gb /ff.ans set
                    456:     /ecart.needSyz ecart.save.needSyz def
                    457:     /arg1 ff.ans def
                    458:   ] pop
                    459:   popVariables
                    460:   arg1
                    461: } def
                    462: (ecart.syz ) messagen-quiet
                    463:
                    464: [(ecart.syz)
                    465:  [(a ecart.syz b)
                    466:   (array a; array b;)
                    467:   $b : [syzygy gb tmat input];  gb = tmat * input $
                    468:   $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) (  x y Dx Dy -1)] (x,y) $
1.8       takayama  469:   $             [ [ (Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.syz /ff set $
1.1       takayama  470:   $ ff 0 get ff 3 get mul pmat $
                    471:   $ ff 2 get  ff 3 get mul [ff 1 get ] transpose sub pmat ; $
                    472:   (  )
1.9       takayama  473:   (To set the current ring to the ring in which ff belongs )
                    474:   (      ff getRing ring_def  )
1.1       takayama  475:   $Example 2: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
1.8       takayama  476:   $             [ [(Dx) 1 (Dy) 1] [ (x) -1 (y) -1] ]  [[0 1] [-3 1] ] ] ecart.syz pmat ; $
1.1       takayama  477:   (  )
                    478:   (cf. ecart.gb)
                    479:   (    /ecart.autoHomogenize 0 def )
                    480: ]] putUsages
1.2       takayama  481:
1.3       takayama  482:
                    483: /ecartn.begin {
                    484:   (red@) (standard) switch_function
                    485: %%  (red@) (ecart) switch_function
                    486:   [(Ecart) 1] system_variable
                    487:   [(CheckHomogenization) 0] system_variable
                    488:   [(ReduceLowerTerms) 0] system_variable
                    489:   [(AutoReduce) 0] system_variable
                    490:   [(EcartAutomaticHomogenization) 0] system_variable
                    491: } def
                    492: /ecartn.gb {
                    493:   /arg1 set
                    494:   [/in-ecartn.gb /aa /typev /setarg /f /v
                    495:    /gg /wv /vec /ans /rr /mm
                    496:    /degreeShift  /env2 /opt /ans.gb
                    497:   ] pushVariables
                    498:   [(CurrentRingp) (KanGBmessage)] pushEnv
                    499:   [
                    500:     /aa arg1 def
                    501:     aa isArray { } { ( << array >> gb) error } ifelse
                    502:     /setarg 0 def
                    503:     /wv 0 def
                    504:     /degreeShift 0 def
                    505:     /opt [(weightedHomogenization) 1] def
                    506:     aa { tag } map /typev set
                    507:     typev [ ArrayP ] eq
                    508:     {  /f aa 0 get def
                    509:        /v gb.v def
                    510:        /setarg 1 def
                    511:     } { } ifelse
                    512:     typev [ArrayP StringP] eq
                    513:     {  /f aa 0 get def
                    514:        /v aa 1 get def
                    515:        /setarg 1 def
                    516:     } { } ifelse
                    517:     typev [ArrayP RingP] eq
                    518:     {  /f aa 0 get def
                    519:        /v aa 1 get def
                    520:        /setarg 1 def
                    521:     } { } ifelse
                    522:     typev [ArrayP ArrayP] eq
                    523:     {  /f aa 0 get def
                    524:        /v aa 1 get from_records def
                    525:        /setarg 1 def
                    526:     } { } ifelse
                    527:     typev [ArrayP StringP ArrayP] eq
                    528:     {  /f aa 0 get def
                    529:        /v aa 1 get def
                    530:        /wv aa 2 get def
                    531:        /setarg 1 def
                    532:     } { } ifelse
                    533:     typev [ArrayP ArrayP ArrayP] eq
                    534:     {  /f aa 0 get def
                    535:        /v aa 1 get from_records def
                    536:        /wv aa 2 get def
                    537:        /setarg 1 def
                    538:     } { } ifelse
                    539:     typev [ArrayP StringP ArrayP ArrayP] eq
                    540:     {  /f aa 0 get def
                    541:        /v aa 1 get def
                    542:        /wv aa 2 get def
                    543:        /degreeShift aa 3 get def
                    544:        /setarg 1 def
                    545:     } { } ifelse
                    546:     typev [ArrayP ArrayP ArrayP ArrayP] eq
                    547:     {  /f aa 0 get def
                    548:        /v aa 1 get from_records def
                    549:        /wv aa 2 get def
                    550:        /degreeShift aa 3 get def
                    551:        /setarg 1 def
                    552:     } { } ifelse
                    553:
                    554:     /env1 getOptions def
                    555:
                    556:     setarg { } { (ecart.gb : Argument mismatch) error } ifelse
                    557:
                    558:     [(KanGBmessage) ecart.gb.verbose ] system_variable
                    559:
                    560:     %%% Start of the preprocess
                    561:     v tag RingP eq {
                    562:        /rr v def
                    563:     }{
                    564:       f getRing /rr set
                    565:     } ifelse
                    566:     %% To the normal form : matrix expression.
                    567:     f gb.toMatrixOfString /f set
                    568:     /mm gb.itWasMatrix def
                    569:
                    570:     rr tag 0 eq {
                    571:       %% Define our own ring
                    572:       v isInteger {
                    573:         (Error in gb: Specify variables) error
                    574:       } {  } ifelse
                    575:       wv isInteger {
                    576:         [v ring_of_differential_operators
                    577:          [ v ecart.wv1 v ecart.wv2 ] weight_vector
                    578:          gb.characteristic
                    579:          opt
                    580:         ] define_ring
                    581:       }{
                    582:        degreeShift isInteger {
                    583:          [v ring_of_differential_operators
                    584:           [v ecart.wv1 v ecart.wv2] wv join weight_vector
                    585:           gb.characteristic
                    586:           opt
                    587:          ] define_ring
                    588:
                    589:        }{
                    590:          [v ring_of_differential_operators
                    591:           [v ecart.wv1 v ecart.wv2] wv join weight_vector
                    592:           gb.characteristic
                    593:           [(degreeShift) degreeShift] opt join
                    594:           ] define_ring
                    595:
                    596:        } ifelse
                    597:       } ifelse
                    598:     } {
                    599:       %% Use the ring structre given by the input.
                    600:       v isInteger not {
                    601:         gb.warning {
                    602:          (Warning : the given ring definition is not used.) message
                    603:         } { } ifelse
                    604:       } {  } ifelse
                    605:       rr ring_def
                    606:       /wv rr gb.getWeight def
                    607:
                    608:     } ifelse
                    609:     %%% Enf of the preprocess
                    610:
                    611:     ecart.gb.verbose {
                    612:       (The first and the second weight vectors are automatically set as follows)
                    613:        message
                    614:        v ecart.wv1 message
                    615:        v ecart.wv2 message
                    616:        degreeShift isInteger { }
                    617:        {
                    618:          (The degree shift is ) messagen
                    619:          degreeShift message
                    620:        } ifelse
                    621:     } { } ifelse
                    622:
1.5       takayama  623:     %%BUG: case of v is integer
                    624:     v ecart.checkOrder
                    625:
1.3       takayama  626:     ecartn.begin
                    627:
                    628:     ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) message } { } ifelse
                    629:     ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
                    630:     ecart.autoHomogenize {
                    631:       (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
                    632:       message
                    633:     } { } ifelse
                    634:     ecart.autoHomogenize {
                    635:       f { {. ecart.dehomogenize} map} map /f set
                    636:       f ecart.homogenize01 /f set
                    637:     }{
                    638:       f { {. } map } map /f set
                    639:     } ifelse
                    640:     ecart.needSyz {
                    641:       [f [(needSyz)] gb.options join ] groebner /gg set
                    642:     } {
                    643:       [f gb.options] groebner 0 get /gg set
                    644:     } ifelse
                    645:
                    646:     ecart.needSyz {
                    647:       mm {
                    648:        gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
                    649:       } { /ans.gb gg 0 get def } ifelse
                    650:       /ans [gg 2 get , ans.gb , gg 1 get , f ] def
1.11    ! takayama  651: %      ans pmat ;
1.3       takayama  652:     } {
                    653:       wv isInteger {
                    654:         /ans [gg gg {init} map] def
                    655:       }{
1.10      takayama  656:        degreeShift isInteger {
                    657:          /ans [gg gg {wv 0 get weightv init} map] def
                    658:        } {
                    659:          /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
                    660:        } ifelse
1.3       takayama  661:       }ifelse
                    662:
                    663:       %% Postprocess : recover the matrix expression.
                    664:       mm {
                    665:         ans { /tmp set [mm tmp] toVectors } map
                    666:         /ans set
                    667:       }{ }
                    668:       ifelse
                    669:     } ifelse
                    670:
                    671:     ecart.end
                    672:
                    673:     %%
                    674:     env1 restoreOptions  %% degreeShift changes "grade"
                    675:
                    676:     /arg1 ans def
                    677:   ] pop
                    678:   popEnv
                    679:   popVariables
                    680:   arg1
                    681: } def
                    682: (ecartn.gb[gb by non-ecart division] ) messagen-quiet
1.4       takayama  683:
                    684: /ecartd.gb {
                    685:   /arg1 set
                    686:   [/in-ecart.gb /aa /typev /setarg /f /v
                    687:    /gg /wv /vec /ans /rr /mm
                    688:    /degreeShift  /env2 /opt /ans.gb
1.11    ! takayama  689:    /hdShift
1.4       takayama  690:   ] pushVariables
                    691:   [(CurrentRingp) (KanGBmessage)] pushEnv
                    692:   [
                    693:     /aa arg1 def
                    694:     aa isArray { } { ( << array >> gb) error } ifelse
                    695:     /setarg 0 def
                    696:     /wv 0 def
                    697:     /degreeShift 0 def
1.11    ! takayama  698:     /hdShift 0 def
1.4       takayama  699:     /opt [(weightedHomogenization) 1] def
                    700:     aa { tag } map /typev set
                    701:     typev [ ArrayP ] eq
                    702:     {  /f aa 0 get def
                    703:        /v gb.v def
                    704:        /setarg 1 def
                    705:     } { } ifelse
                    706:     typev [ArrayP StringP] eq
                    707:     {  /f aa 0 get def
                    708:        /v aa 1 get def
                    709:        /setarg 1 def
                    710:     } { } ifelse
                    711:     typev [ArrayP RingP] eq
                    712:     {  /f aa 0 get def
                    713:        /v aa 1 get def
                    714:        /setarg 1 def
                    715:     } { } ifelse
                    716:     typev [ArrayP ArrayP] eq
                    717:     {  /f aa 0 get def
                    718:        /v aa 1 get from_records def
                    719:        /setarg 1 def
                    720:     } { } ifelse
                    721:     typev [ArrayP StringP ArrayP] eq
                    722:     {  /f aa 0 get def
                    723:        /v aa 1 get def
                    724:        /wv aa 2 get def
                    725:        /setarg 1 def
                    726:     } { } ifelse
                    727:     typev [ArrayP ArrayP ArrayP] eq
                    728:     {  /f aa 0 get def
                    729:        /v aa 1 get from_records def
                    730:        /wv aa 2 get def
                    731:        /setarg 1 def
                    732:     } { } ifelse
                    733:     typev [ArrayP StringP ArrayP ArrayP] eq
                    734:     {  /f aa 0 get def
                    735:        /v aa 1 get def
                    736:        /wv aa 2 get def
                    737:        /degreeShift aa 3 get def
                    738:        /setarg 1 def
                    739:     } { } ifelse
                    740:     typev [ArrayP ArrayP ArrayP ArrayP] eq
                    741:     {  /f aa 0 get def
                    742:        /v aa 1 get from_records def
                    743:        /wv aa 2 get def
                    744:        /degreeShift aa 3 get def
                    745:        /setarg 1 def
                    746:     } { } ifelse
1.11    ! takayama  747:     typev [ArrayP StringP ArrayP ArrayP ArrayP] eq
        !           748:     {  /f aa 0 get def
        !           749:        /v aa 1 get def
        !           750:        /wv aa 2 get def
        !           751:        /degreeShift aa 3 get def
        !           752:        /hdShift aa 4 get def
        !           753:        /setarg 1 def
        !           754:     } { } ifelse
        !           755:     typev [ArrayP ArrayP ArrayP ArrayP ArrayP] eq
        !           756:     {  /f aa 0 get def
        !           757:        /v aa 1 get from_records def
        !           758:        /wv aa 2 get def
        !           759:        /degreeShift aa 3 get def
        !           760:        /hdShift aa 4 get def
        !           761:        /setarg 1 def
        !           762:     } { } ifelse
        !           763:     typev [ArrayP ArrayP ArrayP ArrayP StringP] eq
        !           764:     {  /f aa 0 get def
        !           765:        /v aa 1 get from_records def
        !           766:        /wv aa 2 get def
        !           767:        /degreeShift aa 3 get def
        !           768:        aa 4 get (no) eq {
        !           769:          /hdShift -1 def
        !           770:        } {
        !           771:          (Unknown keyword for the 5th argument) error
        !           772:        } ifelse
        !           773:        /setarg 1 def
        !           774:     } { } ifelse
1.4       takayama  775:
                    776:     /env1 getOptions def
                    777:
                    778:     setarg { } { (ecart.gb : Argument mismatch) error } ifelse
                    779:
                    780:     [(KanGBmessage) ecart.gb.verbose ] system_variable
                    781:     $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ message
                    782:
                    783:     %%% Start of the preprocess
                    784:     v tag RingP eq {
                    785:        /rr v def
                    786:     }{
                    787:       f getRing /rr set
                    788:     } ifelse
                    789:     %% To the normal form : matrix expression.
                    790:     f gb.toMatrixOfString /f set
                    791:     /mm gb.itWasMatrix def
                    792:
                    793:     rr tag 0 eq {
                    794:       %% Define our own ring
                    795:       v isInteger {
                    796:         (Error in gb: Specify variables) error
                    797:       } {  } ifelse
                    798:       wv isInteger {
                    799:         (Give an weight vector such that x < 1) error
                    800:       }{
                    801:        degreeShift isInteger {
                    802:          [v ring_of_differential_operators
                    803:            wv weight_vector
                    804:           gb.characteristic
                    805:           opt
                    806:          ] define_ring
                    807:
                    808:        }{
                    809:          [v ring_of_differential_operators
                    810:            wv weight_vector
                    811:           gb.characteristic
                    812:           [(degreeShift) degreeShift] opt join
                    813:           ] define_ring
                    814:
                    815:        } ifelse
                    816:       } ifelse
                    817:     } {
                    818:       %% Use the ring structre given by the input.
                    819:       v isInteger not {
                    820:         gb.warning {
                    821:          (Warning : the given ring definition is not used.) message
                    822:         } { } ifelse
                    823:       } {  } ifelse
                    824:       rr ring_def
                    825:       /wv rr gb.getWeight def
                    826:
                    827:     } ifelse
                    828:     %%% Enf of the preprocess
                    829:
                    830:     ecart.gb.verbose {
                    831:        degreeShift isInteger { }
                    832:        {
                    833:          (The degree shift is ) messagen
                    834:          degreeShift message
                    835:        } ifelse
                    836:     } { } ifelse
                    837:
1.5       takayama  838:     %%BUG: case of v is integer
                    839:     v ecart.checkOrder
                    840:
1.8       takayama  841:     ecartd.begin
1.4       takayama  842:
                    843:     ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
                    844:
1.11    ! takayama  845:     hdShift tag 1 eq {
        !           846:      hdShift -1 eq {
        !           847: % No automatic h-homogenization.
        !           848:        f { {. } map} map /f set
        !           849:      } {
        !           850: % Automatic h-homogenization without degreeShift
        !           851:        f { {. ecart.dehomogenize} map} map /f set
        !           852:        f ecart.homogenize01 /f set
        !           853:        f { { [[(H). (1).]] replace } map } map /f set
        !           854:      } ifelse
        !           855:    } {
        !           856: % Automatic h-homogenization with degreeShift
        !           857:        f { {. ecart.dehomogenize} map} map /f set
        !           858:        f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set
        !           859:        f { { [[(H). (1).]] replace } map } map /f set
        !           860:    }ifelse
1.4       takayama  861:
                    862:     ecart.needSyz {
                    863:       [f [(needSyz)] gb.options join ] groebner /gg set
                    864:     } {
                    865:       [f gb.options] groebner 0 get /gg set
                    866:     } ifelse
                    867:
                    868:     ecart.needSyz {
                    869:       mm {
                    870:        gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
                    871:       } { /ans.gb gg 0 get def } ifelse
                    872:       /ans [gg 2 get , ans.gb , gg 1 get , f ] def
1.11    ! takayama  873: %      ans pmat ;
1.4       takayama  874:     } {
                    875:       wv isInteger {
                    876:         /ans [gg gg {init} map] def
                    877:       }{
1.11    ! takayama  878: %% Get the initial ideal
1.10      takayama  879:        degreeShift isInteger {
                    880:          /ans [gg gg {wv 0 get weightv init} map] def
                    881:        } {
                    882:          /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
                    883:        } ifelse
1.4       takayama  884:       }ifelse
                    885:
                    886:       %% Postprocess : recover the matrix expression.
                    887:       mm {
                    888:         ans { /tmp set [mm tmp] toVectors } map
                    889:         /ans set
                    890:       }{ }
                    891:       ifelse
                    892:     } ifelse
                    893:
1.8       takayama  894:     ecartd.end
1.4       takayama  895:
                    896:     %%
                    897:     env1 restoreOptions  %% degreeShift changes "grade"
                    898:
                    899:     /arg1 ans def
                    900:   ] pop
                    901:   popEnv
                    902:   popVariables
                    903:   arg1
                    904: } def
                    905: (ecartd.gb[results are dehomogenized at each reduction step] ) messagen-quiet
1.2       takayama  906:
1.5       takayama  907: /ecart.checkOrder {
                    908:   /arg1 set
                    909:   [/in-ecart.checkOrder /vv /tt /dd /n /i] pushVariables
                    910:   [
                    911:     /vv arg1 def
                    912:     vv isArray
                    913:     { } { [vv to_records pop] /vv set } ifelse
                    914:     vv {toString} map /vv set
                    915:     vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
                    916:     % Starting the checks.
                    917:     0 1 vv length 1 sub {
                    918:        /i set
                    919:        vv i get . dd i get . mul /tt set
                    920:        tt @@@.hsymbol . add init tt eq { }
                    921:        { [@@@.hsymbol ( is larger than ) vv i get ( ) dd i get] cat error} ifelse
                    922:     } for
                    923:
                    924:     0 1 vv length 1 sub {
                    925:        /i set
                    926:        vv i get . /tt set
                    927:        tt (1). add init (1). eq { }
1.6       takayama  928:        { [vv i get ( is larger than 1 ) ] cat error} ifelse
1.5       takayama  929:     } for
                    930:     /arg1 1 def
                    931:   ] pop
                    932:   popVariables
                    933:   arg1
                    934: } def
                    935: [(ecart.checkOrder)
                    936:  [(v ecart.checkOrder bool checks if the given order is relevant)
                    937:   (for the ecart division.)
                    938:   (cf. ecartd.gb, ecart.gb, ecartn.gb)
                    939:  ]
                    940: ] putUsages
                    941:
                    942: /ecart.wv_last {
                    943:   /arg1 set
                    944:   [/in-ecart.wv_last /vv /tt /dd /n /i] pushVariables
                    945:   [
                    946:     /vv arg1 def
                    947:     vv isArray
                    948:     { } { [vv to_records pop] /vv set } ifelse
                    949:     vv {toString} map /vv set
                    950:     vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
                    951:     vv {  -1 } map
                    952:     dd {   1 } map join /arg1 set
                    953:   ] pop
                    954:   popVariables
                    955:   arg1
                    956: } def
                    957: [(ecart.wv_last)
                    958:  [(v ecart.wv_last wt )
                    959:   (It returns the weight vector -1,-1,...-1; 1,1, ..., 1)
                    960:   (Use this weight vector as the last weight vector for ecart division)
                    961:   (if ecart.checkOrder complains about the order given.)
                    962:  ]
                    963: ] putUsages
                    964:
1.2       takayama  965: ( ) message-quiet
1.5       takayama  966:

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