Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Consider an incidence matrix A for a bipartite graph (Aij=1 if node i of group 1 and node j of group 2 are connected). A is not symmetric. Assume that A is disconnected or only weakly connected, i.e. there is at least one in-degree or one out-degree (or both) that are zero.

I'm trying to write a function that as input as the matrix A, and the output is a new matrix A', that has the same number of nodes and edges, but it is strongly connected (both in and out degree are different from zero). I want to achieve this result by rewiring the minimum number of edges in the network.

The function I have developed is the following one:

bipRanGraphConn[matrix_] := 
Module[{row, col, a, l, pos0row, xy0row, xy1row, row1, rulerow, 
pos0col, xy0col, xy1col, col1, rulecol, m, m1}, 
a = Sign[matrix]; {row, col} = Dimensions[matrix]; l = Total[a, 2]; 
m = Partition[Nest[RandomSample, Flatten[matrix], 10], 
Dimensions[matrix][[2]]]; 
pos0row = Position[Total[m, {2}], x_ /; x == 0.];

row1 = Cases[GatherBy[Position[m, x_ /; x > 0.], First], 
x_ /; Length[x] >= 2];
pos0row = Position[Total[m, {2}], x_ /; x == 0.];
pos0col = Position[Total[m], x_ /; x == 0.];
col1 = Cases[GatherBy[Position[m, x_ /; x > 0.], Last], 
x_ /; Length[x] >= 2];

If[Length[pos0row] == 0. && 
Length[pos0col] == 0., m1 = m,
If[Length[pos0row] > 0. && Length[row1] > Length[pos0row],
xy0row = 
 Join[pos0row, 
  RandomChoice[Partition[Range[1, col], 1], Length[pos0row]], 2];
xy1row = 
 Flatten[RandomSample[#, 1] & /@ 
   RandomSample[row1, Length[pos0row]], 1];
rulerow = 
 Flatten[Table[{xy0row[[i]] -> Extract[m, xy1row[[i]]], 
    xy1row[[i]] -> 0.}, {i, 1, Length[xy1row]}], 1]; 
m1 = ReplacePart[m, rulerow], m1 = m]; 
col1 = Cases[GatherBy[Position[m1, x_ /; x > 0.], Last], 
 x_ /; Length[x] >= 2];
If[Length[pos0col] > 0. && Length[col1] > Length[pos0col],
xy0col = 
 Join[pos0col, 
  RandomChoice[Partition[Range[1, row], 1], Length[pos0col]], 2];
xy1col = 
 Flatten[RandomSample[#, 1] & /@ 
   RandomSample[col1, Length[pos0col]], 1];
rulecol = 
 Flatten[Table[{xy0col[[i]] -> Extract[m1, xy1col[[i]]], 
    xy1col[[i]] -> 0.}, {i, 1, Length[xy1col]}], 1]; 
m1 = ReplacePart[m1, rulecol]];]; m1
]

In general it works well, but I find that in some cases, it fails and give me a matrix that is still only weakly connected. I appreciate if you can help me understand why does it fails, or if you have a better way to do it.

Working case:

A={{0., 1., 0., 0., 0.}, {0., 1., 1., 1., 1.}, {1., 0., 0., 0., 
   0.}, {0., 0., 1., 0., 0.}, {0., 0., 0., 0., 0.}, {1., 0., 0., 0., 
   0.}, {0., 0., 0., 0., 0.}, {1., 1., 0., 0., 1.}, {1., 1., 0., 1., 
   0.}, {0., 1., 1., 0., 0.}, {0., 1., 0., 0., 0.}, {1., 1., 1., 1., 
   1.}, {0., 1., 1., 0., 0.}, {1., 1., 0., 0., 0.}, {0., 0., 0., 0., 
   0.}, {1., 0., 0., 0., 0.}, {0., 1., 0., 0., 0.}, {1., 0., 0., 0., 
   0.}, {1., 0., 0., 0., 0.}, {1., 0., 0., 0., 0.}, {0., 0., 0., 0., 
   0.}}

Not Working case are usually for large matrix. This is the not working case (most of the times) that has the smaller size:

A= {{0., 0., 0., 1., 0., 1., 0., 1., 0., 0., 0., 1., 1., 0., 0., 0., 0., 
1., 1., 0., 0., 0., 0., 1., 1., 0., 1., 1., 1., 0., 1., 0., 1., 1., 
0., 0.}, {0., 1., 1., 1., 1., 0., 0., 0., 1., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 1., 0., 1., 0., 0., 0., 1., 0., 0., 0., 0., 0., 
1., 0., 0., 0., 0.}, {1., 0., 1., 0., 0., 0., 1., 0., 0., 0., 1., 
1., 0., 0., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 1., 1.}, {0., 0., 0., 1., 0., 0., 1., 0., 
1., 0., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0., 1., 0., 1., 0., 0., 
0., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0.}, {1., 0., 0., 0., 1., 
0., 1., 0., 1., 0., 1., 1., 1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {1., 1., 
0., 0., 0., 0., 0., 0., 0., 1., 0., 0., 0., 0., 1., 1., 1., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0.}, {0., 1., 0., 0., 0., 0., 0., 0., 0., 1., 0., 0., 0., 1., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0.}, {0., 1., 1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0.}, {0., 1., 1., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 1., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 
1., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0.}, {0., 0., 1., 0., 0., 0., 0., 0., 0., 1., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0.}, {0., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 1., 1., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 1., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 
1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0.}, {0., 0., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0.}, {0., 0., 0., 0., 0., 1., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 1., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 
0., 1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {1., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0.}, {1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0.}, {1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 1., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}, {1., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 
0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.}}
share|improve this question

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Browse other questions tagged or ask your own question.