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;