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