File: [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Symmetry / permute_operations.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:31 2000 UTC (23 years, 7 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_Numbers; use Standard_Complex_Numbers;
package body Permute_Operations is
function "*" ( p : Permutation; v : Standard_Natural_Vectors.Vector )
return Standard_Natural_Vectors.Vector is
r : Standard_Natural_Vectors.Vector(v'range);
begin
for i in p'range loop
if p(i) >= 0
then r(i) := v(p(i));
else r(i) := -v(-p(i));
end if;
end loop;
return r;
end "*";
function "*" ( p : Permutation; v : Standard_Integer_Vectors.Vector )
return Standard_Integer_Vectors.Vector is
r : Standard_Integer_Vectors.Vector(v'range);
begin
for i in p'range loop
if p(i) >= 0
then r(i) := v(p(i));
else r(i) := -v(-p(i));
end if;
end loop;
return r;
end "*";
function "*" ( p : Permutation; v : Standard_Floating_Vectors.Vector )
return Standard_Floating_Vectors.Vector is
r : Standard_Floating_Vectors.Vector(v'range);
begin
for i in p'range loop
if p(i) >= 0
then r(i) := v(p(i));
else r(i) := -v(-p(i));
end if;
end loop;
return r;
end "*";
function "*" ( p : Permutation; v : Standard_Complex_Vectors.Vector )
return Standard_Complex_Vectors.Vector is
r : Standard_Complex_Vectors.Vector(v'range);
begin
for i in p'range loop
if p(i) >= 0
then r(i) := v(p(i));
else r(i) := -v(-p(i));
end if;
end loop;
return r;
end "*";
function Permutable ( v1,v2 : Standard_Natural_Vectors.Vector )
return boolean is
begin
if v1'first /= v2'first or else v1'last /= v2'last
then return false; -- the dimensions must correspond !
else declare
p : Permutation(v1'first..v1'last);
begin
for k in p'range loop
p(k) := 0;
for l in v2'range loop
if v2(l) = v1(k)
then p(k) := l;
for j in 1..(k-1) loop
if p(j) = l
then p(k) := 0;
end if;
end loop;
end if;
exit when p(k) /= 0;
end loop;
if p(k) = 0
then return false;
end if;
end loop;
end;
return true;
end if;
end Permutable;
function Permutable ( v1,v2 : Standard_Integer_Vectors.Vector )
return boolean is
begin
if v1'first /= v2'first or else v1'last /= v2'last
then return false; -- the dimensions must correspond !
else declare
p : Permutation(v1'first..v1'last);
begin
for k in p'range loop
p(k) := 0;
for l in v2'range loop
if v2(l) = v1(k)
then p(k) := l;
for j in 1..(k-1) loop
if p(j) = l
then p(k) := 0;
end if;
end loop;
end if;
exit when p(k) /= 0;
end loop;
if p(k) = 0
then return false;
end if;
end loop;
end;
return true;
end if;
end Permutable;
function Permutable ( v1,v2 : Standard_Floating_Vectors.Vector )
return boolean is
begin
if v1'first /= v2'first or else v1'last /= v2'last
then return false; -- the dimensions must correspond !
else declare
p : Permutation(v1'first..v1'last);
begin
for k in p'range loop
p(k) := 0;
for l in v2'range loop
if v2(l) = v1(k)
then p(k) := l;
for j in 1..(k-1) loop
if p(j) = l
then p(k) := 0;
end if;
end loop;
end if;
exit when p(k) /= 0;
end loop;
if p(k) = 0
then return false;
end if;
end loop;
end;
return true;
end if;
end Permutable;
function Permutable ( v1,v2 : Standard_Complex_Vectors.Vector )
return boolean is
begin
if v1'first /= v2'first or else v1'last /= v2'last
then return false; -- the dimensions must correspond !
else declare
p : Permutation(v1'first..v1'last);
begin
for k in p'range loop
p(k) := 0;
for l in v2'range loop
if v2(l) = v1(k)
then p(k) := l;
for j in 1..(k-1) loop
if p(j) = l
then p(k) := 0;
end if;
end loop;
end if;
exit when p(k) /= 0;
end loop;
if p(k) = 0
then return false;
end if;
end loop;
end;
return true;
end if;
end Permutable;
function Permutable ( v1,v2 : Standard_Floating_Vectors.Vector;
tol : double_float ) return boolean is
begin
if v1'first /= v2'first or else v1'last /= v2'last
then return false; -- the dimensions must correspond !
else declare
p : Permutation(v1'first..v1'last);
begin
for k in p'range loop
p(k) := 0;
for l in v2'range loop
if ABS(v2(l) - v1(k)) <= tol
then p(k) := l;
for j in 1..(k-1) loop
if p(j) = l
then p(k) := 0;
end if;
end loop;
end if;
exit when p(k) /= 0;
end loop;
if p(k) = 0
then return false;
end if;
end loop;
end;
return true;
end if;
end Permutable;
function Permutable ( v1,v2 : Standard_Complex_Vectors.Vector;
tol : double_float ) return boolean is
begin
if v1'first /= v2'first or else v1'last /= v2'last
then return false; -- the dimensions must correspond !
else declare
p : Permutation(v1'first..v1'last);
begin
for k in p'range loop
p(k) := 0;
for l in v2'range loop
if (ABS(REAL_PART(v2(l)) - REAL_PART(v1(k))) <= tol)
and then (ABS(IMAG_PART(v2(l)) - IMAG_PART(v1(k))) <= tol)
then p(k) := l;
for j in 1..(k-1) loop
if p(j) = l
then p(k) := 0;
end if;
end loop;
end if;
exit when p(k) /= 0;
end loop;
if p(k) = 0
then return false;
end if;
end loop;
end;
return true;
end if;
end Permutable;
function Sign_Permutable ( v1,v2 : Standard_Natural_Vectors.Vector )
return boolean is
begin
if v1'first /= v2'first or else v1'last /= v2'last
then return false; -- the dimensions must correspond !
else declare
p : Permutation(v1'first..v1'last);
begin
for k in p'range loop
p(k) := 0;
for l in v2'range loop
if v2(l) = v1(k) or else v2(l) = -v1(k)
then p(k) := l;
for j in 1..(k-1) loop
if p(j) = l
then p(k) := 0;
end if;
end loop;
end if;
exit when p(k) /= 0;
end loop;
if p(k) = 0
then return false;
end if;
end loop;
end;
return true;
end if;
end Sign_Permutable;
function Sign_Permutable ( v1,v2 : Standard_Integer_Vectors.Vector )
return boolean is
begin
if v1'first /= v2'first or else v1'last /= v2'last
then return false; -- the dimensions must correspond !
else declare
p : Permutation(v1'first..v1'last);
begin
for k in p'range loop
p(k) := 0;
for l in v2'range loop
if v2(l) = v1(k) or else v2(l) = -v1(k)
then p(k) := l;
for j in 1..(k-1) loop
if p(j) = l
then p(k) := 0;
end if;
end loop;
end if;
exit when p(k) /= 0;
end loop;
if p(k) = 0
then return false;
end if;
end loop;
end;
return true;
end if;
end Sign_Permutable;
function Sign_Permutable ( v1,v2 : Standard_Floating_Vectors.Vector )
return boolean is
begin
if v1'first /= v2'first or else v1'last /= v2'last
then return false; -- the dimensions must correspond !
else declare
p : Permutation(v1'first..v1'last);
begin
for k in p'range loop
p(k) := 0;
for l in v2'range loop
if v2(l) = v1(k) or else v2(l) = -v1(k)
then p(k) := l;
for j in 1..(k-1) loop
if p(j) = l
then p(k) := 0;
end if;
end loop;
end if;
exit when p(k) /= 0;
end loop;
if p(k) = 0
then return false;
end if;
end loop;
end;
return true;
end if;
end Sign_Permutable;
function Sign_Permutable ( v1,v2 : Standard_Complex_Vectors.Vector )
return boolean is
begin
if v1'first /= v2'first or else v1'last /= v2'last
then return false; -- the dimensions must correspond !
else declare
p : Permutation(v1'first..v1'last);
begin
for k in p'range loop
p(k) := 0;
for l in v2'range loop
if v2(l) = v1(k) or else v2(l) = -v1(k)
then p(k) := l;
for j in 1..(k-1) loop
if p(j) = l
then p(k) := 0;
end if;
end loop;
end if;
exit when p(k) /= 0;
end loop;
if p(k) = 0
then return false;
end if;
end loop;
end;
return true;
end if;
end Sign_Permutable;
function Sign_Permutable ( v1,v2 : Standard_Floating_Vectors.Vector;
tol : double_float ) return boolean is
begin
if v1'first /= v2'first or else v1'last /= v2'last
then return false; -- the dimensions must correspond !
else declare
p : Permutation(v1'first..v1'last);
begin
for k in p'range loop
p(k) := 0;
for l in v2'range loop
if (ABS(v2(l) - v1(k)) <= tol)
or else (ABS(v2(l) + v1(k)) <= tol)
then p(k) := l;
for j in 1..(k-1) loop
if p(j) = l
then p(k) := 0;
end if;
end loop;
end if;
exit when p(k) /= 0;
end loop;
if p(k) = 0
then return false;
end if;
end loop;
end;
return true;
end if;
end Sign_Permutable;
function Sign_Permutable ( v1,v2 : Standard_Complex_Vectors.Vector;
tol : double_float ) return boolean is
begin
if v1'first /= v2'first or else v1'last /= v2'last
then return false; -- the dimensions must correspond !
else declare
p : Permutation(v1'first..v1'last);
begin
for k in p'range loop
p(k) := 0;
for l in v2'range loop
if ((ABS(REAL_PART(v2(l)) - REAL_PART(v1(k))) <= tol)
and then (ABS(IMAG_PART(v2(l)) - IMAG_PART(v1(k))) <= tol))
or else ((ABS(REAL_PART(v2(l)) + REAL_PART(v1(k))) <= tol)
and then (ABS(IMAG_PART(v2(l)) + IMAG_PART(v1(k))) <= tol))
then p(k) := l;
for j in 1..(k-1) loop
if p(j) = l
then p(k) := 0;
end if;
end loop;
end if;
exit when p(k) /= 0;
end loop;
if p(k) = 0
then return false;
end if;
end loop;
end;
return true;
end if;
end Sign_Permutable;
function "*" ( p : Permutation; t : Standard_Complex_Polynomials.Term )
return Standard_Complex_Polynomials.Term is
res : Standard_Complex_Polynomials.Term;
begin
res.cf := t.cf;
res.dg := new Standard_Natural_Vectors.Vector(t.dg'range);
for i in p'range loop
if p(i) >= 0
then res.dg(i) := t.dg(p(i));
else res.dg(i) := t.dg(-p(i));
res.cf := -res.cf;
end if;
end loop;
return res;
end "*";
function "*" ( p : Permutation; s : Standard_Complex_Polynomials.Poly )
return Standard_Complex_Polynomials.Poly is
use Standard_Complex_Polynomials;
res : Poly := Null_Poly;
procedure Permute_Term ( t : in Term; continue : out boolean ) is
tt : Term := p*t;
begin
Add(res,tt);
Clear(tt);
continue := true;
end Permute_Term;
procedure Permute_Terms is new Visiting_Iterator(Permute_Term);
begin
Permute_Terms(s);
return res;
end "*";
function "*" ( p : Permutation; t : Standard_Complex_Laur_Polys.Term )
return Standard_Complex_Laur_Polys.Term is
res : Standard_Complex_Laur_Polys.Term;
begin
res.cf := t.cf;
res.dg := new Standard_Integer_Vectors.Vector(t.dg'range);
for i in p'range loop
if p(i) >= 0
then res.dg(i) := t.dg(p(i));
else res.dg(i) := t.dg(-p(i));
res.cf := -res.cf;
end if;
end loop;
return res;
end "*";
function "*" ( p : Permutation; s : Standard_Complex_Laur_Polys.Poly )
return Standard_Complex_Laur_Polys.Poly is
use Standard_Complex_Laur_Polys;
res : Poly := Null_Poly;
procedure Permute_Term ( t : in Term; continue : out boolean ) is
tt : Term := p*t;
begin
Add(res,tt);
Clear(tt);
continue := true;
end Permute_Term;
procedure Permute_Terms is new Visiting_Iterator(Permute_Term);
begin
Permute_Terms(s);
return res;
end "*";
function "*" ( s : Poly_Sys; p : Permutation ) return Poly_Sys is
res : Poly_Sys(s'range);
begin
for k in res'range loop
res(k) := p*s(k);
end loop;
return res;
end "*";
function "*" ( s : Laur_Sys; p : Permutation ) return Laur_Sys is
res : Laur_Sys(s'range);
begin
for k in res'range loop
res(k) := p*s(k);
end loop;
return res;
end "*";
function "*" ( p : Permutation; s : Poly_Sys ) return Poly_Sys is
r : Poly_Sys(s'range);
use Standard_Complex_Polynomials;
begin
for i in p'range loop
if p(i) >= 0
then Copy(s(p(i)),r(i));
else r(i) := -s(-p(i));
end if;
end loop;
return r;
end "*";
function "*" ( p : Permutation; s : Laur_Sys ) return Laur_Sys is
r : Laur_Sys(s'range);
use Standard_Complex_Laur_Polys;
begin
for i in p'range loop
if p(i) >= 0
then Copy(s(p(i)),r(i));
else r(i) := -s(-p(i));
end if;
end loop;
return r;
end "*";
end Permute_Operations;
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to permute_operations.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Symmetry