find connectivity

Imagine a chain of 20 rings, labeled by 1-20 sequentially. We want to make random size sets of numbers randomly chosen from these 1-20 rings. No duplicate numbers are allowed.

Example of a set: $\{16,7,11\}$.

We want to count the links between the members of different sets. Rules:

1. If we have got one number $N$ in set $A$ and next successive number $N+1$ exists in set $B$ this is called link of length $1$.
2. If the next successive number $N+1$ is not member of any set, we look for the closest successive number $N+m$ existing in other sets, so this is called a link of length $m$.
3. If the next successive number is also in the set $A$, then is a loop, we ignore it.
4. The two ends of the chain, if not member of any set, are dangled, we ignore it.

Output = {the number of links of length i}.

Example:

clusters = {{2,3,4}, {16,7,11}, {9,20,12,18}}

In clusters we have:

1 link of length 1 : 11-12

3 links of length 2 : 16-17-18, 7-8-9, 9-10-11

1 link of length 3 : 4-5-6-7

1 link of length 4: 12-13-14-15-16

and 18-19-20 is a loop to same cluster and 1 is a free end so ignore them.

How can I count the links to have:

out1 = {{1,length1}, {3,length2}, {1,length3}, {1,length4}}

Also we need to know the total number of links between two given cluster. for above example we will have:

• I"m afraid that your question is not comprehensible as stated. Maybe if you provide a small sample of the input and what you wish the output to be, it would help clarify. – bill s Jan 24 '14 at 17:00
• Should we assume no repeats (NO connectivity = 0 ? ) – george2079 Jan 24 '14 at 19:46
• yes, no connection=0 – Sesna Secna Jan 24 '14 at 20:33
• Now it makes sense !.. – george2079 Jan 25 '14 at 14:11
• is this still unclear? I see it is on hold – Sesna Secna Jan 25 '14 at 15:52

Third try; here is a different method that I believe is equivalent but which should be much better performing. Now with additional optimizations for a threefold increase in performance.

links3[clusters : {{__Integer} ..}?(Min@# > 0 &)] :=
Module[{x, pair, uni},
uni = Union @@ clusters;
x = ConstantArray[0, Last @ uni];
MapIndexed[(x[[#]] = #2[]) &, clusters];
pair = Partition[#, 2, 1] &;
pair[uni][[ SparseArray[pair[ x[[uni]] ].{-1, 1}] @ "AdjacencyLists" ]]
]

links3[{{2, 3, 4}, {16, 7, 11}, {9, 20, 12, 18}}]
{{4, 7}, {7, 9}, {9, 11}, {11, 12}, {12, 16}, {16, 18}}

This explicitly outputs the link intervals so you can check them. To tally use:

count[{}] := {0}
count[a : {{_, _} ..}] := Sort @ Tally[a.{-1, 1}]

count @ links3[{{2, 3, 4}, {16, 7, 11}, {9, 20, 12, 18}}]
{{1, 1}, {2, 3}, {3, 1}, {4, 1}}

Note that Tally gives the counts in the form {link-length, occurrences}; this can be reversed if necessary.

• As usual, such a pretty answer. Might want to enforce elements are positive, else if say there's a zero you'll replace the head with the sublist index. Still works though... +1 – ciao Jan 26 '14 at 2:21
• @rasher Thank you. We have yet to confirm that it's what the OP needs however. The argument test was an afterthought, and perhaps a half-hearted one; you're right, if I was going to include it I should have made it robust. – Mr.Wizard Jan 26 '14 at 2:41
• thanks. this last (third) one works excellent. except when all numbers are member of one list (0 link) Tally gives error of course. – Sesna Secna Jan 26 '14 at 10:55
• @Sesna I'm glad I understood you. I may edit the question tomorrow to add an alternative description since apparently a lot of people did not. Regarding the empty set ({}), if that is a problem in practice you could modify count to handle it, e.g.: count[{}] := {{0}} (* or whatever else you want *); count[a : {{_, _} ..}] := Sort @ Tally[a.{-1, 1}]; – Mr.Wizard Jan 26 '14 at 11:23
• sorry I couldn't get this working. could you explain how does it work? – Sesna Secna Jan 26 '14 at 12:30

Try as I might, your question is pretty indecipherable. I urge you to clean it up, add some concrete examples and rules of what a 'connection' is, exclusion rules, etc. Nonetheless, the following will generate a list of all pairs matched in the sublists along with their corresponding 'distance'. Perhaps you can use its output to accomplish what you want.

list = {{7, 2}, {3, 1}, {9, 4, 15, 23}};

Flatten[Outer[{{##}, Abs[#1 - #2]} &, #[], #[]] & /@
Subsets[list, {2}], 2]

(*
{{{7, 3}, 4}, {{7, 1}, 6}, {{2, 3}, 1}, {{2, 1}, 1}, {{7, 9}, 2},
{{7, 4}, 3}, {{7, 15}, 8}, {{7, 23}, 16}, {{2, 9}, 7}, {{2, 4}, 2},
{{2, 15}, 13}, {{2, 23}, 21}, {{3, 9}, 6}, {{3, 4}, 1},
{{3, 15}, 12}, {{3, 23}, 20}, {{1, 9}, 8}, {{1, 4}, 3},
{{1, 15}, 14}, {{1, 23}, 22}}
*)
• sorry for unclear question. edited. – Sesna Secna Jan 25 '14 at 10:25
• @SesnaSecna: I'm afraid that edit made the question even more ambiguous. This is an awesome community, you'll find members really want to help and educate, but they can't if the question is nebulous. How about you post a small but real example, say using 50 numbers split into sublists, and show what the precise end result should be and explain the mechanism / rules / etc. that gets to it. Then someone can help you build the MM code to do it. – ciao Jan 25 '14 at 10:33
• @SesnaSecna: tell me this - if the list were say {{7, 2}, {10, 1}, {5, 9, 4, 15, 23}}, is the expected output {2, 3, 1, 0, 1}? – ciao Jan 25 '14 at 11:51
• no, the expected output for this list is: 2 length1; 3length2; 1 length5; so: {{2,1},{3,2},{1,5}} I also edited the question with example. hope it's clear this time. sorry or being annoying beginner. – Sesna Secna Jan 25 '14 at 13:29
• @SesnaSecna: that is not how your question had the output formatted, but OK, give me a moment to rework code... – ciao Jan 25 '14 at 13:58

Here is the first step for you..

list = {{7, 2}, {3, 1}, {9, 4, 15, 23}}

Total@((Count[Tuples[#] , {x_, y_} /; Abs[x - y] == 1 ]) & /@
Subsets[list, {2}])

-> 3

Edit.. based on revision.

Sorry i don't have mathematica here to work this out exactly, but you can use this framework with the Count criteria something like:

( Abs[x-y]==n && Union[Flatten@list,Range[Min[{x,y}]+1,Max[{x,y}]-1]]=={} )

Then wrap the whole works in

maxpos = (Max[#]-Min[#])&@Flatten@list
Table[ .. , {n, maxpos}]

Edit..that should have been Intersection..

list = {{2, 3, 4}, {16, 7, 11}, {9, 20, 12, 18}}
maxpos = (Max[#] - Min[#]) &@Flatten@list
Select[ Table[ {n,
Total@((Count[
Tuples[#], {x_, y_} /;(
Abs[x - y] == n &&
Intersection[
Flatten@list,
Range[Min[{x, y}] + 1, Max[{x, y}] - 1]] == {} )
]) & /@ Subsets[list, {2}])} , {n, maxpos}], #[] != 0 &]

---> {{1, 1}, {2, 3}, {3, 1}, {4, 1}}

Perhaps more efficiently find valid links then Tally based on length:

-Subtract @@ # & /@
Select[ Sort /@ Flatten[Tuples[#] & /@ Subsets[list, {2}], 1]  ,
Intersection[
Flatten@list,
Range[#[] + 1, #[] - 1]] == {} &
] // Tally // Sort

---> {{1, 1}, {2, 3}, {3, 1}, {4, 1}}
• sorry I didn't get this. and doesn't work. – Sesna Secna Jan 25 '14 at 14:51