# How to delete certain lists from a nested list?

I have a nested list as the following example (want to remove lists with same or incremented elements such as {1,2,3,4,5}, {2,2,2,2,2}, {1,1,1,1,1}):

test={{1,2,3,4,5}, {1,1,1,1,1}, {2,4,6,8,10}, {2,2,2,2,2}, {3,5,2,4,8}};
test1=DeleteCases[test,{1,2,3,4,5}];
test1=DeleteCases[test1,{1,1,1,1,1}];
test1=DeleteCases[test1,{2,2,2,2,2}];


So the result is test1={{3,5,2,4,8}}(here I also delete the case {2,4,6,8,10} due to the equal increaments).

With the above way I can get the list which removes the list that elements are the same or incremented.

The problem is when the test is very large and I don't know what exactly elements are, how can I efficiently remove the lists where elements are the same or incremented? Is there a clever way to do this?

Thanks for all the help in advance!

• Is {-1,-2,-3,-4,-5} also to be removed? It has constant increment -1. Jul 17, 2019 at 0:17
• yes, arbitrary constant increment. @kglr and @JJBK has already given some answers. These answers can be modified such as Select[test, (! Equal @@ #) && (! Equal @@ Differences[#]) &] or DeleteCases[_?(MatchQ[{((n_) ..)}]@*Differences)]@test Jul 17, 2019 at 0:18

Select[Not @* Apply[Equal] @* Differences ] @ test

Pick[test, DeveloperToPackedArray[Unitize@Total[Abs @ Differences[#, 2]]& /@ test], 1]

Select[Not @* MatchQ[{(a_) ..}] @* Differences] @ test

Cases[_?(Not @* MatchQ[{(a_) ..}] @* Differences)] @ test

DeleteCases[_?(MatchQ[{(a_) ..}] @* Differences)] @ test


all give

{{3, 5, 2, 4, 8}}

Update: Adding a pattern "to remove the cases like {1, 0, 1, 0, 1, 0, 1, 0, 1, 0}, {1, 3, 1, 3, 1, 3, 1, 3, 1,3}, where elements repeated in even and odd positions"

test2 = {{1, 2, 3, 4, 5}, {1, 1, 1, 1, 1}, {2, 4, 6, 8, 10}, {2, 2, 2, 2, 2},
{3, 5, 2, 4, 8}, {1, 0, 1, 0, 1, 0, 1, 0, 1, 0}, {1, 3, 1, 3, 1, 3, 1, 3, 1, 3} };

Select[Not @* MatchQ[{(a_) ..|
PatternSequence[(PatternSequence[a_, b_]/; a==-b)..,a_]}] @* Differences] @
test2


{{3, 5, 2, 4, 8}}

Alternatively,

Fold[Select[Not @* #2] @ # &,
test2,
{Apply[Equal] @* Differences,  MatchQ[{PatternSequence[a_, b_  ]..}]}]


{{3, 5, 2, 4, 8}}

• wow, amazing! thank you so much Jul 16, 2019 at 13:43
• Do you also how to apply to remove the cases like {1, 0, 1, 0, 1,0,1,0,1,0}, {1, 3, 1, 3, 1,3,1,3,1,3}, where elements repeated in even and odd positions? thank you very much! Jul 16, 2019 at 16:29
• @XuemeiGu Use reference.wolfram.com/language/ref/FindRepeat.html as Select[test, Length@FindRepeat@# > 2 &] to remove all lists that are just 2 repeated elements. Jul 16, 2019 at 22:44
• @XuemeiGu, please see the update.
– kglr
Jul 16, 2019 at 22:53
• @lirtosiast, this is a very nice solution. I just find out that FindRepeat is new in mathematica 11.2. I didn't realize this function because of my old version. Thanks! Jul 17, 2019 at 0:25
Select[test, (! Equal @@ #) && (! AllTrue[Differences[#], EqualTo[1]]) &]

• thank you very much! Your method is very quick compare to my for-loop way, thanks! Jul 16, 2019 at 13:30

I think the OP wanted to remove sub-lists that used any constant increment, be it 0, 1, or some larger integer. The expression

Select[test, Length@Intersection@Differences[#] > 1 &]


removes all sub-lists with a constant increment (including in the example, those with increments of 0, 1, and 2).

You say you're interested in working with large lists. In that case it is better to avoid Select. Here is an alternate function using Dot and Pick:

removeProgressions[list_?MatrixQ]:=Module[{len=Dimensions[list][[2]]},
Pick[list, Unitize @ Total[Abs[list . Partition[{1,-2,1}, len-2, 1, {-1, 1}, 0]], {2}], 1]
]


Timing comparison:

SeedRandom[1]
list = RandomInteger[10, {10^6, 5}];
r1 = removeProgressions[list]; //AbsoluteTiming
r2 = Select[Not @* MatchQ[{(a_)..}] @* Differences] @ list; //AbsoluteTiming

r1===r2
`

{0.138829, Null}

{1.98615, Null}

True

• Ah, the discrete Laplacian in disguise! Very neat. Jul 17, 2019 at 0:30