1############################################################################
2##
3#W  drawdclasses.gi                     Manuel Delgado <mdelgado@fc.up.pt>
4#W                                      Jose Morais    <josejoao@fc.up.pt>
5##
6#H  @(#)$Id: drawdclasses.gi,v 0.998 $
7##
8#Y  Copyright (C)  2005,  CMUP, Universidade do Porto, Portugal
9##
10##
11##--------------------------------------------------------------------------------
12InstallGlobalFunction(DotForDrawingDClassOfElement, function(arg)
13  local S,                          # The semigroup
14        El,                         # The element whose D-class we'll draw
15        dc,                         # one d-class
16        cl, cl2, cl3,               # index of one certain d-class in dclasses
17        el, el2,                    # one element of an H-class
18        dclasses,
19        len_dclasses,               # number of d-classes
20        dc_number,                  # the number of the dot node of a D-class
21        eggbox, eggbox2,
22        idegg, idegg2,
23        line, col,
24        ident,
25        existsPathFromAtoB,         # matrix with true in [i][j] iff
26        # there is there is a path of arrows
27        # from dclasses[i] to dclasses[j]
28        phi,                        # phi[i][j] = [i', j'] where
29        # mat_input[i'][j'] = mat[i][j]
30        # where mat_input is the input matrix to
31        # GrahamBlocks (it will
32        # reference entries in eggbox!
33        # and mat is graham_eggbox
34        box4,                       # Defined where used
35        box5,                       # Defined where used
36        lenb,                       # Length of box5 which is the number of
37        # levels in the drawing
38        visited, list,              # auxiliary arrays
39        greens_less_than,           # matrix with true in [i][j] iff
40        # dclasses[i] <= dclasses[j]
41        #siegen          file,                       # name of the file where dot code
42        dotstring,                       # name of the string storing the dot code
43        # will be written
44        bag, bag2,                  # matrix such that bag[i][j] = L
45        # where L is the list of elements of the
46        # H-class currently being processed
47        # ready for being written according to
48        # whether we're writing as transformations
49        # or words
50        zero,                       # The "zero" on the transformations if partial
51        is_partial,                 # whether the transformations are partial
52        trans_list,				  # The list of lists of elements to be coloured
53        len_trans_list,
54        generators, generatorsx,
55        genslen,
56        colors, color,
57        #       fich,                       # the name of the dot file given as argument
58#        gv, dot, tdir,
59        alphabet,
60#        idempots,                   # Idempotents of the semigroup
61        idempots2,                  # ImageListOfTransformation of idempots
62        T,                          # whether we're displaying as transformations
63        T__,                        # To hold the value of last argument (may be 1 or 2 or none)
64        # to either display the transformations as transformations
65        # or as an integer (like in the right Cayley Graph).
66        elms__,                     # The elements of S
67        idemps__,                   # Idempotents of the semigroup
68        str, str1, str2,
69        tlen,
70        rows, cols, val,
71        retels,
72        i, j, k, k2, p, m, c, ret, px, map,
73        powerizeWord;
74
75
76
77  # ==========================================
78
79  # if we're displaying as words this function
80  # replaces 2 or more followd occurrences of
81  # letter a by a^...
82  powerizeWord := function(w)
83    local w2, c, j, a;
84
85    w2 := [];
86    c := 0;
87    for j in [1..Length(w)] do
88      if c = 0 then
89        a := w[j];
90        c := 1;
91      elif w[j] = a then
92        c := c + 1;
93      else
94        if c = 1 then
95          Add(w2, a);
96        else
97          w2 := Concatenation(w2, [a], "^", String(c));
98        fi;
99        c := 1;
100        a := w[j];
101      fi;
102    od;
103    if c = 1 then
104      Add(w2, a);
105    else
106      w2 := Concatenation(w2, [a], "^", String(c));
107    fi;
108    return(w2);
109  end;
110  ##  End of powerizeWord()  --
111
112  # alphabet for displaying as words
113  alphabet := "abcdefghijklmnopqrstuvwxyz";
114
115  colors := [ "brown", "burlywood", "cadetblue", "chartreuse", "chocolate", "coral", "cornflowerblue",
116              "crimson", "cyan", "darkgoldenrod", "darkkhaki", "darkorange", "darkorchid",
117              "darksalmon", "darkseagreen", "darkturquoise",
118              "darkviolet", "deeppink", "deepskyblue", "dodgerblue", "firebrick",
119              "forestgreen", "gold", "goldenrod", "green", "greenyellow", "grey",
120              "hotpink", "indianred", "khaki", "lawngreen",
121              "lightblue", "lightcoral",
122              "lightpink", "lightsalmon", "lightseagreen", "lightskyblue", "lightslateblue",
123              "lightslategrey", "limegreen", "magenta",
124              "maroon", "mediumaquamarine", "mediumorchid", "mediumpurple", "mediumseagreen",
125              "mediumspringgreen", "mediumturquoise", "mediumvioletred",
126              "moccasin", "navajowhite", "olivedrab2", "orange", "orangered",
127              "orchid", "palegreen", "paleturquoise", "palevioletred", "peachpuff", "peru",
128              "pink", "plum", "powderblue", "purple", "red", "rosybrown", "royalblue1", "saddlebrown", "salmon",
129              "sandybrown", "seagreen", "skyblue", "slateblue", "slategrey",
130              "springgreen", "steelblue", "tan", "thistle", "tomato", "turquoise", "violet", "violetred",
131              "wheat", "yellow", "yellowgreen" ];
132
133  if not (IsBound(arg[1]) and IsBound(arg[2])) then
134    Error("Two arguments must be given");
135  fi;
136
137  # to face the fact that semigroups behave differently depending on the use or not of the "semigroups" package, a fresh object is created
138  if IsMonoid(arg[1]) then
139    S := Monoid(GeneratorsOfMonoid(arg[1]));
140  elif IsSemigroup(arg[1]) then
141    S := Semigroup(GeneratorsOfSemigroup(arg[1]));
142  else
143    Error("The first argument must be a semigroup");
144  fi;
145
146  if not arg[2] in arg[1] then
147    Error("The second argument must be an element of the senigroup, which is given as first");
148  else
149    El := arg[2];
150  fi;
151  if not (IsTransformationMonoid(S) or IsTransformationSemigroup(S)) then
152    Print("I will work with an isomorphic transformation semigroup instead\n");
153    map := IsomorphismTransformationSemigroup(S);
154
155    S:= Range(map);
156    El := ImagesElm(map,El)[1];
157
158    S := Semigroup(ReduceNumberOfGenerators(GeneratorsOfSemigroup(S)));
159  fi;
160
161  tlen := DegreeOfTransformationSemigroup(S);
162
163  elms__ := Elements(S);
164  idemps__ := Idempotents(S);
165  idempots2 := List(idemps__, x -> ImageListOfTransformation(x,tlen));
166
167  T := false;                          # Display as transformations
168  trans_list := [];                    # the list of lists of elements
169  # to draw in colors given by the user.
170
171  for i in [3..Length(arg)] do
172    if
173      IsList(arg[i]) then
174      if not ForAll(arg[i], e -> IsTransformation(e)) then
175        Error("The list of elements must be a list of Transformations ", arg[i]);
176      fi;
177      Add(trans_list, Set(List(arg[i], trans -> ImageListOfTransformation(trans))));
178    elif i = Length(arg) and (arg[i] = 1 or arg[i] = 2) then
179      T := true;
180      T__ := arg[i];
181    else
182      Error("The arguments must be: <semigroup>, <element>, [, list of elements]* [, file name]");
183    fi;
184  od;
185  len_trans_list := Length(trans_list);
186
187  ##  We will check if the transformations are partial or total
188  generators := GeneratorsOfSemigroup(S);
189  genslen := Length(generators);
190  generatorsx := [];
191  for el in generators do
192    if not el = IdentityTransformation then
193      Add(generatorsx, el);
194    fi;
195  od;
196  Sort(generatorsx);
197
198  # Determine if transitions are partial
199  # and determine the "zero" digit
200  is_partial := ForAll(List(generators, g -> ImageListOfTransformation(g,tlen)), lx -> lx[tlen] = tlen);
201  zero := tlen;
202
203  # ============= Main Code ==================
204
205  dclasses := [GreensDClassOfElement(S, El)];
206  len_dclasses := Length(dclasses);
207  dc_number := 1;
208
209  if not T then
210    retels := [Elements(dclasses[1]), SemigroupFactorization(S, Elements(dclasses[1])),[]];
211  fi;
212
213  #initializing the dotstring
214  dotstring := "digraph  DClassOfElement {\ngraph [center=yes,ordering=out];\nnode [shape=plaintext];\nedge [color=cornflowerblue,arrowhead=none];\n";
215
216
217  # For each d-class write the dot record node
218  for dc in dclasses do
219    eggbox := EggBoxOfDClass(dc);
220    rows := Length(eggbox);
221    cols := Length(eggbox[1]);
222
223    idegg := List(eggbox, r->List(r,
224                     function(h)
225      if IsGroupHClass(h) then
226        return 1;
227      else
228        return 0;
229      fi;
230    end));
231
232
233    ##  Order the columns lexicographically
234    line := List([1..cols], x -> [Representative(eggbox[1][x]), x]);
235    Sort(line);
236    eggbox2 := NullMat(rows, cols);
237    idegg2 := NullMat(rows, cols);
238
239    j := 1;
240    for el in line do
241      for i in [1..rows] do
242        eggbox2[i][j] := ShallowCopy(eggbox[i][el[2]]);
243        idegg2[i][j] := ShallowCopy(idegg[i][el[2]]);
244      od;
245      j := j + 1;
246    od;
247
248    ##  Order the rows lexicographically
249    col := List([1..rows], x -> [Representative(eggbox[x][1]), x]);
250    Sort(col);
251    eggbox := NullMat(rows, cols);
252    idegg := NullMat(rows, cols);
253    i := 1;
254    for el in col do
255      for j in [1..cols] do
256        eggbox[i][j] := ShallowCopy(eggbox2[el[2]][j]);
257        idegg[i][j] := ShallowCopy(idegg2[el[2]][j]);
258      od;
259      i := i + 1;
260    od;
261
262
263    if IsRegularDClass(dc) then
264      ret := GrahamBlocks(idegg);
265      phi := ret[2];
266    fi;
267
268    bag := [];
269    bag2 := [];
270    for k in [1..rows] do
271      bag[k] := [];
272      bag2[k] := [];
273      for p in [1..cols] do
274        bag2[k][p] := [];
275      od;
276    od;
277
278    #siegen: in the folowing, "AppendTo(file," was replaced by "Append(dotstring,"
279
280
281    # Write the dot node definition of the current
282    # D-class
283    Append(dotstring, Concatenation(String(dc_number), " [label=<\n<TABLE BORDER=\"0\" CELLBORDER=\"0\" CELLPADDING=\"0\" CELLSPACING=\"0\" PORT=\"", String(dc_number), "\">\n"));  # opens the D-class and
284    # first column for writing
285
286    # Visit left column first, then second,... because of dot
287    for i in [1..rows] do
288      Append(dotstring, "<TR>");
289      for j in [1..cols] do
290        # Write H-class [i][j] from current eggbox
291        # With the list of
292        # elements of an H-class writes the
293        # corresponding cell of the dot record node
294        # in the current D-class node
295        Append(dotstring, "<TD BORDER=\"0\">");  # opens h-class
296
297        # bag2[i][j] is the list of elements
298        # of eggbox[i'][j'] where i' = phi[i][j][1]
299        # and j' = phi[i][j][2], formatted for being written
300        # phi is needed because GrahamBlocks was called.
301        if IsRegularDClass(dc) then
302          # If we're displaying as transformations
303          if T then
304            bag[i][j] := List(Elements(eggbox[phi[i][j][1]][phi[i][j][2]]), x -> ImageListOfTransformation(x,tlen));
305            if T__ = 1 then
306              # if the transformations are partial
307              if is_partial then
308                for el in bag[i][j] do
309                  # replace the "zero" by "_"
310                  list := [];
311                  for p in [1..zero-1] do
312                    if el[p] = zero then
313                      Add(list, "_");
314                    elif el[p] > zero then
315                      Add(list, el[p]-1);
316                    else
317                      Add(list, el[p]);
318                    fi;
319                  od;
320                  for p in [zero+1..tlen] do
321                    if el[p] = zero then
322                      Add(list, "_");
323                    elif el[p] > zero then
324                      Add(list, el[p]-1);
325                    else
326                      Add(list, el[p]);
327                    fi;
328                  od;
329                  if list = [] then
330                    Add(list, "_");
331                  fi;
332                  # End of replace the "zero" by "_"
333
334                  # str2 will be the written string
335                  str := String(list);
336                  # if it's an idempot put the "*"
337                  if el in idempots2 then
338                    str2 := ['*'];
339                  else
340                    str2 := [];
341                  fi;
342                  # Remove '"'
343                  for c in str do
344                    if not c = '"' then  #"
345                       Add(str2, c);
346                    fi;
347                  od;
348                  # add element for write
349                  if str2[6] = '.' then
350                    ident := List([1..tlen], x -> x);
351                    if str2[1] = '*' then
352                      str2 := Concatenation("*", String(ident));
353                    else
354                      str2 := String(ident);
355                    fi;
356                  fi;
357                  Add(bag2[i][j], str2);
358                od;
359                # If the transformations are total
360              else
361                # Add '*' if it's an idempotent
362                for el in bag[i][j] do
363                  if el in idempots2 then
364                    ##                                        if String(el)[6] = '.' then
365                    if el = [] then
366                      Add(bag2[i][j], Concatenation("*", String(List([1..tlen], x -> x))));
367                    else
368                      Add(bag2[i][j], Concatenation("*", String(el)));
369                    fi;
370                  else
371                    Add(bag2[i][j], String(el));
372                  fi;
373                od;
374              fi;
375            else  # Display transformations as integers
376              # Add '*' if it's an idempotent
377              for el in Elements(eggbox[phi[i][j][1]][phi[i][j][2]]) do
378                if el in idemps__ then
379                  ##                                    if String(el)[6] = '.' then
380                  if el = [] then
381                    Add(bag2[i][j], Concatenation("*", String(List([1..tlen], x -> x))));
382                  else
383                    Add(bag2[i][j], Concatenation("*", String(Position(elms__, el))));
384                  fi;
385                else
386                  Add(bag2[i][j], String(Position(elms__, el)));
387                fi;
388              od;
389            fi;
390            # If we're displaying as words
391          else
392            bag[i][j] := Elements(eggbox[phi[i][j][1]][phi[i][j][2]]);
393            for el in bag[i][j] do
394              if el = MultiplicativeNeutralElement(S) then
395                str1 := "1";
396                retels[3][Position(retels[1], el)] := "1";
397              elif el = MultiplicativeZero(S) then
398                str1 := "0";
399                retels[3][Position(retels[1], el)] := "0";
400              else
401                px := Position(retels[1], el);
402                ret := retels[2][px];
403                str1 := [];
404                if genslen > 26 then
405                  for el2 in ret do
406                    str1 := Concatenation(str1, "a", String(Position(generatorsx, el2)));
407                  od;
408                else
409                  for el2 in ret do
410                    Add(str1, alphabet[Position(generatorsx, el2)]);
411                  od;
412                fi;
413                str1 := powerizeWord(str1);
414                retels[3][px] := str1;
415              fi;
416              if el in idemps__ then
417                Add(bag2[i][j], Concatenation("*", str1));
418              else
419                Add(bag2[i][j], str1);
420              fi;
421            od;
422            # 	bag[i][j] := List(bag[i][j], x -> ImageListOfTransformation(x));
423            bag[i][j] := List(bag[i][j], x -> ImageListOfTransformation(x,tlen));
424          fi;
425          # if it is not a regular d-class
426        else
427          # If we're displaying as transformations
428          if T then
429            # if it is not a regular d-class it has not been sorted by GrahamBlocks,
430            # so pick the elements from eggbox in same (not mapped by phi) order
431            bag[i][j] := List(Elements(eggbox[i][j]), x -> ImageListOfTransformation(x,tlen));
432            if T__ = 1 then
433              if is_partial then
434                for el in bag[i][j] do
435                  list := [];
436                  for p in [1..zero-1] do
437                    if el[p] = zero then
438                      Add(list, "_");
439                    elif el[p] > zero then
440                      Add(list, el[p]-1);
441                    else
442                      Add(list, el[p]);
443                    fi;
444                  od;
445                  for p in [zero+1..tlen] do
446                    if el[p] = zero then
447                      Add(list, "_");
448                    elif el[p] > zero then
449                      Add(list, el[p]-1);
450                    else
451                      Add(list, el[p]);
452                    fi;
453                  od;
454                  str := String(list);
455                  if el in idempots2 then
456                    str2 := ['*'];
457                  else
458                    str2 := [];
459                  fi;
460                  for c in str do
461                    if not c = '"' then #"
462                       Add(str2, c);
463                    fi;
464                  od;
465                  Add(bag2[i][j], str2);
466                od;
467                # If the transformations are total
468              else
469                # Add '*' if it's an idempotent
470                for el in bag[i][j] do
471                  if el in idempots2 then
472                    Add(bag2[i][j], Concatenation("*", String(el)));
473                  else
474                    Add(bag2[i][j], String(el));
475                  fi;
476                od;
477              fi;
478            else  # Display transformations as integers
479              # Add '*' if it's an idempotent
480              for el in Elements(eggbox[i][j]) do
481                if el in idemps__ then
482                  Add(bag2[i][j], Concatenation("*", String(Position(elms__, el))));
483                else
484                  Add(bag2[i][j], String(Position(elms__, el)));
485                fi;
486              od;
487            fi;
488            # If we're displaying as words
489          else
490            bag[i][j] := Elements(eggbox[i][j]);
491            for el in bag[i][j] do
492              if el = MultiplicativeNeutralElement(S) then
493                str1 := "1";
494                retels[3][Position(retels[1], el)] := "1";
495              elif el = MultiplicativeZero(S) then
496                str1 := "0";
497                retels[3][Position(retels[1], el)] := "0";
498              else
499                px := Position(retels[1], el);
500                ret := retels[2][px];
501                str1 := [];
502                if genslen > 26 then
503                  for el2 in ret do
504                    str1 := Concatenation(str1, "a", String(Position(generatorsx, el2)));
505                  od;
506                else
507                  for el2 in ret do
508                    Add(str1, alphabet[Position(generatorsx, el2)]);
509                  od;
510                fi;
511                str1 := powerizeWord(str1);
512                retels[3][px] := str1;
513              fi;
514              if el in idemps__ then
515                Add(bag2[i][j], Concatenation("*", str1));
516              else
517                Add(bag2[i][j], str1);
518              fi;
519            od;
520            bag[i][j] := List(bag[i][j], x -> ImageListOfTransformation(x,tlen));
521          fi;
522        fi;
523
524        # write the elements of current H-class
525        Append(dotstring, "<TABLE CELLSPACING=\"0\">");
526        for k in [1..Length(bag2[i][j])] do
527          color := "white";
528          el := bag[i][j][k];
529          k2 := len_trans_list;
530          while k2 > 0 do
531            if el in trans_list[k2] then
532              color := colors[k2];
533              break;
534            fi;
535            k2 := k2 - 1;
536          od;
537          Append(dotstring, Concatenation("<TR><TD BGCOLOR=\"", color, "\" BORDER=\"0\">"));
538          Append(dotstring, bag2[i][j][k]);
539          Append(dotstring, "</TD></TR>\n");
540        od;
541        Append(dotstring, "</TABLE>");
542
543        Append(dotstring, "</TD>");	# close H-class
544
545      od;
546      Append(dotstring, "</TR>\n");  # closes current row for writing
547      # Current H-class written
548    od;
549    # Current D-class written
550
551    # close current node (D-class)
552    Append(dotstring, "</TABLE>>];\n");
553
554    # Next D-class will have next number
555    dc_number := dc_number + 1;
556  od;
557
558  # ===== write the arrows =====
559
560
561  greens_less_than := [];
562  for i in [1..len_dclasses] do
563    greens_less_than[i] := [];
564    greens_less_than[i][i] := false;
565  od;
566
567  box4 := [];  # This will be a list of lists
568  # for poi3 will be
569  # [ [ 3 ], [ 1, 3 ], [  ], [ 1, 2, 3 ] ],
570  # meaning that dclasses[1] is only below dclasses[3],
571  # dclasses[2] is only below dclasses[1] and dclasses[3],...
572  for i in [1..len_dclasses] do
573    box4[i] := [];
574    list := [1..len_dclasses];
575    RemoveSet(list, i);
576    for j in list do
577      if IsGreensLessThanOrEqual(dclasses[i], dclasses[j]) then
578        Add(box4[i], j);
579        greens_less_than[i][j] := true;
580      else
581        greens_less_than[i][j] := false;
582      fi;
583    od;
584  od;
585  visited := [];
586  for i in [1..len_dclasses] do
587    visited[i] := false;
588  od;
589  val := [];
590  box5 := [];  # This variable will be a list of lists
591  # of integers (indexes into dclasses) where
592  # box5 = [ [ 1 ], [ 2, 3 ], [ 4, 5 ], [ 6 ] ]
593  # means (from top to bottom) first row has dclasses[1],
594  # second row has dclasses[2] and dclasses[3],...
595  j := 1;
596  while ForAny(visited, v -> v = false) do
597    box5[j] := [];
598    for i in [1..len_dclasses] do
599      # If for all d-classes above dclasses[i]
600      #
601      if ForAll(box4[i], a -> a in val) then
602        Add(box5[j], i);
603        visited[i] := true;
604      fi;
605    od;
606    val := box5[j];
607    j := j + 1;
608  od;
609  lenb := j - 1;  # Length of box5
610  list := ShallowCopy(box5[1]);
611  for i in [2..lenb] do
612    SubtractSet(box5[i], list);
613    UniteSet(list, ShallowCopy(box5[i]));
614  od;
615  # box5 has been computed.
616
617
618  # Write arrows
619  existsPathFromAtoB := List([1..len_dclasses], x -> List([1..len_dclasses], y -> false));
620  for i in [2..lenb] do
621    for cl in box5[i] do
622      j := i - 1;
623      while j > 0 do
624        for cl2 in box5[j] do
625          if greens_less_than[cl][cl2] and
626             not greens_less_than[cl2][cl] and
627             not existsPathFromAtoB[cl2][cl] then
628            # Draw arrow from node of dclasses[cl2] to node of
629            # dclasses[cl] where map[i] is the number of dot's node
630            # of d-class dclasses[i]
631            Append(dotstring, Concatenation(String(cl2), ":", String(cl2), " -> ", String(cl), ":", String(cl), ";\n"));
632
633            existsPathFromAtoB[cl2][cl] := true;
634            m := j - 1;
635            while m > 0 do
636              for cl3 in box5[m] do
637                if existsPathFromAtoB[cl3][cl2] then
638                  existsPathFromAtoB[cl3][cl] := true;
639                fi;
640              od;
641              m := m - 1;
642            od;
643          fi;
644        od;
645        j := j - 1;
646      od;
647    od;
648  od;
649  # Arrows written
650
651  # Close the dot file
652  Append(dotstring, "}\n");
653
654  return dotstring;
655end);
656
657
658##--------------------------------------------------------------------------------
659
660##--------------------------------------------------------------------------------
661
662
663InstallGlobalFunction(DotForDrawingDClasses, function(arg)
664  local S,                          # The semigroup
665        dc,                         # one d-class
666        cl, cl2, cl3,               # index of one certain d-class in dclasses
667        el, el2,                    # one element of an H-class
668        dclasses,
669        len_dclasses,               # number of d-classes
670        dc_number,                  # the number of the dot node of a D-class
671        eggbox, eggbox2,
672        idegg, idegg2,
673        line, col,
674        ident,
675        existsPathFromAtoB,         # matrix with true in [i][j] iff
676        # there is there is a path of arrows
677        # from dclasses[i] to dclasses[j]
678        phi,                        # phi[i][j] = [i', j'] where
679        # mat_input[i'][j'] = mat[i][j]
680        # where mat_input is the input matrix to
681        # GrahamBlocks (it will
682        # reference entries in eggbox!
683        # and mat is graham_eggbox
684        box4,                       # Defined where used
685        box5,                       # Defined where used
686        lenb,                       # Length of box5 which is the number of
687        # levels in the drawing
688        visited, list,              # auxiliary arrays
689        greens_less_than,           # matrix with true in [i][j] iff
690        # dclasses[i] <= dclasses[j]
691        #siegen          file,                       # name of the file where dot code
692        dotstring,                       # name of the string storing the dot code
693        # will be written
694        bag, bag2,                  # matrix such that bag[i][j] = L
695        # where L is the list of elements of the
696        # H-class currently being processed
697        # ready for being written according to
698        # whether we're writing as transformations
699        # or words
700        zero,                       # The "zero" on the transformations if partial
701        is_partial,                 # whether the transformations are partial
702        trans_list,				  # The list of lists of elements to be coloured
703        len_trans_list,
704        generators, generatorsx,
705        genslen,
706        colors, color,
707        #siegen          fich,                       # the name of the dot file given as argument
708 #       gv, dot, tdir,
709        alphabet,
710#        idempots,                   # Idempotents of the semigroup
711        idempots2,                  # ImageListOfTransformation of idempots
712        T,                          # whether we're displaying as transformations
713        T__,                        # To hold the value of last argument (may be 1 or 2 or none)
714        # to either display the transformations as transformations
715        # or as an integer (like in the right Cayley Graph).
716        elms__,                     # The elements of S
717        idemps__,                   # Idempotents of the semigroup
718        str, str1, str2,
719        tlen,
720        rows, cols, val,
721        retels,
722        i, j, k, k2, p, m, c, ret, px,
723        powerizeWord;
724
725
726
727  # ==========================================
728
729  # if we're displaying as words this function
730  # replaces 2 or more followed occurrences of
731  # letter a by a^...
732  powerizeWord := function(w)
733    local w2, c, j, a;
734
735    w2 := [];
736    c := 0;
737    for j in [1..Length(w)] do
738      if c = 0 then
739        a := w[j];
740        c := 1;
741      elif w[j] = a then
742        c := c + 1;
743      else
744        if c = 1 then
745          Add(w2, a);
746        else
747          w2 := Concatenation(w2, [a], "^", String(c));
748        fi;
749        c := 1;
750        a := w[j];
751      fi;
752    od;
753    if c = 1 then
754      Add(w2, a);
755    else
756      w2 := Concatenation(w2, [a], "^", String(c));
757    fi;
758    return(w2);
759  end;
760  ##  End of powerizeWord()  --
761
762  # alphabet for displaying as words
763  alphabet := "abcdefghijklmnopqrstuvwxyz";
764
765  colors := [ "brown", "burlywood", "cadetblue", "chartreuse", "chocolate", "coral", "cornflowerblue",
766              "crimson", "cyan", "darkgoldenrod", "darkkhaki", "darkorange", "darkorchid",
767              "darksalmon", "darkseagreen", "darkturquoise",
768              "darkviolet", "deeppink", "deepskyblue", "dodgerblue", "firebrick",
769              "forestgreen", "gold", "goldenrod", "green", "greenyellow", "grey",
770              "hotpink", "indianred", "khaki", "lawngreen",
771              "lightblue", "lightcoral",
772              "lightpink", "lightsalmon", "lightseagreen", "lightskyblue", "lightslateblue",
773              "lightslategrey", "limegreen", "magenta",
774              "maroon", "mediumaquamarine", "mediumorchid", "mediumpurple", "mediumseagreen",
775              "mediumspringgreen", "mediumturquoise", "mediumvioletred",
776              "moccasin", "navajowhite", "olivedrab2", "orange", "orangered",
777              "orchid", "palegreen", "paleturquoise", "palevioletred", "peachpuff", "peru",
778              "pink", "plum", "powderblue", "purple", "red", "rosybrown", "royalblue1", "saddlebrown", "salmon",
779              "sandybrown", "seagreen", "skyblue", "slateblue", "slategrey",
780              "springgreen", "steelblue", "tan", "thistle", "tomato", "turquoise", "violet", "violetred",
781              "wheat", "yellow", "yellowgreen" ];
782
783
784  if not IsBound(arg[1]) or not IsSemigroup(arg[1]) then
785    Error("The first argument must be a semigroup");
786  fi;
787  # to face the fact that semigroups behave differently depending on the use or not of the "semigroups" package, a fresh object is created
788  if IsMonoid(arg[1]) then
789    S := Monoid(GeneratorsOfMonoid(arg[1]));
790  elif IsSemigroup(arg[1]) then
791    S := Semigroup(GeneratorsOfSemigroup(arg[1]));
792  fi;
793
794
795  if not (IsTransformationMonoid(S) or IsTransformationSemigroup(S)) then
796    Print("I will work with an isomorphic transformation semigroup instead\n");
797    S:= Range(IsomorphismTransformationSemigroup(S));
798    S := Semigroup(ReduceNumberOfGenerators(GeneratorsOfSemigroup(S)));
799  fi;
800
801  tlen := DegreeOfTransformationSemigroup(S);
802
803  elms__ := Elements(S);
804  idemps__ := Idempotents(S);
805  idempots2 := List(idemps__, x -> ImageListOfTransformation(x,tlen));
806
807  T := false;                          # Display as transformations
808  trans_list := [];                    # the list of lists of elements
809  # to draw in colors given by
810  # the user.
811  for i in [2..Length(arg)] do
812    if  IsList(arg[i]) then
813      if not ForAll(arg[i], e -> IsTransformation(e)) then
814        Error("The list of elements must be a list of Transformations ", arg[i]);
815      fi;
816      Add(trans_list, Set(List(arg[i], trans -> ImageListOfTransformation(trans,tlen))));
817    elif i = Length(arg) and (arg[i] = 1 or arg[i] = 2) then
818      T := true;
819      T__ := arg[i];
820    else
821      Error("The arguments must be: <semigroup> [, list of elements]* [, file name]");
822    fi;
823  od;
824  len_trans_list := Length(trans_list);
825
826  ##  We will check if the transformations are partial or total
827  generators := GeneratorsOfSemigroup(S);
828  genslen := Length(generators);
829  generatorsx := [];
830  for el in generators do
831    if not el = IdentityTransformation then
832      Add(generatorsx, el);
833    fi;
834  od;
835  Sort(generatorsx);
836
837  # Determine if transitions are partial
838  # and determine the "zero" digit
839  is_partial := ForAll(List(generators, g -> ImageListOfTransformation(g,tlen)), lx -> lx[tlen] = tlen);
840  zero := tlen;
841
842  # ============= Main Code ==================
843
844  dclasses := GreensDClasses(S);
845  len_dclasses := Length(dclasses);
846  dc_number := 1;
847
848  if not T then
849    retels := [Elements(S), SemigroupFactorization(S, Elements(S)),[]];
850  fi;
851
852  #initializing the dotstring
853  dotstring := "digraph  DClasses {\ngraph [center=yes,ordering=out];\nnode [shape=plaintext];\nedge [color=cornflowerblue,arrowhead=none];\n";
854
855
856  # For each d-class write the dot record node
857  for dc in dclasses do
858    eggbox := EggBoxOfDClass(dc);
859    rows := Length(eggbox);
860    cols := Length(eggbox[1]);
861
862    idegg := List(eggbox, r->List(r,
863                     function(h)
864      if IsGroupHClass(h) then
865        return 1;
866      else
867        return 0;
868      fi;
869    end));
870
871
872    ##  Order the columns lexicographically
873    line := List([1..cols], x -> [Representative(eggbox[1][x]), x]);
874    Sort(line);
875    eggbox2 := NullMat(rows, cols);
876    idegg2 := NullMat(rows, cols);
877
878    j := 1;
879    for el in line do
880      for i in [1..rows] do
881        eggbox2[i][j] := ShallowCopy(eggbox[i][el[2]]);
882        idegg2[i][j] := ShallowCopy(idegg[i][el[2]]);
883      od;
884      j := j + 1;
885    od;
886
887    ##  Order the rows lexicographically
888    col := List([1..rows], x -> [Representative(eggbox[x][1]), x]);
889    Sort(col);
890    eggbox := NullMat(rows, cols);
891    idegg := NullMat(rows, cols);
892    i := 1;
893    for el in col do
894      for j in [1..cols] do
895        eggbox[i][j] := ShallowCopy(eggbox2[el[2]][j]);
896        idegg[i][j] := ShallowCopy(idegg2[el[2]][j]);
897      od;
898      i := i + 1;
899    od;
900
901
902    if IsRegularDClass(dc) then
903      ret := GrahamBlocks(idegg);
904      ##    Print(idegg,"\n",ret,"\n");
905
906      #            graham_eggbox := ret[1];
907      phi := ret[2];
908    fi;
909
910    bag := [];
911    bag2 := [];
912    for k in [1..rows] do
913      bag[k] := [];
914      bag2[k] := [];
915      for p in [1..cols] do
916        bag2[k][p] := [];
917      od;
918    od;
919
920
921    # Write the dot node definition of the current
922    # D-class
923    Append(dotstring, Concatenation(String(dc_number), " [label=<\n<TABLE BORDER=\"0\" CELLBORDER=\"0\" CELLPADDING=\"0\" CELLSPACING=\"0\" PORT=\"", String(dc_number), "\">\n"));  # opens the D-class and
924    # first column for writing
925
926    # Visit left column first, then second,... because of dot
927    for i in [1..rows] do
928      Append(dotstring, "<TR>");
929      for j in [1..cols] do
930        # Write H-class [i][j] from current eggbox
931        # With the list of
932        # elements of an H-class writes the
933        # corresponding cell of the dot record node
934        # in the current D-class node
935        Append(dotstring, "<TD BORDER=\"0\">");  # opens h-class
936
937        # bag2[i][j] is the list of elements
938        # of eggbox[i'][j'] where i' = phi[i][j][1]
939        # and j' = phi[i][j][2], formatted for being written
940        # phi is needed because GrahamBlocks was called.
941        if IsRegularDClass(dc) then
942          # If we're displaying as transformations
943          if T then
944            bag[i][j] := List(Elements(eggbox[phi[i][j][1]][phi[i][j][2]]), x -> ImageListOfTransformation(x,tlen));
945            if T__ = 1 then
946              # if the transformations are partial
947              if is_partial then
948                for el in bag[i][j] do
949                  # replace the "zero" by "_"
950                  list := [];
951                  for p in [1..zero-1] do
952                    if el[p] = zero then
953                      Add(list, "_");
954                    elif el[p] > zero then
955                      Add(list, el[p]-1);
956                    else
957                      Add(list, el[p]);
958                    fi;
959                  od;
960                  for p in [zero+1..tlen] do
961                    if el[p] = zero then
962                      Add(list, "_");
963                    elif el[p] > zero then
964                      Add(list, el[p]-1);
965                    else
966                      Add(list, el[p]);
967                    fi;
968                  od;
969                  if list = [] then
970                    Add(list, "_");
971                  fi;
972                  # End of replace the "zero" by "_"
973
974                  # str2 will be the written string
975                  str := String(list);
976                  # if it's an idempot put the "*"
977                  if el in idempots2 then
978                    str2 := ['*'];
979                  else
980                    str2 := [];
981                  fi;
982                  # Remove '"'
983                  for c in str do
984                    if not c = '"' then #"
985                       Add(str2, c);
986                    fi;
987                  od;
988                  # add element for write
989                  if str2[6] = '.' then
990                    ident := List([1..tlen], x -> x);
991                    if str2[1] = '*' then
992                      str2 := Concatenation("*", String(ident));
993                    else
994                      str2 := String(ident);
995                    fi;
996                  fi;
997                  Add(bag2[i][j], str2);
998                od;
999                # If the transformations are total
1000              else
1001                # Add '*' if it's an idempotent
1002                for el in bag[i][j] do
1003                  if el in idempots2 then
1004                    ##                                        if String(el)[6] = '.' then
1005                    if el = [] then
1006                      Add(bag2[i][j], Concatenation("*", String(List([1..tlen], x -> x))));
1007                    else
1008                      Add(bag2[i][j], Concatenation("*", String(el)));
1009                    fi;
1010                  else
1011                    Add(bag2[i][j], String(el));
1012                  fi;
1013                od;
1014              fi;
1015            else  # Display transformations as integers
1016              # Add '*' if it's an idempotent
1017              for el in Elements(eggbox[phi[i][j][1]][phi[i][j][2]]) do
1018                if el in idemps__ then
1019                  if String(el)[6] = '.' then
1020                    Add(bag2[i][j], Concatenation("*", String(List([1..tlen], x -> x))));
1021                  else
1022                    Add(bag2[i][j], Concatenation("*", String(Position(elms__, el))));
1023                  fi;
1024                else
1025                  Add(bag2[i][j], String(Position(elms__, el)));
1026                fi;
1027              od;
1028            fi;
1029            # If we're displaying as words
1030          else
1031            bag[i][j] := Elements(eggbox[phi[i][j][1]][phi[i][j][2]]);
1032            for el in bag[i][j] do
1033              if el = MultiplicativeNeutralElement(S) then
1034                str1 := "1";
1035                retels[3][Position(retels[1], el)] := "1";
1036              elif el = MultiplicativeZero(S) then
1037                str1 := "0";
1038                retels[3][Position(retels[1], el)] := "0";
1039              else
1040##                    Error("..");
1041
1042                px := Position(retels[1], el);
1043                ret := retels[2][px];
1044                str1 := [];
1045                if genslen > 26 then
1046                  for el2 in ret do
1047                    str1 := Concatenation(str1, "a", String(Position(generatorsx, el2)));
1048                  od;
1049                else
1050                  for el2 in ret do
1051                    Add(str1, alphabet[Position(generatorsx, el2)]);
1052                  od;
1053                fi;
1054                str1 := powerizeWord(str1);
1055                retels[3][px] := str1;
1056              fi;
1057              if el in idemps__ then
1058                Add(bag2[i][j], Concatenation("*", str1));
1059              else
1060                Add(bag2[i][j], str1);
1061              fi;
1062            od;
1063            bag[i][j] := List(bag[i][j], x -> ImageListOfTransformation(x,tlen));
1064          fi;
1065          # if it is not a regular d-class
1066        else
1067          # If we're displaying as transformations
1068          if T then
1069            # if it is not a regular d-class it has not been sorted by GrahamBlocks,
1070            # so pick the elements from eggbox in same (not mapped by phi) order
1071            bag[i][j] := List(Elements(eggbox[i][j]), x -> ImageListOfTransformation(x,tlen));
1072            if T__ = 1 then
1073              if is_partial then
1074                for el in bag[i][j] do
1075                  list := [];
1076                  for p in [1..zero-1] do
1077                    if el[p] = zero then
1078                      Add(list, "_");
1079                    elif el[p] > zero then
1080                      Add(list, el[p]-1);
1081                    else
1082                      Add(list, el[p]);
1083                    fi;
1084                  od;
1085                  for p in [zero+1..tlen] do
1086                    if el[p] = zero then
1087                      Add(list, "_");
1088                    elif el[p] > zero then
1089                      Add(list, el[p]-1);
1090                    else
1091                      Add(list, el[p]);
1092                    fi;
1093                  od;
1094                  str := String(list);
1095                  if el in idempots2 then
1096                    str2 := ['*'];
1097                  else
1098                    str2 := [];
1099                  fi;
1100                  for c in str do
1101                    if not c = '"' then  #"
1102                       Add(str2, c);
1103                    fi;
1104                  od;
1105                  Add(bag2[i][j], str2);
1106                od;
1107                # If the transformations are total
1108              else
1109                # Add '*' if it's an idempotent
1110                for el in bag[i][j] do
1111                  if el in idempots2 then
1112                    Add(bag2[i][j], Concatenation("*", String(el)));
1113                  else
1114                    Add(bag2[i][j], String(el));
1115                  fi;
1116                od;
1117              fi;
1118            else  # Display transformations as integers
1119              # Add '*' if it's an idempotent
1120              for el in Elements(eggbox[i][j]) do
1121                if el in idemps__ then
1122                  Add(bag2[i][j], Concatenation("*", String(Position(elms__, el))));
1123                else
1124                  Add(bag2[i][j], String(Position(elms__, el)));
1125                fi;
1126              od;
1127            fi;
1128            # If we're displaying as words
1129          else
1130            bag[i][j] := Elements(eggbox[i][j]);
1131            for el in bag[i][j] do
1132              if el = MultiplicativeNeutralElement(S) then
1133                str1 := "1";
1134                retels[3][Position(retels[1], el)] := "1";
1135              elif el = MultiplicativeZero(S) then
1136                str1 := "0";
1137                retels[3][Position(retels[1], el)] := "0";
1138              else
1139                px := Position(retels[1], el);
1140                ret := retels[2][px];
1141                str1 := [];
1142                if genslen > 26 then
1143                  for el2 in ret do
1144                    str1 := Concatenation(str1, "a", String(Position(generatorsx, el2)));
1145                  od;
1146                else
1147                  for el2 in ret do
1148                    Add(str1, alphabet[Position(generatorsx, el2)]);
1149                  od;
1150                fi;
1151                str1 := powerizeWord(str1);
1152                retels[3][px] := str1;
1153              fi;
1154              if el in idemps__ then
1155                Add(bag2[i][j], Concatenation("*", str1));
1156              else
1157                Add(bag2[i][j], str1);
1158              fi;
1159            od;
1160            bag[i][j] := List(bag[i][j], x -> ImageListOfTransformation(x,tlen));
1161          fi;
1162        fi;
1163
1164        # write the elements of current H-class
1165        Append(dotstring, "<TABLE CELLSPACING=\"0\">");
1166        for k in [1..Length(bag2[i][j])] do
1167          color := "white";
1168          el := bag[i][j][k];
1169          k2 := len_trans_list;
1170          while k2 > 0 do
1171            if el in trans_list[k2] then
1172              color := colors[k2];
1173              break;
1174            fi;
1175            k2 := k2 - 1;
1176          od;
1177          Append(dotstring, Concatenation("<TR><TD BGCOLOR=\"", color, "\" BORDER=\"0\">"));
1178          Append(dotstring, bag2[i][j][k]);
1179          Append(dotstring, "</TD></TR>\n");
1180        od;
1181        Append(dotstring, "</TABLE>");
1182
1183        Append(dotstring, "</TD>");	# close H-class
1184
1185      od;
1186      Append(dotstring, "</TR>\n");  # closes current row for writing
1187      # Current H-class written
1188    od;
1189    # Current D-class written
1190
1191    # close current node (D-class)
1192    Append(dotstring, "</TABLE>>];\n");
1193
1194    # Next D-class will have next number
1195    dc_number := dc_number + 1;
1196  od;
1197
1198  # ===== write the arrows =====
1199
1200  greens_less_than := [];
1201  for i in [1..len_dclasses] do
1202    greens_less_than[i] := [];
1203    greens_less_than[i][i] := false;
1204  od;
1205
1206  box4 := [];  # This will be a list of lists
1207  # for poi3 will be
1208  # [ [ 3 ], [ 1, 3 ], [  ], [ 1, 2, 3 ] ],
1209  # meaning that dclasses[1] is only below dclasses[3],
1210  # dclasses[2] is only below dclasses[1] and dclasses[3],...
1211  for i in [1..len_dclasses] do
1212    box4[i] := [];
1213    list := [1..len_dclasses];
1214    RemoveSet(list, i);
1215    for j in list do
1216      if IsGreensLessThanOrEqual(dclasses[i], dclasses[j]) then
1217        Add(box4[i], j);
1218        greens_less_than[i][j] := true;
1219      else
1220        greens_less_than[i][j] := false;
1221      fi;
1222    od;
1223  od;
1224  visited := [];
1225  for i in [1..len_dclasses] do
1226    visited[i] := false;
1227  od;
1228  val := [];
1229  box5 := [];  # This variable will be a list of lists
1230  # of integers (indexes into dclasses) where
1231  # box5 = [ [ 1 ], [ 2, 3 ], [ 4, 5 ], [ 6 ] ]
1232  # means (from top to bottom) first row has dclasses[1],
1233  # second row has dclasses[2] and dclasses[3],...
1234  j := 1;
1235  while ForAny(visited, v -> v = false) do
1236    box5[j] := [];
1237    for i in [1..len_dclasses] do
1238      # If for all d-classes above dclasses[i]
1239      #
1240      if ForAll(box4[i], a -> a in val) then
1241        Add(box5[j], i);
1242        visited[i] := true;
1243      fi;
1244    od;
1245    val := box5[j];
1246    j := j + 1;
1247  od;
1248  lenb := j - 1;  # Length of box5
1249  list := ShallowCopy(box5[1]);
1250  for i in [2..lenb] do
1251    SubtractSet(box5[i], list);
1252    UniteSet(list, ShallowCopy(box5[i]));
1253  od;
1254  # box5 has been computed.
1255
1256
1257  # Write arrows
1258  existsPathFromAtoB := List([1..len_dclasses], x -> List([1..len_dclasses], y -> false));
1259  for i in [2..lenb] do
1260    for cl in box5[i] do
1261      j := i - 1;
1262      while j > 0 do
1263        for cl2 in box5[j] do
1264          if greens_less_than[cl][cl2] and
1265             not greens_less_than[cl2][cl] and
1266             not existsPathFromAtoB[cl2][cl] then
1267            # Draw arrow from node of dclasses[cl2] to node of
1268            # dclasses[cl] where map[i] is the number of dot's node
1269            # of d-class dclasses[i]
1270            Append(dotstring, Concatenation(String(cl2), ":", String(cl2), " -> ", String(cl), ":", String(cl), ";\n"));
1271            ##Append(dotstring, Concatenation(cl2, ":", cl2, " -> ", cl, ":", cl, ";\n"));
1272
1273            existsPathFromAtoB[cl2][cl] := true;
1274            m := j - 1;
1275            while m > 0 do
1276              for cl3 in box5[m] do
1277                if existsPathFromAtoB[cl3][cl2] then
1278                  existsPathFromAtoB[cl3][cl] := true;
1279                fi;
1280              od;
1281              m := m - 1;
1282            od;
1283          fi;
1284        od;
1285        j := j - 1;
1286      od;
1287    od;
1288  od;
1289  # Arrows written
1290
1291  # Close the dot file
1292  Append(dotstring, "}\n");
1293  return dotstring;
1294end);
1295
1296
1297
1298##--------------------------------------------------------------------------------
1299##--------------------------------------------------------------------------------
1300