@@ -2411,3 +2411,146 @@ function(D)
24112411  M :=  List(DigraphLoops(D), x ->  [ x, x] );
24122412  return  Union(M, DIGRAPHS_MateToMatching(D, mateD));
24132413end );
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