HomGrpPerm.mag

import "Utils.mag": not_implemented, Z, sprint_with_parens;

declare type PGGHomGrpPerm;
declare attributes PGGHomGrpPerm: domain, codomain, hom, shape, image, kernel, is_injective;

declare type PGGHomGrpPerm_Id: PGGHomGrpPerm;

declare type PGGHomGrpPerm_DirProd: PGGHomGrpPerm;
declare attributes PGGHomGrpPerm_DirProd: factors;

declare type PGGHomGrpPerm_WrProd: PGGHomGrpPerm;
declare attributes PGGHomGrpPerm_WrProd: factors, cumulative_shapes;

declare type PGGHomGrpPerm_Cyclic: PGGHomGrpPerm;
declare attributes PGGHomGrpPerm_Cyclic: genimg;

declare type PGGHomGrpPerm_WrDiagonal: PGGHomGrpPerm;
declare attributes PGGHomGrpPerm_WrDiagonal: nfactors, parent_hom;

DOM := Domain;
CODOM := Codomain;

intrinsic Domain(h :: PGGHomGrpPerm) -> PGGGrpPerm
  {The domain.}
  return h`domain;
end intrinsic;

intrinsic Codomain(h :: PGGHomGrpPerm) -> PGGGrpPerm
  {The codomain.}
  return h`codomain;
end intrinsic;

intrinsic Image(h :: PGGHomGrpPerm) -> PGGGrpPerm
  {The image of h.}
  if not assigned h`image then
    h`image := PGGGrpPerm_RawSubgroup_Make(Codomain(h), Group(Domain(h)) @ h);
  end if;
  return h`image;
end intrinsic;

intrinsic Kernel(h :: PGGHomGrpPerm) -> PGGGrpPerm
  {The kernel of h.}
  if not assigned h`kernel then
    h`kernel := PGGGrpPerm_RawSubgroup_Make(Domain(h), Kernel(Hom(h)));
  end if;
  return h`kernel;
end intrinsic;

