9
$\begingroup$

I want to find the n largest values in a matrix and replace all others with zero.

The solution I found uses ReplaceAll and becomes very slow as the size of matrices grows:

FindLargestValues[m_?MatrixQ, n_Integer] :=
  With[{v = (Union @ Flatten @ m)[[-n]]},
    m /. x_Real /; x < v :> 0]

Example:

(small = RandomReal[{1, 10}, {5, 5}]) // MatrixForm

enter image description here

FindLargestValues[small, 10] // MatrixForm

enter image description here

Timing example:

large = RandomReal[{1, 10}, {50, 50}];

Do[FindLargestValues[large, 50], {1000}]; // Timing // First

2.574016

Is there a faster way to do this?

$\endgroup$
1

4 Answers 4

11
$\begingroup$

Assuming that the values of your matrix are all distinct, or that you don't count repetitions in n, you can do this:

ClearAll[largest];
largest[mat_, n_] := Clip[mat,{RankedMax[#, n], Max[#]}, {0, 0}] &[Flatten@mat]

So that

large = RandomReal[{1, 10}, {50, 50}];
Do[largest[large, 50], {1000}]; // Timing // First

(* 0.076633 *)
$\endgroup$
5
  • $\begingroup$ Beat me to it! +1 :-) $\endgroup$ Sep 9, 2014 at 12:01
  • $\begingroup$ Your assumptions are right +1 $\endgroup$
    – eldo
    Sep 9, 2014 at 12:06
  • $\begingroup$ ah, Clip, me old favorite! $\endgroup$
    – Yves Klett
    Sep 9, 2014 at 14:16
  • $\begingroup$ It seems a teeny bit faster to use Infinity in place of Max[#] $\endgroup$ Sep 9, 2014 at 18:48
  • 1
    $\begingroup$ @SimonWoods Somehow I seemed to recall that Infinity might unpack, so didn't use it. Perhaps, I was wrong - I didn't test it this time. $\endgroup$ Sep 9, 2014 at 18:52
9
$\begingroup$

I can't test the timing right now, but maybe it's worth mentioning

Threshold[large, {"LargestValues", 50}]
$\endgroup$
0
4
$\begingroup$

Here is a relative minor variation on eldo's method that speeds it up considerably, but still falls well short of Lenonid Shifrin's better algorithm.

 keepMax[matrix_, n_] :=
   With[{threshold = (Union@Flatten@matrix)[[-n]]},
     Map[If[# < threshold, 0, #] &, matrix, {2}]]

Absolute timings

SeedRandom[42]; testData = RandomInteger[{1, 99}, {50, 50}];
eldo = (Do[FindLargestValues[testData, 50], {1000}]; // Timing // First)
1.218814
shif = (Do[largest[testData, 50], {1000}]; // Timing // First)
0.088629
mg = (Do[keepMax[testData, 50], {1000}]; // Timing // First)
0.446820

Comparative timings

{eldo/mg, mg/shif, eldo/shif}a 
{2.72775, 5.0415, 13.752}

Further, it would seem that my computer is faster than eldo's but a little slower than Shifrin's.

$\endgroup$
1
$\begingroup$

I wondered if compiling was worth a shot...

You can go a little faster than @SimonWoods' answer of Threshold[large, {"LargestValues", 50}].

large = RandomReal[{1, 10}, {50, 50}];

FindLargestValues = Compile[{{matrix, _Real, 2}, {n, _Integer}},
   Module[{minvalue},
    minvalue = (Union@Flatten@matrix)[[-n]];
    Chop[matrix, minvalue]
    ],
   CompilationTarget -> "C"
   ];

Do[FindLargestValues[large, 50], {1000}]; // AbsoluteTiming // First
(* 0.151 seconds *)

Do[Threshold[large, {"LargestValues", 50}], {1000}]; // 
  AbsoluteTiming // First
(* 0.270 seconds *)

But still @LeonidShifrin's answer wins out (and contains functions that cannot be compiled anyway).

largest[mat_, n_] := 
 Clip[mat, {RankedMax[#, n], Max[#]}, {0, 0}] &[Flatten@mat]

Do[largest[large, 50], {1000}]; // AbsoluteTiming // First
(* 0.044 seconds *)
$\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.