Replacing a for-loop with something functional

Question

I'm a physics grad and have been using Mathematica mostly for data visualization. The evaluation part I normally do with C/Python, but I've been wanting to try out Mathematica for these tasks, too.

Case in point, I made two notebooks for trimming and evaluating data for a recent experiment.

Code example:

new = data[[All, 1]]
For[i = 1, i < Length[data[[All, 1]]] - 1, i += 1,
If[
   Abs[data[[i, 1]] - data[[i + 1, 1]]] > 2000,
   new[[i + 1]] = Mean[{data[[i, 1]], data[[i + 2, 1]]}];
i += 1;
]];

data[] is a list with ~30000 datapoints (x, y, value). Here, x from xmin to xmax has to be linear, but there are some (very few) points that were measured incorrectly and thus are way above/below the other points.

The loop above iterates over this list and checks the difference of list element [i] and [i+1]. If this difference is larger than a threshold, element [i+1] is replaced by the mean value of element [i] and [i+2].

I would love to know if there was a more elegant way of doing this? Ideally faster, too, since I intend to use this on much larger lists. The above is one loop of many, so an explanation of the thought process that went into the solution would help a great deal :)

Thanks a lot in advance!

EDIT: Maybe I haven't stated my problem clearly enough, so I'll try again. I really don't need help regarding what the above code does - it does exactly what I want and has been tested with many datasets. I just want to know if there is a more "Mathematica-ish" way of writing it, since I've been told to avoid for-loops as Mathematica promotes a more functional style of programming.

ONE MORE EDIT: I'd like to thank everyone who devoted some time to this. I see that I should've included sample data when stating the problem, I'll try to remember next time ;)

Answer 1

Best to try and work with the entire lists rather than loop through it with For or Table.

You obviously have your reasons for your algorithm but to me it is strange because if your test returns True then you effectively increment twice. Which you can see with this version of your code:

list = {};
new = data[[All, 1]]
For[i = 1, i < Length[data[[All, 1]]] - 1, ++i,
  test = Abs[data[[i, 1]] - data[[i + 1, 1]]] > 2000;
  If[test,
   list = Join[list, {{i, test}}];
   new[[i + 1]] = Mean[{data[[i, 1]], data[[i + 2, 1]]}];
   ++i,
   list = Join[list, {{i, test}}]]
  ];
list

So you are not actually looping through every element in your list.

Going through what you are doing

Abs[data[[i, 1]] - data[[i + 1, 1]]]

can be rewritten for the list as

Abs[-Differences[data[[All, 1]]]]

From here, If I wanted to "loop" through every element, rather than skip some, I would do this:

positions = 
 Pick[Range[2, Length[data[[All, 1]]] - 1], 
  Thread[Abs[-Differences[data[[;; -2, 1]]]] > 2000], True];

new[[positions]] = 
  Mean /@ Transpose[{data[[positions - 1, 1]], 
     data[[positions + 1, 1]]}];

So what happens in this code is that you test which elements need to be replaced in one go rather than via a loop. You then apply that test to find the positions in your list that get replaced. You could also use Position and I would recommend trying that as well to see which is the more efficient ...Pick is likely to be faster for longer lists. ListCorrelate is another function that could be used to develop a solution.

To address your increment jumping I've made the following modification:

new1 = data[[All, 1]];
tmp = # > 2000 & /@ Abs[-Differences[data[[;; -2, 1]]]];
true = Rest@FoldList[If[#1 == #2, False, #2] &, False, tmp];
positions = Pick[Range[2, Length[data[[All, 1]]] - 1], true, True];
new1[[positions]] = 
  Mean /@ Transpose[{data[[positions - 1, 1]], 
     data[[positions + 1, 1]]}];
new1

Test

SeedRandom[123];
data = RandomReal[{1, 10000}, {30000, 2}];

On my computer -- V9.0.1 OS X -- your method (returning new) took 27 seconds mine (returning new1) took 0.054 seconds. A not too shabby 500 times improvement.

new==new1

(* True *)

Answer 2

There are some problems with your example code, you are incrementing i twice, it looks like you might subscript past the end of data, etc.

Consider this idea. It sounds like you are looking at triples in your data. So start with

Partition[data, 3, 1]

That is going to take overlapping triples of your data and you process each triple separately.

Now write a function that takes three consecutive items and returns a (potentially) cleaned first item.

f[{{x1_,__},{x2_,__},{x3_,__}}]:=If[x1-x2>2000, (x1+x3)/2, x1];

That takes a list of three rows from your data and if the difference between the first item in the first two rows is too great then averages the first and third, otherwise it gives you the unchanged first item. (This doesn't exactly match your verbal description, but your verbal description doesn't match your example code, Hopefully you can see how you want to change this to get what you really want).

Now you would like to use that function f on every triple, so

Map[f, Partition[data, 3, 1]]

Given data = {{1875.81, 1, 2}, {-1613.51, 2, 3}, {533.669, 3, 4}, {-1758.47, 4, 5}, {1613.63, 5, 6}, {100.325, 6, 7}}

it give you

{1204.74, -1613.51, 1073.65, -1758.47}

and you can try to check if that does exactly what you want

Answer 3

For demonstration purpose I'll use some simple test data

test = Range[20];
test[[5]] = 200;
test[[7]] = -200;

test

{1, 2, 3, 4, 200, 6, -200, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20}

Here is a way using one of the Sequence* functions introduced in version 10.1 of Mathematica:

(test[[# + 1]] = Mean@test[[{#, # + 2}]]) & /@ 
 SequencePosition[test, {a_, b_} /; Abs[a - b] > 2000, Overlaps -> False][[All, 1]];

test

{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20}

For your special case:

new = data[[All, 1]];
(new[[# + 1]] = Mean@new[[{#, # + 2}]]) & /@ 
 SequencePosition[new, {a_, b_} /; Abs[a - b] > 2000, Overlaps -> False][[All, 1]];

Or broadly similar

new = ReplacePart[new,
 Thread[# + 1 -> Mean@new[[{#, # + 2}]] & /@ #] &
 [SequencePosition[new, {a_, b_} /; Abs[a - b] > 2000, Overlaps -> False][[All, 1]]]]

Answer 4

Table[
    If[Abs[data[[i + 1]] - data[[i]]] > 2000, 
     Mean[{data[[i]], data[[i + 2]]}], data[[i]]], 
{i, Length[data] - 2}]

It is unclear what you want to do with the last two data points, so the above code just eliminates them.