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.

When I have a list of data (measured per day), is it possible to define a function that gives the nr of days since the data has been 0? I tried working withPositionto find the 0's but that did not really help me to create a function.

Simplified example:

data = {{1, 0}, {2, 1}, {3, 3}, {4, 0}, {5, 1}, {6, 0}};
ListPlot[data, InterpolationOrder -> 0, AxesLabel -> {"time(day)", "data(mm)"}, Joined -> True]

enter image description here

Result I want: ( I now entered it myself, but I want to do this for large amounts of data, which makes typing it very time consuming ;))

result = {{1, 0}, {2, 0}, {3, 1}, {4, 2}, {4,0}, {5, 0}, {6, 1}};
ListPlot[result, AxesLabel -> {"time(day)", "days since last 0"}, 
   Joined -> True]

enter image description here

share|improve this question
    
Your first Plot has an InterpolationOrder->0 the other one does not have. Length@data gives 6 and Length@result gives 7. I don't really get what you want.., am I the only one? –  Öskå Aug 14 '13 at 9:28
    
The first one has InterpolationOrder ->0 as the data the graph represents is assumed to be constant over the day. For the results, I want to know the time that has passed since the last time data=0. So in this case I want a lineair function. Length@data and Length@results are not equal because I needed to specify two points at time 4 to let the graph drop to 0 directly (as from time 4 on, it has been 0 days again since the last 0) –  Wiebe Aug 14 '13 at 9:33
    
In other terms you want to know the length of gap between {2,0} and {4,0} in the result set of data? *Still confused* –  Öskå Aug 14 '13 at 9:43
    
Not completely. I want to know the gap between the 0's in data. But then given in a list, showing (per day) the time since the last 0. - Maybe the result I put in is a bit confusing. Result is not what I want, its what I have constructed myself to show the plot I want as a result. –  Wiebe Aug 14 '13 at 9:49
    
First Position[data, {_, 0}] and then Differences@Flatten@%-1? –  Öskå Aug 14 '13 at 9:51

4 Answers 4

up vote 4 down vote accepted

Basic distance function

I believe we can use a binary search as I did for:
How can the behavior of InterpolationOrder->0 be controlled?

We start by extracting the zeros from your data:

zeros = Cases[Sort @ data, {x_, 0} :> x]

{1, 4, 6}

  • If data is always sorted you can omit Sort.

  • If your zeros may not always have head Integer use the rule {x_, n_ /; n==0} :> x

I'll use the Combinatorica`BinarySearch function and Floor for simplicity; use a compiled version of Leonid's bsearchMin if you need greater speed.

Now:

Needs["Combinatorica`"]

distanceFromLast[lst_List][val_?NumericQ] :=
  val - lst[[ Floor @ BinarySearch[lst, val] ]]

Plot[distanceFromLast[zeros][x], {x, 0, 10}, AspectRatio -> Automatic]

enter image description here

Or equivalently:

distanceFromLast[zeros] /@ Range[0, 10, 0.1] // ListLinePlot

Extension and generalization

The output above doesn't quite match what question requested: the function should start climbing from zero where it does in ListPlot[data, InterpolationOrder -> 0] rather than immediately after a zero. If the data is regular as shown (sequential, evenly spaced indexes) this is simply a matter of an offset and threshold which may be done with Max[0, value - 1]:

Plot[Max[0, #-1]& @ distanceFromLast[zeros][x], {x, 0, 10}, AspectRatio -> Automatic]

enter image description here

Generalizing this to arbitrary $(x, y)$ data is more involved because the gaps vary in size. I chose to use SplitBy as a foundation. I will show the use of several functions and include the code for them below.

First I generate some data:

n = 40;
SeedRandom[1]
data = {Sort @ RandomReal[14, n], RandomInteger[4, n]}\[Transpose];

It looks like this:

p0 = ListLinePlot[data, InterpolationOrder -> 0, AspectRatio -> Automatic]

enter image description here

Then I create a distance function using my makeDistFun, plot it, and Show the two:

f1 = makeDistFun[data];

p1 = Plot[f1[x], {x, 0, 14},
      PlotStyle -> Directive[Thick, Red, Dashed],
      PlotRange -> All];

Show[p0, p1, Frame -> True]

enter image description here

If you merely wish to draw the line it will be more efficient to use the draw function I provide:

p2 = draw[data, Green];

Show[p0, p2, Axes -> False]

enter image description here

Code

Note: I again use the Combinatorica BinarySearch function for brevity, and again bsearchMin or similar will be faster if it matters in practice.

breaks[data : {{_, _} ..}] :=
  Module[{d2, split},
    d2 = Append[data, Last[data] {1, 0}];
    split = SplitBy[d2, Unitize @ #[[2]] &][[All, 1, 1]];
    Partition[If[d2[[1, 2]] == 0, Rest@#, #] &[split], 2]
  ]

Needs["Combinatorica`"]
makeDistFun[data : {{_, _} ..}] := 
  Module[{starts, ends},
    {starts, ends} = breaks[data]\[Transpose];
    With[{n = Floor @ BinarySearch[starts, #]},
      If[# < ends[[n]], # - starts[[n]], 0]
    ] &
  ]

draw[data : {{_, _} ..}, {dir__} | dir__, opts : OptionsPattern[]] :=
 Graphics[{dir,
   Line @ Flatten[{{#, 0}, {#2, #2 - #}, {#2, 0}} & @@@ breaks[data], 1]
   }, opts
 ]
share|improve this answer
    
Do you have any experience about the speed difference between Case[] and Flatten@Position[] ? –  Öskå Aug 14 '13 at 10:04
    
@Öskå It really depends on the operation; usually they are reasonably comparable. If you are thinking of Flatten @ Position[data, {_, 0}] I did not use that here because I did not assume that the indexes would always be 1 through n; with my method I extract the actual x values from the data. –  Mr.Wizard Aug 14 '13 at 10:06
    
Ok it makes sense indeed, thanks :) –  Öskå Aug 14 '13 at 10:09
    
Thanks, this is almost what I wanted. However, I want the time to start counting since data != 0. For example data=0 for t>=1 to t<2. This means I want the distanceFromLast 0 to start counting from t>=2 to t<4 –  Wiebe Aug 14 '13 at 10:16
    
@user9022 I think I understand but I'm not certain; please try using distanceFromLast[lst_List][val_?NumericQ] := Max[0, val - 1 - lst[[Floor@BinarySearch[lst, val]]]] and tell me if it works as desired; if so I'll update my answer. –  Mr.Wizard Aug 14 '13 at 10:26

Maybe :

data = {{1, 0}, {2, 1}, {3, 3}, {4, 0}, {5, 1}, {6, 0}};  

counter = 0;
result = Flatten[
                  If[ #[[2]] == 0,
                      {{#[[1]], counter}, {#[[1]], counter = 0}},
                      {{#[[1]], counter++}}
                    ] & /@ data
                ,1]

ListPlot[result, AxesLabel -> {"time(day)", "days since last 0"}, 
 Joined -> True]  

{{1, 0}, {1, 0}, {2, 0}, {3, 1}, {4, 2}, {4, 0}, {5, 0}, {6, 1}, {6, 0}}

enter image description here

The length of result is not the same as the length of data. It is also the case in your example.
Here, each time the counter is reset there is one more data : Length[result] gives 9 (instead of 7 in your example)

share|improve this answer
    
That's an interpretation of the question I quite overlooked. I assumed that he wanted a function and not the actual list. –  Mr.Wizard Aug 14 '13 at 10:57
    
Mr Wizard is right. I don't see any simple modification of my answer that make it fit the question. I will probably delete the answer. –  andre Aug 15 '13 at 10:23
    
andre No, don't delete it. It's quite relevant. It also made me think about this problem in a different way which I'll post soon if I have time. +1 –  Mr.Wizard Aug 15 '13 at 11:01
    
It took me a while to return to it but if you're interested in my solution see my updated answer. –  Mr.Wizard Aug 17 '13 at 16:27

What follows is an alternative visualization of the zeros in your data.

Let's try to separate the property of your data that you seem to be interested in from your display.

Some data...

data = RandomInteger[{0, 3}, 100]

{0, 3, 2, 1, 3, 0, 3, 3, 3, 1, 1, 2, 3, 0, 3, 0, 2, 1, 2, 1, 0, 3, 2, 1, 1, 0, 0, 3, 2, 1, 3, 1, 1, 1, 3, 1, 3, 2, 0, 1, 2, 2, 2, 1, 1, 1, 0, 3, 3, 2, 0, 2, 1, 2, 2, 3, 3, 1, 3, 1, 1, 3, 3, 0, 1, 0, 0, 2, 1, 1, 3, 1, 2, 2, 3, 1, 3, 2, 3, 1, 2, 1, 2, 1, 2, 2, 2, 2, 0, 2, 3, 0, 1, 2, 0, 1, 2, 1, 2, 0}

All that really matters is the positions of the zeros. Unitize is unnecessary but it helps hide noise in the data.

 Unitize@data /. {0 -> Style[0, 24]}
 p=Position[data, 0] // Flatten

 krea

{1, 6, 14, 16, 21, 26, 27, 39, 47, 51, 64, 66, 67, 89, 92, 95, 100}

 Differences@%

{5, 8, 2, 5, 5, 1, 12, 8, 4, 13, 2, 1, 22, 3, 3, 5}

The differences are only counted from the first occurrence of zero.

To visualize the gaps, you might use something like this...

BarChart[%,  ChartLabels -> Rest@p]

The labels on the x-axis refer to the position in which the second, third, fourth...nth zero occurred. The height represents the number of non-zero elements that preceded each respective occurrence.

enter image description here

share|improve this answer

FoldList can be used to keep track of how long ago the previous 0 occurred.

data = RandomInteger[{0, 3}, 20]

   ==> {1, 0, 2, 2, 1, 0, 1, 3, 3, 3, 0, 2, 2, 0, 0, 0, 0, 2, 0, 3}

daysSince = Rest[FoldList[If[#2 == 0, 0, #1 + 1] &, 0, data]]

   ==> {1, 0, 1, 2, 3, 0, 1, 2, 3, 4, 0, 1, 2, 0, 0, 0, 0, 1, 0, 1}

(Of course the first entry in the output list is arbitrary since we don't really know when the previous 0 occurred before the data started.)

share|improve this answer
    
mef, I'm giving you a vote because this is an excellent way to approach the basic question. However, it doesn't quite match what the OP requested. –  Mr.Wizard Aug 17 '13 at 18:03

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.