5
$\begingroup$

I have a list of the form list={list1,list2,...}, where list1 is of the form {a,b,c,d} and similarly for other sublists, i.e. list2,list3 etc.

I would like to select the sublists of the list that have $a\neq b$ and $c\neq d$. I tried to use DeleteCases, but I am not sure how to do it properly.

$\endgroup$
1
  • 1
    $\begingroup$ Select will be more natural here. $\endgroup$
    – Kuba
    Commented Jan 5, 2018 at 13:31

7 Answers 7

6
$\begingroup$
SeedRandom[123]
data = RandomChoice[CharacterRange["a", "d"], {10, 4}]

{{"b", "d", "b", "a"}, {"c", "c", "c", "c"}, {"a", "a", "a", "c"},
{"b", "c", "b", "d"}, {"c", "b", "c", "a"}, {"a", "d", "c", "b"},
{"c", "a", "d", "d"}, {"c", "c", "b", "b"}, {"a", "c", "d", "a"}, {"d", "a", "c", "c"}}

DeleteCases[data, {a_, a_, _, _} | {_, _, b_, b_}]

{{"b", "d", "b", "a"}, {"b", "c", "b", "d"}, {"c", "b", "c", "a"}, {"a", "d", "c", "b"}, {"a", "c", "d", "a"}}

Select[data, UnsameQ @@ #[[;; 2]] && UnsameQ @@ #[[3 ;;]] &]

{{"b", "d", "b", "a"}, {"b", "c", "b", "d"}, {"c", "b", "c", "a"}, {"a", "d", "c", "b"}, {"a", "c", "d", "a"}}

$\endgroup$
4
$\begingroup$

Another way:

Delete[data, Position[
    Differences[ArrayReshape[data, {Length[data], 2, 2}], {0, 1}],
    {{0, 0}}]]
$\endgroup$
2
$\begingroup$
list =
  {{"b", "d", "b", "a"}, {"c", "c", "c", "c"}, {"a", "a", "a", "c"}, 
   {"b", "c", "b", "d"}, {"c", "b", "c", "a"}, {"a", "d", "c", "b"}, 
   {"c", "a", "d", "d"}, {"c", "c", "b", "b"}, {"a", "c", "d", "a"}, 
   {"d", "a", "c", "c"}};

Using SequenceSplit (new in 11.3)

Join @@ SequenceSplit[list, {{a_, a_, __} | {__, a_, a_} ..}]

{{"b", "d", "b", "a"}, {"b", "c", "b", "d"}, {"c", "b", "c", "a"}, {"a", "d", "c", "b"}, {"a", "c", "d", "a"}}

$\endgroup$
2
$\begingroup$

Using ReplaceList and ReplaceAll:

patt = {Repeated[a_, {2}], __} | {__, Repeated[a_, {2}]};

list /. Thread[Union@ReplaceList[list, {__, s : patt, ___} :> s] -> Nothing]

{{"b", "d", "b", "a"}, {"b", "c", "b", "d"}, {"c", "b", "c", "a"}, {"a", "d", "c", "b"}, {"a", "c", "d", "a"}}

Or using Cases:

Cases[list, {a_, b_, c_, d_} /; a =!= b && c =!= d]

{{"b", "d", "b", "a"}, {"b", "c", "b", "d"}, {"c", "b", "c", "a"}, {"a", "d", "c", "b"}, {"a", "c", "d", "a"}}

$\endgroup$
2
$\begingroup$
SeedRandom[123];
data = RandomChoice[CharacterRange["a", "d"], {10, 4}]

Using Pick, UnsameQ and Partition:

Pick[data, And @@ UnsameQ @@@ Partition[#, 2] & /@ data]

Using SequenceCases:

SequenceCases[data, {k : {a_, Except[a_], b_, Except[b_]} ..} :> k]

Using Subtract:

{#1 - #2, #3 - #4} & @@@ data // Map[Apply[Times]] // 
  Position[#, Except[0], 1, Heads -> False] & // Extract[data, #] &

For readability:

Second = #[[2]] &;
Third = #[[3]] &;
Fourth = #[[4]] &;
IsNotTheSameAs = UnsameQ;
f = (First@#~IsNotTheSameAs~Second@#)~
    And~(Third@#~IsNotTheSameAs~Fourth@#) &;

Pick[data, f /@ data]

or

Select[f][data]

or

DeleteCases[_?(Not@*f)][data]

Result:

{{"b", "d", "b", "a"}, {"b", "c", "b", "d"}, {"c", "b", "c", 
  "a"}, {"a", "d", "c", "b"}, {"a", "c", "d", "a"}}
$\endgroup$
2
$\begingroup$
list =
  {{"b", "d", "b", "a"}, {"c", "c", "c", "c"}, {"a", "a", "a", "c"}, 
   {"b", "c", "b", "d"}, {"c", "b", "c", "a"}, {"a", "d", "c", "b"}, 
   {"c", "a", "d", "d"}, {"c", "c", "b", "b"}, {"a", "c", "d", "a"}, 
   {"d", "a", "c", "c"}};

Using DeleteElements (new in 13.1) and SequenceCases

DeleteElements[list, Catenate @ SequenceCases[list, {{a_, a_, __} | {__, a_, a_}}]]

{{"b", "d", "b", "a"}, {"b", "c", "b", "d"}, {"c", "b", "c", "a"}, {"a", "d", "c", "b"}, {"a", "c", "d", "a"}}

$\endgroup$
1
$\begingroup$
SeedRandom[123]
data = RandomChoice[CharacterRange["a", "d"], {10, 4}];
Pick[#,MapThread[DiscreteDelta,MapApply[KroneckerDelta]/@{#[[All,;;2]],
    #[[All,3;;]]}],1]&[data]

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

    
$\endgroup$

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.