7
$\begingroup$

I have a very large table containing sublists, such as for instance:

{{1, 2, 3}, {4, 5, 6, 7}, {1}, {1, 8}, {9, 10}, {11, 6, 12, 13, 14, 15, 16}}

I want to remove elements from all sublists based on their count. For example, from the list above I would like to remove all elements of count greater than or equal to 2. In this case only 1 and 6 appear more than twice, so those should be removed, and I would like the following output:

{{2, 3}, {4, 5, 7}, {8}, {9, 10}, {11, 12, 13, 14, 15, 16}}
$\endgroup$
  • $\begingroup$ This does not remove the 1's and 6's inside the sublist $\endgroup$ – Hamti Aug 7 '15 at 21:52
  • $\begingroup$ How dense is the list, that is, is the expectation of duplicate/triplicate/etc. high or low? Depending on this, methods posted so far can be handily beaten. And what is "very large"? Millions of sublists, or thousands? Different techniques for each case... $\endgroup$ – ciao Aug 7 '15 at 23:29
  • $\begingroup$ What would be the bottleneck, @ciao, tallying, the selecting, or the delete cases? $\endgroup$ – march Aug 8 '15 at 2:39
  • $\begingroup$ @march: I'd venture the selecting - but when/if OP more precisely specifies, I'll enter the fray with ideas if appropriate. As it stands, too under-specified to guide fastest solution, IMO. $\endgroup$ – ciao Aug 8 '15 at 5:11
7
$\begingroup$

Version 10 offers Counts which is useful for this question:

$list = {{1, 2, 3}, {4, 5, 6, 7}, {1}, {1, 8}, {9, 10}, {11, 6, 12, 13, 14, 15, 16}};

count = Counts @ Flatten @ $list

(* <| 1->3, 2->1, 3->1, 4->1, 5->1, 6->2, 7->1, 8->1, 9->1, 10->1, 11->1,
      12->1, 13->1, 14->1, 15->1, 16->1 |> *)

count[6]

(* 2 *)

(A shame that Counts does not accept a level specification.)

With this information, we can use DeleteCases to express the requirement fairly directly:

DeleteCases[$list, x_ /; count[x] >= 2, {2}]

(* {{2, 3}, {4, 5, 7}, {}, {8}, {9, 10}, {11, 12, 13, 14, 15, 16}} *)

Or we could use Pick to keep the desired values:

Pick[$list, Map[count[#] < 2 &, $list, {2}]]

(* {{2, 3}, {4, 5, 7}, {}, {8}, {9, 10}, {11, 12, 13, 14, 15, 16}} *)

With version 10.2, we can replace all rejected values with Nothing:

$list /. x_Integer /; count[x] >= 2 -> Nothing

(* {{2, 3}, {4, 5, 7}, {}, {8}, {9, 10}, {11, 12, 13, 14, 15, 16}} *)

... although in earlier versions the cryptic (##&[]) can express the idea of Nothing.

Each of these techniques leaves an empty sublist when all of its original elements are rejected. We can use the operator DeleteCases[{}] to get rid of such empty remnants. For example:

DeleteCases[$list, x_ /; count[x] >= 2, {2}] // DeleteCases[{}]

(* {{2, 3}, {4, 5, 7}, {8}, {9, 10}, {11, 12, 13, 14, 15, 16}} *)
$\endgroup$
  • 3
    $\begingroup$ The pronunciation of (##&[]) cannot be uttered in polite company. It is a rather harsh colloquial synonym for Nothing. ;) $\endgroup$ – WReach Aug 8 '15 at 3:35
  • $\begingroup$ Also it's impossible to search for it. $\endgroup$ – shrx Aug 8 '15 at 7:09
  • $\begingroup$ @shrx FWIW I use the term "vanishing function" $\endgroup$ – Mr.Wizard Aug 9 '15 at 5:42
6
$\begingroup$
a = {{1, 2, 3}, {4, 5, 6, 7}, {1}, {1, 8}, {9, 10}, {11, 6, 12, 13, 14, 15, 16}};

b = First /@ Select[Tally[Flatten@a], Last[#] > 1 &];

c = DeleteCases[a /. Thread[b -> Sequence[]], {}]

{{2, 3}, {4, 5, 7}, {8}, {9, 10}, {11, 12, 13, 14, 15, 16}}

$\endgroup$
5
$\begingroup$

If

list = {{1, 2, 3}, {4, 5, 6, 7}, {1}, {1, 8}, {9, 10}, {11, 6, 12, 13, 14, 15, 16}}

then define

outs = Alternatives @@ Cases[Tally@Flatten@list, a_ /; Last@a >= 2 :> First@a];

Change the 2 to whatever tally you want.

Then

DeleteCases[#, outs] & /@ list /. {} -> Sequence[]
(* {{2, 3}, {4, 5, 7}, {8}, {9, 10}, {11, 12, 13, 14, 15, 16}} *)

Alternatively (based on a comment from MarcoB),

DeleteCases[list, outs, {2}] /. {} -> Sequence[]
$\endgroup$
  • 2
    $\begingroup$ As an alternative to Mapping the DeleteCases expression, you could also indicate a level specification for its application, such as DeleteCases[list, outs, 2]. (+1) $\endgroup$ – MarcoB Aug 7 '15 at 22:07
  • $\begingroup$ Yes that gets me what I wanted $\endgroup$ – Hamti Aug 7 '15 at 22:07
  • 1
    $\begingroup$ @MarcoB. Thanks for the hint (+1); somehow I missed the fact that Cases takes a level-spec. $\endgroup$ – march Aug 7 '15 at 22:22
  • 1
    $\begingroup$ Slightly shorter version: list /. Cases[Tally@Flatten@list, a_ /; Last@a >= 2 :> (First@a -> Sequence[])] /. {} -> Sequence[] $\endgroup$ – Simon Rochester Aug 7 '15 at 22:22
  • $\begingroup$ @march no problem, thank you for including it! $\endgroup$ – MarcoB Aug 7 '15 at 22:26
5
$\begingroup$

My proposal, also leveraging Counts as used by WReach:

drop[expr_, thr_Integer] :=
  Pick[expr, Replace[expr, UnitStep[Counts[Join @@ expr] - thr], {2}], 0]

And not quite as efficient but pleasingly terse:

drop2[expr_, thr_Integer] :=
  Select[# < thr & /@ Counts[Join @@ expr]] /@ expr

Test:

input = {{1, 2, 3}, {4, 5, 6, 7}, {1}, {1, 8}, {9, 10}, {11, 6, 12, 13, 14, 15, 16}};

drop[input, 2]
{{2, 3}, {4, 5, 7}, {}, {8}, {9, 10}, {11, 12, 13, 14, 15, 16}}

To drop the empty list you can follow with DeleteCases:

input ~drop~ 2 ~DeleteCases~ {}
{{2, 3}, {4, 5, 7}, {8}, {9, 10}, {11, 12, 13, 14, 15, 16}}

This appears to be somewhat faster than WReach's formulations. His as functions:

WRf1[$list_, n_] :=
     With[{count = Counts@Flatten@$list},
      DeleteCases[$list, x_ /; count[x] >= n, {2}]
 ]

WRf2[$list_, n_] :=
     With[{count = Counts@Flatten@$list},
      Pick[$list, Map[count[#] < 2 &, $list, {2}]]
 ]

WRf3[$list_, n_] :=
     With[{count = Counts@Flatten@$list},
      $list /. x_Integer /; count[x] >= 2 :> Sequence[]
 ]

And a timing comparison:

big = RandomInteger[1*^5, {5000, 100}];

First @ RepeatedTiming @ #[big, 3] & /@ {WRf1, WRf2, WRf3, drop, drop2}
{0.5712, 0.603, 0.593, 0.369, 0.434}
$\endgroup$
3
$\begingroup$
test = {{1, 2, 3}, {4, 5, 6, 7}, {1}, {1, 8}, {9, 10}, {11, 6, 12, 13,
    14, 15, 16}}

then

res=test /. Cases[
  Tally[Flatten@test], {x_, _?(# >= 2 &)} :> Rule[x, Sequence[]]]

yields:

{{2, 3}, {4, 5, 7}, {}, {8}, {9, 10}, {11, 12, 13, 14, 15, 16}}

and

res/.{}->Sequence[]

will yield desired result

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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