# Selecting elements of a list based on frequency

Suppose I have a list as follow:

l = {{"a", "b", "c"}, {"a", "b"}, {"a", "d", "b"}, {"a", "c", "e"}};


Now I am going to flatten it and apply Counts to count each element:

l // Flatten // Counts

<|"a" -> 4, "b" -> 3, "c" -> 2, "d" -> 1, "e" -> 1|>


Now I want to do followings:

1. From the list how can I retain only sublists whose components have frequency more than 1 in the overall list l, namely the output should look like this:

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


as all "a", "b" and "c" have frequency above 1.

1. how can I delete those sublists that contain any components that have frequency 1 from l, namely the output should look like:

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


Here's an example:

counts = l // Flatten // Counts;
mask = Map[counts[#] != 1 &, l, {2}];


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

And for the other one,

mask = Map[counts[#] > 1 &, l, {2}];


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

Another way:

Map[
If[counts[#] != 1, #, Nothing] &,
l, {2}]


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

If[And @@ (counts[#] > 1 & /@ #), #, Nothing] & /@ l


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

Alternatives using Select rather than Pick:

l = {{"a", "b", "c"}, {"a", "b"}, {"a", "d", "b"}, {"a", "c", "e"}};
counts = Counts[Flatten@l];

1. To obtain the sublists whose elements are repeated in the list:

Select[ContainsNone[Keys@Select[# == 1 &]@counts]@l
(* Out: {{"a", "b", "c"}, {"a", "b"}} *)

2. To remove those sublists that contain non-repeated elements in the overall list:

DeleteCases[Alternatives @@ Keys@Select[# == 1 &]@counts] /@ l
(* Out: {{"a", "b", "c"}, {"a", "b"}, {"a", "b"}, {"a", "c"}} *)

a = {{"a", "b", "c"}, {"a", "b"}, {"a", "d", "b"}, {"a", "c", "e"}};


Pre-define c for better readability

c = a /. Counts @ Flatten @ a


{{4, 3, 2}, {4, 3}, {4, 1, 3}, {4, 2, 1}}

1st question

Using AllTrue

Pick[a, AllTrue[GreaterThan @ 1] /@ c]


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

2nd question

Using ReplaceAt (new in 13.1) and Nothing

ReplaceAt[_ :> Nothing, Position[1] @ c] @ a


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

Using Tally and AssociationThread to obtain the frequency of all elements:

counts = Merge[AssociationThread @@@ Tally[Flatten@#], Identity[#[[1]]] &] &@l;


1st question

Using Pick and FreeQ:

Pick[#, FreeQ[#, 1] & /@ (# /. counts)] &@l

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


2nd question

Using Select and DeleteElements:

DeleteElements[#, Keys[Select[counts, # == 1 &]]] & /@ l

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

Clear["Global*"];

l = {{"a", "b", "c"}, {"a", "b"}, {"a", "d", "b"}, {"a", "c", "e"}};
items = Union@Flatten@l (* find unique items *)

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

lens = Position[l, #] & /@ items // Map[Length]  (* find tallies *)

(*{4,3,2,1,1}*)

del = Pick[items, lens, 1]  (* identify items to be deleted *)

(*{"d","e"}*)


or do so more directly:

(* Tally@Flatten@l /. {a_, Except[1]} :> Nothing // Map[First] *)


First question

DeleteCases[l, _?(ContainsAny[del])]


Secondquestion

DeleteCases[l, Alternatives @@ del, {2}]
`

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

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