# Replacing matrix values

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 FindLargestValues[small, 10] // MatrixForm 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?

• – Yves Klett Sep 9 '14 at 14:18

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

• Beat me to it! +1 :-) – dr.blochwave Sep 9 '14 at 12:01
• Your assumptions are right +1 – eldo Sep 9 '14 at 12:06
• ah, Clip, me old favorite! – Yves Klett Sep 9 '14 at 14:16
• It seems a teeny bit faster to use Infinity in place of Max[#] – Simon Woods Sep 9 '14 at 18:48
• @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. – Leonid Shifrin Sep 9 '14 at 18:52

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

Threshold[large, {"LargestValues", 50}]


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; 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.

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