removed rgbif dependency, added googleway for quicker polyline decoding

fawda123 · Jun 3, 2019 · a6dfba8 · a6dfba8
1 parent 000d85e
commit a6dfba8
Show file tree

Hide file tree

Showing 90 changed files with 1,502 additions and 1,197 deletions.
diff --git 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
@@ -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
diff --git 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
@@ -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
@@ -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
@@ -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