1############################################################################# 2## 3## attr.gi 4## Copyright (C) 2014-19 James D. Mitchell 5## 6## Licensing information can be found in the README file of this package. 7## 8############################################################################# 9## 10 11InstallMethod(DigraphNrVertices, "for a digraph by out-neighbours", 12[IsDigraphByOutNeighboursRep], DIGRAPH_NR_VERTICES); 13 14InstallMethod(OutNeighbours, "for a digraph by out-neighbours", 15[IsDigraphByOutNeighboursRep], DIGRAPH_OUT_NEIGHBOURS); 16 17# The next method is (yet another) DFS as described in 18# http://www.eecs.wsu.edu/~holder/courses/CptS223/spr08/slides/graphapps.pdf 19 20InstallMethod(ArticulationPoints, "for a digraph by out-neighbours", 21[IsDigraphByOutNeighboursRep], 22function(D) 23 local copy, nbs, counter, visited, num, low, parent, points, points_seen, 24 stack, depth, v, w, i; 25 if (HasIsConnectedDigraph(D) and not IsConnectedDigraph(D)) 26 or DigraphNrVertices(D) <= 1 then 27 return []; 28 elif not IsSymmetricDigraph(D) then 29 copy := DigraphSymmetricClosure(DigraphMutableCopyIfMutable(D)); 30 else 31 copy := D; 32 fi; 33 nbs := OutNeighbours(copy); 34 35 counter := 0; 36 visited := BlistList([1 .. DigraphNrVertices(copy)], []); 37 num := []; 38 low := []; 39 parent := [1]; 40 points := []; 41 points_seen := BlistList([1 .. DigraphNrVertices(copy)], []); 42 stack := [[1, 0]]; 43 depth := 1; 44 45 while depth > 1 or not visited[1] do 46 v := stack[depth][1]; 47 if visited[v] then 48 depth := depth - 1; 49 v := stack[depth][1]; 50 w := nbs[v][stack[depth][2]]; 51 if v <> 1 and low[w] >= num[v] and not points_seen[v] then 52 points_seen[v] := true; 53 Add(points, v); 54 fi; 55 if low[w] < low[v] then 56 low[v] := low[w]; 57 fi; 58 else 59 visited[v] := true; 60 counter := counter + 1; 61 num[v] := counter; 62 low[v] := counter; 63 fi; 64 i := PositionProperty(nbs[v], w -> w <> v, stack[depth][2]); 65 while i <> fail do 66 w := nbs[v][i]; 67 if not visited[w] then 68 parent[w] := v; 69 stack[depth][2] := i; 70 depth := depth + 1; 71 if not IsBound(stack[depth]) then 72 stack[depth] := []; 73 fi; 74 stack[depth][1] := w; 75 stack[depth][2] := 0; 76 break; 77 elif parent[v] <> w and num[w] < low[v] then 78 low[v] := num[w]; 79 fi; 80 i := PositionProperty(nbs[v], w -> w <> v, i); 81 od; 82 od; 83 84 if counter = DigraphNrVertices(D) then 85 i := Position(parent, 1, 1); 86 if i <> fail and Position(parent, 1, i) <> fail then 87 Add(points, 1); 88 fi; 89 if IsImmutableDigraph(D) then 90 SetIsConnectedDigraph(D, true); 91 fi; 92 return points; 93 else 94 if IsImmutableDigraph(D) then 95 SetIsConnectedDigraph(D, false); 96 fi; 97 return []; 98 fi; 99end); 100 101InstallMethod(ChromaticNumber, "for a digraph by out-neighbours", 102[IsDigraphByOutNeighboursRep], 103function(D) 104 local nr, comps, upper, chrom, tmp_comps, tmp_upper, n, comp, bound, clique, 105 c, i; 106 nr := DigraphNrVertices(D); 107 108 if DigraphHasLoops(D) then 109 ErrorNoReturn("the argument <D> must be a digraph with no loops,"); 110 elif nr = 0 then 111 return 0; # chromatic number = 0 iff <D> has 0 verts 112 elif IsNullDigraph(D) then 113 return 1; # chromatic number = 1 iff <D> has >= 1 verts & no edges 114 elif IsBipartiteDigraph(D) then 115 return 2; # chromatic number = 2 iff <D> has >= 2 verts & is bipartite 116 # <D> has at least 2 vertices at this stage 117 fi; 118 119 # The chromatic number of <D> is at least 3 and at most nr 120 D := DigraphMutableCopy(D); 121 D := DigraphRemoveAllMultipleEdges(D); 122 D := DigraphSymmetricClosure(D); 123 124 if IsCompleteDigraph(D) then 125 # chromatic number = nr iff <D> has >= 2 verts & this cond. 126 return nr; 127 elif nr = 4 then 128 # if nr = 4, then 3 is only remaining possible chromatic number 129 return 3; 130 fi; 131 132 # The chromatic number of <D> is at least 3 and at most nr - 1 133 134 # The variable <chrom> is the current best known lower bound for the 135 # chromatic number of <D>. 136 chrom := 3; 137 138 # Prepare a list of connected components of D whose chromatic number we 139 # do not yet know. 140 if IsConnectedDigraph(D) then 141 comps := [D]; 142 upper := [RankOfTransformation(DigraphGreedyColouring(D), nr)]; 143 chrom := Maximum(CliqueNumber(D), chrom); 144 else 145 tmp_comps := []; 146 tmp_upper := []; 147 for comp in DigraphConnectedComponents(D).comps do 148 n := Length(comp); 149 if chrom < n then 150 # If chrom >= n, then we can colour the vertices of comp using any n of 151 # the required (at least) chrom colours, and we do not have to consider 152 # comp. 153 154 # Note that n > chrom >= 3 and so comp is not null, so no need to check 155 # for that. 156 comp := InducedSubdigraph(DigraphMutableCopy(D), comp); 157 if IsCompleteDigraph(comp) then 158 # Since n > chrom, this is an improved lower bound for the overall 159 # chromatic number. 160 chrom := n; 161 elif not IsBipartiteDigraph(comp) then 162 # If comp is bipartite, then its chromatic number is 2, and, since 163 # the chromatic number of D is >= 3, this component can be 164 # ignored. 165 bound := RankOfTransformation(DigraphGreedyColouring(comp), 166 DigraphNrVertices(comp)); 167 if bound > chrom then 168 # If bound <= chrom, then comp can be coloured by at most chrom 169 # colours, and so we can ignore comp. 170 clique := CliqueNumber(comp); 171 if clique = bound then 172 # The chromatic number of this component is known, and it can be 173 # ignored, and clique = bound > chrom, and so clique is an 174 # improved lower bound for the chromatic number of D. 175 chrom := clique; 176 else 177 Add(tmp_comps, comp); 178 Add(tmp_upper, bound); 179 if clique > chrom then 180 chrom := clique; 181 fi; 182 fi; 183 fi; 184 fi; 185 fi; 186 od; 187 188 # Remove the irrelevant components since we have a possibly improved value 189 # of chrom. 190 comps := []; 191 upper := []; 192 193 for i in [1 .. Length(tmp_comps)] do 194 if chrom < DigraphNrVertices(tmp_comps[i]) and chrom < tmp_upper[i] then 195 Add(comps, tmp_comps[i]); 196 Add(upper, tmp_upper[i]); 197 fi; 198 od; 199 200 # Sort by size, since smaller components are easier to colour 201 SortParallel(comps, upper, {x, y} -> Size(x) < Size(y)); 202 fi; 203 for i in [1 .. Length(comps)] do 204 # <c> is the current best upper bound for the chromatic number of comps[i] 205 c := upper[i]; 206 while c > chrom and DigraphColouring(comps[i], c - 1) <> fail do 207 c := c - 1; 208 od; 209 if c > chrom then 210 chrom := c; 211 fi; 212 od; 213 return chrom; 214end); 215 216# 217# The following method is currently useless, as the OutNeighbours are computed 218# and set whenever a digraph is created. It could be reinstated later if we 219# decide to allow digraphs to exist without known OutNeighbours. 220# 221 222# InstallMethod(OutNeighbours, 223# "for a digraph with representative out neighbours and group", 224# [IsDigraph and HasRepresentativeOutNeighbours and HasDigraphGroup], 225# function(D) 226# local gens, sch, reps, out, trace, word, i, w; 227# 228# gens := GeneratorsOfGroup(DigraphGroup(D)); 229# sch := DigraphSchreierVector(D); 230# reps := RepresentativeOutNeighbours(D); 231# 232# out := EmptyPlist(DigraphNrVertices(D)); 233# 234# for i in [1 .. Length(sch)] do 235# if sch[i] < 0 then 236# out[i] := reps[-sch[i]]; 237# fi; 238# 239# trace := DIGRAPHS_TraceSchreierVector(gens, sch, i); 240# out[i] := out[trace.representative]; 241# word := trace.word; 242# for w in word do 243# out[i] := OnTuples(out[i], gens[w]); 244# od; 245# od; 246 247# return out; 248# end); 249 250InstallMethod(DigraphAdjacencyFunction, "for a digraph by out-neighbours", 251[IsDigraph], D -> {u, v} -> IsDigraphEdge(D, u, v)); 252 253InstallMethod(AsTransformation, "for a digraph by out-neighbours", 254[IsDigraphByOutNeighboursRep], 255function(D) 256 if not IsFunctionalDigraph(D) then 257 return fail; 258 fi; 259 return Transformation(Concatenation(OutNeighbours(D))); 260end); 261 262InstallMethod(DigraphNrEdges, "for a digraph", [IsDigraphByOutNeighboursRep], 263function(D) 264 local m; 265 m := DIGRAPH_NREDGES(D); 266 if IsImmutableDigraph(D) then 267 SetIsEmptyDigraph(D, m = 0); 268 fi; 269 return m; 270end); 271 272InstallMethod(DigraphEdges, "for a digraph by out-neighbours", 273[IsDigraphByOutNeighboursRep], 274function(D) 275 local out, adj, nr, i, j; 276 out := EmptyPlist(DigraphNrEdges(D)); 277 adj := OutNeighbours(D); 278 nr := 0; 279 280 for i in DigraphVertices(D) do 281 for j in adj[i] do 282 nr := nr + 1; 283 out[nr] := [i, j]; 284 od; 285 od; 286 return out; 287end); 288 289# attributes for digraphs . . . 290 291InstallMethod(AsGraph, "for a digraph", [IsDigraph], Graph); 292 293InstallMethod(DigraphVertices, "for a digraph", [IsDigraph], 294D -> [1 .. DigraphNrVertices(D)]); 295 296InstallMethod(DigraphRange, 297"for an immutable digraph by out-neighbours", 298[IsDigraphByOutNeighboursRep and IsImmutableDigraph], 299function(D) 300 if not IsBound(D!.DigraphRange) then 301 DIGRAPH_SOURCE_RANGE(D); 302 SetDigraphSource(D, D!.DigraphSource); 303 fi; 304 return D!.DigraphRange; 305end); 306 307InstallMethod(DigraphRange, 308"for a mutable digraph by out-neighbours", 309[IsDigraphByOutNeighboursRep and IsMutableDigraph], 310D -> DIGRAPH_SOURCE_RANGE(D).DigraphRange); 311 312InstallMethod(DigraphSource, 313"for an immutable digraph by out-neighbours", 314[IsDigraphByOutNeighboursRep and IsImmutableDigraph], 315function(D) 316 if not IsBound(D!.DigraphSource) then 317 DIGRAPH_SOURCE_RANGE(D); 318 SetDigraphRange(D, D!.DigraphRange); 319 fi; 320 return D!.DigraphSource; 321end); 322 323InstallMethod(DigraphSource, 324"for a mutable digraph by out-neighbours", 325[IsDigraphByOutNeighboursRep and IsMutableDigraph], 326D -> DIGRAPH_SOURCE_RANGE(D).DigraphSource); 327 328InstallMethod(InNeighbours, "for a digraph", [IsDigraphByOutNeighboursRep], 329D -> DIGRAPH_IN_OUT_NBS(OutNeighbours(D))); 330 331InstallMethod(AdjacencyMatrix, "for a digraph", [IsDigraphByOutNeighboursRep], 332ADJACENCY_MATRIX); 333 334InstallMethod(BooleanAdjacencyMatrix, "for a digraph by out-neighbours", 335[IsDigraphByOutNeighboursRep], 336function(D) 337 local n, nbs, mat, i, j; 338 n := DigraphNrVertices(D); 339 nbs := OutNeighbours(D); 340 mat := List(DigraphVertices(D), x -> BlistList([1 .. n], [])); 341 for i in DigraphVertices(D) do 342 for j in nbs[i] do 343 mat[i][j] := true; 344 od; 345 od; 346 return mat; 347end); 348 349InstallMethod(DigraphShortestDistances, "for a digraph by out-neighbours", 350[IsDigraphByOutNeighboursRep], 351function(D) 352 local vertices, data, sum, distances, v, u; 353 if HasDIGRAPHS_ConnectivityData(D) then 354 vertices := DigraphVertices(D); 355 data := DIGRAPHS_ConnectivityData(D); 356 sum := 0; 357 for v in vertices do 358 if IsBound(data[v]) then 359 sum := sum + 1; 360 fi; 361 od; 362 if sum > Int(0.9 * DigraphNrVertices(D)) 363 or (HasDigraphGroup(D) and not IsTrivial(DigraphGroup(D))) then 364 # adjust the constant 0.9 and possibly make a decision based on 365 # how big the group is 366 distances := []; 367 for u in vertices do 368 distances[u] := []; 369 for v in vertices do 370 distances[u][v] := DigraphShortestDistance(D, u, v); 371 od; 372 od; 373 return distances; 374 fi; 375 fi; 376 return DIGRAPH_SHORTEST_DIST(D); 377end); 378 379# returns the vertices (i.e. numbers) of <D> ordered so that there are no 380# edges from <out[j]> to <out[i]> for all <i> greater than <j>. 381 382InstallMethod(DigraphTopologicalSort, "for a digraph by out-neighbours", 383[IsDigraphByOutNeighboursRep], 384D -> DIGRAPH_TOPO_SORT(OutNeighbours(D))); 385 386InstallMethod(DigraphStronglyConnectedComponents, 387"for a digraph by out-neighbours", 388[IsDigraphByOutNeighboursRep], 389function(D) 390 local verts; 391 392 if HasIsAcyclicDigraph(D) and IsAcyclicDigraph(D) then 393 verts := DigraphVertices(D); 394 return rec(comps := List(verts, x -> [x]), id := verts * 1); 395 396 elif HasIsStronglyConnectedDigraph(D) 397 and IsStronglyConnectedDigraph(D) then 398 verts := DigraphVertices(D); 399 return rec(comps := [verts * 1], id := verts * 0 + 1); 400 fi; 401 402 return GABOW_SCC(OutNeighbours(D)); 403end); 404 405InstallMethod(DigraphNrStronglyConnectedComponents, "for a digraph", 406[IsDigraph], 407D -> Length(DigraphStronglyConnectedComponents(D).comps)); 408 409InstallMethod(DigraphConnectedComponents, "for a digraph by out-neighbours", 410[IsDigraphByOutNeighboursRep], 411DIGRAPH_CONNECTED_COMPONENTS); 412 413InstallMethod(DigraphNrConnectedComponents, "for a digraph", 414[IsDigraph], 415D -> Length(DigraphConnectedComponents(D).comps)); 416 417InstallMethod(OutDegrees, "for a digraph by out-neighbours", 418[IsDigraphByOutNeighboursRep], 419function(D) 420 local adj, degs, i; 421 adj := OutNeighbours(D); 422 degs := EmptyPlist(DigraphNrVertices(D)); 423 for i in DigraphVertices(D) do 424 degs[i] := Length(adj[i]); 425 od; 426 return degs; 427end); 428 429InstallMethod(InDegrees, "for a digraph with in neighbours", 430[IsDigraph and HasInNeighbours], 4312, # to beat the method for IsDigraphByOutNeighboursRep 432function(D) 433 local inn, degs, i; 434 inn := InNeighbours(D); 435 degs := EmptyPlist(DigraphNrVertices(D)); 436 for i in DigraphVertices(D) do 437 degs[i] := Length(inn[i]); 438 od; 439 return degs; 440end); 441 442InstallMethod(InDegrees, "for a digraph by out-neighbours", 443[IsDigraphByOutNeighboursRep], 444function(D) 445 local adj, degs, x, i; 446 adj := OutNeighbours(D); 447 degs := [1 .. DigraphNrVertices(D)] * 0; 448 for x in adj do 449 for i in x do 450 degs[i] := degs[i] + 1; 451 od; 452 od; 453 return degs; 454end); 455 456InstallMethod(OutDegreeSequence, "for a digraph", [IsDigraph], 457function(D) 458 D := ShallowCopy(OutDegrees(D)); 459 Sort(D, {a, b} -> b < a); 460 return D; 461 # return SortedList(OutDegrees(D), {a, b} -> b < a); 462end); 463 464InstallMethod(OutDegreeSequence, 465"for a digraph by out-neighbours with known digraph group", 466[IsDigraphByOutNeighboursRep and HasDigraphGroup], 467function(D) 468 local out, adj, orbs, orb; 469 out := []; 470 adj := OutNeighbours(D); 471 orbs := DigraphOrbits(D); 472 for orb in orbs do 473 Append(out, [1 .. Length(orb)] * 0 + Length(adj[orb[1]])); 474 od; 475 Sort(out, {a, b} -> b < a); 476 return out; 477end); 478 479InstallMethod(OutDegreeSet, "for a digraph", [IsDigraph], 480D -> Set(ShallowCopy(OutDegrees(D)))); 481 482InstallMethod(InDegreeSequence, "for a digraph", [IsDigraph], 483function(D) 484 D := ShallowCopy(InDegrees(D)); 485 Sort(D, {a, b} -> b < a); 486 return D; 487 # return SortedList(OutDegrees(D), {a, b} -> b < a); 488end); 489 490InstallMethod(InDegreeSequence, 491"for a digraph with known digraph group and in-neighbours", 492[IsDigraph and HasDigraphGroup and HasInNeighbours], 493function(D) 494 local out, adj, orbs, orb; 495 out := []; 496 adj := InNeighbours(D); 497 orbs := DigraphOrbits(D); 498 for orb in orbs do 499 Append(out, [1 .. Length(orb)] * 0 + Length(adj[orb[1]])); 500 od; 501 Sort(out, {a, b} -> b < a); 502 return out; 503end); 504 505InstallMethod(InDegreeSet, "for a digraph", [IsDigraph], 506D -> Set(ShallowCopy(InDegrees(D)))); 507 508InstallMethod(DigraphSources, "for a digraph with in-degrees", 509[IsDigraph and HasInDegrees], 3, 510function(D) 511 local degs; 512 degs := InDegrees(D); 513 return Filtered(DigraphVertices(D), x -> degs[x] = 0); 514end); 515 516InstallMethod(DigraphSources, "for a digraph with in-neighbours", 517[IsDigraph and HasInNeighbours], 5182, # to beat the method for IsDigraphByOutNeighboursRep 519function(D) 520 local inn, sources, count, i; 521 522 inn := InNeighbours(D); 523 sources := EmptyPlist(DigraphNrVertices(D)); 524 count := 0; 525 for i in DigraphVertices(D) do 526 if IsEmpty(inn[i]) then 527 count := count + 1; 528 sources[count] := i; 529 fi; 530 od; 531 ShrinkAllocationPlist(sources); 532 return sources; 533end); 534 535InstallMethod(DigraphSources, "for a digraph by out-neighbours", 536[IsDigraphByOutNeighboursRep], 537function(D) 538 local out, seen, tmp, next, v; 539 out := OutNeighbours(D); 540 seen := BlistList(DigraphVertices(D), []); 541 for next in out do 542 for v in next do 543 seen[v] := true; 544 od; 545 od; 546 # FIXME use FlipBlist (when available) 547 tmp := BlistList(DigraphVertices(D), DigraphVertices(D)); 548 SubtractBlist(tmp, seen); 549 return ListBlist(DigraphVertices(D), tmp); 550end); 551 552InstallMethod(DigraphSinks, "for a digraph with out-degrees", 553[IsDigraph and HasOutDegrees], 5542, # to beat the method for IsDigraphByOutNeighboursRep 555function(D) 556 local degs; 557 degs := OutDegrees(D); 558 return Filtered(DigraphVertices(D), x -> degs[x] = 0); 559end); 560 561InstallMethod(DigraphSinks, "for a digraph by out-neighbours", 562[IsDigraphByOutNeighboursRep], 563function(D) 564 local out, sinks, count, i; 565 566 out := OutNeighbours(D); 567 sinks := []; 568 count := 0; 569 for i in DigraphVertices(D) do 570 if IsEmpty(out[i]) then 571 count := count + 1; 572 sinks[count] := i; 573 fi; 574 od; 575 return sinks; 576end); 577 578InstallMethod(DigraphPeriod, "for a digraph", [IsDigraphByOutNeighboursRep], 579function(D) 580 local comps, out, deg, nrvisited, period, stack, len, depth, current, 581 olddepth, i; 582 583 if HasIsAcyclicDigraph(D) and IsAcyclicDigraph(D) then 584 return 0; 585 fi; 586 587 comps := DigraphStronglyConnectedComponents(D).comps; 588 out := OutNeighbours(D); 589 deg := OutDegrees(D); 590 591 nrvisited := [1 .. Length(DigraphVertices(D))] * 0; 592 period := 0; 593 594 for i in [1 .. Length(comps)] do 595 stack := [comps[i][1]]; 596 len := 1; 597 depth := EmptyPlist(Length(DigraphVertices(D))); 598 depth[comps[i][1]] := 1; 599 while len <> 0 do 600 current := stack[len]; 601 if nrvisited[current] = deg[current] then 602 len := len - 1; 603 else 604 nrvisited[current] := nrvisited[current] + 1; 605 len := len + 1; 606 stack[len] := out[current][nrvisited[current]]; 607 olddepth := depth[current]; 608 if IsBound(depth[stack[len]]) then 609 period := GcdInt(period, depth[stack[len]] - olddepth - 1); 610 if period = 1 then 611 return period; 612 fi; 613 else 614 depth[stack[len]] := olddepth + 1; 615 fi; 616 fi; 617 od; 618 od; 619 620 if period = 0 and IsImmutableDigraph(D) then 621 SetIsAcyclicDigraph(D, true); 622 fi; 623 624 return period; 625end); 626 627InstallMethod(DIGRAPHS_ConnectivityData, "for a digraph", [IsDigraph], 628D -> EmptyPlist(0)); 629 630BindGlobal("DIGRAPH_ConnectivityDataForVertex", 631function(D, v) 632 local data, out_nbs, record, orbnum, reps, i, next, laynum, localGirth, 633 layers, sum, localParameters, nprev, nhere, nnext, lnum, localDiameter, 634 layerNumbers, x, y; 635 data := DIGRAPHS_ConnectivityData(D); 636 637 if IsBound(data[v]) then 638 return data[v]; 639 fi; 640 641 out_nbs := OutNeighbours(D); 642 if HasDigraphGroup(D) then 643 record := DIGRAPHS_Orbits(DigraphStabilizer(D, v), 644 DigraphVertices(D)); 645 orbnum := record.lookup; 646 reps := List(record.orbits, Representative); 647 i := 1; 648 next := [orbnum[v]]; 649 laynum := [1 .. Length(reps)] * 0; 650 laynum[next[1]] := 1; 651 localGirth := -1; 652 layers := [next]; 653 sum := 1; 654 localParameters := []; 655 else 656 orbnum := [1 .. DigraphNrVertices(D)]; 657 reps := [1 .. DigraphNrVertices(D)]; 658 i := 1; 659 next := [orbnum[v]]; 660 laynum := [1 .. Length(reps)] * 0; 661 laynum[next[1]] := 1; 662 localGirth := -1; 663 layers := [next]; 664 sum := 1; 665 localParameters := []; 666 fi; 667 668 # localDiameter is the length of the longest shortest path starting at v 669 # 670 # localParameters is a list of 3-tuples [a_{i - 1}, b_{i - 1}, c_{i - 1}] for 671 # each i between 1 and localDiameter where c_i (respectively a_i and b_i) is 672 # the number of vertices at distance i − 1 (respectively i and i + 1) from v 673 # that are adjacent to a vertex w at distance i from v. 674 675 while Length(next) > 0 do 676 next := []; 677 for x in layers[i] do 678 nprev := 0; 679 nhere := 0; 680 nnext := 0; 681 for y in out_nbs[reps[x]] do 682 lnum := laynum[orbnum[y]]; 683 if i > 1 and lnum = i - 1 then 684 nprev := nprev + 1; 685 elif lnum = i then 686 nhere := nhere + 1; 687 elif lnum = i + 1 then 688 nnext := nnext + 1; 689 elif lnum = 0 then 690 AddSet(next, orbnum[y]); 691 nnext := nnext + 1; 692 laynum[orbnum[y]] := i + 1; 693 fi; 694 od; 695 if (localGirth = -1 or localGirth = 2 * i - 1) and nprev > 1 then 696 localGirth := 2 * (i - 1); 697 fi; 698 if localGirth = -1 and nhere > 0 then 699 localGirth := 2 * i - 1; 700 fi; 701 if not IsBound(localParameters[i]) then 702 localParameters[i] := [nprev, nhere, nnext]; 703 else 704 if nprev <> localParameters[i][1] then 705 localParameters[i][1] := -1; 706 fi; 707 if nhere <> localParameters[i][2] then 708 localParameters[i][2] := -1; 709 fi; 710 if nnext <> localParameters[i][3] then 711 localParameters[i][3] := -1; 712 fi; 713 fi; 714 od; 715 if Length(next) > 0 then 716 i := i + 1; 717 layers[i] := next; 718 sum := sum + Length(next); 719 fi; 720 od; 721 if sum = Length(reps) then 722 localDiameter := Length(layers) - 1; 723 else 724 localDiameter := -1; 725 fi; 726 727 layerNumbers := []; 728 for i in [1 .. DigraphNrVertices(D)] do 729 layerNumbers[i] := laynum[orbnum[i]]; 730 od; 731 data[v] := rec(layerNumbers := layerNumbers, localDiameter := localDiameter, 732 localGirth := localGirth, localParameters := localParameters, 733 layers := layers); 734 return data[v]; 735end); 736 737BindGlobal("DIGRAPHS_DiameterAndUndirectedGirth", 738function(D) 739 local outer_reps, diameter, girth, v, record, localGirth, 740 localDiameter, i; 741 742 # This function attempts to find the diameter and undirected girth of a given 743 # D, using its DigraphGroup. For some digraphs, the main algorithm will 744 # not produce a sensible answer, so there are checks at the start and end to 745 # alter the answer for the diameter/girth if necessary. This function is 746 # called, if appropriate, by DigraphDiameter and DigraphUndirectedGirth. 747 748 if DigraphNrVertices(D) = 0 and IsImmutableDigraph(D) then 749 SetDigraphDiameter(D, fail); 750 SetDigraphUndirectedGirth(D, infinity); 751 return rec(diameter := fail, girth := infinity); 752 fi; 753 754 # TODO improve this, really check if the complexity is better with the group 755 # or without, or if the group is not known, but the number of vertices makes 756 # the usual algorithm impossible. 757 758 outer_reps := DigraphOrbitReps(D); 759 diameter := 0; 760 girth := infinity; 761 762 for i in [1 .. Length(outer_reps)] do 763 v := outer_reps[i]; 764 record := DIGRAPH_ConnectivityDataForVertex(D, v); 765 localGirth := record.localGirth; 766 localDiameter := record.localDiameter; 767 768 if localDiameter > diameter then 769 diameter := localDiameter; 770 fi; 771 772 if localGirth <> -1 and localGirth < girth then 773 girth := localGirth; 774 fi; 775 od; 776 777 # Checks to ensure both components are valid 778 if not IsStronglyConnectedDigraph(D) then 779 diameter := fail; 780 fi; 781 if DigraphHasLoops(D) then 782 girth := 1; 783 elif IsMultiDigraph(D) then 784 girth := 2; 785 fi; 786 787 if IsImmutableDigraph(D) then 788 SetDigraphDiameter(D, diameter); 789 SetDigraphUndirectedGirth(D, girth); 790 fi; 791 return rec(diameter := diameter, girth := girth); 792end); 793 794InstallMethod(DigraphDiameter, "for a digraph", [IsDigraph], 795function(D) 796 if not IsStronglyConnectedDigraph(D) then 797 # Diameter undefined 798 return fail; 799 elif HasDigraphGroup(D) and Size(DigraphGroup(D)) > 1 then 800 # Use the group to calculate the diameter 801 return DIGRAPHS_DiameterAndUndirectedGirth(D).diameter; 802 fi; 803 # Use the C function 804 return DIGRAPH_DIAMETER(D); 805end); 806 807InstallMethod(DigraphUndirectedGirth, "for a digraph", [IsDigraph], 808function(D) 809 # This is only defined on undirected graphs (i.e. symmetric digraphs) 810 if not IsSymmetricDigraph(D) then 811 ErrorNoReturn("the argument <D> must be a symmetric digraph,"); 812 elif DigraphHasLoops(D) then 813 # A loop is a cycle of length 1 814 return 1; 815 elif IsMultiDigraph(D) then 816 # A pair of multiple edges is a cycle of length 2 817 return 2; 818 fi; 819 # Otherwise D is simple 820 return DIGRAPHS_DiameterAndUndirectedGirth(D).girth; 821end); 822 823InstallMethod(DigraphGirth, "for a digraph by out-neighbours", 824[IsDigraphByOutNeighboursRep], 825function(D) 826 local verts, girth, out, dist, i, j; 827 if DigraphHasLoops(D) then 828 return 1; 829 fi; 830 # Only consider one vertex from each orbit 831 if HasDigraphGroup(D) and not IsTrivial(DigraphGroup(D)) then 832 verts := DigraphOrbitReps(D); 833 else 834 verts := DigraphVertices(D); 835 fi; 836 girth := infinity; 837 out := OutNeighbours(D); 838 for i in verts do 839 for j in out[i] do 840 dist := DigraphShortestDistance(D, j, i); 841 # distance [j,i] + 1 equals the cycle length 842 if dist <> fail and dist + 1 < girth then 843 girth := dist + 1; 844 if girth = 2 then 845 return girth; 846 fi; 847 fi; 848 od; 849 od; 850 return girth; 851end); 852 853InstallMethod(DigraphOddGirth, "for a digraph", 854[IsDigraph], 855function(digraph) 856 local comps, girth, oddgirth, A, B, gr, k, comp; 857 858 if IsAcyclicDigraph(digraph) then 859 return infinity; 860 elif IsOddInt(DigraphGirth(digraph)) then 861 # No need to check girth isn't infinity, as we have 862 # that digraph is not acyclic. 863 return DigraphGirth(digraph); 864 fi; 865 comps := DigraphStronglyConnectedComponents(digraph).comps; 866 if Length(comps) > 1 and IsMutableDigraph(digraph) then 867 # Necessary because InducedSubdigraph alters mutable args 868 digraph := DigraphImmutableCopy(digraph); 869 fi; 870 oddgirth := infinity; 871 for comp in comps do 872 if comps > 1 then 873 gr := InducedSubdigraph(digraph, comp); 874 else 875 gr := digraph; 876 # If digraph is strongly connected, then we needn't 877 # induce the subdigraph of its strongly connected comp. 878 fi; 879 if not IsAcyclicDigraph(gr) then 880 girth := DigraphGirth(gr); 881 if IsOddInt(girth) and girth < oddgirth then 882 oddgirth := girth; 883 else 884 k := girth - 1; 885 A := AdjacencyMatrix(gr) ^ k; 886 B := AdjacencyMatrix(gr) ^ 2; 887 while k <= DigraphNrEdges(gr) + 2 and k < DigraphNrVertices(gr) 888 and k < oddgirth - 2 do 889 A := A * B; 890 k := k + 2; 891 if Trace(A) <> 0 then 892 # It suffices to find the trace as the entries of A are positive. 893 oddgirth := k; 894 fi; 895 od; 896 fi; 897 fi; 898 od; 899 900 return oddgirth; 901end); 902 903InstallMethod(DigraphLongestSimpleCircuit, "for a digraph", 904[IsDigraph], 905function(D) 906 local circs, lens, max; 907 if IsAcyclicDigraph(D) then 908 return fail; 909 fi; 910 circs := DigraphAllSimpleCircuits(D); 911 lens := List(circs, Length); 912 max := Maximum(lens); 913 return circs[Position(lens, max)]; 914end); 915 916InstallMethod(DigraphAllSimpleCircuits, "for a digraph by out-neighbours", 917[IsDigraphByOutNeighboursRep], 918function(D) 919 local UNBLOCK, CIRCUIT, out, stack, endofstack, C, scc, n, blocked, B, 920 c_comp, comp, s, loops, i; 921 922 if DigraphNrVertices(D) = 0 or DigraphNrEdges(D) = 0 then 923 return []; 924 fi; 925 926 UNBLOCK := function(u) 927 local w; 928 blocked[u] := false; 929 while not IsEmpty(B[u]) do 930 w := B[u][1]; 931 Remove(B[u], 1); 932 if blocked[w] then 933 UNBLOCK(w); 934 fi; 935 od; 936 end; 937 938 CIRCUIT := function(v, component) 939 local f, buffer, dummy, w; 940 941 f := false; 942 endofstack := endofstack + 1; 943 stack[endofstack] := v; 944 blocked[v] := true; 945 946 for w in OutNeighboursOfVertex(component, v) do 947 if w = 1 then 948 buffer := stack{[1 .. endofstack]}; 949 Add(out, DigraphVertexLabels(component){buffer}); 950 f := true; 951 elif blocked[w] = false then 952 dummy := CIRCUIT(w, component); 953 if dummy then 954 f := true; 955 fi; 956 fi; 957 od; 958 959 if f then 960 UNBLOCK(v); 961 else 962 for w in OutNeighboursOfVertex(component, v) do 963 if not w in B[w] then 964 Add(B[w], v); 965 fi; 966 od; 967 fi; 968 969 endofstack := endofstack - 1; 970 return f; 971 end; 972 973 out := []; 974 stack := []; 975 endofstack := 0; 976 977 # Reduce the D, remove loops, and store the correct vertex labels 978 C := DigraphRemoveLoops(ReducedDigraph(DigraphMutableCopyIfMutable(D))); 979 MakeImmutable(C); 980 if DigraphVertexLabels(D) <> DigraphVertices(D) then 981 SetDigraphVertexLabels(C, Filtered(DigraphVertices(D), 982 x -> OutDegrees(D) <> 0)); 983 fi; 984 985 # Strongly connected components of the reduced graph 986 scc := DigraphStronglyConnectedComponents(C); 987 988 # B and blocked only need to be as long as the longest connected component 989 n := Maximum(List(scc.comps, Length)); 990 blocked := BlistList([1 .. n], []); 991 B := List([1 .. n], x -> []); 992 993 # Perform algorithm once per connected component of the whole digraph 994 for c_comp in scc.comps do 995 n := Length(c_comp); 996 if n = 1 then 997 continue; 998 fi; 999 c_comp := InducedSubdigraph(C, c_comp); # C is definitely immutable 1000 comp := c_comp; 1001 s := 1; 1002 while s < n do 1003 if s <> 1 then 1004 comp := InducedSubdigraph(c_comp, [s .. n]); 1005 comp := InducedSubdigraph(comp, 1006 DigraphStronglyConnectedComponent(comp, 1)); 1007 fi; 1008 1009 if not IsEmptyDigraph(comp) then 1010 # TODO would it be faster/better to create blocked as a new BlistList? 1011 # Are these things already going to be initialised anyway? 1012 for i in DigraphVertices(comp) do 1013 blocked[i] := false; 1014 B[i] := []; 1015 od; 1016 CIRCUIT(1, comp); 1017 fi; 1018 s := s + 1; 1019 od; 1020 od; 1021 loops := List(DigraphLoops(D), x -> [x]); 1022 return Concatenation(loops, out); 1023end); 1024 1025# The following method 'DIGRAPHS_Bipartite' was originally written by Isabella 1026# Scott and then modified by FLS. 1027# It is the backend to IsBipartiteDigraph, Bicomponents, and DigraphColouring 1028# for a 2-colouring 1029 1030InstallMethod(DIGRAPHS_Bipartite, "for a digraph by out-neighbours", 1031[IsDigraphByOutNeighboursRep], 1032function(D) 1033 local n, t, colours, in_nbrs, stack, pop, v, pos, nbrs, w, i; 1034 n := DigraphNrVertices(D); 1035 if n < 2 then 1036 return [false, fail]; 1037 elif IsEmptyDigraph(D) then 1038 t := Concatenation(ListWithIdenticalEntries(n - 1, 1), [2]); 1039 return [true, Transformation(t)]; 1040 fi; 1041 colours := ListWithIdenticalEntries(n, 0); 1042 in_nbrs := InNeighbours(D); 1043 # TODO maybe use stack from DataStructures? 1044 stack := []; 1045 for v in [1 .. n] do 1046 if colours[v] <> 0 then 1047 continue; 1048 fi; 1049 colours[v] := 1; 1050 stack := [[v, 1]]; 1051 while Length(stack) > 0 do 1052 pop := Remove(stack); 1053 v := pop[1]; 1054 pos := pop[2]; 1055 nbrs := Concatenation(OutNeighboursOfVertex(D, v), in_nbrs[v]); 1056 for i in [pos .. Length(nbrs)] do 1057 w := nbrs[i]; 1058 if colours[w] <> 0 then 1059 if colours[w] = colours[v] then 1060 return [false, fail]; 1061 fi; 1062 else 1063 colours[w] := colours[v] mod 2 + 1; 1064 Append(stack, [[v, i + 1], [w, 1]]); 1065 continue; 1066 fi; 1067 od; 1068 od; 1069 od; 1070 return [true, Transformation(colours)]; 1071end); 1072 1073InstallMethod(DigraphBicomponents, "for a digraph", [IsDigraph], 1074function(D) 1075 local b; 1076 1077 # Attribute only applies to bipartite digraphs 1078 if not IsBipartiteDigraph(D) then 1079 return fail; 1080 fi; 1081 b := KernelOfTransformation(DIGRAPHS_Bipartite(D)[2], 1082 DigraphNrVertices(D)); 1083 return b; 1084end); 1085 1086InstallMethod(DigraphLoops, "for a digraph by out-neighbours", 1087[IsDigraphByOutNeighboursRep], 1088function(D) 1089 if HasDigraphHasLoops(D) and not DigraphHasLoops(D) then 1090 return []; 1091 fi; 1092 return Filtered(DigraphVertices(D), x -> x in OutNeighboursOfVertex(D, x)); 1093end); 1094 1095InstallMethod(DigraphDegeneracy, "for a digraph", [IsDigraph], 1096function(D) 1097 if not IsSymmetricDigraph(D) or IsMultiDigraph(D) then 1098 ErrorNoReturn("the argument <D> must be a symmetric digraph ", 1099 "with no multiple edges,"); 1100 fi; 1101 return DIGRAPHS_Degeneracy(DigraphRemoveLoops(D))[1]; 1102end); 1103 1104InstallMethod(DigraphDegeneracyOrdering, "for a digraph", [IsDigraph], 1105function(D) 1106 if not IsSymmetricDigraph(D) or IsMultiDigraph(D) then 1107 ErrorNoReturn("the argument <D> must be a symmetric digraph ", 1108 "with no multiple edges,"); 1109 fi; 1110 return DIGRAPHS_Degeneracy(DigraphRemoveLoops(D))[2]; 1111end); 1112 1113InstallMethod(DIGRAPHS_Degeneracy, "for a digraph by out-neighbours", 1114[IsDigraphByOutNeighboursRep], 1115function(D) 1116 local nbs, n, out, deg_vert, m, verts_deg, k, i, v, d, w; 1117 1118 # The code assumes undirected, no multiple edges, no loops 1119 nbs := OutNeighbours(D); 1120 n := DigraphNrVertices(D); 1121 out := EmptyPlist(n); 1122 deg_vert := ShallowCopy(OutDegrees(D)); 1123 m := Maximum(deg_vert); 1124 verts_deg := List([1 .. m], x -> []); 1125 1126 # Prepare the set verts_deg 1127 for v in DigraphVertices(D) do 1128 if deg_vert[v] = 0 then 1129 Add(out, v); 1130 else 1131 Add(verts_deg[deg_vert[v]], v); 1132 fi; 1133 od; 1134 1135 k := 0; 1136 while Length(out) < n do 1137 i := First([1 .. m], x -> not IsEmpty(verts_deg[x])); 1138 k := Maximum(k, i); 1139 v := Remove(verts_deg[i]); 1140 Add(out, v); 1141 for w in Difference(nbs[v], out) do 1142 d := deg_vert[w]; 1143 Remove(verts_deg[d], Position(verts_deg[d], w)); 1144 d := d - 1; 1145 deg_vert[w] := d; 1146 if d = 0 then 1147 Add(out, w); 1148 else 1149 Add(verts_deg[d], w); 1150 fi; 1151 od; 1152 od; 1153 1154 return [k, out]; 1155end); 1156 1157InstallMethod(DegreeMatrix, "for a digraph", [IsDigraph], 1158function(D) 1159 if DigraphNrVertices(D) = 0 then 1160 return []; 1161 fi; 1162 return DiagonalMat(OutDegrees(D)); 1163end); 1164 1165InstallMethod(LaplacianMatrix, "for a digraph", [IsDigraph], 1166D -> DegreeMatrix(D) - AdjacencyMatrix(D)); 1167 1168InstallMethod(NrSpanningTrees, "for a digraph", [IsDigraph], 1169function(D) 1170 local mat, n; 1171 if not IsSymmetricDigraph(D) then 1172 ErrorNoReturn("the argument <D> must be a symmetric digraph,"); 1173 fi; 1174 1175 n := DigraphNrVertices(D); 1176 if n = 0 then 1177 return 0; 1178 elif n = 1 then 1179 return 1; 1180 fi; 1181 1182 mat := LaplacianMatrix(D); 1183 mat := mat{[1 .. n - 1]}{[1 .. n - 1]}; 1184 return Determinant(mat); 1185end); 1186 1187InstallMethod(HamiltonianPath, "for a digraph", [IsDigraph], 1188function(D) 1189 local path, iter, n; 1190 1191 if DigraphNrVertices(D) <= 1 and IsEmptyDigraph(D) then 1192 if DigraphNrVertices(D) = 0 then 1193 return []; 1194 else 1195 return [1]; 1196 fi; 1197 elif not IsStronglyConnectedDigraph(D) then 1198 return fail; 1199 fi; 1200 1201 if DigraphNrVertices(D) < 256 then 1202 path := DigraphMonomorphism(CycleDigraph(DigraphNrVertices(D)), D); 1203 if path = fail then 1204 return fail; 1205 fi; 1206 return ImageListOfTransformation(path, DigraphNrVertices(D)); 1207 fi; 1208 1209 iter := IteratorOfPaths(D, 1, 1); 1210 n := DigraphNrVertices(D) + 1; 1211 while not IsDoneIterator(iter) do 1212 path := NextIterator(iter)[1]; 1213 if Length(path) = n then 1214 return path; 1215 fi; 1216 od; 1217 return fail; 1218end); 1219 1220InstallMethod(DigraphCore, "for a digraph", 1221[IsDigraph], 1222function(digraph) 1223 local N, lo, topdown, bottomup, hom, lo_var, image, 1224 comps, comp, cores, D, in_core, n, m, L, i; 1225 digraph := DigraphImmutableCopy(digraph); 1226 # copy is necessary so can change vertex labels in function 1227 N := DigraphNrVertices(digraph); 1228 if IsEmptyDigraph(digraph) then 1229 if N >= 1 then 1230 return [1]; 1231 fi; 1232 return []; 1233 fi; 1234 SetDigraphVertexLabels(digraph, [1 .. N]); 1235 digraph := ReducedDigraph(digraph); # isolated verts are not in core 1236 N := DigraphNrVertices(digraph); 1237 if DigraphHasLoops(digraph) then 1238 i := First(DigraphVertices(digraph), 1239 i -> i in OutNeighboursOfVertex(digraph, i)); 1240 return [DigraphVertexLabel(digraph, i)]; 1241 elif IsCompleteDigraph(digraph) then 1242 return DigraphVertexLabels(digraph); 1243 elif IsSymmetricDigraph(digraph) and IsBipartiteDigraph(digraph) then 1244 i := First(DigraphVertices(digraph), 1245 i -> OutDegreeOfVertex(digraph, i) > 0); 1246 return DigraphVertexLabels(digraph){ 1247 [i, OutNeighboursOfVertex(digraph, i)[1]]}; 1248 elif not IsConnectedDigraph(digraph) then 1249 comps := DigraphConnectedComponents(digraph).comps; 1250 cores := []; 1251 for comp in comps do 1252 D := InducedSubdigraph(digraph, comp); 1253 D := InducedSubdigraph(D, DigraphCore(D)); 1254 Add(cores, D); 1255 od; 1256 L := Length(cores); 1257 in_core := ListWithIdenticalEntries(L, true); 1258 n := 1; 1259 while n <= L do 1260 if n <> L then 1261 m := n + 1; 1262 else 1263 m := 1; 1264 fi; 1265 while m <> n and in_core[n] do 1266 if in_core[m] and DigraphHomomorphism(cores[m], cores[n]) <> fail then 1267 in_core[m] := false; 1268 fi; 1269 if m < L then 1270 m := m + 1; 1271 else 1272 m := 1; 1273 fi; 1274 od; 1275 n := n + 1; 1276 od; 1277 cores := ListBlist(cores, in_core); 1278 return Union(List(cores, DigraphVertexLabels)); 1279 elif IsDigraphCore(digraph) then 1280 return DigraphVertexLabels(digraph); 1281 fi; 1282 1283 lo := function(D) # lower bound on core size 1284 local oddgirth; 1285 oddgirth := DigraphOddGirth(D); 1286 if oddgirth <> infinity then 1287 return oddgirth; 1288 fi; 1289 return 3; 1290 end; 1291 1292 hom := []; 1293 lo_var := lo(digraph); 1294 bottomup := lo_var; 1295 N := DigraphNrVertices(digraph); 1296 topdown := N; 1297 1298 while topdown >= bottomup do 1299 HomomorphismDigraphsFinder(digraph, # domain copy 1300 digraph, # range copy 1301 fail, # hook 1302 hom, # user_param 1303 1, # max_results 1304 bottomup, # hint (i.e. rank) 1305 false, # injective 1306 DigraphVertices(digraph), # image 1307 [], # partial_map 1308 fail, # colors1 1309 fail); # colors2 1310 1311 if Length(hom) = 1 then 1312 return DigraphVertexLabels(digraph){ImageSetOfTransformation(hom[1], N)}; 1313 fi; 1314 1315 HomomorphismDigraphsFinder(digraph, # domain copy 1316 digraph, # range copy 1317 fail, # hook 1318 hom, # user_param 1319 1, # max_results 1320 topdown, # hint (i.e. rank) 1321 false, # injective 1322 DigraphVertices(digraph), # image 1323 [], # partial_map 1324 fail, # colors1 1325 fail); # colors2 1326 1327 if Length(hom) = 1 then 1328 image := ImageSetOfTransformation(hom[1], N); 1329 digraph := InducedSubdigraph(digraph, image); 1330 N := DigraphNrVertices(digraph); 1331 lo_var := lo(digraph); 1332 Unbind(hom[1]); 1333 fi; 1334 1335 topdown := Minimum(topdown - 1, N); 1336 bottomup := Maximum(bottomup + 1, lo_var); 1337 1338 od; 1339 return DigraphVertexLabels(digraph); 1340end); 1341 1342InstallMethod(CharacteristicPolynomial, "for a digraph", [IsDigraph], 1343D -> CharacteristicPolynomial(AdjacencyMatrix(D))); 1344 1345InstallMethod(IsVertexTransitive, "for a digraph", [IsDigraph], 1346D -> IsTransitive(AutomorphismGroup(D), DigraphVertices(D))); 1347 1348InstallMethod(IsEdgeTransitive, "for a digraph", [IsDigraph], 1349function(D) 1350 if IsMultiDigraph(D) then 1351 ErrorNoReturn("the argument <D> must be a digraph with no multiple", 1352 " edges,"); 1353 fi; 1354 return IsTransitive(AutomorphismGroup(D), DigraphEdges(D), OnPairs); 1355end); 1356 1357# Things that are attributes for immutable digraphs, but operations for mutable. 1358 1359# Don't use InstallMethodThatReturnsDigraph since we can do better in this case. 1360InstallMethod(DigraphReverse, "for a digraph by out-neighbours", 1361[IsDigraphByOutNeighboursRep], 1362function(D) 1363 local inn, C; 1364 if IsSymmetricDigraph(D) then 1365 return D; 1366 fi; 1367 inn := InNeighboursMutableCopy(D); 1368 if IsImmutableDigraph(D) then 1369 C := ConvertToImmutableDigraphNC(inn); 1370 SetDigraphVertexLabels(C, StructuralCopy(DigraphVertexLabels(D))); 1371 SetInNeighbours(C, OutNeighbours(D)); 1372 SetDigraphReverseAttr(D, C); 1373 return C; 1374 fi; 1375 D!.OutNeighbours := inn; 1376 ClearDigraphEdgeLabels(D); 1377 return D; 1378end); 1379 1380InstallMethodThatReturnsDigraph(DigraphDual, "for a digraph by out-neighbours", 1381[IsDigraphByOutNeighboursRep], 1382function(D) 1383 local nodes, C, list, i; 1384 if IsMultiDigraph(D) then 1385 ErrorNoReturn("the argument <D> must be a digraph with no multiple ", 1386 "edges,"); 1387 fi; 1388 1389 nodes := DigraphVertices(D); 1390 1391 C := DigraphMutableCopyIfImmutable(D); 1392 list := C!.OutNeighbours; 1393 for i in nodes do 1394 list[i] := DifferenceLists(nodes, list[i]); 1395 od; 1396 ClearDigraphEdgeLabels(C); 1397 if IsImmutableDigraph(D) then 1398 MakeImmutable(C); 1399 if HasDigraphGroup(D) then 1400 SetDigraphGroup(C, DigraphGroup(D)); 1401 fi; 1402 # TODO WW: Could preserve some further properties/attributes too 1403 fi; 1404 return C; 1405end); 1406 1407InstallMethodThatReturnsDigraph(ReducedDigraph, 1408"for a digraph by out-neighbours", 1409[IsDigraphByOutNeighboursRep], 1410function(D) 1411 local v, niv, old, C, i; 1412 if IsConnectedDigraph(D) then 1413 return D; 1414 fi; 1415 1416 v := DigraphVertices(D); 1417 niv := BlistList(v, []); 1418 old := OutNeighbours(D); 1419 1420 # First find the non-isolated vertices 1421 for i in [1 .. Length(old)] do 1422 if not IsEmpty(old[i]) then 1423 niv[i] := true; 1424 UniteBlistList(v, niv, old[i]); 1425 fi; 1426 od; 1427 C := InducedSubdigraph(D, ListBlist(v, niv)); 1428 return C; 1429end); 1430 1431InstallMethod(DigraphRemoveAllMultipleEdges, 1432"for a mutable digraph by out-neighbours", 1433[IsMutableDigraph and IsDigraphByOutNeighboursRep], 1434function(D) 1435 local nodes, list, empty, seen, keep, v, u, pos; 1436 1437 nodes := DigraphVertices(D); 1438 list := D!.OutNeighbours; 1439 empty := BlistList(nodes, []); 1440 seen := BlistList(nodes, []); 1441 for u in nodes do 1442 keep := []; 1443 for pos in [1 .. Length(list[u])] do 1444 v := list[u][pos]; 1445 if not seen[v] then 1446 seen[v] := true; 1447 Add(keep, pos); 1448 fi; 1449 od; 1450 list[u] := list[u]{keep}; 1451 IntersectBlist(seen, empty); 1452 od; 1453 # Multidigraphs did not have edge labels 1454 SetDigraphVertexLabels(D, DigraphVertexLabels(D)); 1455 return D; 1456end); 1457 1458InstallMethodThatReturnsDigraph(DigraphRemoveAllMultipleEdges, 1459"for an immutable digraph", 1460[IsImmutableDigraph], 1461function(D) 1462 if IsMultiDigraph(D) then 1463 D := MakeImmutable(DigraphRemoveAllMultipleEdges(DigraphMutableCopy(D))); 1464 SetIsMultiDigraph(D, false); 1465 fi; 1466 return D; 1467end); 1468 1469InstallMethod(DigraphAddAllLoops, "for a digraph by out-neighbours", 1470[IsDigraphByOutNeighboursRep], 1471function(D) 1472 local ismulti, C, list, v; 1473 if HasIsReflexiveDigraph(D) and IsReflexiveDigraph(D) then 1474 return D; 1475 fi; 1476 ismulti := IsMultiDigraph(D); 1477 C := DigraphMutableCopyIfImmutable(D); 1478 list := C!.OutNeighbours; 1479 Assert(1, IsMutable(list)); 1480 for v in DigraphVertices(C) do 1481 if not v in list[v] then 1482 Add(list[v], v); 1483 if not ismulti then 1484 SetDigraphEdgeLabel(C, v, v, 1); 1485 fi; 1486 fi; 1487 od; 1488 if IsImmutableDigraph(D) then 1489 MakeImmutable(C); 1490 SetDigraphAddAllLoopsAttr(D, C); 1491 SetIsReflexiveDigraph(C, true); 1492 SetIsMultiDigraph(C, ismulti); 1493 SetDigraphHasLoops(C, DigraphNrVertices(C) > 0); 1494 fi; 1495 return C; 1496end); 1497 1498InstallMethod(DigraphAddAllLoops, "for a digraph with known add-all-loops", 1499[IsDigraph and HasDigraphAddAllLoopsAttr], SUM_FLAGS, DigraphAddAllLoopsAttr); 1500 1501InstallMethod(DigraphAddAllLoopsAttr, "for an immutable digraph", 1502[IsImmutableDigraph], DigraphAddAllLoops); 1503 1504InstallMethod(DigraphRemoveLoops, "for a digraph by out-neighbours", 1505[IsDigraphByOutNeighboursRep], 1506function(D) 1507 local C, out, lbl, pos, v; 1508 C := DigraphMutableCopyIfImmutable(D); 1509 out := C!.OutNeighbours; 1510 lbl := DigraphEdgeLabelsNC(C); 1511 for v in DigraphVertices(C) do 1512 pos := Position(out[v], v); 1513 while pos <> fail do 1514 Remove(out[v], pos); 1515 Remove(lbl[v], pos); 1516 pos := Position(out[v], v); 1517 od; 1518 od; 1519 if IsImmutableDigraph(D) then 1520 MakeImmutable(C); 1521 SetDigraphRemoveLoopsAttr(D, C); 1522 SetDigraphHasLoops(C, false); 1523 fi; 1524 return C; 1525end); 1526 1527InstallMethod(DigraphRemoveLoops, "for a digraph with stored result", 1528[IsDigraph and HasDigraphRemoveLoopsAttr], SUM_FLAGS, DigraphRemoveLoopsAttr); 1529 1530InstallMethod(DigraphRemoveLoopsAttr, "for an immutable digraph", 1531[IsImmutableDigraph], DigraphRemoveLoops); 1532 1533# TODO (FLS): I've just added 1 as the edge label here, is this really desired? 1534InstallMethod(DigraphSymmetricClosure, "for a digraph by out-neighbours", 1535[IsDigraphByOutNeighboursRep], 1536function(D) 1537 local n, m, verts, C, mat, out, x, i, j, k; 1538 1539 n := DigraphNrVertices(D); 1540 if n <= 1 or IsSymmetricDigraph(D) then 1541 return D; 1542 fi; 1543 1544 # The average degree 1545 m := Float(Sum(OutDegreeSequence(D)) / n); 1546 verts := [1 .. n]; # We don't want DigraphVertices as that's immutable 1547 1548 if IsMultiDigraph(D) then 1549 C := DigraphMutableCopyIfImmutable(D); 1550 mat := List(verts, x -> verts * 0); 1551 out := C!.OutNeighbours; 1552 1553 for i in verts do 1554 for j in out[i] do 1555 if j < i then 1556 mat[j][i] := mat[j][i] - 1; 1557 else 1558 mat[i][j] := mat[i][j] + 1; 1559 fi; 1560 od; 1561 od; 1562 for i in verts do 1563 for j in [i + 1 .. n] do 1564 x := mat[i][j]; 1565 if x > 0 then 1566 for k in [1 .. x] do 1567 Add(out[j], i); 1568 od; 1569 elif x < 0 then 1570 for k in [1 .. -x] do 1571 Add(out[i], j); 1572 od; 1573 fi; 1574 od; 1575 od; 1576 # The approximate complexity of using the adjacency matrix (first method) 1577 # is n * (n - 1) / 2, and that of repeatedly calling AddSet (second method) 1578 # is n * m * log2(m) where m is the mean degree of any vertex. Some 1579 # experimenting showed that the comparison below is a reasonable way to 1580 # decide which method to use. 1581 elif Float(n * (n - 1) / 2) < n * m * Log2(m) then 1582 # If we have no multiple edges, then we use a Boolean matrix because it 1583 # uses less space. 1584 mat := BooleanAdjacencyMatrixMutableCopy(D); 1585 for i in verts do 1586 for j in [i + 1 .. n] do 1587 if mat[i][j] <> mat[j][i] then 1588 mat[i][j] := true; 1589 mat[j][i] := true; 1590 fi; 1591 od; 1592 od; 1593 out := List(mat, row -> ListBlist(verts, row)); 1594 if IsImmutableDigraph(D) then 1595 C := ConvertToImmutableDigraphNC(out); 1596 else 1597 C := D; 1598 C!.OutNeighbours := out; 1599 fi; 1600 else 1601 C := DigraphMutableCopyIfImmutable(D); 1602 out := C!.OutNeighbours; 1603 Perform(out, Sort); 1604 for i in [1 .. n] do 1605 for j in out[i] do 1606 if not i in out[j] then 1607 AddSet(out[j], i); 1608 fi; 1609 od; 1610 od; 1611 fi; 1612 ClearDigraphEdgeLabels(C); 1613 if IsImmutableDigraph(D) then 1614 MakeImmutable(C); 1615 SetDigraphSymmetricClosureAttr(D, C); 1616 SetIsSymmetricDigraph(C, true); 1617 fi; 1618 return C; 1619end); 1620 1621InstallMethod(DigraphSymmetricClosure, 1622"for a digraph with known symmetric closure", 1623[IsDigraph and HasDigraphSymmetricClosureAttr], SUM_FLAGS, 1624DigraphSymmetricClosureAttr); 1625 1626InstallMethod(DigraphSymmetricClosureAttr, "for an immutable digraph", 1627[IsImmutableDigraph], DigraphSymmetricClosure); 1628 1629InstallMethod(MaximalSymmetricSubdigraph, "for a digraph by out-neighbours", 1630[IsDigraphByOutNeighboursRep], 1631function(D) 1632 local C, inn, out, i; 1633 1634 # Remove multiple edges if present 1635 if IsMultiDigraph(D) then 1636 if HasDigraphRemoveAllMultipleEdgesAttr(D) then 1637 C := DigraphMutableCopy(DigraphRemoveAllMultipleEdges(D)); 1638 else 1639 C := DigraphRemoveAllMultipleEdges(DigraphMutableCopyIfImmutable(D)); 1640 fi; 1641 else 1642 C := D; 1643 fi; 1644 1645 if not IsSymmetricDigraph(C) then 1646 # C is still immutable here if <D> is immutable and not a multidigraph 1647 inn := InNeighbours(C); 1648 C := DigraphMutableCopyIfImmutable(C); 1649 out := C!.OutNeighbours; 1650 for i in DigraphVertices(C) do 1651 Sort(out[i]); 1652 IntersectSet(out[i], inn[i]); 1653 od; 1654 fi; 1655 1656 ClearDigraphEdgeLabels(C); 1657 if IsImmutableDigraph(D) then 1658 MakeImmutable(C); 1659 SetMaximalSymmetricSubdigraphAttr(D, C); 1660 SetIsSymmetricDigraph(C, true); 1661 SetIsMultiDigraph(C, false); 1662 fi; 1663 return C; 1664end); 1665 1666InstallMethod(MaximalSymmetricSubdigraph, 1667"for a digraph with known maximal symmetric subdigraph", 1668[IsDigraph and HasMaximalSymmetricSubdigraphAttr], SUM_FLAGS, 1669MaximalSymmetricSubdigraphAttr); 1670 1671InstallMethod(MaximalSymmetricSubdigraphAttr, "for an immutable digraph", 1672[IsImmutableDigraph], MaximalSymmetricSubdigraph); 1673 1674InstallMethod(MaximalSymmetricSubdigraphWithoutLoops, "for a mutable digraph", 1675[IsMutableDigraph], 1676D -> DigraphRemoveLoops(MaximalSymmetricSubdigraph(D))); 1677 1678InstallMethod(MaximalSymmetricSubdigraphWithoutLoops, 1679"for an immutable digraph", 1680[IsImmutableDigraph], MaximalSymmetricSubdigraphWithoutLoopsAttr); 1681 1682InstallMethod(MaximalSymmetricSubdigraphWithoutLoopsAttr, 1683"for an immutable digraph", 1684[IsImmutableDigraph], 1685function(D) 1686 if HasMaximalSymmetricSubdigraphAttr(D) then 1687 D := DigraphRemoveLoops(MaximalSymmetricSubdigraph(D)); 1688 else 1689 D := DigraphMutableCopy(D); 1690 D := MakeImmutable(MaximalSymmetricSubdigraphWithoutLoops(D)); 1691 fi; 1692 SetDigraphHasLoops(D, false); 1693 SetIsSymmetricDigraph(D, true); 1694 SetIsMultiDigraph(D, false); 1695 return D; 1696end); 1697 1698InstallMethod(MaximalAntiSymmetricSubdigraph, "for a digraph by out-neighbours", 1699[IsDigraphByOutNeighboursRep], 1700function(D) 1701 local n, C, m, out, pos, j, i, k; 1702 1703 n := DigraphNrVertices(D); 1704 if not IsMultiDigraph(D) and IsAntisymmetricDigraph(D) then 1705 return D; 1706 elif IsMultiDigraph(D) then 1707 if HasDigraphRemoveAllMultipleEdgesAttr(D) then 1708 C := DigraphMutableCopy(DigraphRemoveAllMultipleEdges(D)); 1709 else 1710 C := DigraphRemoveAllMultipleEdges(DigraphMutableCopyIfImmutable(D)); 1711 fi; 1712 else 1713 C := DigraphMutableCopyIfImmutable(D); 1714 fi; 1715 1716 # The average degree 1717 m := Float(Sum(OutDegreeSequence(C)) / n); 1718 1719 if Float(n * (n - 1) / 2) < n * m * Log2(m) then 1720 # The approximate complexity of using the adjacency matrix (first method) 1721 # is n * (n - 1) / 2, and that of repeatedly calling AddSet (second method) 1722 # is n * m * log2(m) where m is the mean degree of any vertex. Some 1723 # experimenting showed that the comparison below is a reasonable way to 1724 # decide which method to use. 1725 out := BooleanAdjacencyMatrixMutableCopy(C); 1726 for i in [1 .. n] do 1727 for j in [i + 1 .. n] do 1728 if out[i][j] then 1729 out[j][i] := false; 1730 fi; 1731 od; 1732 od; 1733 C!.OutNeighbours := List([1 .. n], v -> ListBlist([1 .. n], out[v])); 1734 else 1735 out := C!.OutNeighbours; 1736 Perform(out, Sort); 1737 for i in [1 .. n] do 1738 # For all edges i -> j with i < j, (try to) remove the edge j -> i. 1739 pos := PositionSorted(out[i], i); 1740 if pos > Length(out[i]) then 1741 continue; 1742 elif out[i][pos] = i then 1743 pos := pos + 1; 1744 fi; 1745 for k in [pos .. Length(out[i])] do 1746 j := out[i][k]; 1747 RemoveSet(out[j], i); 1748 od; 1749 od; 1750 fi; 1751 ClearDigraphEdgeLabels(C); 1752 if IsMutableDigraph(D) then 1753 return C; 1754 fi; 1755 MakeImmutable(C); 1756 SetIsAntisymmetricDigraph(C, true); 1757 SetIsMultiDigraph(C, false); 1758 SetMaximalAntiSymmetricSubdigraphAttr(D, C); 1759 return C; 1760end); 1761 1762InstallMethod(MaximalAntiSymmetricSubdigraph, 1763"for a digraph with known maximal antisymmetric subdigraph", 1764[IsDigraph and HasMaximalAntiSymmetricSubdigraphAttr], SUM_FLAGS, 1765MaximalAntiSymmetricSubdigraphAttr); 1766 1767InstallMethod(MaximalAntiSymmetricSubdigraphAttr, "for an immutable digraph", 1768[IsImmutableDigraph], MaximalAntiSymmetricSubdigraph); 1769 1770InstallMethod(DigraphTransitiveClosure, 1771"for a mutable digraph by out-neighbours", 1772[IsMutableDigraph and IsDigraphByOutNeighboursRep], 1773function(D) 1774 local list, m, n, nodes, sorted, trans, tmp, mat, v, u, i; 1775 1776 if IsMultiDigraph(D) then 1777 ErrorNoReturn("the argument <D> must be a digraph with no multiple ", 1778 "edges,"); 1779 fi; 1780 1781 list := D!.OutNeighbours; 1782 m := DigraphNrEdges(D); 1783 n := DigraphNrVertices(D); 1784 nodes := DigraphVertices(D); 1785 1786 ClearDigraphEdgeLabels(D); 1787 # Try correct method vis-a-vis complexity 1788 if m + n + (m * n) < n ^ 3 then 1789 sorted := DigraphTopologicalSort(D); 1790 if sorted <> fail then # Method for big acyclic digraphs (loops allowed) 1791 trans := EmptyPlist(n); 1792 for v in sorted do 1793 trans[v] := BlistList(nodes, [v]); 1794 for u in list[v] do 1795 trans[v] := UnionBlist(trans[v], trans[u]); 1796 od; 1797 # TODO use FlipBlist 1798 tmp := DifferenceBlist(trans[v], BlistList(nodes, list[v])); 1799 tmp[v] := false; 1800 Append(list[v], ListBlist(nodes, tmp)); 1801 od; 1802 return D; 1803 fi; 1804 fi; 1805 # Method for small or non-acyclic digraphs 1806 mat := DIGRAPH_TRANS_CLOSURE(D); 1807 for i in [1 .. Length(list)] do 1808 list[i] := nodes{PositionsProperty(mat[i], x -> x > 0)}; 1809 od; 1810 return D; 1811end); 1812 1813InstallMethod(DigraphTransitiveClosure, "for an immutable digraph", 1814[IsImmutableDigraph], DigraphTransitiveClosureAttr); 1815 1816InstallMethod(DigraphTransitiveClosureAttr, "for an immutable digraph", 1817[IsImmutableDigraph], 1818function(D) 1819 local C; 1820 if IsMultiDigraph(D) then 1821 ErrorNoReturn("the argument <D> must be a digraph with no multiple ", 1822 "edges,"); 1823 fi; 1824 C := MakeImmutable(DigraphTransitiveClosure(DigraphMutableCopy(D))); 1825 SetIsTransitiveDigraph(C, true); 1826 SetIsMultiDigraph(C, false); 1827 return C; 1828end); 1829 1830InstallMethod(DigraphReflexiveTransitiveClosure, "for a digraph", 1831[IsDigraph], 1832function(D) 1833 local C; 1834 if IsMultiDigraph(D) then 1835 ErrorNoReturn("the argument <D> must be a digraph with no multiple ", 1836 "edges,"); 1837 elif HasDigraphTransitiveClosureAttr(D) then 1838 C := DigraphAddAllLoops(DigraphTransitiveClosure(D)); 1839 else 1840 C := DigraphMutableCopyIfImmutable(D); 1841 DigraphAddAllLoops(DigraphTransitiveClosure(C)); 1842 fi; 1843 1844 if IsMutableDigraph(D) then 1845 return C; 1846 fi; 1847 MakeImmutable(C); 1848 SetDigraphReflexiveTransitiveClosureAttr(D, C); 1849 SetIsTransitiveDigraph(C, true); 1850 SetIsReflexiveDigraph(C, true); 1851 SetIsMultiDigraph(C, false); 1852 return C; 1853end); 1854 1855InstallMethod(DigraphReflexiveTransitiveClosure, 1856"for a digraph with known reflexive transitive closure", 1857[IsDigraph and HasDigraphReflexiveTransitiveClosureAttr], SUM_FLAGS, 1858DigraphReflexiveTransitiveClosureAttr); 1859 1860InstallMethod(DigraphReflexiveTransitiveClosureAttr, "for an immutable digraph", 1861[IsImmutableDigraph], DigraphReflexiveTransitiveClosure); 1862 1863InstallMethod(DigraphTransitiveReduction, "for a digraph by out-neighbours", 1864[IsDigraphByOutNeighboursRep], 1865function(D) 1866 local topo, p, C; 1867 if IsMultiDigraph(D) then 1868 ErrorNoReturn("the argument <D> must be a digraph with no ", 1869 "multiple edges,"); 1870 elif DigraphTopologicalSort(D) = fail then 1871 ErrorNoReturn("not yet implemented for non-topologically sortable ", 1872 "digraphs,"); 1873 fi; 1874 topo := DigraphTopologicalSort(D); 1875 p := Permutation(Transformation(topo), topo); 1876 1877 C := DigraphMutableCopyIfImmutable(D); 1878 OnDigraphs(C, p ^ -1); # changes C in-place 1879 DIGRAPH_TRANS_REDUCTION(C); # changes C in-place 1880 ClearDigraphEdgeLabels(C); 1881 OnDigraphs(C, p); # changes C in-place 1882 if IsImmutableDigraph(D) then 1883 MakeImmutable(C); 1884 SetDigraphTransitiveReductionAttr(D, C); 1885 SetIsMultiDigraph(C, false); 1886 fi; 1887 return C; 1888end); 1889 1890InstallMethod(DigraphTransitiveReduction, 1891"for a digraph with known transitive reduction", 1892[IsDigraph and HasDigraphTransitiveReductionAttr], SUM_FLAGS, 1893DigraphTransitiveReductionAttr); 1894 1895InstallMethod(DigraphTransitiveReductionAttr, "for an immutable digraph", 1896[IsImmutableDigraph], DigraphTransitiveReduction); 1897 1898# For a topologically sortable digraph G, this returns the least subgraph G' 1899# of G such that the (reflexive) transitive closures of G and G' are equal. 1900InstallMethod(DigraphReflexiveTransitiveReduction, 1901"for a digraph by out-neighbours", 1902[IsDigraphByOutNeighboursRep], 1903function(D) 1904 local C; 1905 if IsMultiDigraph(D) then 1906 ErrorNoReturn("the argument <D> must be a digraph with no ", 1907 "multiple edges,"); 1908 elif DigraphTopologicalSort(D) = fail then 1909 ErrorNoReturn("not yet implemented for non-topologically sortable ", 1910 "digraphs,"); 1911 elif IsNullDigraph(D) then 1912 return D; 1913 elif HasDigraphRemoveLoopsAttr(D) then 1914 C := DigraphMutableCopy(DigraphRemoveLoops(D)); 1915 else 1916 C := DigraphRemoveLoops(DigraphMutableCopyIfImmutable(D)); 1917 fi; 1918 DigraphTransitiveReduction(C); 1919 if IsImmutableDigraph(D) then 1920 MakeImmutable(C); 1921 SetDigraphReflexiveTransitiveReductionAttr(D, C); 1922 SetIsReflexiveDigraph(C, false); 1923 SetDigraphHasLoops(C, false); 1924 SetIsMultiDigraph(C, false); 1925 fi; 1926 return C; 1927end); 1928 1929InstallMethod(DigraphReflexiveTransitiveReduction, 1930"for a digraph with known reflexive transitive reduction", 1931[IsDigraph and HasDigraphReflexiveTransitiveReductionAttr], SUM_FLAGS, 1932DigraphReflexiveTransitiveReductionAttr); 1933 1934InstallMethod(DigraphReflexiveTransitiveReductionAttr, 1935"for an immutable digraph", 1936[IsImmutableDigraph], DigraphReflexiveTransitiveReduction); 1937 1938InstallMethod(UndirectedSpanningForest, "for a digraph by out-neighbours", 1939[IsDigraphByOutNeighboursRep], 1940function(D) 1941 local C; 1942 if DigraphNrVertices(D) = 0 then 1943 return fail; 1944 fi; 1945 C := MaximalSymmetricSubdigraph(D)!.OutNeighbours; 1946 C := DIGRAPH_SYMMETRIC_SPANNING_FOREST(C); 1947 if IsMutableDigraph(D) then 1948 D!.OutNeighbours := C; 1949 ClearDigraphEdgeLabels(D); 1950 return D; 1951 fi; 1952 C := ConvertToImmutableDigraphNC(C); 1953 SetUndirectedSpanningForestAttr(D, C); 1954 SetIsUndirectedForest(C, true); 1955 SetIsMultiDigraph(C, false); 1956 SetDigraphHasLoops(C, false); 1957 return C; 1958end); 1959 1960InstallMethod(UndirectedSpanningForest, 1961"for a digraph with known undirected spanning forest", 1962[IsDigraph and HasUndirectedSpanningForestAttr], SUM_FLAGS, 1963UndirectedSpanningForestAttr); 1964 1965InstallMethod(UndirectedSpanningForestAttr, "for an immutable digraph", 1966[IsImmutableDigraph], UndirectedSpanningForest); 1967 1968InstallMethod(UndirectedSpanningTree, "for a mutable digraph", 1969[IsMutableDigraph], 1970function(D) 1971 if DigraphNrVertices(D) = 0 1972 or not IsStronglyConnectedDigraph(D) 1973 or not IsConnectedDigraph(UndirectedSpanningForest(DigraphMutableCopy(D))) 1974 then 1975 return fail; 1976 fi; 1977 return UndirectedSpanningForest(D); 1978end); 1979 1980InstallMethod(UndirectedSpanningTree, "for an immutable digraph", 1981[IsImmutableDigraph], UndirectedSpanningTreeAttr); 1982 1983InstallMethod(UndirectedSpanningTreeAttr, "for an immutable digraph", 1984[IsImmutableDigraph], 1985function(D) 1986 if DigraphNrVertices(D) = 0 1987 or not IsStronglyConnectedDigraph(D) 1988 or (HasMaximalSymmetricSubdigraphAttr(D) 1989 and not IsStronglyConnectedDigraph(MaximalSymmetricSubdigraph(D))) 1990 or (DigraphNrEdges(UndirectedSpanningForest(D)) 1991 <> 2 * (DigraphNrVertices(D) - 1)) then 1992 return fail; 1993 fi; 1994 return UndirectedSpanningForest(D); 1995end); 1996 1997InstallMethod(DigraphMycielskian, "for a digraph", 1998[IsDigraph], 1999function(D) 2000 local n, C, i, j; 2001 if not IsSymmetricDigraph(D) or IsMultiDigraph(D) then 2002 ErrorNoReturn("the argument <D> must be a symmetric digraph ", 2003 "with no multiple edges,"); 2004 fi; 2005 2006 # Based on the construction given at https://en.wikipedia.org/wiki/Mycielskian 2007 # on 2019-04-10, v_k = vertex k, u_k = vertex n + k and w = vertex 2n + 1 2008 2009 n := DigraphNrVertices(D); 2010 C := DigraphMutableCopyIfImmutable(D); 2011 2012 for i in [1 .. n + 1] do 2013 DigraphAddVertex(C); 2014 od; 2015 2016 for i in [n + 1 .. 2 * n] do 2017 DigraphAddEdge(C, [i, 2 * n + 1]); 2018 DigraphAddEdge(C, [2 * n + 1, i]); 2019 od; 2020 2021 for i in [1 .. n] do 2022 for j in [i .. n] do 2023 if IsDigraphEdge(C, i, j) then 2024 DigraphAddEdge(C, [i + n, j]); 2025 DigraphAddEdge(C, [j, i + n]); 2026 if i <> j then # Stops duplicate edges being constructed if C has loops 2027 DigraphAddEdge(C, [i, j + n]); 2028 DigraphAddEdge(C, [j + n, i]); 2029 fi; 2030 fi; 2031 od; 2032 od; 2033 2034 if IsImmutableDigraph(D) then 2035 MakeImmutable(C); 2036 SetDigraphMycielskianAttr(D, C); 2037 fi; 2038 return C; 2039end); 2040 2041InstallMethod(DigraphMycielskian, 2042"for a digraph with known Mycielskian", 2043[IsDigraph and HasDigraphMycielskianAttr], SUM_FLAGS, DigraphMycielskianAttr); 2044 2045InstallMethod(DigraphMycielskianAttr, "for an immutable digraph", 2046[IsImmutableDigraph], DigraphMycielskian); 2047