Selecting elements of a list based on frequency

Question

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.

2. 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"}}
   

Answer 1

Here's an example:

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

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

And for the other one,

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

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

Answer 2

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"}} *)
   

Answer 3

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

Answer 4

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"}}*)

Answer 5

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