Artifact 8d25881a48990b6468bdaf84bd7198378824dbca08c7d3c57f3b73238fc4eb5e:
- Executable file
r37/packages/groebner/groebspa.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: 2483) [annotate] [blame] [check-ins using] [more...]
module groebspa; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % manipulation of subspaces. % A subspace among the variables is described by an exponent vector % with only zeroes and ones. It terminates with the last % one. It may be null (nil); expr procedure vevUnion(e1,e2); begin scalar x,y; y := vevUnion1(e1,e2); x := reverse y; if car x = 1 then return y; while x and car x = 0 do x := cdr x; return reversip x; end; expr procedure vevUnion1(e1,e2); if vdpSubspacep(e1,e2) then e2 else if vdpSubspacep(e2,e1) then e1 else if car e1 neq 0 or car e2 neq 0 then 1 . vevUnion1(cdr e1,cdr e2) else 0 . vevUnion1(cdr e1,cdr e2); expr procedure vdpSubspacep(e1,e2); % test if e1 describes a subspace from e2 if null e1 then t else if null e2 then vdpSpacenullp(e1) else if car e1 > car e2 then nil else if e1 = e2 then t else vdpSubspacep(cdr e1,cdr e2); expr procedure vdpOrthSpacep(e1,e2); % test if e1 and e2 describe orthogonal spaces(no intersection); if null e1 or null e2 then t else if car e2 = 0 or car e1 = 0 then vdpOrthSpacep(cdr e1,cdr e2) else nil; expr procedure vdpSpacenullp(e1); % test if e1 describes an null space if null e1 then t else if car e1 = 0 then vdpSpacenullp(cdr e1) else nil; expr procedure vdpSpace(p); % determine the variables of the polynomial. begin scalar x,y; if vdpzero!? p then return nil; x := vdpGetProp(p,'SUBROOM); if x then return x; x := vevUnion(nil,vdpevlmon p); y := vdpred p; while not vdpzero!? y do <<x := vevUnion(x,vdpevlmon y); y := vdpred y>>; vdpPutProp (p,'SUBROOM,x); return x; end; symbolic procedure vdpUnivariate!?(p); if vdpGetProp(p,'UNIVARIATE) then t else begin scalar ev; integer n; ev := vdpevlmon p; for each x in ev do if not(x=0) then n := n#+1; if not(n=1) then return nil; ev := vdpSpace(p); for each x in ev do if not(x=0) then n := n#+1; if not(n=1) then return nil; vdpPutProp(p,'UNIVARIATE,t); return t; end; endmodule; end;