# Dropping n consecutive terms from a list periodically

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.

-

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.

-
+1. This will be hard to beat. – Leonid Shifrin Mar 12 '13 at 23:29
+1. This is nice. Thanks. – RunnyKine Mar 12 '13 at 23:46
Nice, very nice. +1 – rcollyer Mar 13 '13 at 0:38
@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}, {}] – andre Mar 13 '13 at 11:30
@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?) – R. M. Mar 13 '13 at 13:36

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

-
+1, but I have to ask: what labyrinthian path did you take to come up with f2? – rcollyer Mar 13 '13 at 13:42
@rcollyer The usual one, actually. :^) – Mr.Wizard Mar 13 '13 at 13:55

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}*)

-
+1 You beat me to it! :) – Michael E2 Mar 13 '13 at 13:01
You could also write this as: f[a_List, pat:{(0|1)..}] := Pick[a, PadRight[pat, Length@a, pat], 1] – Mr.Wizard Mar 13 '13 at 15:25
@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. – gpap Mar 13 '13 at 15:36
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. – Mr.Wizard Mar 13 '13 at 15:41
+1, this turned out to be really useful for some complicated situation I had. – RunnyKine May 23 '13 at 21:55

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 *)

-
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. :-) – Mr.Wizard Mar 13 '13 at 13:56
@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. – rcollyer Mar 13 '13 at 14:06
In v9, if you pre-calculate the parts list is a pure list[[spec]] faster than Pick with a pre-calculated 0/1 vector? – Mr.Wizard Mar 13 '13 at 14:15
Would you please check the speed of the f4 function I added on v9? – Mr.Wizard Mar 13 '13 at 14:21
Still working on the first request ... but, f4 takes about twice as long as f3 on my machine in v9.0.1. – rcollyer Mar 13 '13 at 14:35

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]]


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.

-
+1 for making me smile – Mr.Wizard Mar 14 '13 at 0:39
+1, because sometimes absurd answers require a great deal of work. – rcollyer Mar 14 '13 at 2:28
+1, I didn't see this before. I was laughing for 1 minute straight. Thanks. – RunnyKine May 23 '13 at 21:54

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.

-
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} *)

-
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}*)

-

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}}


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.

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