@@ -2388,3 +2388,146 @@ function(D)
23882388 M := List(DigraphLoops(D), x -> [ x, x] );
23892389 return Union(M, DIGRAPHS_MateToMatching(D, mateD));
23902390end );
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