diff --git a/DESCRIPTION b/DESCRIPTION index b5f0897..4c52713 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: rStrava Type: Package Title: Access the Strava API -Version: 1.0.0 -Date: 2019-06-02modi +Version: 1.1.0 +Date: 2019-06-03 Description: Functions to access data from Strava's v3 API. LazyData: TRUE BugReports: https://github.com/fawda123/rStrava/issues @@ -14,12 +14,12 @@ Imports: ggmap, ggplot2, ggrepel, + googleway, httr, httpuv, magrittr, plyr, RCurl, - rgbif, rvest, tidyr, XML, diff --git a/NAMESPACE b/NAMESPACE index c3e35f4..b5e5d0c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,7 +21,6 @@ export(compile_club_activities) export(compile_seg_effort) export(compile_seg_efforts) export(compile_segment) -export(decode_Polyline) export(get_KOMs) export(get_activity) export(get_activity_list) diff --git a/R/decode_Polyline.R b/R/decode_Polyline.R deleted file mode 100644 index ee2dd01..0000000 --- a/R/decode_Polyline.R +++ /dev/null @@ -1,72 +0,0 @@ -#' Decode Google polyline of an activity into latitude and longitude -#' -#' Decodes Google's polyline that are given in get_activity() and get_activity_list() -#' -#' @author Daniel Padfield -#' @param Google_polyline character element of Google polyline of an activity -#' @return A vector of latitudes an longitudes in decimals separated by a comma -#' @concept notoken -#' @details When getting an activity using get_activity() a Google polyline is returned as one of the outputs. This function converts the polyline into latitude and longitude coordinates suitable for plotting. Function is used internally within \code{\link{get_latlon}}. -#' @examples -#' \dontrun{ -#' decode_Polyline()} -#' @export -#' @references Original code from : https://s4rdd.blogspot.co.uk/2012/12/google-maps-api-decoding-polylines-for.html?showComment=1473004506791#c3610119369153401460 - -decode_Polyline <- function(Google_polyline){ - - vlen <- nchar(Google_polyline) - vindex <- 0 - varray <- NULL - vlat <- 0 - vlng <- 0 - - while(vindex < vlen){ - vb <- NULL - vshift <- 0 - vresult <- 0 - repeat{ - if(vindex + 1 <= vlen){ - vindex <- vindex + 1 - vb <- as.integer(charToRaw(substr(Google_polyline, vindex, vindex))) - 63 - } - - vresult <- bitops::bitOr(vresult, bitops::bitShiftL(bitops::bitAnd(vb, 31), vshift)) - vshift <- vshift + 5 - if(vb < 32) break - } - - dlat <- ifelse( - bitops::bitAnd(vresult, 1) - , -(bitops::bitShiftR(vresult, 1)+1) - , bitops::bitShiftR(vresult, 1) - ) - vlat <- vlat + dlat - - vshift <- 0 - vresult <- 0 - repeat{ - if(vindex + 1 <= vlen) { - vindex <- vindex+1 - vb <- as.integer(charToRaw(substr(Google_polyline, vindex, vindex))) - 63 - } - - vresult <- bitops::bitOr(vresult, bitops::bitShiftL(bitops::bitAnd(vb, 31), vshift)) - vshift <- vshift + 5 - if(vb < 32) break - } - - dlng <- ifelse( - bitops::bitAnd(vresult, 1) - , -(bitops::bitShiftR(vresult, 1)+1) - , bitops::bitShiftR(vresult, 1) - ) - vlng <- vlng + dlng - - varray <- rbind(varray, c(vlat * 1e-5, vlng * 1e-5)) - } - coords <- data.frame(varray) - names(coords) <- c("lat", "lon") - coords <- tidyr::unite(coords, latlon, c(lat, lon), sep = ',') - return(coords) -} \ No newline at end of file diff --git a/R/get_LatLon.R b/R/get_LatLon.R index 4531a4d..8c5c67f 100644 --- a/R/get_LatLon.R +++ b/R/get_LatLon.R @@ -2,8 +2,9 @@ #' #' get latitude and longitude from Google polyline #' -#' @param x the dataframe that contains the Strava activity data -#' @author Daniel Padfield +#' @param polyline a map polyline returned for an activity from the API +#' @param key chr string of Google API key for elevation data, passed to \code{\link[googleway]{google_elevation}} +#' @author Daniel Padfield, Marcus Beck #' @concept token #' @return dataframe of latitude and longitudes with a column for the unique identifier #' @examples @@ -14,15 +15,20 @@ #' acts_data <- compile_activities(my_acts) #' #' # get lat and lon for a single activity -#' get_latlon(acts_data[1,]) +#' get_latlon(acts_data[1,], key = mykey) #' } #' @export -get_latlon <- function(x){ - if('map.summary_polyline' %in% names(x)){y <- decode_Polyline(x$map.summary_polyline)} - if('map.polyline' %in% names(x)){y <- decode_Polyline(x$map.polyline)} +get_latlon <- function(polyline, key){ - y <- tidyr::separate(y, latlon, c('lat', 'lon'), sep = ',') - y <- dplyr::mutate_at(y, c('lat', 'lon'), as.numeric) + out <- googleway::google_elevation(polyline = polyline, key = key) %>% + .[['results']] %>% + dplyr::mutate( + lat = location$lat, + lon = location$lng + ) %>% + dplyr::select(-location, -resolution) %>% + dplyr::rename(ele = elevation) - return(y) + return(out) + } diff --git a/R/get_elev_prof.R b/R/get_elev_prof.R index 0b31f30..69ccae4 100644 --- a/R/get_elev_prof.R +++ b/R/get_elev_prof.R @@ -8,7 +8,7 @@ #' #' @param act_data an activities list object returned by \code{\link{get_activity_list}} or a \code{data.frame} returned by \code{\link{compile_activities}} #' @param acts numeric value indicating which elements of \code{act_data} to plot, defaults to most recent -#' @param key chr string of Google API key for elevation data, passed to \code{\link[rgbif]{elevation}}, see details +#' @param key chr string of Google API key for elevation data, passed to \code{\link[googleway]{google_elevation}}, see details #' @param total logical indicating if elevations are plotted as cumulative climbed by distance #' @param expand a numeric multiplier for expanding the number of lat/lon points on straight lines. This can create a smoother elevation profile. Set \code{expand = 1} to suppress this behavior. #' @param units chr string indicating plot units as either metric or imperial, this has no effect if input data are already compiled with \code{\link{compile_activities}} @@ -70,33 +70,20 @@ get_elev_prof.actframe <- function(act_data, key, total = FALSE, expand = 10, fi if('units' %in% names(args)) if(args$units != unit_type) warning('units does not match unit type, use compile_activities with different units') - + # remove rows without polylines act_data <- chk_nopolyline(act_data) # create a dataframe of long and latitudes - lat_lon <- dplyr::group_by(act_data, upload_id) %>% - dplyr::do(get_latlon(.)) %>% - dplyr::ungroup() %>% - dplyr::full_join(., act_data, by = 'upload_id') %>% - dplyr::select(., upload_id, type, start_date, lat, lon, total_elevation_gain) - - # expand lat/lon for each activity - lat_lon <- split(lat_lon, lat_lon$upload_id) - lat_lon <- lapply(lat_lon, function(x) { - - xint <- stats::approx(x = x$lon, n = expand * nrow(x))$y - yint <- stats::approx(x = x$lat, n = expand * nrow(x))$y - data.frame( - upload_id = unique(x$upload_id), - start_date = unique(x$start_date), - total_elevation_gain = unique(x$total_elevation_gain), - lat = yint, - lon = xint - ) - - }) - lat_lon <- do.call('rbind', lat_lon) + lat_lon <- act_data %>% + dplyr::group_by(upload_id) %>% + tidyr::nest() %>% + mutate(locs = purrr::map(data, function(x) get_latlon(x$map.summary_polyline, key = key))) %>% + dplyr::select(-data) %>% + dplyr::ungroup() %>% + tidyr::unnest() %>% + dplyr::full_join(., act_data, by = 'upload_id') %>% + dplyr::select(., upload_id, type, start_date, lat, lon, ele, total_elevation_gain) # total elevation gain needs to be numeric for unit conversion lat_lon$total_elevation_gain <- round(as.numeric(as.character(lat_lon$total_elevation_gain)), 1) @@ -108,15 +95,6 @@ get_elev_prof.actframe <- function(act_data, key, total = FALSE, expand = 10, fi dplyr::mutate(., distance = get_dists(lon, lat)) lat_lon$distance <- distances$distance - # adding elevation using rgbif - ele <- try({ - rgbif::elevation(latitude = lat_lon$lat, longitude = lat_lon$lon, key = key)$elevation - }) - if(class(ele) %in% 'try-error') - stop('Elevation not retrieved, check API key') - lat_lon$ele <- ele - lat_lon$ele <- pmax(0, lat_lon$ele) - # axis labels ylab <- paste0('Elevation (', unit_vals['elevation'], ')') xlab <- paste0('Distance (', unit_vals['distance'], ')') diff --git a/R/get_heat_map.R b/R/get_heat_map.R index df20a78..323576b 100644 --- a/R/get_heat_map.R +++ b/R/get_heat_map.R @@ -7,6 +7,7 @@ #' @concept token #' #' @param act_data an activities list object returned by \code{\link{get_activity_list}}, an \code{actframe} returned by \code{\link{compile_activities}}, or a \code{strfame} returned by \code{\link{get_activity_streams}} +#' @param key chr string of Google API key for elevation data, passed to \code{\link[googleway]{google_elevation}} for polyline decoding, see details #' @param acts numeric indicating which activities to plot based on index in the activities list, defaults to most recent #' @param alpha the opacity of the line desired. A single activity should be 1. Defaults to 0.5 #' @param f number specifying the fraction by which the range should be extended for the bounding box of the activities, passed to \code{\link[ggmap]{make_bbox}} @@ -15,7 +16,6 @@ #' @param filltype chr string specifying which stream variable to use for filling line segments, applies only to \code{strframe} objects, acceptable values are \code{"elevation"}, \code{"distance"}, \code{"slope"}, or \code{"speed"} #' @param distlab logical if distance labels are plotted along the route with \code{\link[ggrepel]{geom_label_repel}} #' @param distval numeric indicating rounding factor for distance labels which has direct control on label density, see details -#' @param key chr string of Google API key for elevation data, passed to \code{\link[rgbif]{elevation}}, see details #' @param size numeric indicating width of activity lines #' @param col chr string indicating either a single color of the activity lines if \code{add_grad = FALSE} or a color palette passed to \code{\link[ggplot2]{scale_fill_distiller}} if \code{add_grad = TRUE} #' @param expand a numeric multiplier for expanding the number of lat/lon points on straight lines. This can create a smoother elevation gradient if \code{add_grad = TRUE}. Set \code{expand = 1} to suppress this behavior. @@ -67,7 +67,7 @@ get_heat_map <- function(act_data, ...) UseMethod('get_heat_map') #' @export #' #' @method get_heat_map list -get_heat_map.list <- function(act_data, acts = 1, alpha = NULL, f = 0.1, key = NULL, add_elev = FALSE, as_grad = FALSE, distlab = TRUE, distval = 0, size = 0.5, col = 'red', expand = 10, maptype = 'terrain', source = 'google', units = 'metric', ...){ +get_heat_map.list <- function(act_data, key, acts = 1, alpha = NULL, f = 0.1, add_elev = FALSE, as_grad = FALSE, distlab = TRUE, distval = 0, size = 0.5, col = 'red', expand = 10, maptype = 'terrain', source = 'google', units = 'metric', ...){ # compile act_data <- compile_activities(act_data, acts = acts, units = units) @@ -81,7 +81,7 @@ get_heat_map.list <- function(act_data, acts = 1, alpha = NULL, f = 0.1, key = N #' @export #' #' @method get_heat_map actframe -get_heat_map.actframe <- function(act_data, alpha = NULL, f = 1, key = NULL, add_elev = FALSE, as_grad = FALSE, distlab = TRUE, distval = 0, size = 0.5, col = 'red', expand = 10, maptype = 'terrain', source = 'google', ...){ +get_heat_map.actframe <- function(act_data, key, alpha = NULL, f = 1, add_elev = FALSE, as_grad = FALSE, distlab = TRUE, distval = 0, size = 0.5, col = 'red', expand = 10, maptype = 'terrain', source = 'google', ...){ # get unit types and values attributes unit_type <- attr(act_data, 'unit_type') @@ -97,32 +97,26 @@ get_heat_map.actframe <- function(act_data, alpha = NULL, f = 1, key = NULL, add # remove rows without polylines act_data <- chk_nopolyline(act_data) - + # data to plot - temp <- dplyr::group_by(act_data, map.summary_polyline) %>% - dplyr::do(get_latlon(.)) %>% - dplyr::ungroup() - temp$activity <- as.numeric(factor(temp$map.summary_polyline)) - temp$map.summary_polyline <- NULL - - # expand lat/lon for each activity - temp <- split(temp, temp$activity) - temp <- lapply(temp, function(x) { - - xint <- stats::approx(x = x$lon, n = expand * nrow(x))$y - yint <- stats::approx(x = x$lat, n = expand * nrow(x))$y - data.frame(activity = unique(x$activity), lat = yint, lon = xint) - - }) - temp <- do.call('rbind', temp) - + temp <- act_data %>% + dplyr::group_by(upload_id) %>% + tidyr::nest() %>% + mutate(locs = purrr::map(data, function(x) get_latlon(x$map.summary_polyline, key = key))) %>% + dplyr::select(-data) %>% + dplyr::ungroup() %>% + tidyr::unnest() %>% + dplyr::rename(activity = upload_id) + # get distances, default is km temp <- dplyr::group_by(temp, activity) %>% dplyr::mutate(distance = get_dists(lon, lat)) %>% dplyr::ungroup() - if(unit_type %in% 'imperial') + if(unit_type %in% 'imperial'){ temp$distance <- temp$distance * 0.621371 + temp$ele <- temp$ele * 3.28084 + } # xy lims bbox <- ggmap::make_bbox(temp$lon, temp$lat, f = f) @@ -136,34 +130,14 @@ get_heat_map.actframe <- function(act_data, alpha = NULL, f = 1, key = NULL, add # add elevation to plot if(add_elev){ - # check if key provided - if(is.null(key)) - stop('Google API key is required if plotting elevation') - - # get elevation - ele <- try({ - rgbif::elevation(latitude = temp$lat, longitude = temp$lon, key = key)$elevation - }) - if(class(ele) %in% 'try-error') - stop('Elevation not retrieved, check API key') - temp$ele <- ele - temp$ele <- pmax(0, temp$ele) - - # change units if imperial - if(unit_type %in% 'imperial'){ - - temp$ele <- temp$ele * 3.28084 - - } - - # get gradient - temp <- dplyr::mutate(temp, EleDiff = c(0, diff(ele)), - distdiff = c(0, diff(distance)), - grad = c(0, (EleDiff[2:nrow(temp)]/10)/distdiff[2:nrow(temp)])) - # plot gradient if(as_grad){ + # get gradient + temp <- dplyr::mutate(temp, EleDiff = c(0, diff(ele)), + distdiff = c(0, diff(distance)), + grad = c(0, (EleDiff[2:nrow(temp)]/10)/distdiff[2:nrow(temp)])) + p <- pbase + ggplot2::geom_path(ggplot2::aes(x = lon, y = lat, group = activity, colour = grad), alpha = alpha, data = temp, size = size) + diff --git a/R/globalVariables.R b/R/globalVariables.R index 54c552e..183fd45 100644 --- a/R/globalVariables.R +++ b/R/globalVariables.R @@ -1,4 +1,4 @@ -globalVariables(c('altitude', 'data', 'latlng', 'left_join', 'spread', 'temp', 'unlist.temp.', 'velocity_smooth', 'activity', 'average_speed', 'ColNames', 'cols', 'diffdist', 'distance', 'distdiff', 'ele', 'EleDiff', 'elev_high', 'elev_low', 'Elevation (m)', 'facets', 'grad', 'lat', 'latlon', 'location_city', 'lon', 'map.summary_polyline', 'max_speed', 'spd', 'size', 'start_date', 'tosel', 'total_elevation_gain', 'type', 'unlist.x.', 'upload_id', 'usage_left', 'value', '<<-', '.', 'id', 'lng', 'act_list', 'name')) +globalVariables(c('altitude', 'data', 'latlng', 'left_join', 'spread', 'temp', 'unlist.temp.', 'velocity_smooth', 'activity', 'average_speed', 'ColNames', 'cols', 'diffdist', 'distance', 'distdiff', 'ele', 'EleDiff', 'elev_high', 'elev_low', 'Elevation (m)', 'facets', 'grad', 'lat', 'latlon', 'location_city', 'lon', 'map.summary_polyline', 'max_speed', 'spd', 'size', 'start_date', 'tosel', 'total_elevation_gain', 'type', 'unlist.x.', 'upload_id', 'usage_left', 'value', '<<-', '.', 'id', 'lng', 'act_list', 'name', 'unlist.seglist.', 'location', 'resolution', 'elevation')) #' @importFrom utils data NULL \ No newline at end of file diff --git a/README.html b/README.html index 0931dc7..45aedae 100644 --- a/README.html +++ b/README.html @@ -281,6 +281,9 @@ button.code-folding-btn:focus { outline: none; } +summary { + display: list-item; +} @@ -288,10 +291,71 @@
+ + + @@ -300,7 +364,6 @@ -