8
$\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}}
Improve this question
$\endgroup$
4
  • $\begingroup$ This does not remove the 1's and 6's inside the sublist $\endgroup$
    – Hamti
    Aug 7, 2015 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, 2015 at 23:29
  • $\begingroup$ What would be the bottleneck, @ciao, tallying, the selecting, or the delete cases? $\endgroup$
    – march
    Aug 8, 2015 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, 2015 at 5:11

5 Answers 5

Reset to default
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}} *)
Improve this answer
$\endgroup$
3
  • 3
    $\begingroup$ The pronunciation of (##&[]) cannot be uttered in polite company. It is a rather harsh colloquial synonym for Nothing. ;) $\endgroup$
    – WReach
    Aug 8, 2015 at 3:35
  • $\begingroup$ Also it's impossible to search for it. $\endgroup$
    – shrx
    Aug 8, 2015 at 7:09
  • $\begingroup$ @shrx FWIW I use the term "vanishing function" $\endgroup$
    – Mr.Wizard
    Aug 9, 2015 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}}

Improve this answer
$\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[]
Improve this answer
$\endgroup$
5
  • 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, 2015 at 22:07
  • $\begingroup$ Yes that gets me what I wanted $\endgroup$
    – Hamti
    Aug 7, 2015 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, 2015 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, 2015 at 22:22
  • $\begingroup$ @march no problem, thank you for including it! $\endgroup$
    – MarcoB
    Aug 7, 2015 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}
Improve this answer
$\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

Improve this answer
$\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.