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.

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:

out = {{1,length1}, {3,length2}, {1,length3}, {1,length4}}
share|improve this question
5  
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 at 17:00
    
Should we assume no repeats (NO connectivity = 0 ? ) –  george2079 Jan 24 at 19:46
    
yes, no connection=0 –  Sesna Secna Jan 24 at 20:33
    
Now it makes sense !.. –  george2079 Jan 25 at 14:11
    
is this still unclear? I see it is on hold –  Sesna Secna Jan 25 at 15:52
show 9 more comments

3 Answers

up vote 3 down vote accepted

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[{}] := {}

links3[clusters : {{__Integer} ..}?(Min@# > 0 &)] :=
  Module[{x, pair, uni},
    uni = Union @@ clusters;
    x = ConstantArray[0, Last @ uni];
    MapIndexed[(x[[#]] = #2[[1]]) &, 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.

share|improve this answer
    
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 –  rasher Jan 26 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 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 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 at 11:23
    
sorry I couldn't get this working. could you explain how does it work? –  Sesna Secna Jan 26 at 12:30
show 5 more comments

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]} &, #[[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}}
*)
share|improve this answer
    
sorry for unclear question. edited. –  Sesna Secna Jan 25 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. –  rasher Jan 25 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}? –  rasher Jan 25 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 at 13:29
    
@SesnaSecna: that is not how your question had the output formatted, but OK, give me a moment to rework code... –  rasher Jan 25 at 13:58
show 3 more comments

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}], #[[2]] != 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, #[[2]] - 1]] == {} &
         ] // Tally // Sort

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

Your Answer

 
discard

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

Not the answer you're looking for? Browse other questions tagged or ask your own question.