Return to equivariant_polynomial_systems.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Symmetry

Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Symmetry/equivariant_polynomial_systems.adb, Revision 1.1.1.1

1.1       maekawa     1: with Standard_Complex_Polynomials;       use Standard_Complex_Polynomials;
                      2: with Permutations,Permute_Operations;    use Permutations,Permute_Operations;
                      3:
                      4: package body Equivariant_Polynomial_Systems is
                      5:
                      6:   procedure Act ( v : in List_of_Permutations; s : in Poly_Sys;
                      7:                   w : in out List_of_Permutations;
                      8:                   fail,inva,equi : out boolean ) is
                      9:
                     10:     min_s : Poly_Sys(s'range);
                     11:     last_w : List_of_Permutations;
                     12:     wrkinva,wrkequi : boolean;
                     13:
                     14:     procedure Process ( p : in Permutation; cont : in out boolean ) is
                     15:
                     16:       ps : Poly; -- the permuted polynomial
                     17:       pp : Permutation(p'range);
                     18:
                     19:     begin
                     20:       for i in s'range loop
                     21:         ps := p*s(i);
                     22:         pp(i) := p'last+1;
                     23:         for j in s'range loop
                     24:           if Equal(ps,s(j))
                     25:            then pp(i) := j;
                     26:            elsif Equal(ps,min_s(j))
                     27:                then pp(i) := -j;
                     28:           end if;
                     29:         end loop;
                     30:         if pp(i) = p'last+1
                     31:          then fail := true;
                     32:         end if;
                     33:         Clear(ps);
                     34:       end loop;
                     35:       if wrkinva
                     36:        then for j in pp'range loop
                     37:               wrkinva := (pp(j) = j);
                     38:               exit when not wrkinva;
                     39:             end loop;
                     40:       end if;
                     41:       if wrkequi
                     42:        then wrkequi := Equal(pp,p);
                     43:       end if;
                     44:       Append(w,last_w,pp);
                     45:       cont := true;
                     46:     end Process;
                     47:     procedure Act_of_Permutations is new Iterator(Process);
                     48:
                     49:   begin
                     50:     min_s := -s;
                     51:     fail := false;
                     52:     wrkinva := true; wrkequi := true;
                     53:     Act_of_Permutations(v);
                     54:     inva := wrkinva; equi := wrkequi;
                     55:     Clear(min_s);
                     56:   end Act;
                     57:
                     58:   function Symmetric ( s : Poly_Sys; v,w : List_of_Permutations )
                     59:                      return boolean is
                     60:
                     61:     lw,plw,pw : List_of_Permutations;
                     62:     fail,inva,equi : boolean;
                     63:
                     64:   begin
                     65:     Act(v,s,lw,fail,inva,equi);
                     66:     pw := w;
                     67:     plw := lw;
                     68:     while not Is_Null(plw) loop
                     69:       if not Equal(Permutation(Head_Of(plw).all),Permutation(Head_Of(pw).all))
                     70:        then Clear(lw);
                     71:            return false;
                     72:        else plw := Tail_Of(plw);
                     73:            pw := Tail_Of(pw);
                     74:       end if;
                     75:     end loop;
                     76:     Clear(lw);
                     77:     return true;
                     78:   end Symmetric;
                     79:
                     80: end Equivariant_Polynomial_Systems;