intrinsic IsInjective(h :: PGGHomGrpPerm) -> BoolElt
  {True if h is injective.}
  if not assigned h`is_injective then
    h`is_injective := #Kernel(h) eq 1;
  end if;
  return h`is_injective;
end intrinsic;

intrinsic PGGHomGrpPerm_Id_Make(G :: PGGGrpPerm, H :: PGGGrpPerm) -> PGGHomGrpPerm
  {The identity homomorphism.}
  require Degree(G) eq Degree(H) and Group(G) subset Group(H): "no such embedding";
  h := New(PGGHomGrpPerm_Id);
  h`domain := G;
  h`codomain := H;
  return h;
end intrinsic;

intrinsic IdentityHomomorphism(G :: PGGGrpPerm, H :: PGGGrpPerm) -> PGGHomGrpPerm
  {"}
  return PGGHomGrpPerm_Id_Make(G, H);
end intrinsic;

intrinsic PGGHomGrpPerm_WrProd_Make(hs :: Tup : Domain:=false, Codomain:=false) -> PGGHomGrpPerm_WrProd
  {The hom from the wreath product of the domains to the wreath product of the codomains.}
  require forall{h : h in hs | ISA(Type(h), PGGHomGrpPerm)}: "hs must be a tuple of PGGHomGrpPerm";
  if Domain cmpeq false then
    Domain := PGGGrpPerm_WrProd_Make(<DOM(h) : h in hs>);
  end if;
  assert ISA(Type(Domain), PGGGrpPerm_WrProd);
  assert #Domain`factors eq #hs;
  assert forall{i : i in [1..#hs] | Group(DOM(hs[i])) eq Group(Domain`factors[i])};
  if Codomain cmpeq false then
    Codomain := PGGGrpPerm_WrProd_Make(<CODOM(h) : h in hs>);
  end if;
  assert ISA(Type(Codomain), PGGGrpPerm_WrProd);
  assert #Codomain`factors eq #hs;
  assert forall{i : i in [1..#hs] | Group(CODOM(hs[i])) eq Group(Codomain`factors[i])};
  h := New(PGGHomGrpPerm_WrProd);
  h`domain := Domain;
  h`codomain := Codomain;
  h`factors := hs;
  return h;
end intrinsic;

intrinsic WreathProduct(hs :: [PGGHomGrpPerm] : Domain:=false, Codomain:=false) -> PGGHomGrpPerm_WrProd
  {"}
  return PGGHomGrpPerm_WrProd_Make(<h : h in hs> : Domain:=Domain, Codomain:=Codomain);
end intrinsic;

intrinsic PGGHomGrpPerm_DirProd_Make(hs :: Tup : Domain:=false, Codomain:=false) -> PGGHomGrpPerm_DirProd
  {The hom from the direct product of the domains to the wreath product of the codomains.}
  require forall{h : h in hs | ISA(Type(h), PGGHomGrpPerm)}: "hs must be a tuple of PGGHomGrpPerm";
  if Domain cmpeq false then
    Domain := PGGGrpPerm_DirProd_Make(<DOM(h) : h in hs>);
  else
  end if;
  assert ISA(Type(Domain), PGGGrpPerm_DirProd);
  assert #Domain`factors eq #hs;
  assert forall{i : i in [1..#hs] | Group(DOM(hs[i])) eq Group(Domain`factors[i])};
  if Codomain cmpeq false then
    Codomain := PGGGrpPerm_DirProd_Make(<CODOM(h) : h in hs>);
  end if;
  assert ISA(Type(Codomain), PGGGrpPerm_DirProd);
  assert #Domain`factors eq #hs;
  assert forall{i : i in [1..#hs] | Group(CODOM(hs[i])) eq Group(Codomain`factors[i])};
  h := New(PGGHomGrpPerm_DirProd);
  h`domain := Domain;
  h`codomain := Codomain;
  h`factors := hs;
  return h;
end intrinsic;

intrinsic DirectProduct(hs :: [PGGHomGrpPerm] : Domain:=false, Codomain:=false) -> PGGHomGrpPerm_DirProd
  {"}
  return PGGHomGrpPerm_DirProd_Make(<h : h in hs> : Domain:=Domain, Codomain:=Codomain);
end intrinsic;

intrinsic PGGHomGrpPerm_Cyclic_Make(G :: PGGGrpPerm_Cyclic, H :: PGGGrpPerm, genimg :: GrpPermElt) -> PGGHomGrpPerm_Cyclic
  {The hom sending the generator of G to genimg in H.}
  require genimg in Group(H): "genimg must be an element of H";
  h := New(PGGHomGrpPerm_Cyclic);
  h`domain := G;
  h`codomain := H;
  h`genimg := genimg;
  return h;
end intrinsic;

intrinsic PGGHomGrpPerm_WrDiagonal_Make(G :: PGGGrpPerm, H :: PGGGrpPerm_WrProd : NumFactors:=false) -> PGGHomGrpPerm_WrDiagonal
  {Diagonally embeds G into H.}
  deg := Degree(G);
  facdegs := Reverse([Z| Degree(fac) : fac in H`factors]);
  if NumFactors cmpeq false then
    for i in [0..#facdegs] do
      d := &*facdegs[1..i];
      if d eq deg then
        nfactors := i;
        break;
      elif (d gt deg) or (i eq #facdegs) then
        require false: "degree of G does not equal a partial degree of H";
      end if;
    end for;
  else
    require NumFactors ge 0 and NumFactors le #facdegs: "NumFactors out of range";
    nfactors := NumFactors;
    require &*facdegs[1..nfactors] eq deg: "degree of G does not equal the NumFactors'th partial degree of H";
  end if;
  partial := Group(H, [#H`factors-nfactors+1..#H`factors]);
  assert Degree(partial) eq Degree(G);
  require Group(G) subset partial: "G is not a subgroup of the corresponding partial factor of H";
  h := New(PGGHomGrpPerm_WrDiagonal);
  h`domain := G;
  h`codomain := H;
  h`nfactors := nfactors;
  return h;
end intrinsic;

intrinsic PGGHomGrpPerm_WrDiagonal_Make(G :: PGGGrpPerm, H :: PGGGrpPerm_RawSubgroup : NumFactors:=false) -> PGGHomGrpPerm_WrDiagonal
  {"}
  h0 := PGGHomGrpPerm_WrDiagonal_Make(G, H`overgroup : NumFactors:=NumFactors);
  require Image(Hom(h0)) subset Group(H): "G does not embed diagonally into H";
  h := New(PGGHomGrpPerm_WrDiagonal);
  h`domain := G;
  h`codomain := H;
  h`parent_hom := h0;
  return h;
end intrinsic;

intrinsic Hom(h :: PGGHomGrpPerm) -> Map
  {The underlying homomorphism.}
  if not assigned h`hom then
    h`hom := _Hom(h);
  end if;
  return h`hom;
end intrinsic;

intrinsic _Hom(h :: PGGHomGrpPerm_Id) -> Map
  {"}
  G := Group(Domain(h));
  H := Group(Codomain(h));
  return hom<G -> H | [H| G.i : i in [1..Ngens(G)]]>;
end intrinsic;

intrinsic _Hom(h :: PGGHomGrpPerm_WrProd) -> Map
  {"}
  G := Group(Domain(h));
  H := Group(Codomain(h));
  cshs := CumulativeShapes(h);
  cds := [i eq 0 select 1 else Degree(Codomain(h`factors[i])) * Self(i) : i in [0..#h`factors]];
  gens := [H| Compose(hparts, Codomain(h)) where hparts := <[IsDefined(sh, k) select (gs[sh[k]] @ fac) else Id(Codomain(fac)) : k in [1..cds[j]]] where sh:=cshs[j] where gs:=gparts[j] where fac:=h`factors[j] : j in [1..#h`factors]> where gparts := Decompose(g, Domain(h)) where g := G.i : i in [1..Ngens(G)]];
  return hom<G -> H | gens>;
end intrinsic;

intrinsic _Hom(h :: PGGHomGrpPerm_DirProd) -> Map
  {"}
  G := Group(Domain(h));
  H := Group(Codomain(h));
  gens := [H | Compose(hparts, Codomain(h)) where hparts := <gparts[i] @ h`factors[i] : i in [1..#gparts]> where gparts := Decompose(g, Domain(h)) where g := G.i : i in [1..Ngens(G)]];
  return hom<G -> H | gens>;
end intrinsic;

intrinsic _Hom(h :: PGGHomGrpPerm_Cyclic) -> Map
  {"}
  return hom<Group(Domain(h)) -> Group(Codomain(h)) | h`genimg>;
end intrinsic;

intrinsic _Hom(h :: PGGHomGrpPerm_WrDiagonal) -> Map
  {"}
  G := Group(Domain(h));
  H := Group(Codomain(h));
  if assigned h`parent_hom then
    h0 := Hom(h`parent_hom);
    return hom<G -> H | [H| h0(G.i) : i in [1..Ngens(G)]]>;
  else
    dG := Degree(G);
    dH := Degree(H);
    return hom<G -> H | [H| [(((j-1) mod dG)+1)^g + ((j-1) div dG)*dG : j in [1..dH]] where g:=G.i : i in [1..Ngens(G)]]>;
  end if;
end intrinsic;

intrinsic '@'(x, h :: PGGHomGrpPerm) -> .
  {Application.}
  return x @ Hom(h);
end intrinsic;

intrinsic '@@'(x, h :: PGGHomGrpPerm) -> .
  {Inverse.}
  return x @@ Hom(h);
end intrinsic;

intrinsic Shape(h :: PGGHomGrpPerm) -> []
  {Sequence of length up to Degree(Codomain(h)) where each defined element is an integer up to Degree(Domain(h)) giving the correspondence between the actions. Elements may be unset, signifying no action.}
  if not assigned h`shape then
    h`shape := _Shape(h);
    assert #h`shape le Degree(Codomain(h));
    assert forall{x : x in h`shape | x ge 1 and x le Degree(Domain(h))};
  end if;
  return h`shape;
end intrinsic;

intrinsic _Shape(h :: PGGHomGrpPerm) -> []
  {"}
  not_implemented("Shape:", Type(h));
end intrinsic;

intrinsic _Shape(h :: PGGHomGrpPerm_Id) -> []
  {"}
  return [1..Degree(Domain(h))];
end intrinsic;

intrinsic _Shape(h :: PGGHomGrpPerm_WrDiagonal) -> []
  {"}
  return [((i-1) mod Degree(Domain(h)))+1 : i in [1..Degree(Codomain(h))]];
end intrinsic;

intrinsic _Shape(h :: PGGHomGrpPerm_WrProd) -> []
  {"}
  n := #h`factors;
  shs := CumulativeShapes(h);
  assert #shs eq n+1;
  return shs[n+1];
end intrinsic;

intrinsic CumulativeShapes(h :: PGGHomGrpPerm_WrProd) -> []
  {The cumulative shape of each factor.}
  if not assigned h`cumulative_shapes then
    csh := [Z|1];
    ret := [csh];
    deg := 1;
    for fac in h`factors do
      d0 := Degree(Domain(fac));
      d := Degree(Codomain(fac));
      sh := Shape(fac);
      newsh := [Z|];
      for i in [1..deg] do
        if IsDefined(csh, i) then
          for j in [1..d] do
            if IsDefined(sh, j) then
              newsh[(i-1)*d + j] := sh[j] + d0*(csh[i]-1);
            end if;
          end for;
        end if;
      end for;
      Append(~ret, newsh);
      csh := newsh;
      deg *:= d;
    end for;
    h`cumulative_shapes := ret;
  end if;
  return h`cumulative_shapes;
end intrinsic;

intrinsic Print(h :: PGGHomGrpPerm)
  {Print.}
  printf "homomorphism from %o to %o", sprint_with_parens(Domain(h)), sprint_with_parens(Codomain(h));
end intrinsic;

intrinsic Print(h :: PGGHomGrpPerm_Id)
  {"}
  printf "identity homomorphism from %o to %o", sprint_with_parens(Domain(h)), sprint_with_parens(Codomain(h));
end intrinsic;

intrinsic Print(h :: PGGHomGrpPerm_WrProd)
  {"}
  print "wreath product homomorphism:";
  IndentPush();
  if #h`factors eq 0 then
    printf "(null)";
  else
    for i in [1..#h`factors] do
      Print(h`factors[i]);
      if i lt #h`factors then
        print "";
      end if;
    end for;
  end if;
  IndentPop();
end intrinsic;

intrinsic Print(h :: PGGHomGrpPerm_DirProd)
  {"}
  print "direct product homomorphism:";
  IndentPush();
  if #h`factors eq 0 then
    printf "(null)";
  else
    for i in [1..#h`factors] do
      Print(h`factors[i]);
      if i lt #h`factors then
        print "";
      end if;
    end for;
  end if;
  IndentPop();
end intrinsic;

intrinsic Print(h :: PGGHomGrpPerm_WrDiagonal)
  {"}
  printf "diagonal embedding from %o to %o", sprint_with_parens(Domain(h)), sprint_with_parens(Codomain(h));
end intrinsic;