[R] Script help: Determining Time Difference between two data points.

William Dunlap wdunlap at tibco.com
Tue Jul 17 23:50:10 CEST 2012


By the way, here is a related function I wrote in response to an R-help question
a while back that finds sequences that start when a signal rises about a certain
threshold and end when the signal drops below a lower threshold.  This avoids
hysteresis-like problems.

f1 <- function(x, startThreshold, stopThreshold, plot=FALSE) {
    # find intervals that
    #  start when x goes above startThreshold and
    #  end when x goes below stopThreshold.
    # Return the positions in x of the start and end points of each interval.
    stopifnot(startThreshold > stopThreshold)
    isFirstInRun <- function(x)c(TRUE, x[-1] != x[-length(x)])
    isLastInRun <- function(x)c(x[-1] != x[-length(x)], TRUE)
    isOverStart <- x >= startThreshold
    isOverStop <- x >= stopThreshold
    possibleStartPt <- which(isFirstInRun(isOverStart) & isOverStart)
    possibleStopPt <- which(isLastInRun(isOverStop) & isOverStop)
    pts <- c(possibleStartPt, possibleStopPt)
    names(pts) <- rep(c("start","stop"),
      c(length(possibleStartPt), length(possibleStopPt)))
    pts <- pts[order(pts)]
    tmp <- isFirstInRun(names(pts))
    start <- pts[tmp & names(pts)=="start"]
    stop <- pts[tmp & names(pts)=="stop"]
    # Remove case where first downcrossing happens
    # before first upcrossing.
    if (length(stop) > length(start)) stop <- stop[-1]

    if (plot) {
        plot(x, cex=.5)
        abline(h=c(startThreshold, stopThreshold))
        abline(v=start, col="green")
        abline(v=stop, col="red")
    }
    data.frame(start=start, stop=stop)
}

Bill Dunlap
Spotfire, TIBCO Software
wdunlap tibco.com


> -----Original Message-----
> From: William Dunlap
> Sent: Tuesday, July 17, 2012 2:10 PM
> To: 'APOCooter'; r-help at r-project.org
> Subject: RE: [R] Script help: Determining Time Difference between two data points.
> 
> Look at ?as.numeric.difftime
> 
>   > z <- f(d, d$Score > 150)
>   > elapsedTime <- z$endDate - z$startDate
>   > units(elapsedTime)
>   [1] "secs"
>   > as.numeric(elapsedTime, units="hours")
>   [1]   7.616667   0.000000 192.700000   4.366667  62.966667   0.000000  12.500000
> 0.000000
>   > as.numeric(elapsedTime, units="days")
>   [1] 0.3173611 0.0000000 8.0291667 0.1819444 2.6236111 0.0000000 0.5208333
> 0.0000000
>   > as.numeric(elapsedTime, units="secs")
>   [1]  27420      0 693720  15720 226680      0  45000      0
> 
> Bill Dunlap
> Spotfire, TIBCO Software
> wdunlap tibco.com
> 
> 
> > -----Original Message-----
> > From: r-help-bounces at r-project.org [mailto:r-help-bounces at r-project.org] On
> > Behalf Of APOCooter
> > Sent: Tuesday, July 17, 2012 11:41 AM
> > To: r-help at r-project.org
> > Subject: Re: [R] Script help: Determining Time Difference between two data points.
> >
> > Yes!  That does exactly what I want it to.  Thank you so much.
> >
> > One question, though, is it possible that the time difference be in hours
> > instead of seconds (other than dividing by 3600)?  Looking at the code, I
> > don't know what I would change.
> >
> > Does this do what you want?
> >   > firstInRun <- function(x) c(TRUE, x[-1] != x[-length(x)])
> >   > lastInRun <- function(x) c(x[-1] != x[-length(x)], TRUE)
> >   > f <- function(data, condition) {
> >   +     with(data, data.frame(startDate = Date[firstInRun(condition)],
> >   +                           endDate = Date[lastInRun(condition)]))
> >   + }
> >   > f(d, d$Score > 150)
> >
> > --
> > View this message in context: http://r.789695.n4.nabble.com/Script-help-
> > Determining-Time-Difference-between-two-data-points-tp4636743p4636786.html
> > Sent from the R help mailing list archive at Nabble.com.
> >
> > ______________________________________________
> > R-help at r-project.org mailing list
> > https://stat.ethz.ch/mailman/listinfo/r-help
> > PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> > and provide commented, minimal, self-contained, reproducible code.



More information about the R-help mailing list