#' generate stops statistics for a track
#'
#' \code{statsStops} processes a gps track file to summarize start/stop data
#'
#' @param trackdf data frame or tibble with gps track data
#' @param segInitIdleAggSecs stops/restarts before this time has
#' elapsed are discarded and the ride starts at the last start prior to this
#' @param segInitIdleAggMeters stops/restarts within this distance
#' of the initial start are discarded as above
#' @param ... parameters for \code{\link{processSegments}},
#' \code{\link{statsCadence}},
#' \code{\link{statsPower}},
#' \code{\link{statsHeartRate}},
#' \code{\link{statsGearing}},
#' \code{\link{statsGrade}},
#' \code{\link{statsSession}}
#'
#' @return a list containing summary data
#'
#' @seealso \code{\link{read_ride}},
#' \code{\link{processSegments}},
#' \code{\link{statsCadence}},
#' \code{\link{statsPower}},
#' \code{\link{statsHeartRate}},
#' \code{\link{statsGearing}},
#' \code{\link{statsGrade}},
#' \code{\link{statsSession}}
#'
#' @export
statsStops <- function(trackdf,
segInitIdleAggSecs=60,
segInitIdleAggMeters=20,
...) {
segstart <- trackdf$segment != lag_one(trackdf$segment)
segstart[1] <- TRUE
timesecs <- cumsum(trackdf$deltatime)
# moving <- trackdf$speed.m.s > 0
moving <- !trackdf$stopped
moving[!((lag_one(lag_one(moving))&lag_one(moving))|
(lead_one(lead_one(moving))&lead_one(moving)))] <- FALSE
movingtime <- timesecs*as.numeric(moving)
lastmovetime <- lag_one(cummax(movingtime))
stoplength <- (timesecs[segstart] - lastmovetime[segstart])[-1]
startlinewait <- timesecs <= segInitIdleAggSecs &
trackdf$distance.m <= segInitIdleAggMeters &
trackdf$speed.m.s == 0
startlineTime <- sum(trackdf$deltatime[startlinewait])
stopsSubMinute <- sum(stoplength > 0 & stoplength < 60)
stops1to10Minutes <- sum(stoplength >= 60 & stoplength < 600)
stops10to30Minutes <- sum(stoplength >= 600 & stoplength < 1800)
stopsLong <- sum(stoplength >= 1800)
return(list(startlineTime=startlineTime,
stopsSubMinute=stopsSubMinute,
stops1to10Minutes=stops1to10Minutes,
stops10to30Minutes=stops10to30Minutes,
stopsLong=stopsLong))
}
#' clean up and add start/stop segments to a track tibble, add flag for stopped
#'
#' \code{processSegments} processes a gps track file to correct or add
#' start/stop segment information like that generated by gps autopause.
#' The sequence of processing is: eliminate stops that are too short,
#' split segments where time between observations is too large, split
#' segments where stopped for longer than threshold, then merge segments
#' which are too small. Finally, all segment breaks too close to the
#' start line are removed
#'
#' @param trackdf data frame or tibble with gps track data
#' @param segBreakTimeMin (seconds) segments separated by less time
#' than this are joined
#' @param nonsegTimeGapMax (seconds) segemnts are split between datapoints
#' separated by more time than this
#' @param segSplitTimeStop segments are split at points where
#' @param segMinObs segments smaller than this are joined to closest
#' neighboring segment
#' @param segMinMeters segments shorter than this are joined with predecessor
#' @param segMinSecs (seconds) segments shorter than this are joined
#' @param segInitIdleAggSecs stops/restarts before this time has
#' elapsed are discarded and the ride starts at the last start prior to this
#' @param segInitIdleAggMeters stops/restarts within this distance
#' of the initial start are discarded as above
#' @param ignoreSegInfo wipe existing segment information and use
#' \code{nonsegTimeGapMax} and \code{segSplitTimeStop} to
#' reconstruct segments before merging short ones
#' @param loud display summary of actions
#' @param ... parameters for
#' \code{\link{repairHR}},
#' \code{\link{repairCadence}},
#' \code{\link{statsCadence}},
#' \code{\link{statsPower}},
#' \code{\link{statsHeartRate}},
#' \code{\link{statsGearing}},
#' \code{\link{statsGrade}},
#' \code{\link{statsSession}},
#' \code{\link{statsStops}}
#'
#' @return a tibble containing track data with start/stop segment data
#'
#' @seealso \code{\link{read_ride}},
#' \code{\link{repairHR}},
#' \code{\link{repairCadence}},
#' \code{\link{statsCadence}},
#' \code{\link{statsPower}},
#' \code{\link{statsHeartRate}},
#' \code{\link{statsGearing}},
#' \code{\link{statsGrade}},
#' \code{\link{statsSession}},
#' \code{\link{statsStops}}
#'
#' @export
processSegments <- function(trackdf,
segInitIdleAggSecs=60,
segInitIdleAggMeters=20,
segBreakTimeMin=3,
nonsegTimeGapMax=30,
segSplitTimeStop=3,
segMinObs=4,segMinMeters=20,segMinSecs=20,
ignoreSegInfo=FALSE,loud=FALSE,...) {
# demand some small amount of consistency
segSplitTimeStop <- max(segSplitTimeStop,segBreakTimeMin)
# no observations will be deleted or added, so set up some useful stuff
#
timesecs <- cumsum(trackdf$deltatime)
# usually will choose to set cadence to 0 if not moving, so will have no effect
# stopped <- trackdf$speed.m.s==0 &
# (is.na(trackdf$cadence.rpm) | trackdf$cadence.rpm==0)
# try to catch random gps drift if sensors shut down at stop
# using filter on neightors, not a ts, remove that to hush dplyr warnings
# measured gps speed 0-0.2 mph indoors on window sill = 0.08 m/s
# (0.5-1.0 when warming up 10 feet inside window)
temp <- as.vector(stats::filter(trackdf$speed.m.s, rep(1/5,5)))
temp[is.na(temp)] <- trackdf$speed.m.s[is.na(temp)]
stopped <- ((temp < 0.1 & trackdf$speed.m.s < 0.3) |
trackdf$speed.m.s==0) &
((is.na(trackdf$cadence.rpm) | trackdf$cadence.rpm==0))
stopped[length(stopped)] <-TRUE
starting <- !stopped & lag_one(stopped)
starting[1] <- TRUE
### now process segment and stop data
# wipe existing segment data from gps (auto)start/stop if requested
# otherwise make it a sequence of consecutive nondecreasing integers
if (loud) {
newseg <- trackdf$segment != lag_one(trackdf$segment)
newseg[1] <- TRUE
cat("starting out with ",1+sum(trackdf$segment!=lag_one(trackdf$segment)),
" segments\n")
}
if (ignoreSegInfo) {
if (loud) cat("wiping out existing segment data\n")
trackdf$segment <- 1
}
newseg <- trackdf$segment != lag_one(trackdf$segment)
newseg[1] <- TRUE
# split really, really long intervals between points
needsplit <- (trackdf$deltatime > nonsegTimeGapMax) & !newseg
if (sum(needsplit) > 0) {
if (loud) {
cat("splitting ",sum(needsplit)," long intervals in same segment\n")
# print(trackdf$timestamp.s[needsplit])
}
newseg <- newseg | needsplit
}
# join segment breaks which are too short
needjoin <- (trackdf$deltatime < segBreakTimeMin) & newseg
needjoin[1] <- FALSE
if (sum(needjoin) > 0) {
if (loud) {
cat("joining ",sum(needjoin)," short breaks between segments\n")
#print(trackdf$timestamp.s[needjoin])
}
newseg <- newseg & !needjoin
}
# split if time since last motion is too large
lastmovedtime <- cummax(ifelse(stopped & !newseg,
0,
timesecs))
stoptoolong <- c(FALSE,diff(lastmovedtime) >= segSplitTimeStop) &
!stopped &
lag_one(stopped)
needsplit <- stoptoolong & !newseg
if (sum(needsplit) > 0) {
if (loud) {
cat("splitting ",sum(needsplit)," segments with long stops\n")
#print(trackdf$timestamp.s[needsplit])
}
newseg <- newseg | needsplit
}
############################################################################
# collapse too-short segments together join them with previous segment
# (stops and start/stops occur at end of segment)
# build subsegment id to identify these for subsequent
tempdf <- trackdf %>% dplyr::select(timestamp.s,distance.m)
newseg[1] <- TRUE # do this before regenerate segment variable
newsegBase <- newseg
tempdf$segment <- cumsum(newseg)
# stack the last obs on bottom of newseg for diff'ing
segobs <- newseg
segobs[length(segobs)] <- TRUE
segdf <- tempdf[segobs,]
segmeters <- diff(segdf$distance.m)
segsecs <- difftime(segdf$timestamp.s,
lag_one(segdf$timestamp.s),units="secs")[-1]
segdf <- segdf[-nrow(segdf),]
segdf$segmeters <- segmeters
segdf$segsecs <- as.numeric(segsecs)
tempdf <- tempdf %>%
dplyr::group_by(segment) %>%
dplyr::mutate(nobsinseg=n()) %>%
dplyr::select(c("timestamp.s","nobsinseg","segment")) %>%
dplyr::left_join(segdf,by=c("timestamp.s","segment"))
tempdf[!newseg,"segmeters"] <- 0
tempdf[!newseg,"segsecs"] <- 0
needjoin <- (tempdf$nobsinseg < segMinObs) & newseg
needjoin[1] <- FALSE
if (sum(needjoin) > 0) {
if (loud) {
cat("joining ",sum(needjoin)," segments with fewer than ",
segMinObs," obs\n")
#print(trackdf$timestamp.s[needjoin])
}
newseg <- newseg & !needjoin
}
needjoin <- (tempdf$segmeters < segMinMeters) & newseg
needjoin[1] <- FALSE
if (sum(needjoin) > 0) {
if (loud) {
cat("joining ",sum(needjoin)," segments shorter than ",
segMinMeters," meters\n")
#print(trackdf$timestamp.s[needjoin])
}
newseg <- newseg & !needjoin
}
needjoin <- (tempdf$segsecs < segMinSecs) & newseg
needjoin[1] <- FALSE
if (sum(needjoin) > 0) {
if (loud) {
cat("joining ",sum(needjoin)," segments shorter than ",
segMinSecs," seconds\n")
#print(trackdf$timestamp.s[needjoin])
}
newseg <- newseg & !needjoin
}
newsegJoins <- newseg
### now allow the first segment to include starts/stop issues at beginning
insidefirstseg <- (cumsum(trackdf$deltatime) <= segInitIdleAggSecs) |
(trackdf$distance.m <= segInitIdleAggMeters)
needjoin <- insidefirstseg & newseg
needjoin[1] <- FALSE
if (sum(needjoin) > 0) {
if (loud) {
cat("joining ",sum(needjoin)," segments at start\n")
#print(trackdf$timestamp.s[needjoin])
}
newseg <- newseg & !needjoin
}
newsegStarted <- newseg
# these are only modifications to the track data tibble
newseg[1] <- TRUE
trackdf$segment <- cumsum(newseg)
### flag "stop-py" parts of segment glued on the end
### and "start-ty" parts of (first) segment
### subseg > 1 is stop-py
### subseg == 0 is start-ty
trackdf$newsegBase=newsegBase
trackdf <- trackdf %>%
dplyr::mutate(joinseg=cumsum(newsegJoins)) %>%
dplyr::group_by(joinseg) %>%
dplyr::mutate(subsegment=cumsum(newsegBase)) %>%
dplyr::ungroup() %>%
dplyr::group_by(segment) %>%
dplyr::mutate(starting = joinseg < max(joinseg) ) %>%
dplyr::ungroup() %>%
dplyr::mutate(subsegment=if_else(starting, as.integer(0), subsegment)) %>%
dplyr::select(-joinseg,-starting,-newsegBase)
trackdf$stopped <- stopped
trackdf$deltatimestart <- deltaTimeStart(trackdf$deltatime,trackdf$segment)
if (loud) {
cat("ending with ",sum(newseg)," segments\n")
}
return(trackdf)
}
deltaTimeStart <- function(deltatime,segment) {
leaddeltatime <- c(deltatime[-1],0)
dtime <- deltatime
tdtime <- pmin(deltatime,leaddeltatime)
dtime[segment != lag_one(segment)] <- tdtime[segment != lag_one(segment)]
dtime
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.