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