Artifact 4e204ddc8e971a18976e99d9a4fba3afb873fa3e3ac9169a4184b668d080e6a7:
- Executable file
r38/packages/dipoly/bcoeff.red
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 7038) [annotate] [blame] [check-ins using] [more...]
module bcoeff;% Computation of base coefficients. % Definitions of base coefficient operations for distributive % polynomial package. Fields and rings are supported as coefficient % domains. Side relations (computing modulo an ideal) are supported % if the list bczerodivl is non-zero. % % In this module, a standard quotient coefficient is assumed, unless % !*grmod!* is true, in which case it is a small modular number. % Authors: R. Gebauer, A. C. Hearn, H. Kredel % H. Melenk: added routines for faster computation with % quotients representing integers. symbolic procedure bcint2op(a1,a2,op); if null dmode!* and 1=denr a1 and numberp (a1:=numr a1) and 1=denr a2 and numberp (a2:=numr a2) and (a1:=if op = 'times then a1*a2 else if op = 'plus then a1+a2 else apply2(op,a1,a2)) then ((if a1=0 then nil else a1) ./ 1); fluid'(!*nat); % The following two could be smacros. However, they would then need to % be included in dipoly, thus destroying the modularity of the base % coefficient code. symbolic procedure bcminus!? u; % Boolean function. Returns true if u is a negative base coeff null !*grmod!* and minusf numr u; symbolic procedure bczero!? u; % Returns a boolean expression, true if the base coefficient u is % zero if !*grmod!* then eqn(u,0) else null numr u; symbolic procedure bcfd a; % Base coefficient from domain. a is a domain element. bcfd(a) % returns the base coefficient a. if null !*grmod!* then mkbc(a,1) else if fixp a then bcfi a else if not(car a eq '!:mod!:) then rederr list("Invalid modular coefficient",a) else bcfi cdr a; symbolic procedure bcfi a; % Base coefficient from integer. a is an integer. bcfi(a) % returns the base coefficient a. (if u<0 then if !*balanced_mod and u+u > - current!-modulus then u else u #+ current!-modulus else if !*balanced_mod and u+u > current!-modulus then u #- current!-modulus else u) where u=remainder(a,current!-modulus); symbolic procedure bcdomain!? u; % True if base coefficient u is a domain element. !*grmod!* or (denr u =1 and domainp numr u); symbolic procedure bclcmd(u,v); % Base coefficient least common multiple of denominators. % u and v are two base coefficients. bclcmd(u,v) calculates the % least common multiple of the denominator of u and the % denominator of v and returns a base coefficient of the form % 1/lcm(denom u,denom v). if bczero!? u then mkbc(1,denr v) else if bczero!? v then mkbc(1,denr u) else mkbc(1,multf(quotfx(denr u,gcdf(denr u,denr v)),denr v)); symbolic procedure bclcmdprod(u,v); % Base coefficient least common multiple denominator product. % u is a basecoefficient of the form 1/integer. v is a base % coefficient. bclcmdprod(u,v) calculates (denom u/denom v)*nom v/1 % and returns a base coefficient. mkbc(multf(quotfx(denr u,denr v),numr v),1); symbolic procedure bcone!? u; % Base coefficient one. u is a base coefficient. % bcone!?(u) returns a boolean expression, true if the % base coefficient u is equal 1. if !*grmod!* then eqn(u,1) else denr u = 1 and numr u = 1; symbolic procedure bcinv u; % Base coefficient inverse. u is a base coefficient. % bcinv(u) calculates 1/u and returns a base coefficient. if !*grmod!* then if !*balanced_mod then (if v+v>current!-modulus then v #- current!-modulus else v) where v= modular!-reciprocal u else reciprocal!-by!-gcd(current!-modulus,u,0,1) else invsq u; symbolic procedure bcneg u; % Base coefficient negative. u is a base coefficient. % bcneg(u) returns the negative of the base coefficient % u, a base coefficient. if !*grmod!* then if eqn(u,0) then u else current!-modulus #- u else negsq u; symbolic procedure bcprod (u,v); % Base coefficient product. u and v are base coefficients. % bcprod(u,v) calculates u*v and returns a base coefficient. if !*grmod!* then bcfi(u*v) else bcint2op(u,v,'times) or bccheckz multsq(u,v); symbolic procedure mkbc ( u , v ); % Convert u and v into u/v in lowest terms if !*grmod!* then bcfi ( u * modular!-reciprocal v ) else if v = 1 then ( if u = 1 then ' ( 1 . 1 ) else u ./ v ) else if minusf v then mkbc ( negf u , negf v ) else quotfx ( u , m ) ./ quotfx ( v , m ) where m = gcdf ( u , v ); if null getd 'quotientx then copyd('quotientx,'quotient); symbolic procedure bcquot(u,v); % Base coefficient quotient. u and v are base coefficients. % bcquot(u,v) calculates u/v and returns a base coefficient. if !*grmod!* then bcfi(u*modular!-reciprocal v) else if !*vdpinteger then (bcint2op(u,v,'quotientx) or !*f2q quotfx(numr u,numr v)) else quotsq(u,v); symbolic procedure bcsum(u,v); % Base coefficient sum. u and v are base coefficients. % bcsum(u,v) calculates u+v and returns a base coefficient. if !*grmod!* then bcfi(u+v) else bcint2op(u,v,'plus2) or bccheckz addsq(u,v); symbolic procedure bccheckz u; % Reduce a sum/difference result by members of bczerodivl!*. if null numr u then u else if !*bcsubs2 then subs2 u else <<while l and n do <<n:=cdr qremf(n,car l);l:=cdr l>>;n./d>> where l=bczerodivl!*,n=numr u,d=denr u; symbolic procedure bcdif(u,v); % Base coefficient difference. u and v are base coefficients. % bcdif(u,v) calculates u-v and returns a base coefficient. if !*grmod!* then bcfi(u - v) else bcint2op(u,v,'difference) or bcsum(u,bcneg v); symbolic procedure bcpow(u,n); % Returns the base coefficient u raised to the nth power, where % n is an integer if !*grmod!* then modular!-expt(u,n) else exptsq(u,n); symbolic procedure a2bc u; % Converts the algebraic (kernel) u into a base coefficient. if !*grmod!* then if not domainp u then rederr list ( " Invalid coefficient " , u ) else bcfd u else simp!* u; symbolic procedure bc2a u; % Returns the prefix equivalent of the base coefficient u if !*grmod!* then u else prepsq u; fluid'(!*groebigpos !*groebigneg !*groescale); !*groescale:=20;!*groebigpos:= 10** !*groescale;!*groebigneg:=- 10** !*groescale; symbolic procedure bcprin u; % Prints a base coefficient in infix form if !*grmod!* then prin2 u else begin scalar nat; nat:=!*nat; !*nat:=nil; if cdr u = 1 and numberp car u and (car u>!*groebigpos or car u<!*groebigneg) then bcprin2big car u else if cdr u neq 1 or not numberp car u then <<prin2!* " [ ";sqprint u;prin2!* " ] " >> else sqprint u; !*nat:=nat end; symbolic procedure bcprin2big u; <<if u<0 then<< prin2 "-";u:= -u>>;bcprin2big1(u,0)>>; symbolic procedure bcprin2big1 (u,n); if u>!*groebigpos then bcprin2big1 (u/!*groebigpos,n#+!*groescale) else <<prin2 u;prin2 "e";prin2 n>>; endmodule;;end;