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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>