@@ -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