5
$\begingroup$

I have a list of integers from 1 - 400. I choose n random numbers with replacement from the list.

Here is an example:

list = 
  {5, 14, 15, 29, 38, 100, 112, 139, 156, 165, 195, 217, 
   228, 237, 249, 286, 320, 323, 325, 329, 335, 349}

If I have this list, the routine should find all the sublists with all the elements within 60 of each other

{{5, 14, 15, 29, 38}, {14, 15, 29, 38}, {15, 29, 38}, {29, 38}, 
 {100, 112, 139, 156}, {112, 139, 156, 165}, {139, 156, 165, 195}, 
 {156, 165, 195}, {165, 195, 217}, {195, 217, 228, 237, 249}, 
 {217, 228, 237, 249}, {228, 237, 249, 286}, {237, 249, 286}, {249, 286},
 {286, 320, 323, 325, 329, 335}, {320, 323, 325, 329, 335, 349}, 
 {323, 325, 329, 335, 349}, {325, 329, 335, 349}, {329, 335, 349}, {335, 349}}

list, in this case is sorted but that will generally not be true. I have a small program working now but it is less general and very slow. Can something be done here?

Here is my code:

between[l_] := Module[{}, 
    h = TakeWhile[l, # <= l[[1]] + 60 &];
    s = Drop[s, 1];
    h
]


s = Sort[RandomChoice[Range[400], 22]];
Table[between[s], {Length[s] - 7 + 1}]
Improve this question
$\endgroup$
4
  • 4
    $\begingroup$ You might need to explain a bit more clearly. For example, what's wrong with {5, 14} as one of your sublists? Posting your existing code always helps too. Split and Gather are useful functions for this type of problem. $\endgroup$ – wxffles Jul 17 '13 at 2:59
  • 1
    $\begingroup$ Hi wxffles; Basically between takes the first element of the list and finds the longest sequence it can. Then the front element is dropped from the global variable s. While it does not get all of them it hopefully gets the longest one which is what I was originally after. $\endgroup$ – bobbym Jul 17 '13 at 4:20
  • 1
    $\begingroup$ It's generally a good idea to wait a while before accepting an answer. There may be more than one way to skin a cat $\endgroup$ – DavidC Jul 17 '13 at 7:50
  • $\begingroup$ @David: Hi; I accepted because he exactly explained the command I had been fumbling with. However, Michael E2's routine is smoking on my machine. Fast! $\endgroup$ – bobbym Jul 17 '13 at 12:44
3
$\begingroup$

Nearest with a suitable DistanceFunction, followed by a filtering using Gather can be used to pick the elements:

list = 
  {5, 14, 15, 29, 38, 100, 112, 139, 156, 165, 195, 217, 
   228, 237, 249, 286, 320, 323, 325, 329, 335, 349};

With[{
       nf = Nearest[list, DistanceFunction -> (If[ManhattanDistance[#, #2] <= 60, 0, 1] &)],
       filt = 
         Flatten[Gather[#, ManhattanDistance[#, #2] > 60 &] /. x : {__Integer} :> First@x] &
      },
  Composition[filt, nf] /@ list // DeleteDuplicates
]

(* {{5, 14, 15, 29, 38}, {100, 112, 139, 156}, {112, 139, 156, 165}, 
    {139, 156, 165, 195}, {165, 195, 217}, {195, 217, 228, 237, 249}, {228, 237, 249, 286}, 
    {286, 320, 323, 325, 329, 335}, {320, 323, 325, 329, 335, 349}}*)

If you want all the subsets, you can just call Subsets on each of the sublists above. However, as wxffles notes, your question is underspecified in this regard, because you seem to only consider subsets by dropping the first element successively and that too, only for certain lists.

Improve this answer
$\endgroup$
3
  • $\begingroup$ Hi; Thanks, I was having trouble with an approach like that. Couldn't get it to work. $\endgroup$ – bobbym Jul 17 '13 at 4:22
  • $\begingroup$ @bobbym Does your comment mean that this answer is what you wanted? Then you should accept it. Otherwise you should explain what is missing. $\endgroup$ – Jens Jul 17 '13 at 4:53
  • $\begingroup$ How do I accept it? $\endgroup$ – bobbym Jul 17 '13 at 5:36
4
$\begingroup$

Here's another way to get the output you desire, assuming you are looking for lists that are of length 2 or greater:

list = {5, 14, 15, 29, 38, 100, 112, 139, 156, 165, 195, 217, 228, 
   237, 249, 286, 320, 323, 325, 329, 335, 349};

DeleteCases[
 Pick[#, UnitStep[60 - (# - First@#)] & /@ #, 1] &@ NestList[Rest, list, Length@list - 2],
 _?(Length[#] < 2 &)]

(* {{5, 14, 15, 29, 38}, {14, 15, 29, 38}, {15, 29, 38}, {29, 38},
    {100, 112, 139, 156}, {112, 139, 156, 165}, {139, 156, 165, 195},
    {156, 165, 195}, {165, 195, 217}, {195, 217, 228, 237, 249},
    {217, 228, 237, 249}, {228, 237, 249, 286}, {237, 249, 286},
    {249, 286}, {286, 320, 323, 325, 329, 335}, {320, 323, 325, 329, 335, 349},
    {323, 325, 329, 335, 349}, {325, 329, 335, 349}, {329, 335, 349}, {335, 349}} *)

Alternatively, especially if the list is not sorted, then here's a slightly different way.

SeedRandom[1];
list2 = RandomInteger[{1, 400}, 22]
(* {258, 385, 135, 32, 337, 229, 96, 125, 138, 301, 324, 20, 76, 170,
    397, 10, 193, 318, 341, 175, 48, 115} *)

DeleteCases[
 Pick[list2, UnitBox[Rescale[list2, {#, # + 60}, {-0.5, 0.5}]], 1] & /@ list2,
 _?(Length[#] < 2 &)]

(* {{258, 301, 318}, {385, 397}, {135, 138, 170, 193, 175}, {32, 76, 48},
    {385, 337, 397, 341}, {258, 229}, {135, 96, 125, 138, 115},
    {135, 125, 138, 170, 175}, {138, 170, 193, 175}, {337, 301, 324, 318, 341},
    {337, 324, 341}, {32, 20, 76, 48}, {135, 96, 125, 76, 115},
    {229, 170, 193, 175}, {32, 20, 10, 48}, {229, 193}, {337, 324, 318, 341},
    {385, 397, 341}, {229, 193, 175}, {96, 76, 48}, {135, 125, 138, 170, 175, 115}} *)
Improve this answer
$\endgroup$
2
  • $\begingroup$ Hi; Also very nice solutions that are working, thanks. $\endgroup$ – bobbym Jul 17 '13 at 5:42
  • $\begingroup$ That is quite fast. +1 $\endgroup$ – Mr.Wizard Jul 17 '13 at 7:18
4
$\begingroup$

Maybe I am a bit late, but here's another approach to the problem. To be honest, I do not have any idea how fast my approach is compared to the other ones presented, but I always wanted to use Longest in a "real-life" problem, so here we go:

Using your list (it must be sorted):

list = 
      {5, 14, 15, 29, 38, 100, 112, 139, 156, 165, 195, 217, 
       228, 237, 249, 286, 320, 323, 325, 329, 335, 349};

We apply a pattern and ReplaceAll:

list /. 
  {{___, #, Longest[y___], z_, ___} /; z <= # + 60 :> {#, y, z}, _ :> (## &[])} & /@ list

and get:

{{5, 14, 15, 29, 38}, {14, 15, 29, 38}, {15, 29, 38}, {29, 38}, {100, 112, 139, 156}, {112, 139, 156, 165}, {139, 156, 165, 195}, {156, 165, 195}, {165, 195, 217}, {195, 217, 228, 237, 249}, {217, 228, 237, 249}, {228, 237, 249, 286}, {237, 249, 286}, {249, 286}, {286, 320, 323, 325, 329, 335}, {320, 323, 325, 329, 335, 349}, {323, 325, 329, 335, 349}, {325, 329, 335, 349}, {329, 335, 349}, {335, 349}}

I am not sure how much explanation you need to understand that. Maybe I highlight the central pattern:

 {{___, #, Longest[y___], z_, ___} /; z <= # + 60 :> {#, y, z}

This matches any sequence starting with some numbers or none, then the number # (this is a slot that will be filled with the elements of list, see the Map at the end of the code), then a sequence of numbers (called y___, where y can be "empty"), and finally z, followed by more numbers (or none). We condition z to be <= # + 60, as you desire. This pattern will be replaced by {#, y, z}, which is what you want, I hope. The second pattern is to get rid of the ones that do not match the first one, e.g. when we call 38 (it will be replaced by ##&[], a.k.a. Unevaluated[Sequence[]].

I hope this helps!

Improve this answer
$\endgroup$
3
$\begingroup$

Here is a rather literal method:

near[a_, n_] :=
  DeleteCases[Pick[a, IntervalMemberQ[Interval[{#, # + n}], a]] & /@ a, {_}]

near[list, 60]

{{5, 14, 15, 29, 38}, {14, 15, 29, 38}, {15, 29, 38}, {29, 38}, {100, 112, 139, 156},
 {112, 139, 156, 165}, {139, 156, 165, 195}, {156, 165, 195}, {165, 195, 217},
 {195, 217, 228, 237, 249}, {217, 228, 237, 249}, {228, 237, 249, 286}, {237, 249, 286},
 {249, 286}, {286, 320, 323, 325, 329, 335}, {320, 323, 325, 329, 335, 349},
 {323, 325, 329, 335, 349}, {325, 329, 335, 349}, {329, 335, 349}, {335, 349}}

This is appropriate for short lists which may be your application if "a list of integers from 1 - 400" is not merely an example, but very long lists will be slower. Michael's method should be fast, but in version 7 I need this SparseArray trick for best performance:

near2[a_, n_] := 
 DeleteCases[#[[SparseArray[UnitStep[n + First@# - #]]@"AdjacencyLists"]] & /@ 
   NestList[Rest, a, Length@a - 2], {_}]
Improve this answer
$\endgroup$
1
  • $\begingroup$ +1. I'll have to remember DeleteCases[.., {_}] -- I was stuck thinking in terms of Length, which I knew would slow things down a little. $\endgroup$ – Michael E2 Jul 17 '13 at 12:54

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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