RAQ/gap/structure.gi

## structure.gi RAQ Implementation of definitiions, reps, and elt operations

## Testing properties of collections the hard way if we have to

InstallMethod(IsElementwiseIdempotent, "for finite collections",
              [IsMultiplicativeElementCollection and IsFinite],
              M -> ForAll(Elements(M), m->IsIdempotent(m))
);

InstallMethod(IsLSelfDistributive,
  "for arbitrary multiplicative collections, the hard way",
  [IsMultiplicativeElementCollection],
  function (C)
    local a,b,d;
    for a in C do for b in C do for d in C do
      if d*(a*b) <> (d*a)*(d*b) then return false; fi;
    od; od; od;
    return true;
end);

InstallMethod(IsRSelfDistributive,
  "for arbitrary multiplicative collections, the hard way",
  [IsMultiplicativeElementCollection],
  function (C)
    local a,b,d;
    for a in C do for b in C do for d in C do
      if (a*b)*d <> (a*d)*(b*d) then return false; fi;
    od; od; od;
    return true;
end);
                                 
## Create structures with generators

InstallGlobalFunction(CloneOfTypeByGenerators,
  function(cat, fam, gens, genAttrib, tableCstr)
    local M, elf;
    if not(IsEmpty(gens) or IsIdenticalObj(FamilyObj(gens), fam)) then
      Error("<fam> and family of <gens> do not match");
    fi;
    M := Objectify(NewType( fam, cat and IsAttributeStoringRep), rec());
    Setter(genAttrib)(M, AsList(gens));
    SetConstructorFromTable(M, tableCstr);
    elf := ElementsFamily(fam);
    # Since there doesn't seem to be a way to make the IsFinite method based
    # on the family being finite into an immediate method:
    if HasIsFinite(elf) and IsFinite(elf) then SetIsFinite(M, true); fi;
    return M;
end);

## Helpers for the constructors below:

ArgHelper@ := function(parmlist)
  # returns a list of the family and the flat list of elements of parmlist
  if Length(parmlist) = 0 then
    Error("usage: RAQ constructors take an optional family, followed by gens");
  fi;
  if IsFamily(parmlist[1]) then return [Remove(parmlist,1), Flat(parmlist)]; fi;
  parmlist := Flat(parmlist);
  return [FamilyObj(parmlist), parmlist];
end;

CheckLQGprop@ := function(gens)
  local g, h;
  # Make sure all elements in gens have left quotient property pairwise
  for g in gens do for h in gens do
    if g*LeftQuotient(g,h) <> h or LeftQuotient(g,g*h) <> h then
      Error("left quasigroup property of left quotients violated");
    fi;
  od; od;
  return;
end;

CheckRQGprop@ := function(gens)
  local g, h;
  # Make sure all elements in gens have right quotient property pairwise
  for g in gens do for h in gens do
    if (h*g)/g <> h or (h/g)*g <> h then
      Error("right quasigroup property of / violated");
    fi;
  od; od;
  return;
end;

## Functions for each of the magma categories here
InstallGlobalFunction(LeftQuasigroup, function(arg)
  arg := ArgHelper@(arg);
  CheckLQGprop@(arg[2]);
  return LeftQuasigroupNC(arg[1], arg[2]);
end);

InstallGlobalFunction(LeftQuasigroupNC, function(fam, gens)                      
  return CloneOfTypeByGenerators(IsLeftQuasigroup, fam, gens,
                                 GeneratorsOfLeftQuasigroup, 
                                 LeftQuasigroupByMultiplicationTableNC);
end);

InstallGlobalFunction(LeftRack, function(arg)
  arg := ArgHelper@(arg);
  CheckLQGprop@(arg[2]);
  if not IsLSelfDistributive(arg[2]) then
    Error("Left rack must have left distributive generators");
  fi;
  return LeftRackNC(arg[1], arg[2]);
end);

InstallGlobalFunction(LeftRackNC, function(fam, gens)
  return CloneOfTypeByGenerators(IsLeftRack, fam, gens,
                                 GeneratorsOfLeftQuasigroup,
                                 LeftRackByMultiplicationTableNC);
end);

