Return to cv2.sm1 CVS log

Up to [local] / OpenXM / src / kan96xx / Doc

Annotation of OpenXM/src/kan96xx/Doc/cv2.sm1, Revision 1.1.1.1

1.1       maekawa     1: (cv0.sm1) run
                      2: ( ) message
                      3: (cv2.sm1 11/15, 1994. This program computes characteristic varieties) message
                      4: (                     and multiplicities.) message
                      5: (Revised: 4/2, 1995, 11/5, 1998) message
                      6: (Type in  charv and multi to see a demo.) message
                      7:
                      8: %%%%%%%%%%%%%%%%%% How to use %%%%%%%%%%%%%
                      9: % 1. Set your differential equation in Part A
                     10: % 2. Start sm1 and read this file.
                     11: % 3. Type in
                     12: %            charv
                     13: %    to get the characteristic variety.
                     14: % 4. Next set the localization rule by the command
                     15: %            /locRule locRule1 def
                     16: % 5. And type in
                     17: %            multi
                     18: % 6. to get the multiplicty.
                     19: % 7. goto 4
                     20: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                     21: %  example
                     22: %  sm1>charv ;
                     23: %  sm1>/locRule locRule1 def multi ;
                     24: %  sm1>/locRule locRule2 def multi ;
                     25: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                     26:
                     27:
                     28: %%%%%%%%%%Change here %%% set your data %%%%%%%%%%%%%%%%%%%%%%%%%%
                     29: %%% [Part A]
                     30: %%% Define variables
                     31: (x,y) /vars set
                     32: (a,b,b',c) /parameters set   % Don't use t,e,H,h,E. They are reserved.
                     33: %%% Set your equations
                     34: [ ( Dx*(x*Dx+y*Dy+c-1)-(x*Dx+y*Dy+a)*(x*Dx+b) )
                     35:   ( Dy*(x*Dx+y*Dy+c-1)-(x*Dx+y*Dy+a)*(y*Dy+b') )
                     36:  ]  /ff0 set
                     37: %%% If you can't get the result for general parameters, specialize
                     38: %%% the parameters.
                     39: [[$a$ $a$] [$b$ $b$]] /prule set
                     40: %%% [Part B] localization rules
                     41: %%% localization at the point x=2 y=3 Dx=0, Dy=0 on T^*_M M.
                     42: [[(x) (x+2)] [(y) (y+3)]]   /locRule1 set %example 2
                     43: %%% localization at the point x=2 Dy=3 Dx=0, y=0 on T^*_V M where V={(x,0)}.
                     44: [[(x) (x+2)] [(Dy) (Dy+3)]] /locRule2 set %exmaple 2'
                     45: /locRule locRule1 def
                     46: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                     47:
                     48:
                     49: %%%%%%%%%%%%%% You don't need read the below.
                     50: /charv {
                     51:   [ [vars to_records pop parameters to_records pop]  { (,) 1 cat_n } map cat
                     52:     ring_of_differential_operators
                     53:     dvars  elimination_order 0] swap01 define_ring
                     54:   ff0 { . } map /ff set
                     55:   ff { [[$h$. $1$.]] replace } map  /ff set
                     56:   ff { prule { {. } map } map replace } map  /ff set
                     57:   /ff ff homogenize  def
                     58:   [ff] groebner /ans set
                     59:   ans 0 get {[[$h$. $1$.]] replace} map /gg set
                     60:   (Now, you get the characteristic variety) message
                     61:   gg characteristic-v print (  ) message ( ) message
                     62:   gg characteristic-v 0 get {(string) data_conversion} map
                     63:   /gg0 set
                     64: } def
                     65:
                     66:
                     67: /multi {
                     68:    (Computing the multiplicity along T^*_Y M...) message
                     69:
                     70:    (t) ring_of_differential_operators3 (t) lexicographic_order3 /r1 set
                     71:    % t must be the most expensive.
                     72:    dvars vars 2 cat_n
                     73:    ring_of_polynomials2 ( ) elimination_order2 /r2 set
                     74:
                     75:    parameters ring_of_polynomials2 ( ) elimination_order2 /r3 set
                     76:    (H,h) ring_of_polynomials2 (H,h) lexicographic_order2 /r4 set
                     77:    [r1 r2 add_rings r3 add_rings r4 add_rings 0]  addSwap0k define_ring
                     78:
                     79:    gg0 { . locRule {{ . } map} map replace} map
                     80:
                     81:    (grade) (firstvec) switch_function
                     82:    { homogenize [[$h$. $t$.]] replace (string) data_conversion } map /gg2 set
                     83:
                     84:    [gg2 {.} map] groebner /gg2b set
                     85:    gg2b 0 get {init} map { [[$t$. $1$.]] replace } map /gg3 set
                     86:    gg3 {(string) data_conversion} map print
                     87:    ( ) message
                     88:    gg3 { parameters makeRule replace } map
                     89:    {(string) data_conversion} map
                     90:    [vars to_records pop] { (D) 2 1 roll 2 cat_n} map
                     91:    [vars to_records pop] join
                     92:    hilb ::
                     93:    (The coefficient of h^2 is the multiplicity.) message
                     94:    (grade) (module1) switch_function
                     95: } def
                     96:
                     97:
                     98: [vars to_records pop] { (D) 2 1 roll 2 cat_n (,) 2 cat_n } map cat /dvars set
                     99:
                    100:
                    101: /makeRule {
                    102:   /arg1 set
                    103:   [arg1 to_records pop] { [ 2 1 roll . $1$.] } map
                    104: } def
                    105:
                    106: /writeArray {
                    107:   /arg2 set /arg1 set
                    108:   [/fd /arr /k] pushVariables
                    109:   [ /fd arg1 def
                    110:     /arr arg2 def
                    111:     fd ([ ) writestring
                    112:     0 1 arr length 1 sub
                    113:     {
                    114:       /k set
                    115:       fd ($ ) writestring
                    116:       fd arr k get writestring
                    117:       fd ($     ) writestring
                    118:     } for
                    119:     fd ( ] ) writestring
                    120:   ] pop
                    121:   popVariables
                    122: } def
                    123:
                    124: /addSwap0k {
                    125:   /arg1 set
                    126:   [/rg /ch /tmp] pushVariables
                    127:   [
                    128:     arg1 0 get /rg set  % ring
                    129:     arg1 1 get /ch set  % characteristics
                    130:     [rg 0 get , rg 1 get , rg 2 get ,
                    131:
                    132:      << rg 3 get length >>
                    133:      matid
                    134:      << rg 3 get length >>
                    135:      4 1 d_ij add     %% add 1st row and 4th row
                    136:      << rg 3 get >> mul  /tmp set
                    137:
                    138:      << rg 3 get length >>
                    139:      0 4 e_ij
                    140:      tmp mul %% swap 1st row and 4 th row
                    141:     ] /rg set
                    142:     /arg1 [ rg ch ] def
                    143:   ] pop
                    144:   popVariables
                    145:   arg1
                    146: } def
                    147: