Return to int-q.sm1 CVS log

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

o import OpenXM sources

% int-q.sm1
%%%  Approximate Jackson integral.
%%%  see examples note no3, 1992/04/20.

(int-q.sm1: Sep 26, 1995.) message
(      New macros  "integral-q" and "get0-q"  are added.) message
(      Type in 0 0 demo.int-q to see a demo.) message


%% Usage, putUsages and showKeywords
%% The data should be automatically generated from int-q.txt
%% int-q.sm1 = int-q.sm + int-q.txt
[(integral-q)
[(ff n integral-q ffi  )
 (  ff is a list of operators,)
 (  n  is a number to specify the degree of approximation,)
 (  ffi is the result list that will be the input to the "groebner")
 (  to get the "sum" of the module ff.)
 (  The variables e and E --- E e = q e E --- will be eliminated.)
 (Example: )
 $ [(x) ring_of_q_difference_operators (Qx) elimination_order 0] define_qring $
 $ [(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$
 ( [ffi] groebner 0 get get0-q ::)
 ( )
 (See also, groebner (option countdown) and get0-q.)
]] putUsages

[(get0-q)
[(ff get0 result)
 (   ff is a list of operators. The operators in ff that does not)
 (   contain "e" is stored in result.)
 (   Note that "h" and "E" are set to 1.)
 (See also integral-q)
 (Example: )
 $  [ (x h + E). (e+x).] get0-q :: $
 (  [ x + 1 ] )
]] putUsages

%% You can use it as a template.
/demo.int-q {
/ccc set
/nnn set
%%%% Define the ring
[ (x) ring_of_q_difference_operators (Qx) elimination_order 0] define_qring 

%%%% Give the equations here.
%%%% E e = q e E  and "e"  and "E" will be eliminated.
[(q (2-e) (2-x e) E^2 - 4 (1-e) (1-x e)). 
 ( (2 - x e) Qx^2 - 2 (1-x e)).]
/ff set

%%% Let's compute
ff nnn integral-q /ffi set
%% Give the lower and the upper bound of the degree.
%% /from-degree 0 def  /to-degree 5 def
%%[ffi [(from) from-degree (to) to-degree]] 
[ffi [(countDown) ccc]]
groebner 0 get get0-q /ans set
(Answer is in ans. ans = )  message
ans ::
(   ) message
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%% Don't touch below %%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%% e-vectors, integral-q, get0-q %%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% (Try   [f1 f2 ...] nnn integral-q /ff set) message
%% ([ff] groebner 0 get get0-q) message
%%  number e-vectors
/e-vectors {
  /arg1 set
  [/ans] pushVariables
  [
  /ans [(e).] def
  1 1  << arg1 1 sub >>
  { pop
    /ans
      [(e).] ans {(e). mul} map join
    def
  } for
  /arg1 ans def
  ] pop
  popVariables
  arg1
} def


%% [f1 f2 ...] nnn integral-q
/integral-q {
  /arg2 set
  /arg1 set
  [/nnn /gens /m /ans /fff] pushVariables
  [
  /gens arg1 def
  /nnn arg2 def
  /m gens length def
  /ans [ ] def
  0 1 << m 1 sub >> {
    gens 2 1 roll get /fff set
    %%fff ::
    /ans
      ans [fff] join nnn e-vectors {fff mul} map join 
    def
    %%ans ::
  } for
  /ans
    ans nnn e-vectors {(E-1). 2 1 roll mul} map join 
  def
  /ans ans {[[(h). (1).]] replace} map def
  /ans ans {homogenize} map def
  /arg1 ans def
  ] pop
  popVariables
  arg1
} def
   
% [g1 g2 g3 ...] get0-q
/get0-q {
  /arg1 set
  [/gb /degs /ans /n /ff] pushVariables
  [
  /gb arg1 def
  /degs gb {(e). degree} map def
  /ans [
    0 1 << gb length 1 sub >> {
      /n set
      << degs n get  >>  0 eq
      { gb n get [[(E). (1).] [(h). (1).]] replace /ff set
        ff (0). eq
        {  }
        { ff } ifelse
      }
      {   } ifelse
    } for
  ] def
  /arg1 ans def
  ] pop
  popVariables
  arg1
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%