Return to int-d.sm1 CVS log

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

Annotation of OpenXM/src/kan96xx/Doc/Old/int-d.sm1, Revision 1.1.1.1

1.1       maekawa     1: % int-d.sm1
                      2: %%
                      3: %%%
                      4:
                      5: (int-d.sm1: Aug 28, 1995.) message
                      6: (      New macros  "integral-d" and "get0-d"  are added.) message
                      7: (      Type in 3 0 demo.int-d to see a demo.) message
                      8:
                      9:
                     10: %% Usage, putUsages and showKeywords
                     11: %% The data should be automatically generated from int-d.txt
                     12: %% int-d.sm1 = int-d.sm + int-d.txt
                     13: [(integral-d)
                     14: [(ff n integral-d ffi  )
                     15:  (  ff is a list of operators,)
                     16:  (  n  is a number to specify the degree of approximation,)
                     17:  (  ffi is the result list that will be the input to the "groebner")
                     18:  (  to get the "sum" of the module ff.)
                     19:  (Example: )
                     20:  $ [(m) ring_of_difference_operators (Em) elimination_order 0] define_ring $
                     21:  $ [((m-e+1) Em - (m+1)).  ( (e+1) E - (m-e)).] 3 integral-d /ffi set$
                     22:  ( [ffi] groebner 0 get get0-d ::)
                     23:  ( )
                     24:  (See also, groebner (option countdown) and get0-d.)
                     25: ]] putUsages
                     26:
                     27: [(get0-d)
                     28: [(ff get0 result)
                     29:  (   ff is a list of operators. The operators in ff that does not)
                     30:  (   contain "e" is stored in result.)
                     31:  (   Note that "h" and "E" are set to 1.)
                     32:  (See also integral-d)
                     33:  (Example: )
                     34:  $  [ (x h + E). (e+x).] get0-d :: $
                     35:  (  [ x + 1 ] )
                     36: ]] putUsages
                     37:
                     38: %% You can use it as a template.
                     39: /demo.int-d {
                     40: /ccc set
                     41: /nnn set
                     42: %%%% Define the ring
                     43: [ (n) ring_of_difference_operators (En) elimination_order 0] define_ring
                     44:
                     45: %%%% Give the equations here.
                     46: %%%% E e = e E + E and "e"  and "E" will be eliminated.
                     47: [ ((n-e+1)^2*En - (n+e+1)^2).
                     48:   ((e+1)^4*E - (-1)^2*(n-e)^2*(n+e+1)^2). ] /ff set
                     49:
                     50: %%% Let's compute
                     51: ff nnn integral-d /ffi set
                     52: %% Give the lower and the upper bound of the degree.
                     53: %% /from-degree 0 def  /to-degree 5 def
                     54: %%[ffi [(from) from-degree (to) to-degree]]
                     55: [ffi [(countDown) ccc]]
                     56: groebner 0 get get0-d /ans set
                     57: (Answer is in ans. ans = )  message
                     58: ans ::
                     59: (This is Apery's reccurence formula.) message
                     60: } def
                     61:
                     62: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                     63: %%%%%%%%%%%% Don't touch below %%%%%%%%%%%%%%%%%%%%%%%%
                     64: %%%%%%%%%%%%%% e-vectors, integral-d, get0-d %%%%%%%%%%%%%%
                     65: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                     66: %% (Try   [f1 f2 ...] nnn integral-d /ff set) message
                     67: %% ([ff] groebner 0 get get0-d) message
                     68: %%  number e-vectors
                     69: /e-vectors {
                     70:   /arg1 set
                     71:   [/ans] pushVariables
                     72:   [
                     73:   /ans [(e).] def
                     74:   1 1  << arg1 1 sub >>
                     75:   { pop
                     76:     /ans
                     77:       [(e).] ans {(e). mul} map join
                     78:     def
                     79:   } for
                     80:   /arg1 ans def
                     81:   ] pop
                     82:   popVariables
                     83:   arg1
                     84: } def
                     85:
                     86:
                     87: %% [f1 f2 ...] nnn integral-d
                     88: /integral-d {
                     89:   /arg2 set
                     90:   /arg1 set
                     91:   [/nnn /gens /m /ans /fff] pushVariables
                     92:   [
                     93:   /gens arg1 def
                     94:   /nnn arg2 def
                     95:   /m gens length def
                     96:   /ans [ ] def
                     97:   0 1 << m 1 sub >> {
                     98:     gens 2 1 roll get /fff set
                     99:     %%fff ::
                    100:     /ans
                    101:       ans [fff] join nnn e-vectors {fff mul} map join
                    102:     def
                    103:     %%ans ::
                    104:   } for
                    105:   /ans
                    106:     ans nnn e-vectors {(E-1). 2 1 roll mul} map join
                    107:   def
                    108:   /ans ans {[[(h). (1).]] replace} map def
                    109:   /ans ans {homogenize} map def
                    110:   /arg1 ans def
                    111:   ] pop
                    112:   popVariables
                    113:   arg1
                    114: } def
                    115:
                    116: % [g1 g2 g3 ...] get0-d
                    117: /get0-d {
                    118:   /arg1 set
                    119:   [/gb /degs /ans /n /ff] pushVariables
                    120:   [
                    121:   /gb arg1 def
                    122:   /degs gb {(e). degree} map def
                    123:   /ans [
                    124:     0 1 << gb length 1 sub >> {
                    125:       /n set
                    126:       << degs n get  >>  0 eq
                    127:       { gb n get [[(E). (1).] [(h). (1).]] replace /ff set
                    128:         ff (0). eq
                    129:         {  }
                    130:         { ff } ifelse
                    131:       }
                    132:       {   } ifelse
                    133:     } for
                    134:   ] def
                    135:   /arg1 ans def
                    136:   ] pop
                    137:   popVariables
                    138:   arg1
                    139: } def
                    140:
                    141: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                    142: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
                    143:
                    144:
                    145: