Quelle grahom.gi Sprache: unbekannt

#############################################################################
##
##  grahom.gi
##  Copyright (C) 2014-19                                  Julius Jonusas
##                                                         James Mitchell
##                                                         Wilf A. Wilson
##
##  Licensing information can be found in the README file of this package.
##
#############################################################################
##

InstallGlobalFunction(GeneratorsOfEndomorphismMonoid,
function(arg...)
  local D, limit, colours, G, gens, limit_arg, out;
  if IsEmpty(arg) then
    ErrorNoReturn("at least 1 argument expected, found 0,");
  fi;
  D := arg[1];
  if not IsDigraph(D) then
    ErrorNoReturn("the 1st argument must be a digraph,");
  fi;
  D := DigraphImmutableCopyIfMutable(D);
  if IsBound(arg[2]) then
    if IsHomogeneousList(arg[2]) then
      colours := arg[2];
      G := AutomorphismGroup(DigraphRemoveAllMultipleEdges(D), colours);
    elif not IsBound(arg[3]) and (IsPosInt(arg[2]) or arg[2] = infinity) then
      # arg[2] is <limit>
      arg[3] := arg[2];
      colours := fail;
      G := AutomorphismGroup(DigraphRemoveAllMultipleEdges(D));
    else
      ErrorNoReturn("the 2nd argument must be a homogeneous list,");
    fi;
  else
    if HasGeneratorsOfEndomorphismMonoidAttr(D) then
      return GeneratorsOfEndomorphismMonoidAttr(D);
    fi;
    colours := fail;
    G := AutomorphismGroup(DigraphRemoveAllMultipleEdges(D));
  fi;

  if IsBound(arg[3]) then
    if not (IsPosInt(arg[3]) or arg[3] = infinity) then
      ErrorNoReturn("the 3rd argument must be a positive integer or ",
                    "infinity,");
    fi;
    limit := arg[3];
  else
    limit := infinity;
  fi;

  if IsTrivial(G) then
    gens := [];
  else
    gens := List(GeneratorsOfGroup(G), AsTransformation);
  fi;

  if IsPosInt(limit) then
    limit_arg := limit;
    limit := limit - Length(gens);
  fi;

  if limit <= 0 then
    return gens;
  fi;

  out := HomomorphismDigraphsFinder(D,                   # gr1
                                    D,                   # gr2
                                    fail,                # hook
                                    gens,                # user_param
                                    limit,               # limit
                                    fail,                # hint
                                    0,                   # injective
                                    DigraphVertices(D),  # image
                                    [],                  # partial map
                                    colours,             # colours1
                                    colours,             # colours2
                                    DigraphWelshPowellOrder(D));

  if (limit = infinity or Length(gens) < limit_arg) and IsImmutableDigraph(D)
      and colours = fail then
    SetGeneratorsOfEndomorphismMonoidAttr(D, out);
  fi;
  return out;
end);

InstallMethod(GeneratorsOfEndomorphismMonoidAttr, "for a digraph",
[IsDigraph], GeneratorsOfEndomorphismMonoid);

################################################################################
# COLOURING

InstallMethod(DigraphColouring, "for a digraph and an integer",
[IsDigraph, IsInt],
function(D, n)
  if n < 0 then
    ErrorNoReturn("the 2nd argument <n> must be a non-negative integer,");
  elif HasDigraphGreedyColouring(D) then
    if DigraphGreedyColouring(D) = fail then
      return fail;
    elif RankOfTransformation(DigraphGreedyColouring(D),
                              DigraphNrVertices(D)) = n then
      return DigraphGreedyColouring(D);
    fi;
  fi;

  # Only the null digraph with 0 vertices can be coloured with 0 colours
  if n = 0 then
    if DigraphHasNoVertices(D) then
      return IdentityTransformation;
    fi;
    return fail;
  fi;

  # Special case for bipartite testing; works for large graphs
  if n = 2 then
    if not IsBipartiteDigraph(D) then
      return fail;
    fi;
    return DIGRAPHS_Bipartite(D)[2];
  fi;

  # General case for n > 2; works for small graphs
  return DigraphEpimorphism(D, CompleteDigraph(n));
end);

InstallMethod(DigraphGreedyColouring, "for a digraph", [IsDigraph],
D -> DigraphGreedyColouringNC(D, DigraphWelshPowellOrder(D)));

InstallMethod(DigraphGreedyColouring, "for a digraph",
[IsDigraph, IsHomogeneousList],
function(D, order)
  local n;
  n := DigraphNrVertices(D);
  if Length(order) <> n or ForAny(order, x -> (not IsPosInt(x)) or x > n) then
    ErrorNoReturn("the 2nd argument <order> must be a permutation of ",
                  "[1 .. ", n, "]");
  fi;
  return DigraphGreedyColouringNC(D, order);
end);

