version 1.14, 2004/05/04 07:48:47 |
version 1.21, 2004/07/29 08:13:42 |
|
|
% $OpenXM: OpenXM/src/kan96xx/Doc/hol.sm1,v 1.13 2003/07/29 08:36:39 takayama Exp $ |
% $OpenXM: OpenXM/src/kan96xx/Doc/hol.sm1,v 1.20 2004/06/10 06:01:50 takayama Exp $ |
%% hol.sm1, 1998, 11/8, 11/10, 11/14, 11/25, 1999, 5/18, 6/5. 2000, 6/8 |
%% hol.sm1, 1998, 11/8, 11/10, 11/14, 11/25, 1999, 5/18, 6/5. 2000, 6/8 |
%% rank, rrank, characteristic |
%% rank, rrank, characteristic |
%% This file is error clean. |
%% This file is error clean. |
Line 14 $hol.sm1, basic package for holonomic systems (C) N.Ta |
|
Line 14 $hol.sm1, basic package for holonomic systems (C) N.Ta |
|
message-quiet |
message-quiet |
|
|
/gb.warning 0 def |
/gb.warning 0 def |
|
/gb.oxRingStructure [[ ] [ ]] def |
/rank.v [(x) (y) (z)] def %% default value of v (variables). |
/rank.v [(x) (y) (z)] def %% default value of v (variables). |
/rank.ch [ ] def %% characteristic variety. |
/rank.ch [ ] def %% characteristic variety. |
/rank.verbose 0 def |
/rank.verbose 0 def |
|
|
/ans set |
/ans set |
}{ } |
}{ } |
ifelse |
ifelse |
|
ans getRing (oxRingStructure) dc /gb.oxRingStructure set |
%% |
%% |
env1 restoreOptions %% degreeShift changes "grade" |
env1 restoreOptions %% degreeShift changes "grade" |
|
|
|
|
( array ds; ds is the degree shift ) |
( array ds; ds is the degree shift ) |
( ) |
( ) |
(gb.authoHomogenize 1 [default]) |
(gb.authoHomogenize 1 [default]) |
|
(gb.oxRingStructure ) |
( ) |
( ) |
$Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $ |
$Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $ |
$ [ [ (Dx) 1 ] ] ] gb pmat ; $ |
$ [ [ (Dx) 1 ] ] ] gb pmat ; $ |
|
|
[vsize gtmp] toVectors /gtmp set |
[vsize gtmp] toVectors /gtmp set |
ggall 0 gtmp put |
ggall 0 gtmp put |
}{ } ifelse |
}{ } ifelse |
/arg1 [gg dehomogenize ggall] def |
|
|
gg getRing (oxRingStructure) dc /gb.oxRingStructure set |
|
|
|
/arg1 [gg dehomogenize ggall] def |
] pop |
] pop |
popEnv |
popEnv |
popVariables |
popVariables |
|
|
$ [[(x Dx -h^2) (0)] [(Dx^2) (1)] [(Dx^3) (Dx)]] (x,y)] isSameIdeal_h $ |
$ [[(x Dx -h^2) (0)] [(Dx^2) (1)] [(Dx^3) (Dx)]] (x,y)] isSameIdeal_h $ |
]] putUsages |
]] putUsages |
|
|
|
/gb.reduction { |
|
/arg2 set |
|
/arg1 set |
|
[/in-gb.reduction /gbasis /flist /ans /gbasis2 |
|
] pushVariables |
|
[(CurrentRingp) (KanGBmessage)] pushEnv |
|
[ |
|
/gbasis arg2 def |
|
/flist arg1 def |
|
gbasis 0 get tag 6 eq { } |
|
{ (gb.reduction: the second argument must be a list of lists) error } |
|
ifelse |
|
|
|
gbasis length 1 eq { |
|
gbasis getRing ring_def |
|
/gbasis2 gbasis 0 get def |
|
} { |
|
[ [(1)] ] gbasis rest join gb 0 get getRing ring_def |
|
/gbasis2 gbasis 0 get ,,, def |
|
} ifelse |
|
|
( ) message-quiet ; |
|
|
|
|
flist ,,, /flist set |
|
flist tag 6 eq { |
|
flist { gbasis2 reduction } map /ans set |
|
}{ |
|
flist gbasis2 reduction /ans set |
|
} ifelse |
|
/arg1 ans def |
|
|
|
] pop |
|
popEnv |
|
popVariables |
|
arg1 |
|
} def |
|
|
|
/gb.reduction_noh { |
|
/arg2 set |
|
/arg1 set |
|
[/in-gb.reduction_noh /gbasis /flist /ans /gbasis2 |
|
] pushVariables |
|
[(CurrentRingp) (KanGBmessage) (Homogenize)] pushEnv |
|
[ |
|
/gbasis arg2 def |
|
/flist arg1 def |
|
gbasis 0 get tag 6 eq { } |
|
{ (gb.reduction_noh: the second argument must be a list of lists) error } |
|
ifelse |
|
|
|
gbasis length 1 eq { |
|
gbasis getRing ring_def |
|
/gbasis2 gbasis 0 get def |
|
} { |
|
[ [(1)] ] gbasis rest join gb 0 get getRing ring_def |
|
/gbasis2 gbasis 0 get ,,, def |
|
} ifelse |
|
|
|
|
|
flist ,,, /flist set |
|
[(Homogenize) 0] system_variable |
|
flist tag 6 eq { |
|
flist { gbasis2 reduction } map /ans set |
|
}{ |
|
flist gbasis2 reduction /ans set |
|
} ifelse |
|
/arg1 ans def |
|
|
|
] pop |
|
popEnv |
|
popVariables |
|
arg1 |
|
} def |
|
|
|
/gb.reduction.test { |
|
[ |
|
[( 2*(1-x-y) Dx + 1 ) ( 2*(1-x-y) Dy + 1 )] |
|
(x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] |
|
gb /gg set |
|
|
|
((h-x-y)*Dx) [gg 0 get] gb.reduction /gg2 set |
|
gg2 message |
|
(-----------------------------) message |
|
|
|
[[( 2*(h-x-y) Dx + h^2 ) ( 2*(h-x-y) Dy + h^2 )] |
|
(x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set |
|
((h-x-y)*Dx) ggg gb.reduction /gg4 set |
|
gg4 message |
|
(-----------------------------) message |
|
[gg2 gg4] |
|
} def |
|
[(gb.reduction) |
|
[ (f basis gb.reduction r) |
|
(f is reduced by basis by the normal form algorithm.) |
|
(The first element of basis <g_1,...,g_m> must be a Grobner basis.) |
|
(r is the return value format of reduction;) |
|
(r=[h,c0,syz,input], h = c0 f + \sum syz_i g_i) |
|
(basis is given in the argument format of gb.) |
|
$h[1,1](D)-homogenization is used.$ |
|
(cf. reduction, gb, ecartd.gb, gb.reduction.test ) |
|
$Example:$ |
|
$ [[( 2*(h-x-y) Dx + h^2 ) ( 2*(h-x-y) Dy + h^2 )] $ |
|
$ (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set $ |
|
$ ((h-x-y)^2*Dx*Dy) ggg gb.reduction :: $ |
|
]] putUsages |
|
|
|
[(gb.reduction_noh) |
|
[ (f basis gb.reduction_noh r) |
|
(f is reduced by basis by the normal form algorithm.) |
|
(The first element of basis <g_1,...,g_m> must be a Grobner basis.) |
|
(r is the return value format of reduction;) |
|
(r=[h,c0,syz,input], h = c0 f + \sum syz_i g_i) |
|
(basis is given in the argument format of gb.) |
|
(cf. gb.reduction, gb ) |
|
$Example:$ |
|
$ [[( 2*Dx + 1 ) ( 2*Dy + 1 )] $ |
|
$ (x,y) [[(Dx) 1 (Dy) 1]]] /ggg set $ |
|
$ ((1-x-y)^2*Dx*Dy) ggg gb.reduction_noh :: $ |
|
]] putUsages |
|
|
|
( ) message-quiet ; |
|
|
|
/hol_loaded 1 def |
|
|
|
|
|
|