![]() ![]() | ![]() |
File: [local] / OpenXM / src / kan96xx / Doc / Old / cv2.sm1 (download)
Revision 1.1.1.1 (vendor branch), Fri Oct 8 02:12:03 1999 UTC (24 years, 10 months ago) by maekawa
o import OpenXM sources |
(../Kan/module1.sm1) run ( ) message (cv2.sm1 11/15, 1994. This program computes characteristic varieties) message ( and multiplicities.) message (The program automatically generate the file t.t for a work-file.) message (Revised: 4/2, 1995.) message (Type in charv and multi to see a demo.) message %%%%%%%%%%%%%%%%%% How to use %%%%%%%%%%%%% % 0. Make sure that you installed old sm1 of Version 1.x (x >= 940217) with % the name "sm0". It is used to compute Hilbert function. % 1. Set your differential equation in Part A % 2. Start sm1 and read this file. % 3. Type in % charv % to get the characteristic variety. % 4. Next set the localization rule by the command % /locRule locRule1 def % 5. And type in % multi % 6. to get the multiplicty. % 7. goto 4 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % example % sm1>charv ; % sm1>/locRule locRule1 def multi ; % sm1>/locRule locRule2 def multi ; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%Change here %%% set your data %%%%%%%%%%%%%%%%%%%%%%%%%% %%% [Part A] %%% Define variables (x,y) /vars set (a,b,b',c) /parameters set % Don't use t,e,H,h,E. They are reserved. %%% Set your equations [ ( Dx*(x*Dx+y*Dy+c-1)-(x*Dx+y*Dy+a)*(x*Dx+b) ) ( Dy*(x*Dx+y*Dy+c-1)-(x*Dx+y*Dy+a)*(y*Dy+b') ) ] /ff0 set %%% If you can't get the result for general parameters, specialize %%% the parameters. [[$a$ $a$] [$b$ $b$]] /prule set %%% [Part B] localization rules %%% localization at the point x=2 y=3 Dx=0, Dy=0 on T^*_M M. [[(x) (x+2)] [(y) (y+3)]] /locRule1 set %example 2 %%% localization at the point x=2 Dy=3 Dx=0, y=0 on T^*_V M where V={(x,0)}. [[(x) (x+2)] [(Dy) (Dy+3)]] /locRule2 set %exmaple 2' /locRule locRule1 def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%% You don't need read the below. /charv { [ [vars to_records pop parameters to_records pop] { (,) 1 cat_n } map cat ring_of_differential_operators dvars elimination_order 0] swap01 define_ring ff0 { . } map /ff set ff { [[$h$. $1$.]] replace } map /ff set ff { prule { {. } map } map replace } map /ff set /ff ff homogenize def [ff] groebner /ans set ans 0 get {[[$h$. $1$.]] replace} map /gg set (Now, you get the characteristic variety) message gg characteristic print ( ) message ( ) message gg characteristic 0 get {(string) data_conversion} map /gg0 set } def /multi { (Computing the multiplicity along T^*_Y M...) message (t) ring_of_differential_operators3 (t) lexicographic_order3 /r1 set % t must be the most expensive. dvars vars 2 cat_n ring_of_polynomials2 ( ) elimination_order2 /r2 set parameters ring_of_polynomials2 ( ) elimination_order2 /r3 set (H,h) ring_of_polynomials2 (H,h) lexicographic_order2 /r4 set [r1 r2 add_rings r3 add_rings r4 add_rings 0] addSwap0k define_ring gg0 { . locRule {{ . } map} map replace} map (grade) (firstvec) switch_function { homogenize [[$h$. $t$.]] replace (string) data_conversion } map /gg2 set [gg2 {.} map] groebner /gg2b set gg2b 0 get {init} map { [[$t$. $1$.]] replace } map /gg3 set gg3 {(string) data_conversion} map print ( ) message gg3 { parameters makeRule replace } map {(string) data_conversion} map execSm0 (grade) (module1) switch_function } def /execSm0 { /monoms set (t.t) (w) file /fd set fd ( ${-p,0}$ options ) writestring fd ( $) writestring ${$ dvars vars $}$ 4 cat_n /tmp set fd tmp writestring fd ($ ) writestring fd ( polynomial_ring set_up_ring ${-proof}$ options ) writestring %%fd [$x$ $y$] writeArray fd monoms writeArray fd ( /ff = ff yaGroebner /gg = gg hilbert2 :: quit) writestring fd closefile ( ) message (sm0 -f t.t) system (When the output is [$ a V^k + ... $ $p!$], the multiplicity is ) message $ (k! a)/p! $ message ( ) message } def /cat { /arg1 set [/n /arr /k] pushVariables [ /arr arg1 def 0 1 arr length 1 sub { /k set arr k get } for arr length cat_n /arg1 set ] pop popVariables arg1 } def [vars to_records pop] { (D) 2 1 roll 2 cat_n (,) 2 cat_n } map cat /dvars set /makeRule { /arg1 set [arg1 to_records pop] { [ 2 1 roll . $1$.] } map } def /writeArray { /arg2 set /arg1 set [/fd /arr /k] pushVariables [ /fd arg1 def /arr arg2 def fd ([ ) writestring 0 1 arr length 1 sub { /k set fd ($ ) writestring fd arr k get writestring fd ($ ) writestring } for fd ( ] ) writestring ] pop popVariables } def /addSwap0k { /arg1 set [/rg /ch /tmp] pushVariables [ arg1 0 get /rg set % ring arg1 1 get /ch set % characteristics [rg 0 get , rg 1 get , rg 2 get , << rg 3 get length >> matid << rg 3 get length >> 4 1 d_ij add %% add 1st row and 4th row << rg 3 get >> mul /tmp set << rg 3 get length >> 0 4 e_ij tmp mul %% swap 1st row and 4 th row ] /rg set /arg1 [ rg ch ] def ] pop popVariables arg1 } def