Annotation of OpenXM/src/kan96xx/Doc/dhecart.sm1, Revision 1.1
1.1 ! takayama 1: % $OpenXM$
! 2: % Stdbasis via the double homogenization: dx x = x dx + h H
! 3: % Homogenize=3
! 4: (ecart_loaded) boundp { }
! 5: { [(parse) (ecart.sm1) pushfile] extension } ifelse
! 6:
! 7: /dh.begin {
! 8: [(Homogenize) 3] system_variable
! 9: } def
! 10:
! 11: /dh.end {
! 12: [(Homogenize) 1] system_variable
! 13: } def
! 14:
! 15: /dh.dehomogenize {
! 16: dehomogenize
! 17: } def
! 18:
! 19: % Global environmental variables
! 20: /dh.gb.verbose 1 def
! 21: /dh.autoHomogenize 1 def
! 22: /dh.needSyz 0 def
! 23:
! 24: /dh.message {
! 25: (dh.ecart: ) messagen message
! 26: } def
! 27: /dh.messagen {
! 28: (dh.ecart: ) messagen messagen
! 29: } def
! 30:
! 31: %%test
! 32: % [(x,y) ring_of_differential_operators [[(Dx) 1]] ecart.weight_vector 0] define_ring ; dh.begin ;
! 33: % [[(x Dx + 1). homogenize]] groebner ::
! 34:
! 35: %%test
! 36: % [ [(x Dx + y Dy + 1) (x Dx y Dy -1)] (x,y) [[(x) -1 (y) -1]]] dh.gb pmat
! 37: % --> It is not an admissible order.
! 38: % [ [(x Dx + y Dy + 1) (x Dx y Dy -1)] (x,y) [[(Dx) 1 (Dy) 1 (x) -1 (y) -1] [(Dx) 1 (Dy) 1] [(x) -1 (y) -1]]] dh.gb pmat
! 39:
! 40: /dh.gb {
! 41: /arg1 set
! 42: [/in-dh.gb /aa /typev /setarg /f /v
! 43: /gg /wv /vec /ans /rr /mm
! 44: /env2 /ans.gb
! 45: ] pushVariables
! 46: [(CurrentRingp) (KanGBmessage)] pushEnv
! 47: [
! 48: /aa arg1 def
! 49: aa isArray { } { ( << array >> dh.gb) error } ifelse
! 50: /setarg 0 def
! 51: /wv 0 def
! 52:
! 53: aa { tag } map /typev set
! 54: typev [ ArrayP ] eq
! 55: { /f aa 0 get def
! 56: /v gb.v def
! 57: /setarg 1 def
! 58: } { } ifelse
! 59: typev [ArrayP StringP] eq
! 60: { /f aa 0 get def
! 61: /v aa 1 get def
! 62: /setarg 1 def
! 63: } { } ifelse
! 64: typev [ArrayP RingP] eq
! 65: { /f aa 0 get def
! 66: /v aa 1 get def
! 67: /setarg 1 def
! 68: } { } ifelse
! 69: typev [ArrayP ArrayP] eq
! 70: { /f aa 0 get def
! 71: /v aa 1 get from_records def
! 72: /setarg 1 def
! 73: } { } ifelse
! 74: typev [ArrayP StringP ArrayP] eq
! 75: { /f aa 0 get def
! 76: /v aa 1 get def
! 77: /wv aa 2 get def
! 78: /setarg 1 def
! 79: } { } ifelse
! 80: typev [ArrayP ArrayP ArrayP] eq
! 81: { /f aa 0 get def
! 82: /v aa 1 get from_records def
! 83: /wv aa 2 get def
! 84: /setarg 1 def
! 85: } { } ifelse
! 86:
! 87: /env1 getOptions def
! 88:
! 89: setarg { } { (dh.gb : Argument mismatch) error } ifelse
! 90:
! 91: [(KanGBmessage) dh.gb.verbose ] system_variable
! 92:
! 93: %%% Start of the preprocess
! 94: v tag RingP eq {
! 95: /rr v def
! 96: }{
! 97: f getRing /rr set
! 98: } ifelse
! 99: %% To the normal form : matrix expression.
! 100: f gb.toMatrixOfString /f set
! 101: /mm gb.itWasMatrix def
! 102:
! 103: rr tag 0 eq {
! 104: %% Define the ring.
! 105: v isInteger {
! 106: (Error in dh.gb: Specify variables) error
! 107: } { } ifelse
! 108: %% wv is set when parsing the arguments.
! 109: wv isInteger {
! 110: (Give a weight vector) error
! 111: }{
! 112: [v ring_of_differential_operators
! 113: wv ecart.weight_vector
! 114: gb.characteristic
! 115: ] define_ring
! 116: } ifelse
! 117: } {
! 118: %% Use the ring structre given by the input.
! 119: v isInteger not {
! 120: gb.warning {
! 121: (Warning : the given ring definition is not used.) message
! 122: } { } ifelse
! 123: } { } ifelse
! 124: rr ring_def
! 125: /wv rr gb.getWeight def
! 126: } ifelse
! 127: %%% Enf of the preprocess
! 128:
! 129: dh.begin
! 130:
! 131: v ecart.checkOrder
! 132:
! 133: dh.gb.verbose { (gb.options = ) dh.messagen gb.options dh.message } { } ifelse
! 134:
! 135: dh.autoHomogenize not {
! 136: % No automatic hH-homogenization.
! 137: f { {. } map} map /f set
! 138: } {
! 139: % Automatic hH-homogenization
! 140: (dh.gb : Input polynomial or vectors are automatically homogenized) dh.message
! 141: f { {. } map} map /f set
! 142: f { { [[@@@.Hsymbol . (1).] [@@@.hsymbol . (1).] ] replace } map } map /f set
! 143: f { { homogenize } map } map /f set
! 144: f dh.message
! 145: } ifelse
! 146:
! 147: dh.needSyz {
! 148: [f [(needSyz)] gb.options join ] groebner /gg set
! 149: } {
! 150: [f gb.options] groebner 0 get /gg set
! 151: } ifelse
! 152:
! 153:
! 154: dh.needSyz {
! 155: mm {
! 156: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
! 157: } { /ans.gb gg 0 get def } ifelse
! 158: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
! 159: % ans pmat ;
! 160: } {
! 161: wv isInteger {
! 162: /ans [gg gg {init} map] def
! 163: }{
! 164: %% Get the initial ideal
! 165: /ans [gg gg {wv 0 get weightv init} map] def
! 166: }ifelse
! 167:
! 168: %% Postprocess : recover the matrix expression.
! 169: mm {
! 170: ans { /tmp set [mm tmp] toVectors } map
! 171: /ans set
! 172: }{ }
! 173: ifelse
! 174: } ifelse
! 175:
! 176: dh.end
! 177:
! 178: ans getRing (oxRingStructure) dc /dh.gb.oxRingStructure set
! 179: %%
! 180: env1 restoreOptions %% degreeShift changes "grade"
! 181:
! 182: /arg1 ans def
! 183: ] pop
! 184: popEnv
! 185: popVariables
! 186: arg1
! 187: } def
! 188:
! 189: [(dh.gb)
! 190: [(a dh.gb b)
! 191: (array a; array b;)
! 192: $b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$
! 193: ( in the ring of differential operators.)
! 194: (The computation is done in the doubly homogenized Weyl algebra.)
! 195: (Dx x = x Dx + h H)
! 196: $ ii is the initial ideal in case of w is given or <<a>> belongs$
! 197: $ to a ring. In the other cases, it returns the initial monominal.$
! 198: (a : [f ]; array f; f is a set of generators of an ideal in a ring.)
! 199: (a : [f v]; array f; string v; v is the variables. )
! 200: (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
! 201: ( )
! 202: (Globals: dh.autoHomogenize dh.gb.verbose dh.needSyz dh.gb.oxRingStructure)
! 203: (cf. dh.begin dh.end dh.message dh.messagen)
! 204: ( )
! 205: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
! 206: $ [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] dh.gb pmat ; $
! 207: (Example 2: )
! 208: $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
! 209: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] dh.gb /ff set ff pmat ;$
! 210: (To set the current ring to the ring in which ff belongs )
! 211: ( ff getRing ring_def )
! 212: ( )
! 213: ]] putUsages
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to dhecart.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc