Quelle  greensstar.gi   Sprache: unbekannt

#############################################################################
##
##  greensstar.gi                  Smallsemi - a GAP library of semigroups
##  Copyright (C) 2008-2024            Andreas Distler & James D. Mitchell
##
##  Licensing information can be found in the README file of this package.
##
#############################################################################
##

# This file contains the implementations for starred Green's relations of
# semigroups.

# Returns the appropriate equivalence relation which is stored as an attribute.
# The relation knows nothing about itself except its source, range, and what
# type of congruence it is.
InstallMethod(RStarRelation, "for a small semigroup", [IsSmallSemigroup],
function(X)
  local fam, rel;

  fam := GeneralMappingsFamily(ElementsFamily(FamilyObj(X)),
                               ElementsFamily(FamilyObj(X)));

  # Create the default type for the elements.
  rel := Objectify(NewType(fam, IsEquivalenceRelation
                                and IsEquivalenceRelationDefaultRep
                                and IsRStarRelation), rec());
  SetSource(rel, X);
  SetRange(rel, X);
  # AD The following causes weird viewing of the relation on the command line
  SetIsLeftSemigroupCongruence(rel, true);
  if HasIsFinite(X) and IsFinite(X) then
    SetIsFiniteSemigroupStarRelation(rel, true);
  fi;

  # AD rel is objectified using IsRStarRelation, so other Green's relations
  # should not be set to the same object; classes might be set at the point
  # where they are actually computed, i.e. RStarClasses

  return rel;
end);

InstallMethod(LStarRelation, "for a small semigroup", [IsSmallSemigroup],
function(X)
  local fam, rel;

  fam := GeneralMappingsFamily(ElementsFamily(FamilyObj(X)),
                               ElementsFamily(FamilyObj(X)));

  # Create the default type for the elements.
  rel := Objectify(NewType(fam, IsEquivalenceRelation
                                and IsEquivalenceRelationDefaultRep
                                and IsLStarRelation), rec());

  SetSource(rel, X);
  SetRange(rel, X);
  # AD The following causes weird viewing of the relation on the command line
  SetIsRightSemigroupCongruence(rel, true);
  if HasIsFinite(X) and IsFinite(X) then
    SetIsFiniteSemigroupStarRelation(rel, true);
  fi;

  return rel;
end);

InstallMethod(JStarRelation, "for a small semigroup", [IsSmallSemigroup],
function(X)
  local fam, rel;

  fam := GeneralMappingsFamily(ElementsFamily(FamilyObj(X)),
                               ElementsFamily(FamilyObj(X)));

  # Create the default type for the elements.
  rel := Objectify(NewType(fam, IsEquivalenceRelation
                                and IsEquivalenceRelationDefaultRep
                                and IsJStarRelation), rec());

  SetSource(rel, X);
  SetRange(rel, X);
  if HasIsFinite(X) and IsFinite(X) then
    SetIsFiniteSemigroupStarRelation(rel, true);
  fi;

  return rel;
end);

InstallMethod(DStarRelation, "for a small semigroup", [IsSmallSemigroup],
function(X)
    local fam, rel;

    fam := GeneralMappingsFamily(ElementsFamily(FamilyObj(X)),
                                 ElementsFamily(FamilyObj(X)));

    # Create the default type for the elements.
    rel := Objectify(NewType(fam, IsEquivalenceRelation
                                  and IsEquivalenceRelationDefaultRep
                                  and IsDStarRelation), rec());

    SetSource(rel, X);
    SetRange(rel, X);

    if HasIsFinite(X) and IsFinite(X) then
      SetIsFiniteSemigroupStarRelation(rel, true);
    fi;

    return rel;
end);

InstallMethod(HStarRelation, "for a small semigroup", [IsSmallSemigroup],
function(X)
  local fam, rel;

  fam := GeneralMappingsFamily(ElementsFamily(FamilyObj(X)),
                               ElementsFamily(FamilyObj(X)));

  # Create the default type for the elements.
  rel := Objectify(NewType(fam, IsEquivalenceRelation
                                and IsEquivalenceRelationDefaultRep
                                and IsHStarRelation), rec());

  SetSource(rel, X);
  SetRange(rel, X);

  if HasIsFinite(X) and IsFinite(X) then
    SetIsFiniteSemigroupStarRelation(rel, true);
  fi;

  return rel;
end);

### AD The following methods should probably be installed for ViewString

BindGlobal("SMALLSEMI_ViewStarRelation",
function(obj, type)
  Print("<", type, "*-relation on ");
  ViewObj(Source(obj));
  Print(">");
end);

# AD This is overwritten by the method for LeftSemigroupCongruence
InstallMethod(ViewObj, "for Green's R*-relation", [IsRStarRelation],
16,  # to beat IsLeftSemigroupCongruence
obj -> SMALLSEMI_ViewStarRelation(obj, "R"));

# AD This is overwritten by the method for RightSemigroupCongruence
InstallMethod(ViewObj, "for Green's L*-relation", [IsLStarRelation],
16,  # to beat IsRightSemigroupCongruence
obj -> SMALLSEMI_ViewStarRelation(obj, "L"));

InstallMethod(ViewObj, "for Green's J*-relation", [IsJStarRelation],
obj -> SMALLSEMI_ViewStarRelation(obj, "J"));

InstallMethod(ViewObj, "for Green's D*-relation", [IsDStarRelation],
obj -> SMALLSEMI_ViewStarRelation(obj, "D"));

InstallMethod(ViewObj, "for Green's H*-relation", [IsHStarRelation],
obj -> SMALLSEMI_ViewStarRelation(obj, "H"));

InstallMethod(\=, "for starred Green's relations", IsIdenticalObj,
[IsStarRelation and IsEquivalenceRelation,
 IsStarRelation and IsEquivalenceRelation],
function(rel1, rel2)
  if Source(rel1) <> Source(rel2) then
    return false;
  fi;
  # make sure the internal representation is known
  EquivalenceClasses(rel1);
  EquivalenceClasses(rel2);
  return InternalRepStarRelation(rel1) = InternalRepStarRelation(rel2);
end);

# The following operations are constructors for starred Green's class with
# a given element as a representative. The call is for semigroups
# and an element in the semigroup. This function doesn't check that
# the element is actually a member of the semigroup.

InstallMethod(RStarClass, "for a small semigroup ", IsCollsElms,
[IsSmallSemigroup, IsSmallSemigroupElt],
{s, e} -> EquivalenceClassOfElement(RStarRelation(s), e));

InstallMethod(LStarClass, "for a small semigroup", IsCollsElms,
[IsSmallSemigroup, IsSmallSemigroupElt],
{s, e} -> EquivalenceClassOfElement(LStarRelation(s), e));

InstallMethod(HStarClass, "for a small semigroup", IsCollsElms,
[IsSmallSemigroup, IsSmallSemigroupElt],
{s, e} -> EquivalenceClassOfElement(HStarRelation(s), e));

InstallMethod(DStarClass, "for a small semigroup", IsCollsElms,
[IsSmallSemigroup, IsSmallSemigroupElt],
{s, e} -> EquivalenceClassOfElement(DStarRelation(s), e));

InstallMethod(JStarClass, "for a small semigroup", IsCollsElms,
[IsSmallSemigroup, IsSmallSemigroupElt],
{s, e} -> EquivalenceClassOfElement(JStarRelation(s), e));

# Methods to get any starred Green's class in its canonical form

InstallMethod(CanonicalStarClass, "for a H*-class", [IsHStarClass],
cl -> First(HStarClasses(ParentAttr(cl)), y -> Representative(cl) in y));

InstallMethod(CanonicalStarClass, "for a R * - class", [IsRStarClass],
cl -> First(RStarClasses(ParentAttr(cl)), y -> Representative(cl) in y));

InstallMethod(CanonicalStarClass, "for a L*-class", [IsLStarClass],
cl -> First(LStarClasses(ParentAttr(cl)), y -> Representative(cl) in y));

InstallMethod(CanonicalStarClass, "for a D*-class", [IsDStarClass],
cl -> First(DStarClasses(ParentAttr(cl)), y -> Representative(cl) in y));

InstallMethod(CanonicalStarClass, "for a J*-class", [IsJStarClass],
cl -> First(JStarClasses(ParentAttr(cl)), y -> Representative(cl) in y));

# method to find the images under a starred Green's relation of an
# element of a semigroup.

InstallMethod(ImagesElm, "for a starred Green's relation",
[IsStarRelation, IsObject],
function(rel, elm)
  local exp, semi;

  semi := Source(rel);

  if IsRStarRelation(rel) then
    exp := RStarClass(semi, elm);
  elif IsLStarRelation(rel) then
    exp := LStarClass(semi, elm);
  elif IsHStarRelation(rel) then
    exp := HStarClass(semi, elm);
  elif IsDStarRelation(rel) then
    exp := DStarClass(semi, elm);
  elif IsJStarRelation(rel) then
    exp := JStarClass(semi, elm);
  fi;

  return AsSSortedList(exp);
end);

# Returns ImagesElm for one element in each class of <grelation>

InstallMethod(Successors, "for a starred Green's relation",
[IsStarRelation],
rel -> List(EquivalenceClasses(rel), AsSSortedList));

# Returns the elements of the *-class <gclass>

InstallMethod(AsSSortedList, "for a starred Green's class", [IsStarClass],
x -> AsSSortedList(CanonicalStarClass(x)));

# Equality of *-classes
InstallMethod(\=, "for starred Green's classes",
[IsStarClass, IsStarClass],
function(class1, class2)
  if ParentAttr(class1) <> ParentAttr(class2) then
    return false;
  fi;
  return Representative(class1) in class2;
end);

# Size of a starred Green's class
InstallMethod(Size, "for a starred Green's class", [IsStarClass],
class -> Size(Elements(class)));

# Membership test for a starred Green's class
InstallMethod(\in, "membership test of starred Green's class",
[IsObject, IsStarClass],
function(elm, class)
  if elm = Representative(class) then
     return true;
  fi;
  return elm in Elements(class);
end);

InstallMethod(EquivalenceRelationPartition, "for a starred Green's equivalence",
[IsEquivalenceRelation and IsStarRelation],
rel -> Filtered(Successors(rel), x -> not Length(x) <> 1));

# New methods required so that what is returned by this function
# is the appropriate type of starred Green's class.

InstallOtherMethod(EquivalenceClassOfElementNC,
"for a starred Green's relation",
[IsEquivalenceRelation and IsStarRelation, IsObject],
function(rel, rep)
  local new;

  new := Objectify(NewType(CollectionsFamily(FamilyObj(rep)),
                   IsEquivalenceClass and IsEquivalenceClassDefaultRep),
                   rec());

  SetEquivalenceClassRelation(new, rel);
  SetRepresentative(new, rep);
  SetParent(new, UnderlyingDomainOfBinaryRelation(rel));
  SetIsStarClass(new, true);

  if IsRStarRelation(rel) then
      SetIsRStarClass(new, true);
  elif IsLStarRelation(rel) then
      SetIsLStarClass(new, true);
  elif IsHStarRelation(rel) then
      SetIsHStarClass(new, true);
  elif IsDStarRelation(rel) then
      SetIsDStarClass(new, true);
  elif IsJStarRelation(rel) then
      SetIsJStarClass(new, true);
  fi;

  return new;
end);

InstallMethod(EquivalenceClasses, "for a starred Green's R - relation",
[IsEquivalenceRelation and IsRStarRelation], x -> RStarClasses(Source(x)));

InstallMethod(EquivalenceClasses, "for a starred Green's L-relation",
[IsEquivalenceRelation and IsLStarRelation], x -> LStarClasses(Source(x)));

InstallMethod(EquivalenceClasses, "for a starred Green's H - relation",
[IsEquivalenceRelation and IsHStarRelation], x -> HStarClasses(Source(x)));

InstallMethod(EquivalenceClasses, "for a starred Green's D - relation",
[IsEquivalenceRelation and IsDStarRelation], x -> DStarClasses(Source(x)));

InstallMethod(EquivalenceClasses, "for a starred Green's J-relation",
[IsEquivalenceRelation and IsJStarRelation], x -> JStarClasses(Source(x)));

# Return the XStarClass containing the smaller class

InstallOtherMethod(RStarClass, "for a starred Green's H-class",
[IsHStarClass], cl -> RStarClass(ParentAttr(cl), Representative(cl)));

InstallOtherMethod(LStarClass, "for a starred Green's H-class",
[IsHStarClass], cl -> LStarClass(ParentAttr(cl), Representative(cl)));

InstallOtherMethod(DStarClass, "for a starred Green's H-class",
[IsHStarClass], cl -> DStarClass(ParentAttr(cl), Representative(cl)));

InstallOtherMethod(JStarClass, "for a starred Green's H-class",
[IsHStarClass], cl -> JStarClass(ParentAttr(cl), Representative(cl)));

InstallOtherMethod(DStarClass, "for a starred Green's R-class",
[IsRStarClass], cl -> DStarClass(ParentAttr(cl), Representative(cl)));

InstallOtherMethod(JStarClass, "for a starred Green's R-class",
[IsRStarClass], cl -> JStarClass(ParentAttr(cl), Representative(cl)));

InstallOtherMethod(DStarClass, "for a starred Green's L-class",
[IsLStarClass], cl -> DStarClass(ParentAttr(cl), Representative(cl)));

InstallOtherMethod(JStarClass, "for a starred Green's L-class",
[IsLStarClass], cl -> JStarClass(ParentAttr(cl), Representative(cl)));

InstallOtherMethod(JStarClass, "for a starred Green's D-class",
[IsDStarClass], cl -> JStarClass(ParentAttr(cl), Representative(cl)));

# Find all the classes of a particular type

InstallGlobalFunction(LStarPartitionByMT, function(table)
  local mt,         # mutable copy of multiplication table
        n,          # size of <mt>
        profiles,   # types of rows, sorted
        partition,  # partition of indices into R*-classes
        k,          # element counter
        pro,        # profile of current elements row
        pos;        # position of current profile

  # get a mutable copy of the multiplication table
  mt := MutableCopyMat(table);
  n := Length(mt);
  mt{[1 .. n]}[n + 1] := [1 .. n];

  # initialise sorted list of profiles ...
  profiles := EmptyPlist(n);
  # ... and partition into R*-classes
  partition := EmptyPlist(n);

  # loop over elements
  for k in [1 .. n] do
    pro := KernelOfTransformation(TransformationNC(mt[k]));
    pos := PositionSorted(profiles, pro);

    # either ...
    if IsBound(profiles[pos]) and profiles[pos] = pro then
        # add element to part with same profile ...
        Add(partition[pos], k);
    else
        # ... or start a new part
        Add(profiles, pro, pos);
        Add(partition, [k], pos);
    fi;
  od;

  return AsSSortedList(partition);
end);

InstallMethod(RStarClasses, "for a small semigroup", [IsSmallSemigroup],
function(semi)
  local partition,  # partition of indices into R*-classes
        classes,    # the actual classes
        part,       # one part of <partition>, used as loop counter
        rc;         # one R*-class

  # get partition of index set into R*-classes ...
  partition := LStarPartitionByMT(TransposedMat(MultiplicationTable(semi)));

  # ... and use as internal representation
  SetInternalRepStarRelation(RStarRelation(semi), partition);

  # create actual classes as GAP objects
  classes := EmptyPlist(Length(partition));

  for part in partition do
    rc := RStarClass(semi, Elements(semi)[part[1]]);
    Add(classes, rc);
    SetAsSSortedList(rc, Elements(semi){part});
    SetSize(rc, Size(part));
    SetCanonicalStarClass(rc, rc);
  od;

  return classes;
end);

InstallOtherMethod(RStarClasses, "for a starred Green's D-class",
[IsDStarClass], cl -> Filtered(RStarClasses(ParentAttr(cl)),
                               c -> Representative(c) in cl));

InstallOtherMethod(RStarClasses, "for a starred Green's J-class",
[IsJStarClass], cl -> Filtered(RStarClasses(ParentAttr(cl)),
                               c -> Representative(c) in cl));

InstallMethod(LStarClasses, "for a small semigroup", [IsSmallSemigroup],
function(semi)
  local partition,  # partition of indices into L*-classes
        classes,    # the actual classes
        part,       # one part of <partition>, used as loop counter
        lc;         # one L*-class

  # get partition of index set into L*-classes ...
  partition := LStarPartitionByMT(MultiplicationTable(semi));

  # ... and use as internal representation
  SetInternalRepStarRelation(LStarRelation(semi), partition);

  # create actual classes as GAP objects
  classes := EmptyPlist(Length(partition));

  for part in partition do
    lc := LStarClass(semi, Elements(semi)[part[1]]);
    Add(classes, lc);
    SetAsSSortedList(lc, Elements(semi){part});
    SetSize(lc, Size(part));
    SetCanonicalStarClass(lc, lc);
  od;

  return classes;
end);

InstallOtherMethod(LStarClasses, "for a starred Green's D-class",
[IsDStarClass], cl -> Filtered(LStarClasses(ParentAttr(cl)),
                               c -> Representative(c) in cl));

InstallOtherMethod(LStarClasses, "for a starred Green's J-class",
[IsJStarClass], cl -> Filtered(LStarClasses(ParentAttr(cl)),
                               c -> Representative(c) in cl));

# AD would it be better to use JoinEquivalenceRelations?
InstallMethod(DStarClasses, "for a small semigroup", [IsSmallSemigroup],
function(semi)
  local mt,         # multiplication table of <semi>
        left,       # partition of indices into L*-classes
        right,      # partition of indices into R*-classes
        lookupL,    # positions of parts in <left> containing each index
        lookupR,    # positions of parts in <right> containing each index
        partition,  # partition of indices into D*-classes
        classes,    # the actual classes
        part,       # one part of <partition>, used as loop counter
        dc;         # one D*-class

  mt := MultiplicationTable(semi);

  # get R- and L-classes
  LStarClasses(semi);
  RStarClasses(semi);
  left := InternalRepStarRelation(LStarRelation(semi));
  right := InternalRepStarRelation(RStarRelation(semi));

  lookupL := List([1 .. Size(mt)], k -> First(left, part -> k in part));
  lookupR := List([1 .. Size(mt)], k -> First(right, part -> k in part));

  while left <> right do
    left := Unique(List(right, part -> Union(List(part, k -> lookupL[k]))));
    right := Unique(List(left, part -> Union(List(part, k -> lookupR[k]))));
  od;

  partition := AsSSortedList(left);

  SetInternalRepStarRelation(DStarRelation(semi), partition);
  classes := EmptyPlist(Length(partition));

  for part in partition do
    dc := DStarClass(semi, Elements(semi)[part[1]]);
    Add(classes, dc);
    SetAsSSortedList(dc, Elements(semi){part});
    SetSize(dc, Size(part));
    SetCanonicalStarClass(dc, dc);
  od;

  return classes;
end);

InstallOtherMethod(DStarClasses, "for a starred Green's J-class",
[IsJStarClass], cl -> Filtered(DStarClasses(ParentAttr(cl)),
                               c -> Representative(c) in cl));

InstallMethod(JStarClasses, "for a small semigroup", [IsSmallSemigroup],
function(semi)
  local mt,         # multiplication table of <semi>
        n,          # size of <mt>
        jideals,    # Green's J*-ideals of all elements
        partition,  # partition of indices into J*-classes
        set,        # a subset of the indices to become a part of <partition>
        classes,    # list of Green's J*-classes
        rest,       # elements not yet sorted into classes
        elm,        # element for building next class
        part,       # one part of <partition>, used as loop counter
        jc,         # one J*-class
        # AD the ideal computation should certainly become a user function
        # AD but the necessary technicalities are unclear to me
        greensStarJIdealRaw;

  greensStarJIdealRaw := function(elm)
    local ideal,     # the Green's J*-ideal of <elm>
          new,       # auxiliary variable for construction of <ideal>
          trans,     # transposed of <mt>
          dclasses,  # internal representation of Green's D*-classes
          greensJIdeal;

    # AD this step is rather inefficient in its current form
    # AD it should be replaced by a call to an attribute
    greensJIdeal := function(a)
      local regid;  # the regular Greens J-ideal of <a>
      # {a} \cup aS
      regid := Union(mt[a], [a]);
      # {a} \cup aS \cup aS \cup SaS
      return Union(regid, Union(List(regid, x -> trans[x])));
    end;

    trans := TransposedMat(mt);
    DStarClasses(semi);
    dclasses := InternalRepStarRelation(DStarRelation(semi));
    dclasses := List([1 .. n], x -> First(dclasses, cl -> x in cl));

    new := [elm];

    repeat
      ideal := new;
      new := Union(List(ideal, greensJIdeal));
      new := Union(List(new, x -> dclasses[x]));
    until new = ideal;

    return ideal;
  end;

  mt := MultiplicationTable(semi);
  n := Size(mt);

  jideals := List([1 .. n], greensStarJIdealRaw);

  partition := EmptyPlist(Size(mt));
  rest := [1 .. Size(mt)];

  repeat
    # take one of the remaining elements
    elm := rest[1];

    # get remaining elements in the same class
    set := Filtered(Intersection(rest, jideals[elm]),
                    x -> elm in jideals[x]);

    # remember new class and prepare for next step
    Add(partition, set);
    rest := Difference(rest, set);
  until IsEmpty(rest);

  MakeImmutable(partition);
  SetIsSSortedList(partition, true);

  SetInternalRepStarRelation(JStarRelation(semi), partition);
  classes := EmptyPlist(Length(partition));

  for part in partition do
      jc := JStarClass(semi, Elements(semi)[part[1]]);
      Add(classes, jc);
      SetAsSSortedList(jc, Elements(semi){part});
      SetSize(jc, Size(part));
      SetCanonicalStarClass(jc, jc);
  od;

  SetJStarClasses(semi, classes);

  return classes;
end);

InstallMethod(HStarClasses, "for a small semigroup", [IsSmallSemigroup],
function(semi)
    local left,       # partition of indices into L*-classes
          lpart,      # one part of <left>
          right,      # partition of indices into R*-classes
          rpart,      # one part of <right>
          partition,  # partition of indices into D*-classes
          classes,    # the actual classes
          part,       # one part of <partition>, used as loop counter
          hc;         # one H*-class

    # get R- and L-classes
    LStarClasses(semi);
    RStarClasses(semi);

    left := InternalRepStarRelation(LStarRelation(semi));
    right := InternalRepStarRelation(RStarRelation(semi));

    partition := [];

    for lpart in left do
      for rpart in right do
        Add(partition, Intersection(lpart, rpart));
      od;
    od;

    partition := AsSSortedList(Filtered(partition, p -> not IsEmpty(p)));

    SetInternalRepStarRelation(HStarRelation(semi), partition);
    classes := EmptyPlist(Length(partition));

    for part in partition do
      hc := HStarClass(semi, Elements(semi)[part[1]]);
      Add(classes, hc);
      SetAsSSortedList(hc, Elements(semi){part});
      SetSize(hc, Size(part));
      SetCanonicalStarClass(hc, hc);
    od;
    SetHStarClasses(semi, classes);
    return classes;
end);

InstallOtherMethod(HStarClasses, "for a starred Green's class",
[IsStarClass], cl -> Filtered(HStarClasses(ParentAttr(cl)),
                              c -> Representative(c) in cl));