Efficiency in array element replacement

Question

Suppose I have two lists:

list1={{-4,10,3},{8,-2,7},{10,-8,-3}, {9,9,-10}, {9,-3,-2}, {-5,-3,5}}
list2={{-4,10,0},{8,-2,-3},{10,-8,-4}, {9,9,10}, {9,-3,1}, {-5,-3,8}}

The goal is to identify elements in each sublist of list1 whose third element is larger than a given criterion, and replace the third element in the corresponding tuple in list2 with $0$.

Let's say the threshold is $1$, then the result would be:

result = {{-4, 10, 0}, {8, -2, 0}, {10, -8, -4}, {9, 9, 10}, {9, -3, 1}, {-5, -3, 0}}

I already have code to solve this, but I am looking for a more efficient way to do this without Do.

I can achieve the result by using:

out = Reap[Do[If[list1[[n, 3]] > 1, Sow[n], Continue], {n, 1, Dimensions[list1[[1]]}]][[2, 1]];
Do[list2[[out[[s]], 3]] = 0.0, {s, 1, Dimensions[out][[1]]}]

This is good for a small list, however I need an efficient way to do this with approximately 265,000 tuples. It would be a plus to keep something similar to the first step, where the points are identified and stored. The second step can be done on multiple lists, without doing the identifying of the points each time. Any ideas how to improve this ?

Answer 1

t = 1;
list2[[All, -1]] = list2[[All, -1]] UnitStep[t - list1[[All, -1]]];
list2 == result

True

Timing comparison with OP's and MarcoB's methods:

SeedRandom[1]
l1 = RandomInteger[{-10, 10}, {3000000, 3}];
l2 = RandomInteger[{-10, 10}, {3000000, 3}];
l2a = l2;
l2b = l2;
l2c = l2;

t = 1;
l2a[[All, -1]] = l2a[[All, -1]] UnitStep[t - l1[[All, -1]]]; // AbsoluteTiming // First

0.213539

(out = Reap[Do[If[l1[[n, 3]] > 1, Sow[n], Continue], {n, 1, 
        Dimensions[l1][[1]]}]][[2, 1]];
   Do[l2b[[out[[s]], 3]] = 0.0, {s, 1, Dimensions[out][[1]]}]) // 
  AbsoluteTiming // First

7.655828

With[{positions = Join[#, {-1}] & /@ Position[l1, {__, _?(# > t &)}]},
     l2c = ReplacePart[l2c, positions -> 0]]; // 
  AbsoluteTiming // First

6.617897

l2a == l2b == l2c

True

Answer 2

@kglr's answer is very elegant. Here is an alternative that explicitly stores the positions of such tuples, and for the sake of variety:

threshold = 1;

With[
  {positions = Join[#, {-1}] & /@ Position[list1, {__, _?(# > threshold &)}]},
  ReplacePart[list2, positions -> 0]
]

% == result

(* Out: 
 {{-4, 10, 0}, {8, -2, 0}, {10, -8, -4}, {9, 9, 10}, {9, -3, 1}, {-5, -3, 0}}
 True
*)

Answer 3

You can try ReplacePart, after first identifying the positions with Position, and filtering out to the ones that are position 3 with Cases:

ReplacePart[list2, Cases[Position[list1, x_ /; x > 1 ], {_, 3}] -> 0]