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

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, #[] >= sTfI[] && #[] <= sTfI[] &];

datafrmod = Select[data2, #[] > (loT[[1, 1]] + 5.) && #[]<(loT[[-1, 1]] - 5.) &];
xx = DeleteDuplicates[
Select[loT, #[] != T &][[;; , 1]], (Abs[#1 - #2] < 5. &)];

Do[datafrmod =
Join[Select[datafrmod, #[] < (xx[[i]] - 10) &],
Select[datafrmod, #[] > (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 =
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?

• Can you provide a sample of data? Upload to say Dropbox. – ercegovac May 23 '18 at 19:05
• Wait, so are data1 and data2 the same length or not? How is it possible that the time stamps in data2 run up to t2n while the viscosities run up to Ym, with n and m different? – Sjoerd Smit May 24 '18 at 9:39
• @SjoerdSmit data1 and data2 are of different length. I have corrected the typo in the description of data1, thanks for pointing out – Bulat Munavirov May 25 '18 at 6:02
• Your data2 time coordinates are a mix of reals and integers. This is why Nearest is slow. Use Nearest[N @ data2[[All, 1]] -> "Index" , tsBad, {Infinity, 10}] instead and it will be much faster. Even faster is Nearest[Developer`ToPackedArray @ N @ data2[[All, 1]] -> "Index", tsBad, {Infinity, 10}] – Carl Woll May 25 '18 at 16:42

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

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}] // 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.