2
$\begingroup$

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

$\endgroup$
9
  • $\begingroup$ 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? $\endgroup$
    – Öskå
    Aug 14, 2013 at 9:28
  • $\begingroup$ 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) $\endgroup$
    – Wiebe
    Aug 14, 2013 at 9:33
  • $\begingroup$ 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* $\endgroup$
    – Öskå
    Aug 14, 2013 at 9:43
  • $\begingroup$ 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. $\endgroup$
    – Wiebe
    Aug 14, 2013 at 9:49
  • $\begingroup$ First Position[data, {_, 0}] and then Differences@Flatten@%-1? $\endgroup$
    – Öskå
    Aug 14, 2013 at 9:51

4 Answers 4

4
$\begingroup$

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
 ]
$\endgroup$
7
  • $\begingroup$ Do you have any experience about the speed difference between Case[] and Flatten@Position[] ? $\endgroup$
    – Öskå
    Aug 14, 2013 at 10:04
  • $\begingroup$ @Ö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. $\endgroup$
    – Mr.Wizard
    Aug 14, 2013 at 10:06
  • $\begingroup$ Ok it makes sense indeed, thanks :) $\endgroup$
    – Öskå
    Aug 14, 2013 at 10:09
  • $\begingroup$ 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 $\endgroup$
    – Wiebe
    Aug 14, 2013 at 10:16
  • $\begingroup$ @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. $\endgroup$
    – Mr.Wizard
    Aug 14, 2013 at 10:26
2
$\begingroup$

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)

$\endgroup$
4
  • $\begingroup$ That's an interpretation of the question I quite overlooked. I assumed that he wanted a function and not the actual list. $\endgroup$
    – Mr.Wizard
    Aug 14, 2013 at 10:57
  • $\begingroup$ 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. $\endgroup$
    – andre314
    Aug 15, 2013 at 10:23
  • $\begingroup$ 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 $\endgroup$
    – Mr.Wizard
    Aug 15, 2013 at 11:01
  • $\begingroup$ It took me a while to return to it but if you're interested in my solution see my updated answer. $\endgroup$
    – Mr.Wizard
    Aug 17, 2013 at 16:27
1
$\begingroup$

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

$\endgroup$
0
1
$\begingroup$

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.)

$\endgroup$
1
  • $\begingroup$ 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. $\endgroup$
    – Mr.Wizard
    Aug 17, 2013 at 18:03

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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