Quickly plotting (number of events) vs. (time) for a very large number of events encoded as pairs of real numbers representing start and end times

Question

I have an array that looks like the following:

exampleArray = {{t1,r1},{t2,r2},{t3,r3},{t4,r4},{t5,r5},...};

Where each pair of real numbers $(t_k,r_k)$ represents some "event" (independent of all other events) starting at time $t_k$ and ending at time $r_k$. Provided some time $t_i$ and exampleArray, I'd like to quickly return the number of "events" at this time. I'd also like to quickly plot the number of events versus time over some interval. The catch is that exampleArray might have a very large number of elements, so we wouldn't want to scan through it multiple times.

Is there an elegant way to do this in Mathematica?

Answer 1

First, make up some data in the form of the exampleArray:

startTimes = RandomReal[{0, 100}, 50];
endTimes = startTimes + RandomReal[{0, 10}, 50];
ex = Transpose[{startTimes, endTimes}]

Here's a function to find how many of the pairs straddle the value t:

sel[t_] := Length[Select[ex, #[[1]] < t < #[[2]] &]]

For example, calling sel[25] counts how many of the pairs contain the point t=25. Calling

sel[#] & /@ {25, 30, 35}

shows how many times 25, 30 and 35 are contained. You can plot straightforwardly:

ListPlot[Table[sel[t], {t, 1, 100}]]

Answer 2

It's certainly not as fast as the implementations already provided, but have you considered looking at EventData and the related functionality introduced in M9?

Using Kuba's data:

startTimes = RandomReal[{0, 100}, 100];
endTimes = startTimes + RandomReal[{0, 10}, 100];
events = EventData[Transpose[{startTimes, endTimes}]];

Use SurvivalModelFit to build a survival model of the data, this is like LinearModelFit in that it creates an object with properties. The useful one here is "EventMatrixPlot"

AbsoluteTiming[SurvivalModelFit[events]["EventMatrixPlot"]]

Answer 3

data = [Sort /@ RandomReal[100, {100, 2}];

Now let's get list of beginings and endings:

{start,stop}=Transpose[data]

Now both time-start[[i]] and stop-time[[i]] have to be positive:

sel2[t_] := Total[UnitStep[t - start] UnitStep[stop - t]]


Plot[Total[UnitStep[t - start] UnitStep[stop - t]], {t, 0, 100}]

---

Speed comparison:

startTimes = RandomReal[{0, 100}, 100];
endTimes = startTimes + RandomReal[{0, 10}, 100];

ex = Transpose[{startTimes, endTimes}];

sel[t_] := Length[Select[ex, #[[1]] < t < #[[2]] &]];
sel2[t_] := Total[UnitStep[t - startTimes] UnitStep[endTimes - t]]

n = 1000;
k = RandomReal[100];
sel[k]~Do~{n} // Timing
sel2[k]~Do~{n} // Timing

{0.312002, Null}
{0.015600, Null}