module edsnormal;
% Converting exterior systems to internal form
% Author: David Hartley
Comment. The next section contains routines for putting an EDS into
"normal" form. An EDS S is in "normal" form if
*** 1) S contains no 0-forms, *** removed 27/4/95
2) the 1-forms {theta(a)} in S satisfy
lc theta(a) = 1
lpow theta(a) in xpows theta(b) iff a = b.
3) the 1-forms {omega(i)} in eds_ind S are reduced mod {theta(a)}
and satisfy
trc omega(i) = 1
trpow omega(i) in xpows omega(j) iff i = j
where trc/trpow mean trailing coefficient/power.
4) S\{theta(a)} is in normal form mod {theta(a)}.
If S satisfies 1, it is "generated in positive degree". If S satisfies
2, and 3, it is in "solved" form. If S satisfies 4, it is "reduced".
endcomment;
fluid '(cfrmrsx!* !*edssloppy pullback_maps xvars!* kord!*);
symbolic procedure normaleds s;
% s:eds -> normaleds:eds
% Bring s into normal form as far as possible.
if normaledsp s then s
% else if emptyedsp(s := solvededs s) then s
% else positiveeds sorteds reducededs s;
else sorteds reducededs solvededs s;
symbolic procedure normaledsp s;
% s:eds -> normaledsp:bool
solvededsp s and
reducededsp s;
% null scalarpart eds_sys s;
put('lift,'edsfn,'positiveeds);
put('lift,'rtypefn,'getrtypecar);
symbolic procedure positiveeds s;
% s:eds -> positiveeds:xeds
% Bring s into positive form as far as possible.
begin scalar v,c,s1;
v := foreach f in scalarpart eds_sys s collect lc f;
if null v then return s;
edsverbose("Solving 0-forms",nil,nil);
eds_sys s := setdiff(eds_sys s,v);
c := reverse setdiff(edscrd s,edsindcrd s);
c := edsgradecoords(c,geteds(s,'jet0));
v := edssolvegraded(v,c,cfrm_rsx eds_cfrm s);
s := purgexeds makelist
if null v then
<< edsverbose("System inconsistent",nil,nil); {}>>
else foreach strata in v collect
if null car strata then
<< edsverbose("Couldn't solve 0-forms",cdr strata,'sq);
strata := foreach q in cdr strata collect 1 .* q .+ nil;
augmentsys(s,strata) >>
else
<< edsverbose("New equations:",cadr strata,'map);
%%% pullback_maps:= append(pullback_maps,{!*rmap2a cdr strata});
s1 := pullback0(s,cdr strata); % might add 0-forms
if null scalarpart eds_sys s1 then s1
else edscall positiveeds s1 >>; % so go round again
return s;
end;
flag('(reduced solved),'hidden); % non-printing and purgeable
symbolic procedure reducededs s;
% s:eds -> reducededs:eds
% Bring s into reduced form as far as possible.
% Changes background coframing.
if knowntrueeds(s,'reduced) then s else
begin scalar m,p,q;
m := setcfrm eds_cfrm!* s;
p := solvedpart pfaffpart eds_sys s;
q := foreach f in setdiff(eds_sys s,p) join
if f := xreduce(f,p) then
{if cfrmnowherezero numr lc f then xnormalise f else f};
eds_sys s := append(p,q);
flagtrueeds(s,'reduced);
return s;
end;
symbolic procedure reducededsp s;
% s:eds -> reducededsp:bool
knowntrueeds(s,'reduced);
symbolic procedure solvededs s;
% s:eds -> solvededs:eds
% Bring s into solved form as far as possible.
% Local variables:
% m - coframing for s
% n - external background coframing
% p - solved part of 1-forms in s
% q - unsolved part of 1-forms in s
% z - 0-forms picked up from 1-forms in s
% i - independence 1-forms
% ik - independent kernels (cf indkrns)
% dk - dependent kernels (cf depkrns)
% pk - principal kernels (cf prlkrns)
% kl - cobasis (cf edscob)
if knowneds(s,'solved) then s else
begin scalar m,n,p,q,z,i,ik,dk,pk,kl;
m := copycfrm eds_cfrm!* s;
% Set up coframing and initial ordering
i := xautoreduce eds_ind s; % check if indkrns are obvious
i := if !*edssloppy or singleterms i then reverse lpows i else {};
kl := append(setdiff(cfrm_cob m,i),i);
cfrm_cob m := kl;
n := setcfrm m;
% Put 1-forms into solved form as far as possible
edsdebug("Solving Pfaffian subsystem",nil,nil);
q := solvepfsys1(pfaffpart eds_sys s,
if !*edssloppy then setdiff(cfrm_cob m,i));
p := car q;
dk := lpows p;
% Put independence 1-forms into solved form mod p
edsdebug("Solving independence forms",nil,nil);
i := solvepfsys1(foreach f in eds_ind s join
if f := xreduce(xreorder f,p) then {f},
if !*edssloppy then i);
if length eds_ind s > length car i + length cadr i then
return <<edsverbose("System inconsistent",nil,nil);
setcfrm n;
emptyeds()>>;
ik := lpows car i;
% Check for f(i)*omega(i) 1-forms from q
q := foreach f in cadr q join
if xreduce(f := xreorder f,car i) then {f}
else
<<z := union(foreach w in ik join
if w := xcoeff(f,wedgefax w) then {w},
z);
nil>>;
if z then edsverbose("New 0-form conditions detected",z,'sys);
% Set final ordering
pk := setdiff(kl,append(dk,ik));
kl := append(dk,append(pk,ik)); % dep > prl > ind
updkordl kl;
% Construct final eds
m := copycfrm eds_cfrm s;
s := copyeds s;
eds_sys s :=
xreordersys append(z,append(p,append(q,nonpfaffpart eds_sys s)));
eds_ind s := xreordersys append(car i,cadr i);
cfrm_cob m := kl;
eds_cfrm s := m;
if !*edssloppy then eds_cfrm s := updatersx eds_cfrm s;
% Fix flags
if q or cadr i then flagfalseeds(s,'solved)
else flagtrueeds(s,'solved);
rempropeds(s,'reduced);
if z then remtrueeds(s,'closed);
remkrns s;
setcfrm n;
return s;
end;
symbolic procedure xreordersys p;
% p:sys -> xreordersys:sys
foreach f in p collect xreorder f;
symbolic procedure solvededsp s;
% s:eds -> solvededsp:bool
knowntrueeds(s,'solved);
symbolic procedure reordereds s;
% s:eds -> reordereds:eds
% Reorder s according to current kernel order as far as possible.
begin scalar r,k;
r := copyeds s;
k := rightunion(kord!*,edscob r);
eds_sys r := sortsys(xreordersys eds_sys r,k);
eds_ind r := sortsys(xreordersys eds_ind r,k);
eds_cfrm r := reordercfrm eds_cfrm r;
return if r = s then s else normaleds r;
end;
symbolic procedure sorteds s;
% s:eds -> sorteds:eds
begin scalar k;
s := copyeds s;
k := edscob s;
eds_sys s := sortsys(eds_sys s,k);
eds_ind s := sortsys(eds_ind s,k);
return s;
end;
symbolic procedure sortsys(s,c);
% s:sys, c:cob -> sortsys:sys
% sort forms by degree, should add some more stuff.
reversip sort(s,function pfordp)
where kord!* = reverse c;
endmodule;
end;