16
$\begingroup$

Suppose I have the following list

lis = Range[100];

and I want to remove n consecutive terms periodically from the list. For example suppose I want to drop terms 4 and 5, 9 and 10, 14 and 15 etc. I could do this sequentially as follows:

Drop[Drop[lis, {5, -1, 5}], {4, -1, 4}];

This gives:

{1, 2, 3, 6, 7, 8, 11, 12, 13, 16, 17, 18, 21, 22, 23, 26, 27, 28, 
31, 32, 33, 36, 37, 38, 41, 42, 43, 46, 47, 48, 51, 52, 53, 56, 57, 
58, 61, 62, 63, 66, 67, 68, 71, 72, 73, 76, 77, 78, 81, 82, 83, 86, 
87, 88, 91, 92, 93, 96, 97, 98}

This gets really messy if I have to drop n consecutive terms where n is large. Is there a way to do this with just one Drop function or a better more compact and efficient way to achieve this where my list is huge. In my example above, n is 2, but it could be 3, 4 etc. What I want is a general solution. Thanks.

Improve this question
$\endgroup$

9 Answers 9

Reset to default
23
$\begingroup$

The simplest (and probably fastest) way is to use Partition with the appropriate offset:

list = Range@100;
Flatten@Partition[list, 3, 5]
(* {1, 2, 3, 6, 7, 8, 11, 12, 13, 16, 17, 18, 21, 22, 23, 26, 27, 28, 
    31, 32, 33, 36, 37, 38, 41, 42, 43, 46, 47, 48, 51, 52, 53, 56, 57, 
    58, 61, 62, 63, 66, 67, 68, 71, 72, 73, 76, 77, 78, 81, 82, 83, 86, 
    87, 88, 91, 92, 93, 96, 97, 98} *)

The logic is: "Take 3, drop 2, take 3, drop 2,... " till the end of the list (the argument 5 is just 3+2). You can change these numbers as desired.

Improve this answer
$\endgroup$
4
  • $\begingroup$ Nice, very nice. +1 $\endgroup$
    – rcollyer
    Commented Mar 13, 2013 at 0:38
  • 2
    $\begingroup$ @rm -rf There is a problem, but it is easy to fix. Try list=Range@97 and you see that 96 and 97 are missing. The fix is probably to use Flatten@Partition[list, 3, 5, {1, 1}, {}] $\endgroup$
    – andre314
    Commented Mar 13, 2013 at 11:30
  • $\begingroup$ @andre Yes, the extra arguments to Partition is what you need. I didn't go there because the OP didn't specify what the behaviour should be (i.e., should you take less than 3 if there aren't enough or just ignore it?) $\endgroup$
    – rm -rf ♦
    Commented Mar 13, 2013 at 13:36
  • $\begingroup$ @rm-rf, with regards to my data, there's always going to be enough, so your answer is perfect as is. But it's good to see the generalizations being offered here. $\endgroup$
    – RunnyKine
    Commented Mar 13, 2013 at 15:15
11
$\begingroup$

I am rather amused that my f2 is considerably faster than Partition (here as f1).

Now with an additional method I'll name f4.

Third try. I'll name this function f5. It is optimized for short take sequences and it is quite fast in its element. It is in a way based on your original method.

f1[list_, take_, skip_] := Flatten @ Partition[list, take, take + skip, 1, {}]

f2[list_, take_, skip_] := 
  list[[ SparseArray[PadRight[#, Length@list, #] & @ 
   UnitStep @ Range[take - 1, -skip, -1]]["AdjacencyLists"] ]]

f4[list_, take_, skip_] := list ~Part~ With[{n = Length@list, m = take + skip},
   Drop[Tuples[{Range[0, n, m], Range[take]}] ~Total~ {2}, Min[0, Mod[n, m] - take]]
  ]

f5[list_, take_, skip_] := 
  list ~Part~ Flatten[Range[Range@take, Length@list, take + skip], {2, 1}]

Test:

a = RandomInteger[99, 1*^6];

First @ Timing @ Do[#[a, 3, 2], {100}] & /@ {f1, f2, f4, f5}

SameQ @@ (#[a, 3, 2] & /@ {f1, f2, f4, f5})

{3.962, 0.983, 0.952, 0.702}

True

Timings in version 10.1, including the Pick variation of f2 that rcollyer posted as f3 which only became practical in Mathematica 8.

Needs["GeneralUtilities`"]

BenchmarkPlot[
  Cases[{f1, f2, f3, f4, f5}, f_ :> (f[#, 3, 2] &)],
  RandomInteger[99, #] &,
  5
]

enter image description here

The same benchmark with (f[#, 88, 7] &):

enter image description here

And finally (f[#, 7, 88] &):

enter image description here

Improve this answer
$\endgroup$
2
  • 3
    $\begingroup$ +1, but I have to ask: what labyrinthian path did you take to come up with f2? $\endgroup$
    – rcollyer
    Commented Mar 13, 2013 at 13:42
  • $\begingroup$ @rcollyer The usual one, actually. :^) $\endgroup$
    – Mr.Wizard
    Commented Mar 13, 2013 at 13:55
6
$\begingroup$

This is around six to nine times slower than @rm-rf 's :) But you can use it for more complicated patterns:

pickpat[a_List, pattern_List: {1, 1, 1, 0, 0}] := 
    Module[{patarray},
      patarray = Flatten@ConstantArray[pattern, Ceiling[Length@a/Length@pattern]];
      Pick[a, patarray[[1 ;; Length@a]], 1]
           ]

so

pickpat[Range@100]

 (*{1, 2, 3, 6, 7, 8, 11, 12, 13, 16, 17, 18, 21, 22, 23, 26, 27, 28,
31, 32, 33, 36, 37, 38, 41, 42, 43, 46, 47, 48, 51, 52, 53, 56, 57,
58, 61, 62, 63, 66, 67, 68, 71, 72, 73, 76, 77, 78, 81, 82, 83, 86,
87, 88, 91, 92, 93, 96, 97, 98}*)

but, say if you wanted to drop the 2nd, 4th, 5th and 7th elements of a list you could call it like this:

pickpat[Range@100, {1,0,1,0,0,1,0}]

(*{1, 3, 6, 8, 10, 13, 15, 17, 20, 22, 24, 27, 29, 31, 34, 36, 38, 41,
43, 45, 48, 50, 52, 55, 57, 59, 62, 64, 66, 69, 71, 73, 76, 78, 80,
83, 85, 87, 90, 92, 94, 97, 99}*)
Improve this answer
$\endgroup$
4
  • $\begingroup$ You could also write this as: f[a_List, pat:{(0|1)..}] := Pick[a, PadRight[pat, Length@a, pat], 1] $\endgroup$
    – Mr.Wizard
    Commented Mar 13, 2013 at 15:25
  • $\begingroup$ @Mr.Wizard thanks - PadRight doesn't do much to the speed in v8 but the {(0|1)..} pattern is GREATLY appreciated. I really need to learn to declare my functions better. $\endgroup$
    – gpap
    Commented Mar 13, 2013 at 15:36
  • 1
    $\begingroup$ Since you're interested in the subject, if that argument was a long vector and you wanted speed (with a valid argument) you might write it as pat:{__Integer} /; 0 <= Min[pat] && 1 >= Max[pat] or something similar, to avoid patten matching every element independently. $\endgroup$
    – Mr.Wizard
    Commented Mar 13, 2013 at 15:41
  • $\begingroup$ +1, this turned out to be really useful for some complicated situation I had. $\endgroup$
    – RunnyKine
    Commented May 23, 2013 at 21:55
6
$\begingroup$

While Mr.Wizard's f2 is fast, there is still faster:

f3[list_, take_, skip_] := 
Pick[list, PadRight[#, Length@list, #]& @ UnitStep @ Range[take - 1, -skip, -1], 1]

on my machine:

Do[f1[a, 3, 2], {100}] // Timing // First
(* 13.023044 *)

Do[f2[a, 3, 2], {100}] // Timing // First
(* 2.665350 *)

Do[f3[a, 3, 2], {100}] // Timing // First
(* 1.461291 *)
Improve this answer
$\endgroup$
9
  • $\begingroup$ I suspected as much for v8, but in v7 Pick is not yet optimized for packed arrays so it's much slower. This was surely part of the "labyrinthine path" I took. :-) $\endgroup$
    – Mr.Wizard
    Commented Mar 13, 2013 at 13:56
  • $\begingroup$ @Mr.Wizard those timings are on v9.0.1, and the difference isn't quite as dramatic on v8.0.1. But, f3 is still faster. That reminds me, we should take up a collection to get you a newer version. $\endgroup$
    – rcollyer
    Commented Mar 13, 2013 at 14:06
  • $\begingroup$ In v9, if you pre-calculate the parts list is a pure list[[spec]] faster than Pick with a pre-calculated 0/1 vector? $\endgroup$
    – Mr.Wizard
    Commented Mar 13, 2013 at 14:15
  • $\begingroup$ Would you please check the speed of the f4 function I added on v9? $\endgroup$
    – Mr.Wizard
    Commented Mar 13, 2013 at 14:21
  • $\begingroup$ Still working on the first request ... but, f4 takes about twice as long as f3 on my machine in v9.0.1. $\endgroup$
    – rcollyer
    Commented Mar 13, 2013 at 14:35
6
$\begingroup$

At the time of writing there are 8 sensible answers to this question. I find this rather imbalanced and would like to add a silly answer:

Clear[picker];
picker[d_List] := DynamicModule[{picked = Table[Unique[], {Length[d]}]},
  Column[{Framed[Row[{
      #[[1]], Spacer[2], Checkbox[Dynamic@Evaluate@#[[2]]]
      }], FrameStyle -> Gray] & /@ Thread[{d, picked}],
   Spacer[10], Dynamic@Pick[d, picked]}]];

In action:

picker[Range[50]]

picker

This is potentially faster than anything by Hypnowizard, depending on the user's competence.

The full inefficacy of this answer can only be appreciated by trying to copy and paste the result.

Improve this answer
$\endgroup$
2
  • $\begingroup$ +1, because sometimes absurd answers require a great deal of work. $\endgroup$
    – rcollyer
    Commented Mar 14, 2013 at 2:28
  • $\begingroup$ +1, I didn't see this before. I was laughing for 1 minute straight. Thanks. $\endgroup$
    – RunnyKine
    Commented May 23, 2013 at 21:54
3
$\begingroup$

A possibility :

lis = Range[100];
ReplacePart[lis, {i_} /; 4 <= Mod[i - 1, 5] + 1 <= 5 ->  Sequence[]]

(*
{1, 2, 3, 6, 7, 8, 11, 12, 13, 16, 17, 18, 21, 22, 23, 26, 27, 28, \
31, 32, 33, 36, 37, 38, 41, 42, 43, 46, 47, 48, 51, 52, 53, 56, 57, \
58, 61, 62, 63, 66, 67, 68, 71, 72, 73, 76, 77, 78, 81, 82, 83, 86, \
87, 88, 91, 92, 93, 96, 97, 98}  *)

It can be interesting if the conditions on the index i are complicated.

Improve this answer
$\endgroup$
3
$\begingroup$ 
lst0 = Range[20];
dltF = Delete[#1, List /@ Flatten@Range[#2, Length@#1, #3]] &;
lst1 = dltF[lst0, {4, 5}, 5]
(* {1,2,3,6,7,8,11,12,13,16,17,18} *)
Improve this answer
$\endgroup$
2
$\begingroup$ 
LinearRecurrence[{1, 0, 1, -1}, {1, 2, 3, 6}, 60]

Table[(-12 + 15 n - 4 Sqrt[3] Sin[1/3 (Pi - 2 n Pi)])/9, {n, 1, 60}]

RecurrenceTable[{a[n] + a[n + 1] + a[n + 2] == 5 n + 1, 
 a[1] == 1, a[2] == 2}, a, {n, 60}]


(*{1, 2, 3, 6, 7, 8, 11, 12, 13, 16, 17, 18, 21, 22, 23, 26, 27, 28, \
31, 32, 33, 36, 37, 38, 41, 42, 43, 46, 47, 48, 51, 52, 53, 56, 57, \
58, 61, 62, 63, 66, 67, 68, 71, 72, 73, 76, 77, 78, 81, 82, 83, 86, \
87, 88, 91, 92, 93, 96, 97, 98}*)
Improve this answer
$\endgroup$
2
$\begingroup$

Alternately take and drop elements, with an offset, somewhat like Dashing. It is basically an elaboration of rm-rf's answer. We pad the list on the left for the offset. Partitition truncates a leftover segment at the end of the list, so we pad the list on the right and drop any excess. (See note at end.)

skim[l_List, take_Integer, drop_Integer, offset_Integer: 0] := 
 Module[{period, reducedOffset, len},
  period = take + drop;
  reducedOffset = Mod[offset, period];
  len = Length[l];
  Take[
   Flatten[Partition[
     PadRight[PadLeft[l, len + reducedOffset], len + reducedOffset + take], take, period], 1],
   {1 + Min[take, reducedOffset, len], 
    Min[Mod[len + reducedOffset, period] - take - 1, -1]}
   ]
  ]

Table[skim[Range@27, 4, 6, off], {off, 0, 9}]

{{1, 2, 3, 4, 11, 12, 13, 14, 21, 22, 23, 24},
 {1, 2, 3, 10, 11, 12, 13, 20, 21, 22, 23},
 {1, 2, 9, 10, 11, 12, 19, 20, 21, 22},
 {1, 8, 9, 10, 11, 18, 19, 20, 21},
 {7, 8, 9, 10, 17, 18, 19, 20, 27},
 {6, 7, 8, 9, 16, 17, 18, 19, 26, 27},
 {5, 6, 7, 8, 15, 16, 17, 18, 25, 26, 27},
 {4, 5, 6, 7, 14, 15, 16, 17, 24, 25, 26, 27},
 {3, 4, 5, 6, 13, 14, 15, 16, 23, 24, 25, 26},
 {2, 3, 4, 5, 12, 13, 14, 15, 22, 23, 24, 25}}

How not to read Shakespeare:

skim[
 Take[StringSplit[ExampleData[{"Text", "Hamlet"}]], {13363, 13385}],
 3, 1]

{"To", "be,", "or", "to", "be,--that", "is", "question:--", 
"Whether", "'tis", "in", "the", "mind", "suffer", "The", "slings", 
"arrows", "of", "outrageous"}

Note: Partition will do padding, but it slows down a lot, about 6 times as slow. The time is similar to some of the the answer(s) using Pick. With Pick a lot of time is used to construct the pick list, but I don't see why Partition would be doing that. skim above takes about 50% longer than just using Partition as in rm-rf's answer.

Improve this answer
$\endgroup$
3
  • $\begingroup$ +1 for the literature application. But I am afraid @rcoyller took Pick to the next level. $\endgroup$
    – gpap
    Commented Mar 13, 2013 at 14:29
  • $\begingroup$ I hadn't realized how much the padding spec slowed down Partition! $\endgroup$
    – Mr.Wizard
    Commented Mar 13, 2013 at 14:32
  • $\begingroup$ @gpap Yes, he did, didn't he. I'll change my answer. $\endgroup$
    – Michael E2
    Commented Mar 13, 2013 at 14:33

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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