Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Consider :

list = {100,102,103,99,106,107,104,112}

I want to consider, extract only the "big moves" of that time series. In this case the moves bigger then 5 from the moving point of reference.

The pseudo code would go as such :

Let's assume you have the data x(t) for t=1 to T,

You start from the first data point, z(1) = x(1)

if abs(x(2)-z(1))> delta, 
    z(2)= x(2), 
elseif abs(x(3)-z(1))> delta, 
    z(2)= x(3), 
elseif abs(x(4)-z(1))> delta, 
    z(2)= x(4),    
    if abs(x(5)-z(2))> delta, 
        z(3)= x(5), 
    elseif abs(x(6)-z(2))>delta, 
        z(3)= x(6),
        if abs(x(7)-z(3))>delta, 
            z(4)=x(7)
        endif
    endif
endif

I tried to write it with an If statement, but I don't know when my test is going to pass thus, how many Ifs to nest.

If[Abs[list[[2]]-list[[1]]]>5,
   list[[2]],
             If[Abs[list[[3]]-list[[1]]>5,
             list[[3]]....

Here this process will stop at list[[5]] with Abs[list[[5]]-list[[1]]=6

At this point, list[[5]] becomes my new point of reference :

 If[Abs[list[[6]]-list[[5]]]>5,
     list[[6]],
              If[Abs[list[[7]]-list[[5]]>5,
             list[[7]]....

So my desired output is the following :

{100,106,112}

I am pretty sure, this type of operation has a name but I don't know it. It felt like a While[] or For[] but I can`t figure it out. Please let me know how to improve the question.

share|improve this question
    
You meant "You start from the first data point, z(1) = x(1)"? –  Rojo Feb 25 '12 at 0:44
    
@Rojo, Yes ! Thank you, Edited. –  500 Feb 25 '12 at 0:45
    
500, apparently I misunderstood your question, so please disregard my answers for the time being. I'll leave them for reference. I am too tired to fix it now. –  Mr.Wizard Feb 25 '12 at 3:14
    
500, just FYI, you're getting you've been using backquotes () instead of an apostrophe (') in contractions. For example "dont" instead of "don't", which causes problems with the formatting of your posts. –  Brett Champion Feb 25 '12 at 5:36
    
This reminds me of things like KagiChart and RenkoChart which have similar behavior. It's not easy to clearly and concisely describe them either. –  Brett Champion Feb 25 '12 at 5:38
add comment

6 Answers

up vote 8 down vote accepted

In contrast to the very fast methods presented, let me give you a maybe more easy to understand solution (while this in the eye of the beholder). Basically it's sort of the way I would implement it in Haskell.

Assume you want to solve your problem step by step and in each step you have your data in the form {res, in} where res is your current solution and in is the rest of the input which needs to be processed. The initial situation is that the list res contains your first element and in contains the rest of the input. Let's go through the two possible situations:

  • Since res is your current output, you always want to compare the last element of this with the first element of your in list. When the absolute difference is larger then 5, you want to append this first element of in to your res list.

  • In all other cases, you just want to throw away the first element of in and leave res untouched.

You want to iterate this as long as there are elements in your input. Thats all, and you can write it directly down:

step[{res_, in_}] := {Append[res, First[in]], Rest[in]} /; 
  Abs[Last[res] - First[in]] > 5;

step[{res_, in_}] := {res, Rest[in]};

NestWhile[step, {{100}, {102, 103, 99, 106, 107, 104, 112}}, 
 Length[Last[#]] > 0 &]

(* {{100, 106, 112}, {}} *)

You see that after your input list is empty, you have collected your result.

share|improve this answer
add comment

Another yet-another possibility is ReplaceRepeated:

Define

crossings = ({{First[#1]}, #1}) //. 
({a_, {Shortest[b__], e___}} /; (Abs[First@{b} - Last@{b}] > #2) 
 :> {Insert[a, Last@{b}, -1], {Last@{b}, e}}) &

Usage:

 crossings @@ {list, 5}   

gives

{{100, 106, 112}, {112}}

the first part of which gives the desired result:

 crossings @@ {list, 5} //First
 (* ==> {{100, 106, 112} *) 

An alternative is using ReplaceAll in combination with FixedPointList:

 crossingList[list_, delta_] := 
 First /@ Most@
 FixedPointList[#1 /. ({Shortest[a__], b___} /; 
 (Abs[First@{a} - Last@{a}] > delta) 
 :> {Last@{a}, b}) &, list]
share|improve this answer
add comment

I favor Fold over Scan. I find it faster, and it does without an additional variable.

Reap[
  Fold[If[Abs[#2 - #] > delta, Sow[#2], #] &, Infinity, list];
][[2, 1]]

500 asked:

How could I now store as a sublist every element skipped in between the z points in addition to the the z point themselves. I would like to have the list of the coordinates that do not pass the test, but sublists for each group of point skipped in between two Sow[].

This is the cleanest method I could think of:

list = {100, 102, 103, 99, 106, 107, 104, 107, 112};

idx =
  Reap[i = 0;
    Fold[If[++i; Abs[#2 - #] > delta, Sow[i]; #2, #] &, Infinity, list];
  ][[2, 1]];

MapThread[list[[# ;; #2]] &, {idx, Append[Rest@idx - 1, -1]}]
{{100, 102, 103, 99}, {106, 107, 104, 107}, {112}}

The output is a list of sublists, each starting with a "z point" and continuing with intervening elements before the next point.

share|improve this answer
    
Thank You very much ! –  500 Feb 25 '12 at 1:24
    
@500 I just added a much faster, if admittedly more specific answer. –  Mr.Wizard Feb 25 '12 at 1:25
    
This doesn't give the answer I expect for {100, 102, 103, 99, 106, 107, 104, 107, 112}. –  Brett Champion Feb 25 '12 at 1:45
    
@Brett Since two notes of incorrect output have been made I perhaps didn't understand the question. What output do you expect for that list? –  Mr.Wizard Feb 25 '12 at 2:51
    
Btw, I had written a similar solution and deleted it in a panick attack. It had a bug however not sowing the first element, that you neatly dealt with with that Infinity. +1 for the Infinity, hehe –  Rojo Feb 25 '12 at 4:59
show 8 more comments

Here is a slightly faster version based on FoldList and Split.

Split[
  FoldList[If[Abs[#2 - #] > delta, #2, #] &, Infinity, list]
][[2 ;;, 1]]
share|improve this answer
    
I think your first function works not correctly. Can you test the input {20, 56, 57, 62, 20}? –  halirutan Feb 25 '12 at 1:58
    
@halirutan Since two notes of incorrect output have been made I perhaps didn't understand the question. What output do you expect for that list? –  Mr.Wizard Feb 25 '12 at 2:51
2  
@MrWizard I expect {20, 56, 62, 20}. You misunderstood maybe, that after the test for (56,57) fails, 56 is kept as *reference element` until a test succeeds. –  halirutan Feb 25 '12 at 3:08
1  
@Mr.Wizard, this one yes shows you misunderstood. It doesn't do the same as your previous answer. This one only collects those contiguous jumps above delta, but he wants to go dropping values until you get to the delta difference. So if delta=3, {0, 1, 2, 3, 4, 5, 6,7,8} should give {0, 4, 8} if I understood –  Rojo Feb 25 '12 at 5:02
    
@Mr.Wizard yeah, they seem to work well if I understood the problem. I was wrong with my comment on the other post the other day, I had a blank and thought Sow as something that returned Null. +1 on this one now –  Rojo Feb 27 '12 at 0:19
add comment

Something along these lines could work:

Reap[
  Sow[ z = list[[1]] ];
  Scan[If[Abs[# - z] > delta, Sow[z = #]] &, list]
][[2, 1]]
share|improve this answer
    
Thank You for your answer ! –  500 Feb 25 '12 at 1:25
add comment

Here's another approach, based on a recursive function and pattern matching.

MinDifference[list_, d_] := MinDifference[{First[list]}, Rest[list], d]

MinDifference[store_, {}, d_] := store

MinDifference[{store___, s_}, {v_, list___}, d_] /; Abs[v-s] > d := 
   MinDifference[{store, s, v}, {list}, d]

MinDifference[{store___}, {v_, list___}, d_] := 
   MinDifference[{store}, {list}, d]

MinDifference[{100, 102, 103, 99, 106, 107, 104, 112}, 5]
{100, 106, 112}
MinDifference[{100, 102, 103, 99, 106, 107, 104, 107, 112}, 5]
{100, 106, 112}
share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.