@@ -2411,3 +2411,146 @@ function(D)
2411
2411
M := List(DigraphLoops(D), x -> [ x, x] );
2412
2412
return Union(M, DIGRAPHS_MateToMatching(D, mateD));
2413
2413
end );
2414
+
2415
+ InstallMethod(VertexConnectivity, " for a digraph" , [ IsDigraph] ,
2416
+ function (digraph )
2417
+ local kappas, newnetw, edmondskarp, mat, degs, mindegv, mindeg, Nv, outn, k,
2418
+ i, j, x, y;
2419
+
2420
+ if DigraphNrVertices(digraph) <= 1 or not IsConnectedDigraph(digraph) then
2421
+ return 0 ;
2422
+ fi ;
2423
+
2424
+ if IsMultiDigraph(digraph) then
2425
+ digraph := DigraphRemoveAllMultipleEdges(digraph);
2426
+ fi ;
2427
+
2428
+ kappas := [ DigraphNrVertices(digraph) - 1 ] ;
2429
+
2430
+ # The function newnetw is an implementation of Algorithm Nine from
2431
+ # Abdol-Hossein Esfahanian's ``Connectivity Algorithms'' which can be found at
2432
+ # https://www.cse.msu.edu/~cse835/Papers/Graph_connectivity_revised.pdf
2433
+ newnetw := function (digraph, source, sink )
2434
+ local n, mat, outn, x, y;
2435
+ n := DigraphNrVertices(digraph);
2436
+ mat := List([ 1 .. 2 * n] , x -> BlistList([ 1 .. 2 * n] , [] ));
2437
+ outn := OutNeighbours(digraph);
2438
+ for x in [ 1 .. DigraphNrVertices(digraph)] do
2439
+ if x <> source and x <> sink then
2440
+ mat[ x + n][ x] := true ;
2441
+ fi ;
2442
+ for y in outn[ x] do
2443
+ if x = source or x = sink then
2444
+ mat[ x][ y + n] := true ;
2445
+ mat[ y][ x] := true ;
2446
+ elif y = source or y = sink then
2447
+ mat[ y][ x + n] := true ;
2448
+ mat[ x][ y] := true ;
2449
+ else
2450
+ mat[ y][ x + n] := true ;
2451
+ mat[ x][ y + n] := true ;
2452
+ fi ;
2453
+ od ;
2454
+ od ;
2455
+ return List(mat, x -> ListBlist([ 1 .. 2 * n] , x));
2456
+ end ;
2457
+
2458
+ # The following function is an implementation of the Edmonds-Karp algorithm
2459
+ # with some minor adjustments that take into account the fact that the
2460
+ # capacity of all edges is 1.
2461
+ edmondskarp := function (netw, source, sink )
2462
+ local flow, capacity, queue, m, predecessor, edgeindex, stop, current, n, v;
2463
+
2464
+ flow := 0 ;
2465
+ capacity := List(netw, x -> BlistList(x, x));
2466
+ # nredges := Sum(List(netw, Length));
2467
+
2468
+ while true do
2469
+ queue := [ source] ;
2470
+ m := 1 ;
2471
+ predecessor := List(netw, x -> 0 );
2472
+ edgeindex := List(netw, x -> 0 );
2473
+ stop := false ;
2474
+ while m <= Size(queue) and not stop do
2475
+ current := queue[ m] ;
2476
+ n := 0 ;
2477
+ for v in netw[ current] do
2478
+ n := n + 1 ;
2479
+ if predecessor[ v] = 0 and v <> source and capacity[ current][ n] then
2480
+ predecessor[ v] := current;
2481
+ edgeindex[ v] := n;
2482
+ Add(queue, v);
2483
+ fi ;
2484
+ if v = sink then
2485
+ stop := true ;
2486
+ break ;
2487
+ fi ;
2488
+ od ;
2489
+ m := m + 1 ;
2490
+ od ;
2491
+
2492
+ if predecessor[ sink] <> 0 then
2493
+ v := predecessor[ sink] ;
2494
+ n := edgeindex[ sink] ;
2495
+ while v <> 0 do
2496
+ capacity[ v][ n] := false ;
2497
+ n := edgeindex[ v] ;
2498
+ v := predecessor[ v] ;
2499
+ od ;
2500
+ flow := flow + 1 ;
2501
+ else
2502
+ return flow;
2503
+ fi ;
2504
+ od ;
2505
+ end ;
2506
+
2507
+ # Referring once again to Abdol-Hossein Esfahanian's paper (see newnetw, above)
2508
+ # the following lines implement Algorithm Eleven of that paper.
2509
+ mat := BooleanAdjacencyMatrix(digraph);
2510
+ degs := ListWithIdenticalEntries(DigraphNrVertices(digraph), 0 );
2511
+ for i in DigraphVertices(digraph) do
2512
+ for j in [ i + 1 .. DigraphNrVertices(digraph)] do
2513
+ if mat[ i][ j] or mat[ j][ i] then
2514
+ degs[ i] := degs[ i] + 1 ;
2515
+ degs[ j] := degs[ j] + 1 ;
2516
+ fi ;
2517
+ od ;
2518
+ od ;
2519
+
2520
+ mindegv := 0 ;
2521
+ mindeg := DigraphNrVertices(digraph) + 1 ;
2522
+ for i in DigraphVertices(digraph) do
2523
+ if degs[ i] < mindeg then
2524
+ mindeg := degs[ i] ;
2525
+ mindegv := i;
2526
+ fi ;
2527
+ od ;
2528
+
2529
+ Nv := OutNeighboursOfVertex(digraph, mindegv);
2530
+ outn := OutNeighbours(digraph);
2531
+
2532
+ for x in DigraphVertices(digraph) do
2533
+ if x <> mindegv and not mat[ x][ mindegv] and not mat[ mindegv][ x] then
2534
+ k := edmondskarp(newnetw(digraph, mindegv, x), mindegv, x);
2535
+ if k = 0 then
2536
+ return 0 ;
2537
+ else
2538
+ AddSet(kappas, k);
2539
+ fi ;
2540
+ fi ;
2541
+ od ;
2542
+
2543
+ for x in [ 1 .. Size(Nv) - 1 ] do
2544
+ for y in [ x + 1 .. Size(Nv)] do
2545
+ if not mat[ Nv[ x]][ Nv[ y]] and not mat[ Nv[ y]][ Nv[ x]] then
2546
+ k := edmondskarp(newnetw(digraph, Nv[ x] , Nv[ y] ), Nv[ x] , Nv[ y] );
2547
+ if k = 0 then
2548
+ return 0 ;
2549
+ else
2550
+ AddSet(kappas, k);
2551
+ fi ;
2552
+ fi ;
2553
+ od ;
2554
+ od ;
2555
+ return kappas[ 1 ] ;
2556
+ end );
0 commit comments