# Delete elements from a list with consecutive elements in sublist

I do not know if this is question has already been asked but I did see some posts on deleting duplicate elements but I am unable to understand completely. So forgive me if this turns out to be duplicate.

I have a list of the form {{a,b,a,b},{b,a,b,a},{a,a,b,b},{b,b,a,a},{a,b,b,a},{b,a,a,b}}. I need to eliminate sublist which have same consecutive elements.

Example I should eliminate {a,a,b,b}, {b,b,a,a}, {a,b,b,a} and {b,a,a,b} and thus end up with only alternating as and bs.

Any suggestions will be appreciated. Thanks in advance.

• i mean in a loop it is pretty straightforward but I was hoping to avoid loops given the huge number of options in mathematica – Abhishek Pal Feb 23 '17 at 9:03
• DeleteCases[lst, {___, x_, x_, ___}] where lst is your target list. – ciao Feb 23 '17 at 9:06
• @ciao Why not make an answer of it? The key is to explain in detail for newbies how {__, x, x_, ___} works. – nilo de roock Feb 23 '17 at 9:53
• so does {____,x_,x_,___} work for arrays of arbitrary length ?? – Abhishek Pal Feb 23 '17 at 10:11
• @AbhishekPal Yes it does. ___ is BlankNullSequence so this will work for a List of any length. – Mr.Wizard Feb 23 '17 at 10:33

As ciao commented you can use the pattern {___, x_, x_, ___}. This works because x_ is a named pattern and therefore within a pattern expression any match must match every other pattern with the same name. One could also use {___, Repeated[x_, {2}], ___} for the same reason.

dat =
{{a, b, a, b}, {b, a, b, a}, {a, a, b, b}, {b, b, a, a}, {a, b, b, a}, {b, a, a, b}};

dat // DeleteCases[{___, x_, x_, ___}]

dat /. {___, x_, x_, ___} -> Sequence[]

dat // Cases[Except[{___, x_, x_, ___}]]

dat // DeleteCases[{___, Repeated[x_, {2}], ___}]

{{a, b, a, b}, {b, a, b, a}}     (* same output for each *)


Above I use the new-in-v10 operator forms of Cases and DeleteCases.

Other posts I could find where the uniqueness of named patterns is used or mentioned:

Because I always like to see another way to accomplish the same task here is a method without any patterns. I use Throw and Catch to exist Fold early.

test[a_] := Catch[Fold[If[# === #2, Throw[False], #2] &, a]; True]

Select[dat, test]

{{a, b, a, b}, {b, a, b, a}}


Also

lst = {{a, b, a, b}, {b, a, b, a}, {a, a, b, b}, {b, b, a, a}, {a, b, b, a}, {b, a, a, b}};

Pick[#, PossibleZeroQ /@ Times @@@ Differences /@ #, False] & @ lst
Pick[#, FreeQ[0|0.] /@ Differences /@ #] & @ lst  (*thanks: Mr.W *)
Pick[#, SequenceCount[#, {Repeated[x_, {2, Infinity}]}]==0&/@#]& @ lst


all give

{{a, b, a, b}, {b, a, b, a}}

• @Mr.Wizard, of course! (Still on Version 9, I had thought about FreeQ[#,0]& /@.. first but settled on PossibleZeroQ. The operator form FreeQ is much cleaner. – kglr Feb 23 '17 at 21:42
• @Mr.Wizard, right again , thank you! – kglr Feb 23 '17 at 21:48
• Glad I could help! :-D – Mr.Wizard Feb 23 '17 at 21:52
• Caveat with Differences: {a, b, ∞, ∞} – Mr.Wizard Feb 23 '17 at 21:58