Annotation of OpenXM/src/kan96xx/Doc/ecart.sm1, Revision 1.1
1.1 ! takayama 1: % $OpenXM$
! 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
! 10:
! 11: /ecart.dehomogenize {
! 12: /arg1 set
! 13: [/in.ecart.dehomogenize /ll /rr] pushVariables
! 14: [
! 15: /ll arg1 def
! 16: ll tag 6 eq {
! 17: ll { ecart.dehomogenize } map /ll set
! 18: } {
! 19: ll (0). eq {
! 20: } {
! 21: ll getRing /rr set
! 22: ll [ [ (H) rr ,, (1) rr ,, ]
! 23: [ (h) rr ,, (1) rr ,, ]] replace
! 24: /ll set
! 25: } ifelse
! 26: } ifelse
! 27: /arg1 ll def
! 28: ] pop
! 29: popVariables
! 30: arg1
! 31: } def
! 32: [(ecart.dehomogenize)
! 33: [(obj ecart.dehomogenize r)
! 34: (h->1, H->1)
! 35: ]] putUsages
! 36:
! 37: /ecart.dehomogenizeH {
! 38: /arg1 set
! 39: [/in.ecart.dehomogenize /ll /rr] pushVariables
! 40: [
! 41: /ll arg1 def
! 42: ll tag 6 eq {
! 43: ll { ecart.dehomogenize } map /ll set
! 44: } {
! 45: ll (0). eq {
! 46: } {
! 47: ll getRing /rr set
! 48: ll [ [ (H) rr ,, (1) rr ,, ] ] replace
! 49: /ll set
! 50: } ifelse
! 51: } ifelse
! 52: /arg1 ll def
! 53: ] pop
! 54: popVariables
! 55: arg1
! 56: } def
! 57: [(ecart.dehomogenizeH)
! 58: [(obj ecart.dehomogenizeH r)
! 59: (H->1, h is not changed.)
! 60: ]] putUsages
! 61:
! 62: /ecart.homogenize01 {
! 63: /arg1 set
! 64: [/in.ecart.homogenize01 /ll ] pushVariables
! 65: [
! 66: /ll arg1 def
! 67: [(degreeShift) [ ] ll ] homogenize
! 68: /arg1 set
! 69: ] pop
! 70: popVariables
! 71: arg1
! 72: } def
! 73: [(ecart.homogenize01)
! 74: [(obj ecart.homogenize01 r)
! 75: (Example: )
! 76: ( [(x1,x2) ring_of_differential_operators )
! 77: ( [[(H) 1 (h) 1 (x1) 1 (x2) 1] )
! 78: ( [(h) 1 (Dx1) 1 (Dx2) 1] )
! 79: ( [(Dx1) 1 (Dx2) 1] )
! 80: ( [(x1) -1 (x2) -1])
! 81: ( ] weight_vector )
! 82: ( 0 )
! 83: ( [(degreeShift) [[0 0 0]]])
! 84: ( ] define_ring)
! 85: ( ecart.begin)
! 86: ( [[1 -4 -2 5]] appell4 0 get /eqs set)
! 87: ( eqs { . [[(x1). (x1+2).] [(x2). (x2+4).]] replace} map )
! 88: ( ecart.homogenize01 /eqs2 set)
! 89: ( [eqs2] groebner )
! 90: ]] putUsages
! 91:
! 92: /ecart.homogenize01_with_shiftVector {
! 93: /arg2.set
! 94: /arg1 set
! 95: [/in.ecart.homogenize01 /ll /sv] pushVariables
! 96: [
! 97: /sv arg2 def
! 98: /ll arg1 def
! 99: [(degreeShift) sv ll ] homogenize
! 100: /arg1 set
! 101: ] pop
! 102: popVariables
! 103: arg1
! 104: } def
! 105: [(ecart.dehomogenize01_with_degreeShift)
! 106: [(obj shift-vector ecart.dehomogenize01_with_degreeShift r)
! 107: ]] putUsages
! 108:
! 109: %% Aux functions to return the default weight vectors.
! 110: /ecart.wv1 {
! 111: /arg1 set
! 112: [/in.ecart.wv1 /v] pushVariables
! 113: [
! 114: /v arg1 def
! 115: [(H) (h) v to_records pop] /v set
! 116: v { 1 } map /v set
! 117: /arg1 v def
! 118: ] pop
! 119: popVariables
! 120: arg1
! 121: } def
! 122: /ecart.wv2 {
! 123: /arg1 set
! 124: [/in.ecart.wv2 /v] pushVariables
! 125: [
! 126: /v arg1 def
! 127: [v to_records pop] /v set
! 128: v { [ @@@.Dsymbol 3 -1 roll ] cat 1 } map /v set
! 129: [(h) 1 ] v join /v set
! 130: /arg1 v def
! 131: ] pop
! 132: popVariables
! 133: arg1
! 134: } def
! 135:
! 136: /ecart.gb.verbose 1 def
! 137: /ecart.gb {
! 138: /arg1 set
! 139: [/in-ecart.gb /aa /typev /setarg /f /v
! 140: /gg /wv /vec /ans /rr /mm
! 141: /degreeShift /env2 /opt /ans.gb
! 142: ] pushVariables
! 143: [(CurrentRingp) (KanGBmessage)] pushEnv
! 144: [
! 145: /aa arg1 def
! 146: aa isArray { } { ( << array >> gb) error } ifelse
! 147: /setarg 0 def
! 148: /wv 0 def
! 149: /degreeShift 0 def
! 150: /opt [(weightedHomogenization) 1] def
! 151: aa { tag } map /typev set
! 152: typev [ ArrayP ] eq
! 153: { /f aa 0 get def
! 154: /v gb.v def
! 155: /setarg 1 def
! 156: } { } ifelse
! 157: typev [ArrayP StringP] eq
! 158: { /f aa 0 get def
! 159: /v aa 1 get def
! 160: /setarg 1 def
! 161: } { } ifelse
! 162: typev [ArrayP RingP] eq
! 163: { /f aa 0 get def
! 164: /v aa 1 get def
! 165: /setarg 1 def
! 166: } { } ifelse
! 167: typev [ArrayP ArrayP] eq
! 168: { /f aa 0 get def
! 169: /v aa 1 get from_records def
! 170: /setarg 1 def
! 171: } { } ifelse
! 172: typev [ArrayP StringP ArrayP] eq
! 173: { /f aa 0 get def
! 174: /v aa 1 get def
! 175: /wv aa 2 get def
! 176: /setarg 1 def
! 177: } { } ifelse
! 178: typev [ArrayP ArrayP ArrayP] eq
! 179: { /f aa 0 get def
! 180: /v aa 1 get from_records def
! 181: /wv aa 2 get def
! 182: /setarg 1 def
! 183: } { } ifelse
! 184: typev [ArrayP StringP ArrayP ArrayP] eq
! 185: { /f aa 0 get def
! 186: /v aa 1 get def
! 187: /wv aa 2 get def
! 188: /degreeShift aa 3 get def
! 189: /setarg 1 def
! 190: } { } ifelse
! 191: typev [ArrayP ArrayP ArrayP ArrayP] eq
! 192: { /f aa 0 get def
! 193: /v aa 1 get from_records def
! 194: /wv aa 2 get def
! 195: /degreeShift aa 3 get def
! 196: /setarg 1 def
! 197: } { } ifelse
! 198:
! 199: /env1 getOptions def
! 200:
! 201: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
! 202:
! 203: [(KanGBmessage) ecart.gb.verbose ] system_variable
! 204:
! 205: %%% Start of the preprocess
! 206: v tag RingP eq {
! 207: /rr v def
! 208: }{
! 209: f getRing /rr set
! 210: } ifelse
! 211: %% To the normal form : matrix expression.
! 212: f gb.toMatrixOfString /f set
! 213: /mm gb.itWasMatrix def
! 214:
! 215: rr tag 0 eq {
! 216: %% Define our own ring
! 217: v isInteger {
! 218: (Error in gb: Specify variables) error
! 219: } { } ifelse
! 220: wv isInteger {
! 221: [v ring_of_differential_operators
! 222: [ v ecart.wv1 v ecart.wv2 ] weight_vector
! 223: 0
! 224: opt
! 225: ] define_ring
! 226: }{
! 227: degreeShift isInteger {
! 228: [v ring_of_differential_operators
! 229: [v ecart.wv1 v ecart.wv2] wv join weight_vector
! 230: 0
! 231: opt
! 232: ] define_ring
! 233:
! 234: }{
! 235: [v ring_of_differential_operators
! 236: [v ecart.wv1 v ecart.wv2] wv join weight_vector
! 237: 0
! 238: [(degreeShift) degreeShift] opt join
! 239: ] define_ring
! 240:
! 241: } ifelse
! 242: } ifelse
! 243: } {
! 244: %% Use the ring structre given by the input.
! 245: v isInteger not {
! 246: gb.warning {
! 247: (Warning : the given ring definition is not used.) message
! 248: } { } ifelse
! 249: } { } ifelse
! 250: rr ring_def
! 251: /wv rr gb.getWeight def
! 252:
! 253: } ifelse
! 254: %%% Enf of the preprocess
! 255:
! 256: ecart.gb.verbose {
! 257: (The first and the second weight vectors are automatically set as follows)
! 258: message
! 259: v ecart.wv1 message
! 260: v ecart.wv2 message
! 261: degreeShift isInteger { }
! 262: {
! 263: (The degree shift is ) messagen
! 264: degreeShift message
! 265: } ifelse
! 266: } { } ifelse
! 267:
! 268: ecart.begin
! 269:
! 270: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
! 271: ecart.autoHomogenize {
! 272: (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
! 273: message
! 274: } { } ifelse
! 275: ecart.autoHomogenize {
! 276: f { {. ecart.dehomogenize} map} map /f set
! 277: f ecart.homogenize01 /f set
! 278: }{
! 279: f { {. } map } map /f set
! 280: } ifelse
! 281: ecart.needSyz {
! 282: [f [(needSyz)] gb.options join ] groebner /gg set
! 283: } {
! 284: [f gb.options] groebner 0 get /gg set
! 285: } ifelse
! 286:
! 287: ecart.needSyz {
! 288: mm {
! 289: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
! 290: } { /ans.gb gg 0 get def } ifelse
! 291: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
! 292: ans pmat ;
! 293: } {
! 294: wv isInteger {
! 295: /ans [gg gg {init} map] def
! 296: }{
! 297: /ans [gg gg {wv 0 get weightv init} map] def
! 298: }ifelse
! 299:
! 300: %% Postprocess : recover the matrix expression.
! 301: mm {
! 302: ans { /tmp set [mm tmp] toVectors } map
! 303: /ans set
! 304: }{ }
! 305: ifelse
! 306: } ifelse
! 307:
! 308: ecart.end
! 309:
! 310: %%
! 311: env1 restoreOptions %% degreeShift changes "grade"
! 312:
! 313: /arg1 ans def
! 314: ] pop
! 315: popEnv
! 316: popVariables
! 317: arg1
! 318: } def
! 319: (ecart.gb ) messagen-quiet
! 320:
! 321: [(ecart.gb)
! 322: [(a ecart.gb b)
! 323: (array a; array b;)
! 324: $b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$
! 325: ( in the ring of differential operators.)
! 326: (The computation is done by using Ecart division algorithm and )
! 327: (the double homogenization.)
! 328: (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
! 329: $ ii is the initial ideal in case of w is given or <<a>> belongs$
! 330: $ to a ring. In the other cases, it returns the initial monominal.$
! 331: (a : [f ]; array f; f is a set of generators of an ideal in a ring.)
! 332: (a : [f v]; array f; string v; v is the variables. )
! 333: (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
! 334: (a : [f v w ds]; array f; string v; array of array w; w is the weight matirx.)
! 335: ( array ds; ds is the degree shift )
! 336: ( )
! 337: (/ecart.autoHomogenize 0 def )
! 338: ( not to dehomogenize and homogenize)
! 339: ( )
! 340: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
! 341: $ [ [ (Dx) 1 ] ] ] ecart.gb pmat ; $
! 342: (Example 2: )
! 343: (To put H and h=1, type in, e.g., )
! 344: $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
! 345: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecart.gb /gg set gg ecart.dehomogenize pmat ;$
! 346: ( )
! 347: $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
! 348: $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $
! 349: ( )
! 350: $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
! 351: $ [ [ (x) -1 (y) -1] ] ] ecart.gb pmat ; $
! 352: ( )
! 353: $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
! 354: $ [ [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.gb pmat ; $
! 355: ( )
! 356: (cf. gb, groebner, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
! 357: ( ecart.dehomogenize, ecart.dehomogenizeH)
! 358: ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
! 359: ( define_ring )
! 360: ]] putUsages
! 361:
! 362: %% BUG: " f weight init " works well in case of vectors with degree shift ?
! 363:
! 364: /ecart.syz {
! 365: /arg1 set
! 366: [/in-ecart.syz /ecart.save.needSyz /ff /ff.ans] pushVariables
! 367: [
! 368: /ff arg1 def
! 369: /ecart.save.needSyz ecart.needSyz def
! 370: /ecart.needSyz 1 def
! 371: ff ecart.gb /ff.ans set
! 372: /ecart.needSyz ecart.save.needSyz def
! 373: /arg1 ff.ans def
! 374: ] pop
! 375: popVariables
! 376: arg1
! 377: } def
! 378: (ecart.syz ) messagen-quiet
! 379:
! 380: [(ecart.syz)
! 381: [(a ecart.syz b)
! 382: (array a; array b;)
! 383: $b : [syzygy gb tmat input]; gb = tmat * input $
! 384: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
! 385: $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.syz /ff set $
! 386: $ ff 0 get ff 3 get mul pmat $
! 387: $ ff 2 get ff 3 get mul [ff 1 get ] transpose sub pmat ; $
! 388: ( )
! 389: $Example 2: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
! 390: $ [ [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.syz pmat ; $
! 391: ( )
! 392: (cf. ecart.gb)
! 393: ( /ecart.autoHomogenize 0 def )
! 394: ]] putUsages
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ecart.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc