10
$\begingroup$

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.

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

5 Answers 5

8
$\begingroup$

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.

Reference: Pattern, Blank, BlankNullSequence, Repeated, Except

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}}
$\endgroup$
7
$\begingroup$

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

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

With V 13.1 came DeleteAdjacentDuplicates

list = {{a, b, a, b}, {b, a, b, a}, {a, a, b, b}, {b, b, a, a}, {a, b, b, a}, {b, a, a, b}};

Select[DeleteAdjacentDuplicates /@ list, Length[#] == 4 &]

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

$\endgroup$
3
$\begingroup$

Another way using Select and ConsecutiveQ:

ConsecutiveQ = Most[#] == Rest[#] - 1 &; (*By Kuba*)

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

Select[lst, AllTrue[Partition[Ordering[#], 2], Not@*ConsecutiveQ] &]

(*{{a, b, a, b}, {b, a, b, a}}*)

Or using SubsetCases:

f = SubsetCases[#, {{___, x__, x__, ___}} :> 
    If[Length@{x, x} != Last@Dimensions@#, Nothing, {x, x}]] &;

f@lst

(*{{a, b, a, b}, {b, a, b, a}}*)
$\endgroup$
3
$\begingroup$

Using Split:

Clear["Global`*"];
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[lst, 
 lst // Map[Split[#, SameQ] &] // Map[Length, #, {2}] & // 
  Map[ContainsOnly[{1}]]
 ]

Using SequenceReplace:

SequenceReplace[lst, {{___, a_, a_, ___} } :> Nothing]

Result

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

$\endgroup$

Your Answer

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

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