File: [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Symmetry / equivariant_polynomial_systems.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:31 2000 UTC (23 years, 10 months ago) by maekawa
Branch: PHC, MAIN
CVS Tags: v2, maekawa-ipv6, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, HEAD Changes since 1.1: +0 -0
lines
Import the second public release of PHCpack.
OKed by Jan Verschelde.
|
with Standard_Complex_Polynomials; use Standard_Complex_Polynomials;
with Permutations,Permute_Operations; use Permutations,Permute_Operations;
package body Equivariant_Polynomial_Systems is
procedure Act ( v : in List_of_Permutations; s : in Poly_Sys;
w : in out List_of_Permutations;
fail,inva,equi : out boolean ) is
min_s : Poly_Sys(s'range);
last_w : List_of_Permutations;
wrkinva,wrkequi : boolean;
procedure Process ( p : in Permutation; cont : in out boolean ) is
ps : Poly; -- the permuted polynomial
pp : Permutation(p'range);
begin
for i in s'range loop
ps := p*s(i);
pp(i) := p'last+1;
for j in s'range loop
if Equal(ps,s(j))
then pp(i) := j;
elsif Equal(ps,min_s(j))
then pp(i) := -j;
end if;
end loop;
if pp(i) = p'last+1
then fail := true;
end if;
Clear(ps);
end loop;
if wrkinva
then for j in pp'range loop
wrkinva := (pp(j) = j);
exit when not wrkinva;
end loop;
end if;
if wrkequi
then wrkequi := Equal(pp,p);
end if;
Append(w,last_w,pp);
cont := true;
end Process;
procedure Act_of_Permutations is new Iterator(Process);
begin
min_s := -s;
fail := false;
wrkinva := true; wrkequi := true;
Act_of_Permutations(v);
inva := wrkinva; equi := wrkequi;
Clear(min_s);
end Act;
function Symmetric ( s : Poly_Sys; v,w : List_of_Permutations )
return boolean is
lw,plw,pw : List_of_Permutations;
fail,inva,equi : boolean;
begin
Act(v,s,lw,fail,inva,equi);
pw := w;
plw := lw;
while not Is_Null(plw) loop
if not Equal(Permutation(Head_Of(plw).all),Permutation(Head_Of(pw).all))
then Clear(lw);
return false;
else plw := Tail_Of(plw);
pw := Tail_Of(pw);
end if;
end loop;
Clear(lw);
return true;
end Symmetric;
end Equivariant_Polynomial_Systems;