InstallGlobalFunction(LeftQuandle, function(arg)
  arg := ArgHelper@(arg);
  CheckLQGprop@(arg[2]);
  if not IsLSelfDistributive(arg[2]) then
    Error("Left quandle must have left distributive generators");
  fi;
  if not IsElementwiseIdempotent(arg[2]) then
    Error("Quandles must contain only idempotent elements");
  fi;
  return LeftQuandleNC(arg[1], arg[2]);
end);

InstallGlobalFunction(LeftQuandleNC, function(fam, gens)
  return CloneOfTypeByGenerators(IsLeftQuandle, fam, gens,
                                 GeneratorsOfLeftQuasigroup,
                                 LeftQuandleByMultiplicationTableNC);
end);

InstallGlobalFunction(RightQuasigroup, function(arg)
  arg := ArgHelper@(arg);
  CheckRQGprop@(arg[2]);
  return RightQuasigroupNC(arg[1], arg[2]);
end);

InstallGlobalFunction(RightQuasigroupNC, function(fam, gens)
  return CloneOfTypeByGenerators(IsRightQuasigroup, fam, gens,
                                 GeneratorsOfRightQuasigroup, 
                                 RightQuasigroupByMultiplicationTableNC);
end);

InstallGlobalFunction(RightRack, function(arg)
  arg := ArgHelper@(arg);
  CheckRQGprop@(arg[2]);
  if not IsRSelfDistributive(arg[2]) then
    Error("Right rack must have right distributive generators");
  fi;
  return RightRackNC(arg[1], arg[2]);
end);

InstallGlobalFunction(RightRackNC, function(fam, gens)
  return CloneOfTypeByGenerators(IsRightRack, fam, gens,
                                 GeneratorsOfRightQuasigroup,
                                 RightRackByMultiplicationTableNC);
end);

InstallGlobalFunction(RightQuandle, function(arg)
  arg := ArgHelper@(arg);
  CheckRQGprop@(arg[2]);
  if not IsRSelfDistributive(arg[2]) then
    Error("Right quandle must have right distributive generators");
  fi;
  if not IsElementwiseIdempotent(arg[2]) then
    Error("Quandles must contain only idempotent elements");
  fi;
  return RightQuandleNC(arg[1], arg[2]);
end);

InstallGlobalFunction(RightQuandleNC, function(fam, gens)
  return CloneOfTypeByGenerators(IsRightQuandle, fam, gens,
                                 GeneratorsOfRightQuasigroup,
                                 RightQuandleByMultiplicationTableNC);
end);

## NOTE: If it is the case that the magma generated by the
## GeneratorsOf[Left|Right]Quasigroup is finite, then since the [left|right]
## multiplication is injective, it is also surjective on that set and in fact
## it is the whole quasigroup. However, it is not yet clear to me how best to
## capture this fact in GAP in a computationally useful way.

## View and print and such
LeftObjString@ := function(Q)
  # Don't test distributivity if we haven't already
  if HasIsLSelfDistributive(Q) and IsLeftRack(Q) then 
    if HasIsElementwiseIdempotent(Q) and IsElementwiseIdempotent(Q) then
      return "LeftQuandle";
    fi;
    return "LeftRack";
  fi;
  return "LeftQuasigroup";
end;

RightObjString@ := function(Q)
  # Don't test distributivity if we haven't already
  if HasIsRSelfDistributive(Q) and IsRightRack(Q) then 
    if HasIsElementwiseIdempotent(Q) and IsElementwiseIdempotent(Q) then
      return "RightQuandle";
    fi;
    return "RightRack";
  fi;
  return "RightQuasigroup";
end;

InstallMethod(String, "for a left quasigroup",
              [IsLeftQuasigroup],
              Q -> Concatenation(LeftObjString@(Q), "(...)"));

InstallMethod(String, "for a left quasigroup with generators",
              [IsLeftQuasigroup and HasGeneratorsOfLeftQuasigroup],
              Q -> Concatenation(LeftObjString@(Q), "( ", 
                                 String(GeneratorsOfLeftQuasigroup(Q)), " )"));

InstallMethod(String, "for a left quasigroup with multiplication table",
              [IsLeftQuasigroup and HasMultiplicationTable],
              Q -> Concatenation(LeftObjString@(Q), 
                                 "ByMultiplicationTableNC( ",
                                 String(MultiplicationTable(Q)), " )"));

InstallMethod(String, "for a right quasigroup",
              [IsRightQuasigroup],
              Q -> Concatenation(RightObjString@(Q), "(...)"));

InstallMethod(String, "for a right quasigroup with generators",
              [IsRightQuasigroup and HasGeneratorsOfRightQuasigroup],
              Q -> Concatenation(RightObjString@(Q), "( ", 
                                 String(GeneratorsOfRightQuasigroup(Q)), " )"));

InstallMethod(String, "for a right quasigroup with multiplication table",
              [IsRightQuasigroup and HasMultiplicationTable],
              Q -> Concatenation(RightObjString@(Q), 
                                 "ByMultiplicationTableNC( ",
                                 String(MultiplicationTable(Q)), " )"));

InstallMethod(PrintString, "for a left quasigroup",
              [IsLeftQuasigroup], Q -> String(Q));

InstallMethod(PrintString, "for a right quasigroup",
              [IsRightQuasigroup], Q -> String(Q));

InstallMethod(DisplayString, "for a left quasigroup",
              [IsLeftQuasigroup], Q -> String(Q));

InstallMethod(DisplayString, "for a right quasigroup",
              [IsRightQuasigroup], Q -> String(Q));

InstallMethod(Display, "for a left quasigroup with multiplication table",
  [IsLeftQuasigroup and HasMultiplicationTable],
  function(Q)
    Print(LeftObjString@(Q), " with ", Size(Q), 
          " elements, generated by ", 
          GeneratorsOfLeftQuasigroup(Q), ", with table\n");
    Display(MultiplicationTable(Q));
end);

InstallMethod(Display, "for a right quasigroup with multiplication table",
  [IsRightQuasigroup and HasMultiplicationTable],
  function(Q)
    Print(RightObjString@(Q), " with ", Size(Q), 
          " elements, generated by ", 
          GeneratorsOfRightQuasigroup(Q), ", with table\n");
    Display(MultiplicationTable(Q));
end);

LeftObjView@ := function(Q)
  # Don't test distributivity if we haven't already
  if HasIsLSelfDistributive(Q) and IsLeftRack(Q) then 
    if HasIsElementwiseIdempotent(Q) and IsElementwiseIdempotent(Q) then
      return "<left quandle";
    fi;
    return "<left rack";
  fi;
  return "<left quasigroup";
end;

RightObjView@ := function(Q)
  # Don't test distributivity if we haven't already
  if HasIsRSelfDistributive(Q) and IsRightRack(Q) then 
    if HasIsElementwiseIdempotent(Q) and IsElementwiseIdempotent(Q) then
      return "<right quandle";
    fi;
    return "<right rack";
  fi;
  return "<right quasigroup";
end;

InstallMethod(ViewString, "for a left quasigroup",
              [IsLeftQuasigroup], 
              Q -> Concatenation(LeftObjView@(Q), ">"));

InstallMethod(ViewString, "for a left quasigroup with generators",
              [IsLeftQuasigroup and HasGeneratorsOfLeftQuasigroup], 
              Q -> Concatenation(LeftObjView@(Q), " with ",
                                 String(Size(GeneratorsOfLeftQuasigroup(Q))), 
                                 " generators>"));

InstallMethod(ViewString, "for a right quasigroup",
              [IsRightQuasigroup], 
              Q -> Concatenation(RightObjView@(Q), ">"));

InstallMethod(ViewString, "for a right quasigroup with generators",
              [IsRightQuasigroup and HasGeneratorsOfRightQuasigroup], 
              Q -> Concatenation(RightObjView@(Q), " with ",
                                 String(Size(GeneratorsOfRightQuasigroup(Q))), 
                                 " generators>"));

## Opposite structures
OFDir@ := NewDictionary("strings", true);
# What property does the Opposite family have for each property of the
# underlying elements? Hopefully we have gotten all of the relevant
# properties. What we really want is the implied (and maybe the required)
# properties of the family of the elements that we are taking the Opposite of,
# but there is not any documented way of obtaining those.
AddDictionary(OFDir@, "CanEasilyCompareElements", CanEasilyCompareElements);
AddDictionary(OFDir@, "CanEasilySortElements", CanEasilySortElements);
AddDictionary(OFDir@, "IsAssociativeElement", IsAssociativeElement);
AddDictionary(OFDir@, "IsCommutativeElement", IsCommutativeElement);
AddDictionary(OFDir@, "IsExtLElement", IsExtRElement);
AddDictionary(OFDir@, "IsExtRElement", IsExtLElement);
AddDictionary(OFDir@, "IsFiniteOrderElement", IsFiniteOrderElement);
AddDictionary(OFDir@, "IsLeftQuotientElement", IsRightQuotientElement);
AddDictionary(OFDir@, "IsLSelfDistElement", IsRSelfDistElement);
AddDictionary(OFDir@, "IsMultiplicativeElementWithInverse",
              IsMultiplicativeElementWithInverse);
AddDictionary(OFDir@, "IsMultiplicativeElementWithOne",
              IsMultiplicativeElementWithOne);
AddDictionary(OFDir@, "IsRightQuotientElement", IsLeftQuotientElement);
AddDictionary(OFDir@, "IsRSelfDistElement", IsLSelfDistElement);

InstallMethod(OppositeFamily, "for a family",
  [IsFamily],
  function(fam)
    local F, elt, elt_props, opp_props, prop, opp_filt, filt;
    elt := Representative(fam);
    elt_props := CategoriesOfObject(elt);
    Append(elt_props, KnownTruePropertiesOfObject(elt));
    opp_props := [];
    for prop in elt_props do
      if KnowsDictionary(OFDir@, prop) then
        Add(opp_props, LookupDictionary(OFDir@, prop));
      fi;
    od;
    opp_filt := IsMultiplicativeElement;
    for filt in opp_props do opp_filt := opp_filt and filt; od;
    return NewFamily(Concatenation("OppositeFamily(", fam!.NAME, ")"),
                     IsOppositeObject, opp_filt);
end);
                   
InstallMethod(OppositeType, "for a family",
  [IsFamily],
  fam -> NewType(OppositeFamily(fam), IsDefaultOppositeObject)
);
                   
InstallMethod(OppositeObj, "for a multiplicative element",
  [IsMultiplicativeElement],
  function (obj)
    local fam;
    fam := FamilyObj(obj);
    SetRepresentative(fam, obj);
    return Objectify(OppositeType(fam), [Immutable(obj)]);
end);

InstallMethod(OppositeObj, "for a commutative element",
  [IsMultiplicativeElement and IsCommutativeElement],
  IdFunc
);

InstallMethod(UnderlyingMultiplicativeElement, "for a default opposite obj",
  [IsDefaultOppositeObject],
  obj -> obj![1]
);

## Printing and viewing opposite objects
InstallMethod(String, "for opposite objects",
  [IsDefaultOppositeObject],
  obj -> Concatenation("OppositeObj( ", String(obj![1]), " )")
);

InstallMethod(ViewString, "for opposite objects",
  [IsDefaultOppositeObject],
  obj -> Concatenation("o", ViewString(obj![1]))
);

InstallMethod(\=, "for two opposite objects",
  IsIdenticalObj,
  [IsDefaultOppositeObject, IsDefaultOppositeObject],
  function(l,r) return l![1] = r![1]; end
);

InstallMethod(\<, "for two opposite objects",
  IsIdenticalObj,
  [IsDefaultOppositeObject, IsDefaultOppositeObject],
  function(l,r) return l![1] < r![1]; end
);

InstallMethod(\*, "for two opposite objects",
  IsIdenticalObj,
  [IsDefaultOppositeObject, IsDefaultOppositeObject],
  function(l,r) return OppositeObj(r![1]*l![1]); end
);

InstallOtherMethod(LeftQuotient, "for two opposite objects",
  IsIdenticalObj,
  [IsDefaultOppositeObject and IsLeftQuotientElement, IsDefaultOppositeObject],
  function(l,r) return OppositeObj(r![1]/l![1]); end
);

InstallOtherMethod(\/, "for two opposite objects",
  IsIdenticalObj,
  [IsDefaultOppositeObject, IsDefaultOppositeObject and IsRightQuotientElement],
  function(l,r) return OppositeObj(LeftQuotient(r![1], l![1])); end
);

InstallMethod(OneOp, "for an opposite object",
  [IsDefaultOppositeObject and IsMultiplicativeElementWithOne],
  ob -> OppositeObj(One(ob![1]))
);

InstallMethod(InverseOp, "for an opposite object",
  [IsDefaultOppositeObject and IsMultiplicativeElementWithInverse],
  ob -> OppositeObj(Inverse(ob![1]))
);

# Now the many Opposite implementations. How can we cut this down?

InstallMethod(Opposite, "for a commutative magma",
  [IsMagma and IsCommutative],
  IdFunc
);

InstallMethod(Opposite, "for a finitely generated magma",
  [IsMagma and HasGeneratorsOfMagma],
  function(M)
    local fam, elts;
    # Get elements first to prime the representative of the family
    elts := List(GeneratorsOfMagma(M), m -> OppositeObj(m));
    fam := CollectionsFamily(OppositeFamily(ElementsFamily(FamilyObj(M))));
    return Magma(fam, elts);
end);             

InstallMethod(Opposite, "for a finitely generated magma with one",
  [IsMagmaWithOne and HasGeneratorsOfMagmaWithOne],
  function(M)
    local fam, elts;
    # Get elements first to prime the representative of the family
    elts := List(GeneratorsOfMagmaWithOne(M), m -> OppositeObj(m));
    fam := CollectionsFamily(OppositeFamily(ElementsFamily(FamilyObj(M))));
    return MagmaWithOne(fam, elts);
end);             

InstallMethod(Opposite, "for a finitely generated magma with inverse",
  [IsMagmaWithInverses and HasGeneratorsOfMagmaWithInverses],
  function(M)
    local fam, elts;
    # Get elements first to prime the representative of the family
    elts := List(GeneratorsOfMagmaWithInverses(M), m -> OppositeObj(m));
    fam := CollectionsFamily(OppositeFamily(ElementsFamily(FamilyObj(M))));
    return MagmaWithInverses(fam, elts);
end);             

# Do we need Opposite() methods for Semigroups, Monoids, and Groups? Or have
# we copied enough properties that those filters will simply carry over? The
# couple of small tests I did the Opposite of a Group was again reported as a
# Group, so let's leave those methods out for now, and move on to quasigroups,
# racks, and quandles.

OppHelper@ := function(Q, whichgens, cnstr)
  local fam, elts, opp;
  elts := List(whichgens(Q), q -> OppositeObj(q));
  fam := CollectionsFamily(OppositeFamily(ElementsFamily(FamilyObj(Q))));
  opp := cnstr(fam, elts);
  if HasIsFinite(Q) then SetIsFinite(opp, IsFinite(Q)); fi;
  return opp;
end;


InstallMethod(Opposite, "for a left quasigroup",
  [IsLeftQuasigroup and HasGeneratorsOfLeftQuasigroup],
  Q -> OppHelper@(Q, GeneratorsOfLeftQuasigroup, RightQuasigroupNC)
);

InstallMethod(Opposite, "for a left rack",
  [IsLeftRack and HasGeneratorsOfLeftQuasigroup],
  Q -> OppHelper@(Q, GeneratorsOfLeftQuasigroup, RightRackNC)
);

InstallMethod(Opposite, "for a left quandle",
  [IsLeftQuandle and HasGeneratorsOfLeftQuasigroup],
  Q -> OppHelper@(Q, GeneratorsOfLeftQuasigroup, RightQuandleNC)
);

InstallMethod(Opposite, "for a right quasigroup",
  [IsRightQuasigroup and HasGeneratorsOfRightQuasigroup],
  Q -> OppHelper@(Q, GeneratorsOfRightQuasigroup, LeftQuasigroupNC)
);

InstallMethod(Opposite, "for a right rack",
  [IsRightRack and HasGeneratorsOfRightQuasigroup],
  Q -> OppHelper@(Q, GeneratorsOfRightQuasigroup, LeftRackNC)
);

InstallMethod(Opposite, "for a right quandle",
  [IsRightQuandle and HasGeneratorsOfRightQuasigroup],
  Q -> OppHelper@(Q, GeneratorsOfRightQuasigroup, LeftQuandleNC)
);

# Direct Products
# We actually try to handle here the general cases that are not otherwise
# handled by the groups functions in GAP as a whole, or the LOOPS package

# Helper for roughly creating the join of the filters of a bunch of objects.
FiltersOfObj@ := function(obj)
  local f;
  f := CategoriesOfObject(obj);
  Append(f,KnownTruePropertiesOfObject(obj));
  Append(f,List(KnownAttributesOfObject(obj), x -> Concatenation("Has", x)));
  return f;
end;

# From the implementation of DirectProductOp for groups and quasigroups, the
# below will only be called with a second-argument collection which is not a
# group or quasigroup.

# This is a helper that creates a rough join of the filters of a list of
# objects, using the same arguments as directproduct op (the redundant "first"
# argument, which is handy for seeding the filter list)
RoughJoinOfFilters@ := function(list, first)
  local item, jof;
  jof := Set(FiltersOfObj@(first));
  for item in list{[2..Length(list)]} do
    IntersectSet(jof, FiltersOfObj@(item));
  od;
  return jof;
end;

InstallOtherMethod(DirectProductOp, "for a list and non-quasigroup magma",
  [IsList, IsMagma],
  function (list, first)
    local item, i, jof, ids, gens, g, current, genfunc, genlists;
    # Simple checks
    if IsEmpty(list) then
      Error("Usage: Cannot take DirectProduct of zero items.");
    elif Length(list) = 1 then
      return list[1];
    fi;
    jof := RoughJoinOfFilters@(list, first);
    
    # The dispatch below is somewhat ad-hoc, but covers the major existing cases
    
    # First, if we don't have generators for all of the items, we're kinda out
    # of luck here:
    if not ForAny(jof, nm -> StartsWith(nm,"HasGenerators")) then
      TryNextMethod();
    fi;
    # Next, if anything is not even a magma, recommend cartesian product
    if not "IsMagma" in jof then
      Info(InfoRAQ, 1, "Try Cartesian() for products of collections.");
      TryNextMethod();
    fi;
        
    # The primary division now is between entities with identities, for which
    # the product will have a smaller generating set, and those which do
    # not, for which the generators is the full cartesian product of generators.
    if "IsMagmaWithOne" in jof then
      # Code basically copied from DirectProductOp() for general groups;
      # would be better if this could be moved into the GAP core
      ids := List(list, One);
      gens := [];
      for i in [1..Length(list)] do
        for g in GeneratorsOfMagmaWithOne(list[i]) do
          current := ShallowCopy(ids);
          current[i] := g;
          Add(gens, DirectProductElement(current));
        od;
      od;
      # Now, we want the most specific structure we know about here.
      # Only aware of MagmaWithOne and Monoid, as direct products of 
      # loops are already covered by the LOOPS package:
      if "IsMonoid" in jof then
        return MonoidByGenerators(gens);
      fi;
      return MagmaWithOneByGenerators(gens);
    fi;
    # OK, here we know not all structures have inverses. Therefore, we must
    # resort to the full cartesian product of generators.
    # But we need to figure out what function to use to obtain the generators.
    if "HasGeneratorsOfLeftQuasigroup" in jof then
      genfunc := GeneratorsOfLeftQuasigroup;
    elif "HasGeneratorsOfRightQuasigroup" in jof then
      genfunc := GeneratorsOfRightQuasigroup;
    elif "HasGeneratorsOfMagma" in jof then
      genfunc := GeneratorsOfMagma;
    else
      Info(InfoRAQ,1, "RAQ: Unusual product, each of ", list,
           " has generators, but not sure what kind; trying next method.");
      TryNextMethod();
    fi;
    
    genlists := List(list, genfunc);
    gens := Cartesian(genlists);
    Apply(gens, DirectProductElement);
    # Again, we need to figure out what sort of structure we might have
    if "IsAssociative" in jof then
      return SemigroupByGenerators(gens);
    elif "IsLeftQuasigroup" in jof then
      if "IsLSelfDistributive" in jof then
        if "IsElementwiseIdempotent" in jof then
          return LeftQuandleNC(FamilyObj(gens), gens);
        fi;
        return LeftRackNC(FamilyObj(gens), gens);
      fi;
      return LeftQuasigroupNC(FamilyObj(gens), gens);
    elif "IsRightQuasigroup" in jof then
      if "IsRSelfDistributive" in jof then
        if "IsElementwiseIdempotent" in jof then
          return RightQuandleNC(FamilyObj(gens), gens);
        fi;
        return RightRackNC(FamilyObj(gens), gens);
      fi;
      return RightQuasigroupNC(FamilyObj(gens), gens);
    fi;
    # Not seeing any additional structure; did I miss anything?
    return MagmaByGenerators(gens);
end);