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     ! 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: