How to speed up Mathematica replacement of matrix elements - wolfram-mathematica

Question

I have several 100x15 matrices; one of them is a distance. When elements of that matrix exceed a bound, I want to reset those elements to zero and also reset the corresponding elements of three other matrices to zero. Here's my silly way (but it works):
Do[ If[ xnow[[i, j]] > L, xnow[[i, j]] = 0.;
cellactvA[[i, j ]] = 0.;
cellactvB[[i, j ]] = 0.;
cellactvC[[i, j ]] = 0.; ], (* endIF *)
{ i, 1, nstrips}, {j, 1, ncells} ]; (* endDO *)
I tried ReplacePart:
xnow = ReplacePart[ xnow, Position[ xnow, x_?(# > L &) ] ]
(something like this, I don't have it handy; it was done correctly enough to execute), but it was as slow as the loop and did not produce the correct replacement structure in matrix xnow. Please advise on how to do this in a way that is reasonably quick, as this calc is inside another loop (over time) that executes many many times. The overall calculation is of course, now, very slow. Thanks in advance.
Here is how I did this in R; very simple and quick:
# -- find indices of cells outside window
indxoutRW <- which( xnow > L, arr.ind=T )
# -- reset cells outside window
cellrateA[indxoutRW] <- 0
cellrateB[indxoutRW] <- 0
cellrateC[indxoutRW] <- 0
# -- move reset cells back to left side
xnow[indxoutRW] <- xnow[indxoutRW] - L

Answer 1

How about this:
Timing[
matrixMask2 = UnitStep[limit - $xnow];
xnow = $xnow*matrixMask2;
cellactvA2 = $a*matrixMask2;
cellactvB2 = $b*matrixMask2;
cellactvC2 = $c*matrixMask2;
]
If you want to write fast code one thing to make sure is to check that On["Packing"] does not gives messages; or at least that you understand them and know that they are not an issue.
Edit for OP comment:
mask = UnitStep[limit - xnow];
{xnow*mask, cellactvA2*mask, cellactvB2*mask, cellactvC2*mask}
Hope this helps, you still need to set limit.

Answer 2

The following will be based on SparseArrays, avoid extraneous stuff and very fast:
extractPositionFromSparseArray[
HoldPattern[SparseArray[u___]]] := {u}[[4, 2, 2]];
positionExtr[x_List, n_] :=
extractPositionFromSparseArray[
SparseArray[Unitize[x - n], Automatic, 1]]
replaceWithZero[mat_, flatZeroPositions_List, type : (Integer | Real) : Real] :=
Module[{copy = Flatten#mat},
copy[[flatZeroPositions]] = If[type === Integer, 0, 0.];
Partition[copy, Last[Dimensions[mat]]]];
getFlatZeroDistancePositions[distanceMat_, lim_] :=
With[{flat = Flatten[distanceMat]},
With[{originalZPos = Flatten# positionExtr[flat , 0]},
If[originalZPos === {}, #, Complement[#, originalZPos ]] &#
Flatten#positionExtr[Clip[flat , {0, lim}, {0, 0}], 0]]];
Now, we generate our matrices, making sure that they are packed:
{xnow, cellactvA, cellactvB, cellactvC} =
Developer`ToPackedArray /# RandomReal[10, {4, 100, 15}];
Here is the benchmark for doing this 1000 times:
In[78]:=
Do[
With[{L = 5},
With[{flatzpos = getFlatZeroDistancePositions[xnow,L]},
Map[replaceWithZero[#,flatzpos ]&,{xnow,cellactvA,cellactvB,cellactvC}]]
],
{1000}]//Timing
Out[78]= {0.203,Null}
Note that there was no unpacking in the process, but you have to ensure that you have your matrices packed from the start, and that you pick the correct type (Integer or Real) for the replaceWithZero function.

Answer 3

Yet another method which seems to be fast
xnow = $xnow; a = $a; b = $b; c = $c;
umask = Unitize#Map[If[# > limit, 0, #] &, xnow, {2}];
xnow = xnow*umask; a = a*umask; b = b*umask; c = c*umask;
Based on limited testing in Nasser's setup it seems it is as fast as the SparseArray-based mask.
Edit: Can combine with SparseArray to get a slight speed-up
umask2=SparseArray[Unitize#Map[If[# > limit, 0, #] &, xnow, {2}]];
xnow = xnow*umask2; a = a*umask2; b = b*umask2; c = c*umask2;
Edit 2: Inspired by ruebenko's solution, another built-in function (not nearly as fast as UnitStep but much faster than others):
umask3 = Clip[xnow, {limit, limit}, {1, 0}];
xnow = xnow*umask3; a = a*umask3; b = b*umask3; c = c*umask3;

Answer 4

Does this approach work for you?
matrixMask =
SparseArray[Thread[Position[xnow, _?(# > 0.75 &)] -> 0.],
Dimensions[xnow], 1.];
xnow = xnow * matrixMask;
cellactvA = cellactvA * matrixMask;
cellactvB = cellactvB * matrixMask;
cellactvC = cellactvC * matrixMask;
The basic idea is to create a matrix that is zero where your threshold is crossed, and one everywhere else. Then we use element-wise multiplication to zero out the appropriate elements in the various matrices.

Answer 5

ReplacePart is notoriously slow.
MapThread should do what you want - note the third argument.
{xnow, cellactvA, cellactvB, cellactvC} =
RandomReal[{0, 1}, {4, 10, 5}]
L = 0.6;
MapThread[If[#1 > L, 0, #2] &, {xnow, xnow}, 2]
And for all four matrices
{xnow, cellactvA, cellactvB, cellactvC} =
MapThread[Function[{x, y}, If[x > L, 0, y]], {xnow, #},
2] & /# {xnow, cellactvA, cellactvB, cellactvC}

Answer 6

may be
(*data*)
nRow = 5; nCol = 5;
With[{$nRow = nRow, $nCol = nCol},
xnow = Table[RandomReal[{1, 3}], {$nRow}, {$nCol}];
cellactvA = cellactvB = cellactvC = Table[Random[], {$nRow}, {$nCol}]
];
limit = 2.0;
now do the replacement
pos = Position[xnow, x_ /; x > limit];
{cellactvA, cellactvB, cellactvC} =
Map[ReplacePart[#, pos -> 0.] &, {cellactvA, cellactvB, cellactvC}];
edit(1)
Here is a quick speed comparing the 4 methods above, the LOOP, and then Brett, me, and Verbeia. May be someone can double check them. I used the same data for all. created random data once, then used it for each test. Same limit (called L) I used matrix size of 2,000 by 2,000.
So speed Timing numbers below does not include data allocation.
I run the tests once.
This is what I see:
For 2,000 by 2,000 matrices:
Bill (loop): 16 seconds
me (ReplacPart): 21 seconds
Brett (SparseArray): 7.27 seconds
Verbeia (MapThread): 32 seconds
For 3,000 by 3,000 matrices:
Bill (loop): 37 seconds
me (ReplacPart): 48 seconds
Brett (SparseArray): 16 seconds
Verbeia (MapThread): 79 seconds
So, it seems to be that SparseArray is the fastest. (but please check to make sure I did not break something)
code below:
data generation
(*data*)
nRow = 2000;
nCol = 2000;
With[{$nRow = nRow, $nCol = nCol},
$xnow = Table[RandomReal[{1, 3}], {$nRow}, {$nCol}];
$a = $b = $c = Table[Random[], {$nRow}, {$nCol}]
];
limit = 2.0;
ReplacePart test
xnow = $xnow;
a = $a;
b = $b;
c = $c;
Timing[
pos = Position[xnow, x_ /; x > limit];
{xnow, a, b, c} = Map[ReplacePart[#, pos -> 0.] &, {xnow, a, b, c}]][[1]]
SparseArray test
xnow = $xnow;
a = $a;
b = $b;
c = $c;
Timing[
matrixMask =
SparseArray[Thread[Position[xnow, _?(# > limit &)] -> 0.],
Dimensions[xnow], 1.]; xnow = xnow*matrixMask;
a = a*matrixMask;
b = b*matrixMask;
c = c*matrixMask
][[1]]
MapThread test
xnow = $xnow;
a = $a;
b = $b;
c = $c;
Timing[
{xnow, a, b, c} =
MapThread[Function[{x, y}, If[x > limit, 0, y]], {xnow, #},
2] & /# {xnow, a, b, c}
][[1]]
loop test
xnow = $xnow;
a = $a;
b = $b;
c = $c;
Timing[
Do[If[xnow[[i, j]] > limit,
xnow[[i, j]] = 0.;
a[[i, j]] = 0.;
b[[i, j]] = 0.;
c[[i, j]] = 0.
],
{i, 1, nRow}, {j, 1, nCol}
]
][[1]]
edit(2)
There is something really bothering me with all of this. I do not understand how a loop can be faster that the specialized commands for this purpose?
I wrote a simple loop test in Matlab, like Bill had using R, and I getting much lower timings there also. I hope an expert can come up with a much faster method, because now I am not too happy with this.
For 3,000 by 3,000 matrix, I am getting
Elapsed time is 0.607026 seconds.
This is more than 20 times faster than the SparseArray method, and it is just a loop!
%test, on same machine, 4GB ram, timing uses cpu timing using tic/toc
%allocate data
nRow = 3000;
nCol = 3000;
%generate a random matrix of real values
%between 1 and 3
xnow = 1 + (3-1).*rand(nRow,nRow);
%allocate the other 3 matrices
a=zeros(nRow,nCol);
b=a;
c=b;
%set limit
limit=2;
%engine
tstart=tic;
for i=1:nRow
for j=1:nCol
if xnow(i,j) > limit
xnow(i,j) = 0;
a(i,j) = 0;
b(i,j) = 0;
c(i,j) = 0;
end
end
end
toc(tstart)
fyi: using cputime() gives similar values.as tic/toc.