InstallMethod(DigraphGreedyColouringNC,
"for a digraph by out-neighbours and a homogeneous list",
[IsDigraphByOutNeighboursRep, IsHomogeneousList],
function(D, order)
  local n, colour, colouring, out, inn, empty, all, available, nr_coloured, v;
  n := DigraphNrVertices(D);
  if n = 0 then
    return IdentityTransformation;
  elif DigraphHasLoops(D) then
    return fail;
  fi;
  colour := 1;
  colouring := ListWithIdenticalEntries(n, 0);
  out := OutNeighbours(D);
  inn := InNeighbours(D);
  empty := BlistList([1 .. n], []);
  all := BlistList([1 .. n], [1 .. n]);
  available := BlistList([1 .. n], [1 .. n]);
  nr_coloured := 0;
  while nr_coloured < n do
    for v in order do
      if colouring[v] = 0 and available[v] then
        nr_coloured := nr_coloured + 1;
        colouring[v] := colour;
        available[v] := false;
        SubtractBlist(available, BlistList([1 .. n], out[v]));
        SubtractBlist(available, BlistList([1 .. n], inn[v]));
        if available = empty then
          break;
        fi;
      fi;
    od;
    UniteBlist(available, all);
    colour := colour + 1;
  od;
  return TransformationNC(colouring);
end);

InstallMethod(DigraphGreedyColouring, "for a digraph and a function",
[IsDigraph, IsFunction],
{D, func} -> DigraphGreedyColouringNC(D, func(D)));

InstallMethod(DigraphWelshPowellOrder, "for a digraph", [IsDigraph],
function(D)
  local order, deg;
  order := [1 .. DigraphNrVertices(D)];
  deg   := ShallowCopy(OutDegrees(D)) + InDegrees(D);
  SortParallel(deg, order, {x, y} -> x > y);
  return order;
end);

InstallMethod(DigraphSmallestLastOrder, "for a digraph", [IsDigraph],
function(D)
  local order, n, deg, v;
  order := [];
  n := DigraphNrVertices(D);
  D := DigraphMutableCopyIfMutable(D);
  while n > 0 do
    deg := ShallowCopy(OutDegrees(D)) + InDegrees(D);
    v := PositionMinimum(deg);
    order[n] := DigraphVertexLabel(D, v);
    D := DigraphRemoveVertex(D, v);
    n := n - 1;
  od;
  return order;
end);

################################################################################
# HOMOMORPHISMS

# Finds a single homomorphism of highest rank from D1 to D2

InstallMethod(DigraphHomomorphism, "for a digraph and a digraph",
[IsDigraph, IsDigraph],
function(D1, D2)
  local out;
  out := HomomorphismDigraphsFinder(D1,
                                    D2,
                                    fail,                 # hook
                                    [],                   # user_param
                                    1,                    # limit
                                    fail,                 # hint
                                    0,                    # injective
                                    DigraphVertices(D2),  # image
                                    [],                   # map
                                    fail,                 # colours1
                                    fail,                 # colours2
                                    DigraphWelshPowellOrder(D1));
  if IsEmpty(out) then
    return fail;
  fi;
  return out[1];
end);

# Finds a set S of homomorphism from gr1 to gr2 such that every homomorphism g
# between the two graphs can expressed as a composition g = f * x of an element
# f in S and an automorphism x of gr2

InstallMethod(HomomorphismsDigraphsRepresentatives,
"for a digraph and a digraph",
[IsDigraph, IsDigraph],
function(D1, D2)
  return HomomorphismDigraphsFinder(D1,
                                    D2,
                                    fail,                  # hook
                                    [],                    # user_param
                                    infinity,              # limit
                                    fail,                  # hint
                                    0,                     # injective
                                    DigraphVertices(D2),   # image
                                    [],                    # map
                                    fail,                  # colours1
                                    fail,                  # colours2
                                    DigraphWelshPowellOrder(D1));
end);

# Finds the set of all homomorphisms from gr1 to gr2

InstallMethod(HomomorphismsDigraphs, "for a digraph and a digraph",
[IsDigraph, IsDigraph],
function(D1, D2)
  local hom, aut;
  hom := HomomorphismsDigraphsRepresentatives(D1, D2);
  D2 := DigraphMutableCopyIfMutable(D2);
  aut := List(AutomorphismGroup(DigraphRemoveAllMultipleEdges(D2)),
              AsTransformation);
  return Union(List(aut, x -> hom * x));
end);

################################################################################
# INJECTIVE HOMOMORPHISMS

# Finds a single injective homomorphism of gr1 into gr2

InstallMethod(DigraphMonomorphism, "for a digraph and a digraph",
[IsDigraph, IsDigraph],
function(D1, D2)
  local out;
  out := HomomorphismDigraphsFinder(D1,
                                    D2,
                                    fail,                   # hook
                                    [],                     # user_param
                                    1,                      # limit
                                    DigraphNrVertices(D1),  # hint
                                    1,                      # injective
                                    DigraphVertices(D2),    # image
                                    [],                     # map
                                    fail,                   # colours1
                                    fail,                   # colours2
                                    DigraphWelshPowellOrder(D1));
  if IsEmpty(out) then
    return fail;
  fi;
  return out[1];
end);

# Same as HomomorphismsDigraphsRepresentatives, except only injective ones

InstallMethod(MonomorphismsDigraphsRepresentatives,
"for a digraph and a digraph",
[IsDigraph, IsDigraph],
function(D1, D2)
  return HomomorphismDigraphsFinder(D1,
                                    D2,
                                    fail,                    # hook
                                    [],                      # user_param
                                    infinity,                # limit
                                    DigraphNrVertices(D1),   # hint
                                    1,                       # injective
                                    DigraphVertices(D2),     # image
                                    [],                      # map
                                    fail,                    # colours1
                                    fail,                    # colours2
                                    DigraphWelshPowellOrder(D1));
end);

# Finds the set of all monomorphisms from D1 to D2

InstallMethod(MonomorphismsDigraphs, "for a digraph and a digraph",
[IsDigraph, IsDigraph],
function(D1, D2)
  local hom, aut;
  hom := MonomorphismsDigraphsRepresentatives(D1, D2);
  D2 := DigraphMutableCopyIfMutable(D2);
  aut := List(AutomorphismGroup(DigraphRemoveAllMultipleEdges(D2)),
              AsTransformation);
  return Union(List(aut, x -> hom * x));
end);

InstallMethod(SubdigraphsMonomorphismsRepresentatives,
"for a digraph and a digraph", [IsDigraph, IsDigraph],
function(H, G)
  local AG, map, result, K, rep;

  AG := AutomorphismGroup(G);
  map := HashMap();
  result := [];

  for rep in MonomorphismsDigraphsRepresentatives(H, G) do
    K := OnSetsTuples(DigraphEdges(H), rep);
    if not K in map then
      Add(result, rep);
      DIGRAPHS_AddOrbitToHashMap(AG, K, OnSetsTuples, map);
    fi;
  od;

  return result;
end);

InstallMethod(SubdigraphsMonomorphisms, "for a digraph and a digraph",
[IsDigraph, IsDigraph],
function(H, G)
  local AddOrbitToHashMap, AG, map, K, rep;

  AddOrbitToHashMap := function(G, set, act, hashmap, rep)
    local gens, o, im, pt, g;

    gens := GeneratorsOfGroup(G);
    o    := [set];
    Assert(1, not set in hashmap);
    hashmap[set] := rep;
    for pt in o do
      for g in gens do
        im := act(pt, g);
        if not im in hashmap then
          hashmap[im] := hashmap[pt] * g;
          # Assert(0, OnSetsTuples(set, hashmap[im]) = im);
          Add(o, im);
        fi;
      od;
    od;
    return o;
  end;

  AG := AutomorphismGroup(G);
  map := HashMap();

  for rep in MonomorphismsDigraphsRepresentatives(H, G) do
    K := OnSetsTuples(DigraphEdges(H), rep);
    if not K in map then
      AddOrbitToHashMap(AG, K, OnSetsTuples, map, rep);
    fi;
  od;

  return Values(map);
end);

################################################################################
# SURJECTIVE HOMOMORPHISMS

# Finds a single epimorphism from D1 onto D2

InstallMethod(DigraphEpimorphism, "for a digraph and a digraph",
[IsDigraph, IsDigraph],
function(D1, D2)
  local out;
  out := HomomorphismDigraphsFinder(D1,
                                    D2,
                                    fail,                   # hook
                                    [],                     # user_param
                                    1,                      # limit
                                    DigraphNrVertices(D2),  # hint
                                    0,                      # injective
                                    DigraphVertices(D2),    # image
                                    [],                     # map
                                    fail,                   # colours1
                                    fail,                   # colours2
                                    DigraphWelshPowellOrder(D1));
  if IsEmpty(out) then
    return fail;
  fi;
  return out[1];
end);

# Same as HomomorphismsDigraphsRepresentatives, except only surjective ones

InstallMethod(EpimorphismsDigraphsRepresentatives,
"for a digraph and a digraph",
[IsDigraph, IsDigraph],
function(D1, D2)
  return HomomorphismDigraphsFinder(D1,
                                    D2,
                                    fail,                   # hook
                                    [],                     # user_param
                                    infinity,               # limit
                                    DigraphNrVertices(D2),  # hint
                                    0,                      # injective
                                    DigraphVertices(D2),    # image
                                    [],                     # map
                                    fail,                   # colours1
                                    fail,                   # colours2
                                    DigraphWelshPowellOrder(D1));
end);

# Finds the set of all epimorphisms from gr1 to gr2

InstallMethod(EpimorphismsDigraphs, "for a digraph and a digraph",
[IsDigraph, IsDigraph],
function(D1, D2)
  local hom, aut;
  hom := EpimorphismsDigraphsRepresentatives(D1, D2);
  aut := List(AutomorphismGroup(DigraphRemoveAllMultipleEdges(D2)),
              AsTransformation);
  return Union(List(aut, x -> hom * x));
end);

################################################################################
# Embeddings
################################################################################

InstallMethod(DigraphEmbedding, "for a digraph and a digraph",
[IsDigraph, IsDigraph],
function(D1, D2)
  local out;
  out := HomomorphismDigraphsFinder(D1,
                                    D2,
                                    fail,                   # hook
                                    [],                     # user_param
                                    1,                      # limit
                                    DigraphNrVertices(D1),  # hint
                                    2,                      # injective
                                    DigraphVertices(D2),    # image
                                    [],                     # map
                                    fail,                   # colours1
                                    fail,                   # colours2
                                    DigraphWelshPowellOrder(D1));
  if IsEmpty(out) then
    return fail;
  fi;
  return out[1];
end);

# Same as HomomorphismsDigraphsRepresentatives, except only embeddings ones

InstallMethod(EmbeddingsDigraphsRepresentatives,
"for a digraph and a digraph",
[IsDigraph, IsDigraph],
function(D1, D2)
  return HomomorphismDigraphsFinder(D1,
                                    D2,
                                    fail,                   # hook
                                    [],                     # user_param
                                    infinity,               # limit
                                    DigraphNrVertices(D1),  # hint
                                    2,                      # injective
                                    DigraphVertices(D2),    # image
                                    [],                     # map
                                    fail,                   # colours1
                                    fail,                   # colours2
                                    DigraphWelshPowellOrder(D1));
end);

InstallMethod(EmbeddingsDigraphs, "for a digraph and a digraph",
[IsDigraph, IsDigraph],
function(D1, D2)
  local hom, aut;
  hom := EmbeddingsDigraphsRepresentatives(D1, D2);
  D2 := DigraphMutableCopyIfMutable(D2);
  aut := List(AutomorphismGroup(DigraphRemoveAllMultipleEdges(D2)),
              AsTransformation);
  return Union(List(aut, x -> hom * x));
end);

########################################################################
# IsDigraph{Homo/Epi/...}morphism
########################################################################

# Given:
#
# 1) two digraphs <src> and <ran>,
# 2) a transformation <x> mapping the vertices of <src> to <ran>, and
# 3) two lists <cols1> and <cols2> of positive integers defining vertex
#    colourings of <src> and <ran>,
#
# this operation tests whether <x> respects the colouring, i.e. whether for all
# vertices i in <src>, cols[i] = cols[i ^ x].
InstallMethod(DigraphsRespectsColouring,
[IsDigraph, IsDigraph, IsTransformation, IsList, IsList],
function(src, ran, x, cols1, cols2)
  if Maximum(OnTuples(DigraphVertices(src), x)) > DigraphNrVertices(ran) then
    ErrorNoReturn("the third argument <x> must map the vertices of the first ",
                  "argument <src> into the vertices of the second argument ",
                  "<ran>,");
  fi;
  DIGRAPHS_ValidateVertexColouring(DigraphNrVertices(src), cols1);
  DIGRAPHS_ValidateVertexColouring(DigraphNrVertices(ran), cols2);

  return ForAll(DigraphVertices(src), i -> cols1[i] = cols2[i ^ x]);
end);

InstallMethod(DigraphsRespectsColouring,
[IsDigraph, IsDigraph, IsPerm, IsList, IsList],
{src, ran, x, cols1, cols2}
-> DigraphsRespectsColouring(src, ran, AsTransformation(x), cols1, cols2));

InstallMethod(IsDigraphHomomorphism,
"for a digraph by out-neighbours, a digraph, and a perm",
[IsDigraphByOutNeighboursRep, IsDigraph, IsPerm],
{src, ran, x} -> IsDigraphHomomorphism(src, ran, AsTransformation(x)));

InstallMethod(IsDigraphHomomorphism,
"for a digraph by out-neighbours, a digraph, a perm, and two lists",
[IsDigraphByOutNeighboursRep, IsDigraph, IsPerm, IsList, IsList],
{src, ran, x, c1, c2} ->
IsDigraphHomomorphism(src, ran, AsTransformation(x), c1, c2));

InstallMethod(IsDigraphEndomorphism, "for a digraph and a perm",
[IsDigraph, IsPerm], IsDigraphAutomorphism);

InstallMethod(IsDigraphEndomorphism, "for a digraph and a perm",
[IsDigraph, IsPerm, IsList], IsDigraphAutomorphism);

InstallMethod(IsDigraphHomomorphism,
"for a digraph by out-neighbours, digraph, and transformation",
[IsDigraphByOutNeighboursRep, IsDigraph, IsTransformation],
function(src, ran, x)
  local i, j;
  if IsMultiDigraph(src) or IsMultiDigraph(ran) then
    ErrorNoReturn("the 1st and 2nd arguments <src> and <ran> must be digraphs",
                  " with no multiple edges,");
  elif not IsSubset(DigraphVertices(ran), OnSets(DigraphVertices(src), x)) then
    return false;
  fi;
  for i in DigraphVertices(src) do
    for j in OutNeighbours(src)[i] do
      if not IsDigraphEdge(ran, i ^ x, j ^ x) then
        return false;
      fi;
    od;
  od;
  return true;
end);

InstallMethod(IsDigraphHomomorphism,
"for a digraph by out-neighbours, a digraph, a transformation, and two lists",
[IsDigraphByOutNeighboursRep, IsDigraph, IsTransformation, IsList, IsList],

function(src, ran, x, cols1, cols2)
  return IsDigraphHomomorphism(src, ran, x) and
         DigraphsRespectsColouring(src, ran, x, cols1, cols2);
end);

InstallMethod(IsDigraphEndomorphism, "for a digraph and a transformation",
[IsDigraph, IsTransformation],
{D, x} -> IsDigraphHomomorphism(D, D, x));

InstallMethod(IsDigraphEndomorphism,
"for a digraph, transformation, and a list",
[IsDigraph, IsTransformation, IsList],
{D, x, c} -> IsDigraphHomomorphism(D, D, x, c, c));

InstallMethod(IsDigraphEpimorphism, "for digraph, digraph, and transformation",
[IsDigraph, IsDigraph, IsTransformation],
function(src, ran, x)
  return IsDigraphHomomorphism(src, ran, x)
    and OnSets(DigraphVertices(src), x) = DigraphVertices(ran);
end);

InstallMethod(IsDigraphEpimorphism, "for digraph, digraph, and transformation",
[IsDigraph, IsDigraph, IsTransformation, IsList, IsList],
function(src, ran, x, cols1, cols2)
  return IsDigraphEpimorphism(src, ran, x) and
         DigraphsRespectsColouring(src, ran, x, cols1, cols2);
end);

InstallMethod(IsDigraphEpimorphism, "for digraph, digraph, and perm",
[IsDigraph, IsDigraph, IsPerm],
function(src, ran, x)
  return IsDigraphHomomorphism(src, ran, x)
    and OnSets(DigraphVertices(src), x) = DigraphVertices(ran);
end);

InstallMethod(IsDigraphEpimorphism,
"for digraph, digraph, perm, list, and list",
[IsDigraph, IsDigraph, IsPerm, IsList, IsList],
function(src, ran, x, cols1, cols2)
  return IsDigraphEpimorphism(src, ran, x)
    and DigraphsRespectsColouring(src, ran, x, cols1, cols2);
end);

InstallMethod(IsDigraphMonomorphism,
"for digraph, digraph, and transformation",
[IsDigraph, IsDigraph, IsTransformation],
function(src, ran, x)
  return IsDigraphHomomorphism(src, ran, x)
    and IsInjectiveListTrans(DigraphVertices(src), x);
end);

InstallMethod(IsDigraphMonomorphism,
"for digraph, digraph, transformation, list, list",
[IsDigraph, IsDigraph, IsTransformation, IsList, IsList],
function(src, ran, x, cols1, cols2)
  return IsDigraphMonomorphism(src, ran, x)
    and DigraphsRespectsColouring(src, ran, x, cols1, cols2);
end);

InstallMethod(IsDigraphMonomorphism, "for digraph, digraph, and perm",
[IsDigraph, IsDigraph, IsPerm], IsDigraphHomomorphism);

InstallMethod(IsDigraphMonomorphism, "for digraph, digraph, perm, list, list",
[IsDigraph, IsDigraph, IsPerm, IsList, IsList],
function(src, ran, x, cols1, cols2)
  return IsDigraphHomomorphism(src, ran, x)
    and DigraphsRespectsColouring(src, ran, x, cols1, cols2);
end);

InstallMethod(IsDigraphEmbedding,
"for digraph, digraph by out-neighbours, and transformation",
[IsDigraph, IsDigraphByOutNeighboursRep, IsTransformation],
function(src, ran, x)
  local y, induced, i, j;
  if not IsDigraphMonomorphism(src, ran, x) then
    return false;
  fi;
  y := MappingPermListList(OnTuples(DigraphVertices(src), x),
                           DigraphVertices(src));
  induced := BlistList(DigraphVertices(ran), OnSets(DigraphVertices(src), x));
  for i in DigraphVertices(ran) do
    if induced[i] then
      for j in OutNeighbours(ran)[i] do
        if induced[j] and not IsDigraphEdge(src, i ^ y, j ^ y) then
          return false;
        fi;
      od;
    fi;
  od;
  return true;
end);

InstallMethod(IsDigraphEmbedding,
"for digraph, digraph by out-neighbours, transformation, list, and list",
[IsDigraph, IsDigraphByOutNeighboursRep, IsTransformation, IsList, IsList],
function(src, ran, x, cols1, cols2)
  return IsDigraphEmbedding(src, ran, x)
    and DigraphsRespectsColouring(src, ran, x, cols1, cols2);
end);

InstallMethod(IsDigraphEmbedding,
"for a digraph, a digraph by out-neighbours, and a perm",
[IsDigraph, IsDigraphByOutNeighboursRep, IsPerm],
function(src, ran, x)
  local y, induced, i, j;
  if not IsDigraphHomomorphism(src, ran, x) then
    return false;
  fi;
  y := x ^ -1;
  induced := BlistList(DigraphVertices(ran), OnSets(DigraphVertices(src), x));
  for i in DigraphVertices(ran) do
    if induced[i] then
      for j in OutNeighbours(ran)[i] do
        if induced[j] and not IsDigraphEdge(src, i ^ y, j ^ y) then
          return false;
        fi;
      od;
    fi;
  od;
  return true;
end);

InstallMethod(IsDigraphEmbedding,
"for a digraph, a digraph by out-neighbours, a perm, a list, and a list",
[IsDigraph, IsDigraphByOutNeighboursRep, IsPerm, IsList, IsList],
function(src, ran, x, cols1, cols2)
  return IsDigraphEmbedding(src, ran, x)
    and DigraphsRespectsColouring(src, ran, x, cols1, cols2);
end);

InstallMethod(IsDigraphColouring, "for a digraph by out-neighbours and a list",
[IsDigraphByOutNeighboursRep, IsHomogeneousList],
function(D, colours)
  local n, out, v, w;
  n := DigraphNrVertices(D);
  if Length(colours) <> n or ForAny(colours, x -> not IsPosInt(x)) then
    return false;
  fi;
  out := OutNeighbours(D);
  for v in DigraphVertices(D) do
    for w in out[v] do
      if colours[w] = colours[v] then
        return false;
      fi;
    od;
  od;
  return true;
end);

InstallMethod(IsDigraphColouring, "for a digraph and a transformation",
[IsDigraph, IsTransformation],
function(D, t)
  local n;
  n := DigraphNrVertices(D);
  return IsDigraphColouring(D, ImageListOfTransformation(t, n));
end);

InstallMethod(MaximalCommonSubdigraph, "for a pair of digraphs",
[IsDigraph, IsDigraph],
function(A, B)
  local D1, D2, MPG, nonloops, Clqus, M, l, n, m, embedding1, embedding2, iso;

  D1 := DigraphImmutableCopy(A);
  D2 := DigraphImmutableCopy(B);

  # If the digraphs are isomorphic then we return the first one as the answer
  iso := IsomorphismDigraphs(D1, D2);
  if iso <> fail then
    return [D1, IdentityTransformation, AsTransformation(iso)];
  fi;

  n := DigraphNrVertices(D1);
  m := DigraphNrVertices(D2);

  # The algorithm works as follows: We construct the modular product digraph
  # MPG (see https://en.wikipedia.org/wiki/Modular_product_of_graphs for the
  # undirected version) a maximal partial isomorphism between D1 and D2 is
  # equal to a maximal clique this digraph. We then search for cliques using the
  # DigraphMaximalCliquesReps function.

  MPG := ModularProduct(D1, D2);

  nonloops := Filtered([1 .. n * m], x -> not x in OutNeighbours(MPG)[x]);
  # We find a big clique
  Clqus := DigraphMaximalCliquesReps(MPG, [], nonloops);
  M := 1;
  for l in [1 .. Size(Clqus)] do
    if Size(Clqus[l]) > Size(Clqus[M]) then
      M := l;
    fi;
  od;

  embedding1 := List(Clqus[M], x -> QuoInt(x - 1, m) + 1);
  embedding2 := List(Clqus[M], x -> RemInt(x - 1, m) + 1);
  return [InducedSubdigraph(D1, embedding1),
          Transformation([1 .. Size(embedding1)], embedding1),
          Transformation([1 .. Size(embedding2)], embedding2)];

end);

InstallMethod(MinimalCommonSuperdigraph, "for a pair of digraphs",
[IsDigraph, IsDigraph],
function(D1, D2)
  local out, L, v, e, embfunc, embedding1, embedding2, newvertices;
  L := MaximalCommonSubdigraph(D1, D2);
  L[2] := List([1 .. DigraphNrVertices(L[1])], x -> x ^ L[2]);
  L[3] := List([1 .. DigraphNrVertices(L[1])], x -> x ^ L[3]);
  out := List(OutNeighbours(D1), ShallowCopy);
  newvertices := Filtered(DigraphVertices(D2), x -> not x in L[3]);
  embedding1 := [1 .. DigraphNrVertices(D1)];

  embfunc := function(v)
    if v in L[3] then
      return L[2][Position(L[3], v)];
    fi;
    return Position(newvertices, v) + DigraphNrVertices(D1);
  end;
  embedding2 := List(DigraphVertices(D2), embfunc);

  for v in newvertices do
    Add(out, []);
  od;

  for e in DigraphEdges(D2) do
    if (not e[1] in L[3]) or (not e[2] in L[3]) then
       Add(out[embedding2[e[1]]], embedding2[e[2]]);
    fi;
  od;

  return [Digraph(out), Transformation([1 .. Size(embedding1)], embedding1),
                        Transformation([1 .. Size(embedding2)], embedding2)];

end);

InstallMethod(LatticeDigraphEmbedding, "for a pair of digraphs",
[IsDigraph, IsDigraph],
function(L1, L2)
  local join1, meet1, meet2, join2, N1, N2, p, map, conditions, out1, out2,
  in1, in2, mask, defined, not_in_image, FindNextAmong, Recurse;

  p := PermList(Reversed(DigraphWelshPowellOrder(L1)));
  L1 := OnDigraphsNC(L1, p ^ -1);

  # We compute the join/meet table to avoid having to do this twice if L1 or L2
  # is mutable
  join1 := DigraphJoinTable(L1);
  meet1 := DigraphMeetTable(L1);

  if join1 = fail or meet1 = fail then
    ErrorNoReturn("the 1st argument (a digraph) must be a lattice digraph");
  fi;

  meet2 := DigraphMeetTable(L2);
  join2 := DigraphJoinTable(L2);

  if join2 = fail or meet2 = fail then
    ErrorNoReturn("the 2nd argument (a digraph) must be a lattice digraph");
  fi;

  N1 := DigraphNrVertices(L1);
  N2 := DigraphNrVertices(L2);

  if N2 < N1 then
    return fail;
  fi;

  map        := EmptyPlist(N1);
  conditions := [List([1 .. N1], x -> BlistList([1 .. N2], [1 .. N2]))];

  out1 := BooleanAdjacencyMatrix(L1);
  out2 := BooleanAdjacencyMatrixMutableCopy(L2);

  in1 := TransposedMat(BooleanAdjacencyMatrix(L1));
  in2 := TransposedMatMutable(BooleanAdjacencyMatrixMutableCopy(L2));

  mask := List([1 .. N2], i -> BlistList([1 .. N2], [i]));

  defined      := BlistList([1 .. N1], []);
  not_in_image := BlistList([1 .. N2], [1 .. N2]);

  FindNextAmong := function(among, depth)
    local nr_options, min, next, x;

    next := fail;
    min  := N2 + 1;

    for x in among do
      if not defined[x] then
        nr_options := SizeBlist(IntersectionBlist(conditions[depth][x],
                                                  not_in_image));
        if nr_options = 0 then
          return fail;
        elif nr_options < min then
          min  := nr_options;
          next := x;
        fi;
      fi;
    od;
    return next;
  end;

  Recurse := function(depth, print)
    local next, value, try_next_value, prev, x;

    if depth = N1 + 1 then  # When depth = N1 + 1, we have defined all images
      return true;
    fi;
    # Find the next vertex, i.e. the one with fewest options
    next := FindNextAmong([1 .. N1], depth);
    if next = fail then
      return false;
    fi;

    value := Position(conditions[depth][next], true, 0);
    while value <> fail do
      map[next]             := value;
      defined[next]         := true;
      not_in_image[value]   := false;
      # TODO(later): can we avoid copying the entire "conditions" here, like in
      # the C-code?
      conditions[depth + 1] := StructuralCopy(conditions[depth]);

      # meets and joins map to meets and joins, respectively
      for prev in [1 .. N1] do
        if defined[prev] then
          IntersectBlist(conditions[depth + 1][join1[prev][next]],
                         mask[join2[map[prev]][map[next]]]);
          IntersectBlist(conditions[depth + 1][meet1[prev][next]],
                         mask[meet2[map[prev]][map[next]]]);
        fi;
      od;

      try_next_value := false;
      # If the value map[next] breaks a previously defined image of map,
      # try the next possible value for map[next]
      for x in [1 .. N1] do
        if defined[x] and not conditions[depth + 1][x][map[x]] then
          try_next_value := true;
          break;
        fi;
      od;
      if not try_next_value then
        for x in [1 .. N1] do
          if out1[next][x] then
            IntersectBlist(conditions[depth + 1][x], out2[value]);
          else
            FlipBlist(out2[value]);
            IntersectBlist(conditions[depth + 1][x], out2[value]);
            FlipBlist(out2[value]);
          fi;
          if in1[next][x] then
            IntersectBlist(conditions[depth + 1][x], in2[value]);
          else
            FlipBlist(in2[value]);
            IntersectBlist(conditions[depth + 1][x], in2[value]);
            FlipBlist(in2[value]);
          fi;
        od;
        if Recurse(depth + 1, print) then
          return true;
        fi;
      fi;
      Unbind(conditions[depth + 1]);
      Unbind(map[next]);
      not_in_image[value] := true;
      defined[next]       := false;
      value := Position(conditions[depth][next], true, value);
    od;
    return false;
  end;

  if Recurse(1, false) then
    Append(map, [N1 + 1 .. N2]);
    return p ^ -1 * Transformation(map);
  fi;
  return fail;
end);

InstallMethod(IsLatticeHomomorphism,
"for a transformation and a pair of digraphs",
[IsDigraph, IsDigraph, IsTransformation],
function(L1, L2, map)
  local N1, N2, x, y, meet1, meet2, join1, join2;

  N1 := DigraphNrVertices(L1);
  N2 := DigraphNrVertices(L2);

  if LargestMovedPoint(map) > N1 then
    return false;
  fi;

  # We compute the join/meet table to avoid having to do this twice if L1 or L2
  # is mutable
  join1 := DigraphJoinTable(L1);
  meet1 := DigraphMeetTable(L1);

  if join1 = fail or meet1 = fail then
    ErrorNoReturn("the 1st argument (a digraph) must be a lattice digraph");
  fi;

  join2 := DigraphJoinTable(L2);
  meet2 := DigraphMeetTable(L2);

  if join2 = fail or meet2 = fail then
    ErrorNoReturn("the 2nd argument (a digraph) must be a lattice digraph");
  elif Maximum(ImageSetOfTransformation(map, N1)) > N2 then
    return false;
  fi;
  # The above checks if the <x ^ map> and <y ^ map> entries of
  # meet2 and join2 exist

  # TODO(later): can we avoid checking all joins and meets, i.e. by only
  # checking the join-irreducible nodes or something?
  for x in [1 .. N1] do
    for y in [1 .. N1] do
      if meet2[x ^ map, y ^ map] <> meet1[x, y] ^ map
          or join2[x ^ map, y ^ map] <> join1[x, y] ^ map then
        return false;
      fi;
    od;
  od;
  return true;
end);

InstallMethod(IsLatticeHomomorphism,
"for a digraph, a digraph, and a permutation",
[IsDigraph, IsDigraph, IsPerm],
{L1, L2, perm} -> IsLatticeHomomorphism(L1, L2, AsTransformation(perm)));

InstallMethod(IsLatticeEndomorphism, "for a digraph and a transformation",
[IsDigraph, IsTransformation],
{L, map} -> IsLatticeHomomorphism(L, L, map));

InstallMethod(IsLatticeEndomorphism, "for a digraph and a permutation",
[IsDigraph, IsPerm],
{L, perm} -> IsLatticeHomomorphism(L, L, AsTransformation(perm)));

InstallMethod(IsLatticeEpimorphism,
"for a digraph, a digraph, and a transformation",
[IsDigraph, IsDigraph, IsTransformation],
function(L1, L2, map)
  return IsLatticeHomomorphism(L1, L2, map)
    and OnSets(DigraphVertices(L1), map) = DigraphVertices(L2);
end);

InstallMethod(IsLatticeEpimorphism,
"for a digraph, a digraph, and a permutation",
[IsDigraph, IsDigraph, IsPerm],
function(L1, L2, perm)
  return IsLatticeHomomorphism(L1, L2, AsTransformation(perm))
    and OnSets(DigraphVertices(L1), perm) = DigraphVertices(L2);
end);

InstallMethod(IsLatticeEmbedding,
"for a digraph, a digraph, and a transformation",
[IsDigraph, IsDigraph, IsTransformation],
function(L1, L2, map)
  return IsLatticeHomomorphism(L1, L2, map)
    and IsInjectiveListTrans(DigraphVertices(L1), map);
end);

InstallMethod(IsLatticeEmbedding,
"for a digraph, a digraph, and a permutation",
[IsDigraph, IsDigraph, IsPerm],
{L1, L2, perm} -> IsLatticeHomomorphism(L1, L2, AsTransformation(perm)));

Quelle grahom.gi Sprache: unbekannt

[ Dauer der Verarbeitung: 0.44 Sekunden (vorverarbeitet) ]