Efficiency limit reached? to "An efficient way to filter out the list elements based on the the elements of the second list"

Question

The challenge is following: There are two lists data1 and data2 of following type:

data1 = {{t11,X1},{t12,X2},{t13,X3}, ... ,{t1n,Xn}};
data2 = {{t21,Y1},{t22,Y2},{t23,Y3}, ... ,{t2m,Ym}};

The first coordinate in both lists is of the same type, in my case it is time. The second coordinates are different: for example, X is temperature and Y is viscosity. The number of elements in both lists is different: n ~ 10^4 and m ~ 10^7.

The task is to check whether the temperature was constant through out the whole experiment and filter out the viscosity measurements recorded within +/-10s time windows for all these deviations.

So, a suggested algorithm is following: 1. To check whether condition Xi == T is True for all elements of data1, where T is a constant value. 2. Do nothing if the condition is True 3. If the condition is False for i = k: 3.1 Determine the t1k, 3.2 Set up an interval (t1k-10;t1k+10) 3.3 Delete the values Yi that were recorded within this interval

I have performed the straightforward solution applying a number of Do cycles and If type conditions just according to the algorithm. It works but it takes a huge amount of computational time to solve, especially when dealing with large number of lists.

Perhaps there is a more efficient way?

Here is the link for an example data, as requested.

Comparing calculation times:

1. Original (slow) solution -- applied to the example data files took 6 min to compute.

   dataClean = Block[
   {sTfI, loT, datafrmod, xx, T},
   T = 40;
   
   sTfI = Cases[data1, {_, T}][[{1, -1}, 1]];
   loT = Select[data1, #[[1]] >= sTfI[[1]] && #[[1]] <= sTfI[[2]] &];
   
   datafrmod = Select[data2, #[[1]] > (loT[[1, 1]] + 5.) && #[[1]]<(loT[[-1, 1]] - 5.) &];
   xx = DeleteDuplicates[
   Select[loT, #[[2]] != T &][[;; , 1]], (Abs[#1 - #2] < 5. &)];
   
   Do[datafrmod = 
   Join[Select[datafrmod, #[[1]] < (xx[[i]] - 10) &], 
   Select[datafrmod, #[[1]] > (xx[[i]] + 10) &]], {i, Length[xx]}];
   datafrmod
   ]; // AbsoluteTiming
   

2. Solution by Coolwater was much faster but still took 50 sec to compute.

   data = Block[
   {T, which},
   T = 40;
   which = 
   With[{tsBad = 
   Extract[data1[[All, 1]], 
   Position[data1[[All, 2]], Except[T], {1}, Heads -> False]]}, 
   Complement[Range[Length[data2]], ##] & @@ 
   Nearest[data2[[All, 1]] -> "Index", tsBad, {\[Infinity], 10}]];
   data2[[which]]
   ]; // AbsoluteTiming
   

Is it the limit for the efficiency?

Answer 1

Try this:

which = With[{tsBad = Extract[data1[[All, 1]], Position[data1[[All, 2]], Except[T], {1}, Heads -> False]]},
           Complement[Range[Length[data2]], ##] & @@ Nearest[data2[[All, 1]] -> "Index", tsBad, {∞, 10}]];

data3 = data2[[which]];

Answer 2

Here's a readable approach based on your example data

data1 = Import["data1.dat"];
data2 = Import["data2.dat"];

Let's inspect your data.

data1[[;; , 2]] // Union

{20, 26, 40, 41}

There seems to be only 4 values for the temperature ever read.

data1[[;; , 2]] // Commonest

{40}

Seems like the normal, stable temperature is 40. So we want to get rid of any datapoints within 10 seconds of the temperature not being 40. Let's get a list of the bad temperature readings.

bad = Position[data1, {_, Except[40]}] // Flatten // data1[[#]] &

{{2.0013,20},{4.9991,20},{6.9999,20},{8.9999,20},{11.9998,20},<<85>>,
 {38772.4,41},{38775.2,41},{38778.1,41},{41814.,41}}

Let's generate the conditions for the datapoints to be discarded based on the time.

condition = (Or @@ (# - 10 < x && x < # + 10 & @@@ bad) // Simplify) /. x -> #
List @@ condition // Short

{-7.9987<#1<45.9995,895.008<#1<915.008,1797.05<#1<1834.05,
 <<19>>,38759.6<#1<38788.1,41804.<#1<41824.}

Replacing x with Slot (#) has to do with working around MMA's scoping.

There's a lot of data to deal with, let's make this into a compiled function:

compiledTest = 
 With[{condition = condition}, 
  Compile[x, If[condition &@x, 1., 0.], 
   RuntimeAttributes -> {Listable}, Parallelization -> True]]

Slowest part of the procedure:

 picker = compiledTest[data2[[;; , 1]]]; // AbsoluteTiming

{2.01518, Null}

 (filteredData2 = Pick[data2, picker, 0.];) // AbsoluteTiming

{0.161324, Null}

Length@filteredData2
Length@data2

2476550
2514200

Finally:

badData2 = Pick[data2, picker, 1.];
ListPlot[{filteredData2[[;; ;; 100]], badData2}, PlotRange -> Full]

It doesn't look like there was much to gain from filtering in the first place. Looks like you have quite some issues with digital noise.