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     ! 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;