Merge branch 'master' of https://github.com/gap-packages/sgpdec

gap-packages · Aug 10, 2023 · 601d0a6 · 601d0a6
2 parents c78d247 + 1ac7305
commit 601d0a6
Show file tree

Hide file tree

Showing 3 changed files with 39 additions and 24 deletions.
diff --git a/dev/dcl2sk/dcl2sk.g b/dev/dcl2sk/dcl2sk.g
@@ -24,38 +24,44 @@ end;
 # drawing the surjective morphism from the partial order of D-classes to the partial
 # order of subduction equivalence classes
 DotSurHom := function(ts)
-  local  str, i,j,out,dcls, dpo, states, classes, subduction, sk, img,
+  local  str, i,j,out,dcls, dpo, states, classes, subduction, sk, src, img,
   DClass2SubductionClass, gdcls;
 
   dcls := GreensDClasses(ts);
-  dpo := OutNeighbours(PartialOrderOfDClasses(ts));
+  dpo := OutNeighbours(DigraphReflexiveTransitiveReduction(PartialOrderOfDClasses(ts)));
   sk := Skeleton(ts);
   DClass2SubductionClass :=
     function(dcl)
       return SubductionClassOfSet(sk,
               FiniteSet(
-                ImageListOfTransformation(Representative(dcl)),
+                ImageListOfTransformation(Representative(dcl), DegreeOfSkeleton(sk)),
                 DegreeOfSkeleton(sk)));
     end;
   str := "";
   out := OutputTextString(str,true);
   SetPrintFormattingStatus(out,false); #no formatting, line breaks
   PrintTo(out,"//dot\ndigraph surhom{\n");
-  AppendTo(out, "node [shape=circle];\n");
+  AppendTo(out, "node [shape=circle,width=0.2];\n");
 
   AppendTo(out, "subgraph cluster_D{\n");  
   #### D class poset ####
   #nodes
   #we draw the collapsed D-classes in a cluster
   gdcls := Values(Classify(dcls, DClass2SubductionClass));
   for i in [1..Length(gdcls)] do
-    AppendTo(out, Concatenation("subgraph cluster_D", String(i),"{\n"));
-    Perform(gdcls[i],
-            function(dcl) #we still use the node name by the position is dcls for edges
-              AppendTo(out, Concatenation("D",String(Position(dcls,dcl)),
-                                          " [label=\"\"]\n"));
-            end);
-    AppendTo(out,"}\n");
+    if Length(gdcls[i])=1 then
+      AppendTo(out, Concatenation("D",String(Position(dcls,First(gdcls[i]))),
+                                  " [label=\"\"]\n"));
+    else
+      AppendTo(out, Concatenation("subgraph cluster_D", String(i),"{\n",
+                                  "style=filled;color=lightgrey;\n"));
+      Perform(gdcls[i],
+              function(dcl) #we still use the node name by the position is dcls for edges
+                AppendTo(out, Concatenation("D",String(Position(dcls,dcl)),
+                                            " [label=\"\"]\n"));
+              end);
+      AppendTo(out,"}\n");
+    fi;
   od;
   #edges
   for i in [1..Length(dcls)] do
@@ -76,11 +82,11 @@ DotSurHom := function(ts)
   for i in [1..Length(classes)] do
       AppendTo(out, Concatenation("S",String(i)));
       AppendTo(out, " [label=\"");
-      for j in [1..Length(classes[i])] do
-        AppendTo(out,List2Label(
-                TrueValuePositionsBlistString(classes[i][j],states))," ");
-      od;
-      AppendTo(out, "\",shape=box];\n");
+      # for j in [1..Length(classes[i])] do
+      #   AppendTo(out,List2Label(
+      #           TrueValuePositionsBlistString(classes[i][j],states))," ");
+      # od;
+      AppendTo(out, "\",shape=circle];\n");
   od;
   #edges
   for i in [1..Length(classes)] do
@@ -90,11 +96,11 @@ DotSurHom := function(ts)
   od;
   AppendTo(out,"}\n");
 
-  #now the connection
-  for i in [1..Length(dcls)] do
-    img := DClass2SubductionClass(dcls[i]);
-    AppendTo(out,Concatenation("D",String(i),"->S",String(Position(classes,img)),
-      "[color=red];\n"));
+  #now the connections
+  for i in [1..Length(gdcls)] do #using Last in group for bottom connections
+    src := Position(dcls,Last(gdcls[i])); #the index of D-class (last in its group)
+    img := Position(classes, DClass2SubductionClass(Last(gdcls[i]))); # the index of the resulting image
+    AppendTo(out,Concatenation("D",String(src),"->S",String(img),"[color=red];\n"));
   od;
 
   AppendTo(out,"}\n");

diff --git a/lib/skeleton.gi b/lib/skeleton.gi
@@ -114,15 +114,16 @@ end);
 
 
 RepSubRel := function(sk)
-  local o, SCCLookup, DirectImages, NonFailing, Set2Index, SubSets, reps, imgs, subs, l;
+  local o, SCCLookup, SCCOf, DirectImages, NonFailing, Set2Index, SubSets, reps, imgs, subs, l;
   o := ForwardOrbit(sk);
   # functions are defined for better readability and separating technical (Orb) code
   SCCLookup := x -> OrbSCCLookup(o)[x]; #finds SCC of an orbit element (the index of it)
-  DirectImages := x -> OrbitGraph(o)[x]; #direct descendants in the orbit graph
+  SCCOf := x -> OrbSCC(o)[OrbSCCLookup(o)[x]]; #finds the SCC and return the whole class
+  DirectImages := x -> Union(List(SCCOf(x),  y -> OrbitGraph(o)[y])); #direct descendants in the orbit graph
   NonFailing := x -> x <> fail; #predicate function for not being fail
   Set2Index := x -> Position(o,x);
   reps := SkeletonTransversal(sk);
-  SubSets := x -> Images(InclusionCoverBinaryRelation(sk),o[x]);
+  SubSets := x -> Union(List(SCCOf(x), y -> Images(InclusionCoverBinaryRelation(sk),o[y])));
   #subduction is image of and subset of relation combined
   imgs := List(reps, DirectImages); #direct images of representatives
   subs := List(reps, rep -> Filtered( List(SubSets(rep),Set2Index), NonFailing));

diff --git a/tst/skeleton.tst b/tst/skeleton.tst
@@ -8,6 +8,14 @@ false
 gap> IsSubductionLessOrEquivalent(sk,FiniteSet([1],5), FiniteSet([2,4,5],5));
 true
 
+#this was a bug in the 2023.08 rewrite
+gap>  ts := Semigroup(Transformation([2,2,1,2,4]),Transformation([3,5,2,3,2]), Transformation([3,5,4,5,4]));;
+gap> sk := Skeleton(ts);;
+gap> IsSubductionLessOrEquivalent(sk, FiniteSet([1,2],5), FiniteSet([2,5],5));
+true
+gap> SubductionWitness(sk, FiniteSet([1,2],5), FiniteSet([2,5],5));
+[ 3, 2, 1 ]
+
 #extended image set for a constant monoid
 gap> S := Semigroup(Transformation([5,5,5,5,5]));;
 gap> sk := Skeleton(S);;