#' collect gps session statistics for a track
#'
#' \code{statsSession} processes a gps session file
#'
#' @param session data frame or tibble with gps session data
#'
#' @return a list containing summary data
#'
#' @seealso \code{\link{read_ride}},\code{\link{processSegments}},
#' \code{\link{repairSensorDropOut}},
#' \code{\link{repairHR}},
#' \code{\link{repairCadence}},
#' \code{\link{repairPower}},
#' \code{\link{statsHeartRate}},
#' \code{\link{statsCadence}},
#' \code{\link{statsPower}},
#' \code{\link{statsGearing}},
#' \code{\link{statsGrade}},
#' \code{\link{statsStops}},
#' \code{\link{statsTemp}}
#'
#' @export
statsSession <- function(session) {
if (is.null(session)) {
sessionDistance <- NA
sessionElapsedTime <- NA
sessionTimerTime <- NA
sessionPedalStrokes <- NA
sessionTotalCalories <- NA
sessionAvgSpeed <- NA
sessionMaxSpeed <- NA
sessionTotalAscent <- NA
sessionTotalDescent <- NA
sessionAvgCadence <- NA
sessionAvgHr <- NA
sessionMaxHr <- NA
sessionAvgPower <- NA
sessionMaxPower <- NA
sessionPedalSmoothness <- NA
sessionLeftPedalSmoothness <- NA
sessionRightPedalSmoothness <- NA
sessionLeftTorqueEff <- NA
sessionRightTorqueEff <- NA
sessionTimeStanding <- NA
sessionLeftRightBalance <- NA
} else {
sessionDistance <- ifelse("total_distance" %in% colnames(session),
session$total_distance[1],NA)
sessionElapsedTime <- ifelse("total_elapsed_time" %in% colnames(session),
session$total_elapsed_time[1],NA)
sessionTimerTime <- ifelse("total_timer_time" %in% colnames(session),
session$total_timer_time[1],NA)
sessionPedalStrokes <- ifelse("total_cycles" %in% colnames(session),
session$total_cycles[1],NA)
sessionTotalCalories <- ifelse("total_calories" %in% colnames(session),
session$total_calories[1],NA)
sessionAvgSpeed <- ifelse("avg_speed" %in% colnames(session),
session$avg_speed[1],NA)
sessionMaxSpeed <- ifelse("max_speed" %in% colnames(session),
session$max_speed[1],NA)
sessionTotalAscent <- ifelse("total_ascent" %in% colnames(session),
session$total_ascent[1],NA)
sessionTotalDescent <- ifelse("total_descent" %in% colnames(session),
session$total_descent[1],NA)
sessionAvgCadence <- ifelse("avg_cadence" %in% colnames(session),
session$avg_cadence[1],NA)
sessionAvgHr <- ifelse("avg_heart_rate" %in% colnames(session),
session$avg_heart_rate[1],NA)
sessionMaxHr <- ifelse("max_heart_rate" %in% colnames(session),
session$max_heart_rate[1],NA)
sessionAvgPower <- ifelse("avg_power" %in% colnames(session),
session$avg_power[1],NA)
sessionMaxPower <- ifelse("max_power" %in% colnames(session),
session$max_power[1],NA)
sessionPedalSmoothness <- ifelse("avg_combined_pedal_smoothness" %in% colnames(session),
session$avg_combined_pedal_smoothness[1],NA)
sessionLeftPedalSmoothness <- ifelse("avg_left_pedal_smoothness" %in% colnames(session),
session$avg_left_pedal_smoothness[1],NA)
sessionRightPedalSmoothness <- ifelse("avg_right_pedal_smoothness" %in% colnames(session),
session$avg_right_pedal_smoothness[1],NA)
sessionLeftTorqueEff <- ifelse("avg_left_torque_effectiveness" %in% colnames(session),
session$avg_left_torque_effectiveness[1],NA)
sessionRightTorqueEff <- ifelse("avg_right_torque_effectiveness" %in% colnames(session),
session$avg_right_torque_effectiveness[1],NA)
sessionTimeStanding <- ifelse("time_standing" %in% colnames(session),
session$time_standing[1],NA)
sessionLeftRightBalance <- ifelse("left_right_balance" %in% colnames(session),
session$left_right_balance[1]/100,NA)
}
return(lapply(list(
sessionDistance = sessionDistance,
sessionElapsedTime = sessionElapsedTime,
sessionTimerTime = sessionTimerTime,
sessionPedalStrokes = sessionPedalStrokes,
sessionTotalCalories = sessionTotalCalories,
sessionAvgSpeed = sessionAvgSpeed,
sessionMaxSpeed = sessionMaxSpeed,
sessionTotalAscent = sessionTotalAscent,
sessionTotalDescent = sessionTotalDescent,
sessionAvgCadence = sessionAvgCadence,
sessionAvgHr = sessionAvgHr,
sessionMaxHr = sessionMaxHr,
sessionAvgPower = sessionAvgPower,
sessionMaxPower = sessionMaxPower,
sessionPedalSmoothness = sessionPedalSmoothness,
sessionLeftPedalSmoothness = sessionLeftPedalSmoothness,
sessionRightPedalSmoothness = sessionRightPedalSmoothness,
sessionLeftTorqueEff = sessionLeftTorqueEff,
sessionRightTorqueEff = sessionRightTorqueEff,
sessionTimeStanding = sessionTimeStanding,
sessionLeftRightBalance = sessionLeftRightBalance
),as.numeric)
)
}
#' clean up sensor dropout data for a track
#'
#' \code{repairSensorDropOut} processes a gps track file for data dropouts
#'
#'
#' @param trackdf data frame or tibble with gps track data
#' @param loud display actions taken
#' @param fixAllSensorDrop logical, if TRUE fix case of all sensor dropouts
#' @param fixSpeedSensorDrop logical, if TRUE fix case of speed sensor dropouts
#' @param sensorDropSmooth fill in values
#' @param lookBackward number of seconds to look before dropout when fixing
#' @param lookForward number of seconds to look after dropout when fixing
#' @param ... parameters for \code{\link{processSegments}},
#' \code{\link{repairHR}},
#' \code{\link{repairCadence}},
#' \code{\link{repairPower}},
#' \code{\link{statsHeartRate}},
#' \code{\link{statsCadence}},
#' \code{\link{statsPower}},
#' \code{\link{statsGearing}},
#' \code{\link{statsGrade}},
#' \code{\link{statsSession}},
#' \code{\link{statsStops}},
#' \code{\link{statsTemp}}
#'
#' @return dataframe with data repaired
#'
#' @seealso \code{\link{read_ride}}
#'
#' @export
repairSensorDropOut <- function(trackdf,
fixAllSensorDrop=TRUE,
fixSpeedSensorDrop=TRUE,
sensorDropSmooth=TRUE,
lookBackward=3,
lookForward=5,
loud=FALSE,...) {
flagdrop <- function(varname) {
if (varname %in% names(trackdf)) {
return(is.na(deframe(trackdf[,varname])))
} else {
return(TRUE)
}
}
repairdrops <- function(trackdf,varname,NAOK,zeroOK,allDrop) {
dropsrle <- rle(allDrop)
dropids <- dropsrle[["values"]]
ndropouts <- sum(dropids)
dropids[dropids] <- cumsum(dropids)[dropids]
dropsrle[["values"]] <- dropids
allDrop <- inverse.rle(dropsrle)
if (ndropouts > 0) {
for (d in 1:ndropouts) {
dd=allDrop==d
trackdf <- repairdrop(trackdf,d,varname,NAOK,zeroOK,allDrop=dd)
}
}
return(trackdf)
}
repairdrop <- function(trackdf,d,varname,NAOK,zeroOK,allDrop) {
begdrow <- max(which.max(allDrop) - 1,1)
enddrow <- min(length(allDrop) + 1 - which.max(rev(allDrop)) + 1,
length(allDrop))
begtime <- max(trackdf$timestamp.s[1],
trackdf$timestamp.s[begdrow] - lookBackward)
endtime <- min(trackdf$timestamp.s[nrow(allDrop)],
trackdf$timestamp.s[enddrow] + lookForward)
begdrow <- max(begdrow-1,1)
enddrow <- min(enddrow+1,length(allDrop))
begrow <- which.max(trackdf$timestamp.s >= begtime)
endrow <- length(allDrop) + 1 - which.max(rev(trackdf$timestamp.s <= endtime))
if (NAOK) {
ytemp <- deframe(trackdf[begdrow:enddrow,varname])
if (!zeroOK) ytemp[ytemp==0] <- NA
if (sum(!is.na(trackdf[begdrow:enddrow,varname])) >= 2) {
yreplace <- approx(x=deframe(trackdf[begdrow:enddrow,"timestamp.s"]),
y=ytemp,
xout=deframe(trackdf[begdrow:enddrow,"timestamp.s"]),
method="linear")[[2]]
trackdf[begdrow:enddrow,varname] <- round(yreplace)
}
} else {
ytemp <- deframe(trackdf[begrow:endrow,varname])
if (!zeroOK) ytemp[ytemp==0] <- NA
if (sum(!is.na(ytemp)) >= 2) {
yreplace <- approx(x=deframe(trackdf[begrow:endrow,"timestamp.s"]),
y=ytemp,
xout=deframe(trackdf[begrow:endrow,"timestamp.s"]),
method="linear")[[2]]
trackdf[begrow:endrow,varname] <- round(yreplace)
}
}
return(trackdf)
}
spdDrop <- flagdrop("speed.m.s")
cadDrop <- flagdrop("cadence.rpm")
hrDrop <- flagdrop("heart_rate.bpm")
powDrop <- flagdrop("power.watts" )
allDrop <- spdDrop & cadDrop & hrDrop & powDrop
if (sum(allDrop) > 0) {
if (loud) {
cat(" there are ",sum(allDrop)," records with no external sensor data\n")
cat(" ",paste(sort(unique(trackdf$timestamp.s[allDrop])),sep=","),"\n")
}
if (fixAllSensorDrop) {
if (sensorDropSmooth) {
trackdf <- repairdrops(trackdf,"speed.m.s",NAOK=FALSE,
zeroOK=TRUE,allDrop)
trackdf <- repairdrops(trackdf,"cadence.rpm",NAOK=FALSE,
zeroOK=TRUE,allDrop)
trackdf <- repairdrops(trackdf,"heart_rate.bpm",NAOK=FALSE,
zeroOK=FALSE,allDrop)
trackdf <- repairdrops(trackdf,"power.watts",NAOK=FALSE,
zeroOK=FALSE,allDrop)
} else {
if (loud) cat(" removing them\n")
trackdf <- trackdf[!allDrop,]
}
}
}
if (sum(spdDrop) > 0) {
if (loud) {
cat(" ** there are ",sum(spdDrop)," records with no speed data\n")
cat(" ",paste(sort(unique(trackdf$timestamp.s[spdDrop])),sep=","),"\n")
}
if (fixSpeedSensorDrop) {
trackdf$speed.m.s[spdDrop] <- 0.0
if (loud) cat(" setting them to zero\n")
}
}
if (loud & sum(cadDrop) > 0 & sum(!cadDrop) > 0)
cat(" ** there are ",sum(cadDrop)," records with no cadence data\n")
if (loud & sum(hrDrop) > 0 & sum(!hrDrop) > 0)
cat(" ** there are ",sum(hrDrop)," records with no heartrate data\n")
if (loud & sum(powDrop) > 0 & sum(!powDrop) > 0)
cat(" ** there are ",sum(powDrop)," records with no power data\n")
return(trackdf)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.