Return to int-q.sm1 CVS log

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

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

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