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