Here is some updated R code from my previous post. It doesn't throw any warnings when importing tracks with and without heart rate information. Also, it is easier to distinguish types of tracks now (e.g., when you want to plot runs and rides separately). Another thing I changed: You get very basic information on the track when you click on it (currently the name of the track and the total length).

Have fun and leave a comment if you have any questions.



options(stringsAsFactors = F)

rm(list=ls())

library(httr)
library(rjson)
library(leaflet)
library(dplyr)

token <- "<your Strava API token>"

# Functions ---------------------------------------------------------------

get.coord.df.from.stream <- function (stream.obj) {
  data.frame(lat = sapply(stream.obj[[1]]$data, USE.NAMES = F, FUN = function (x) x[[1]]),
             lon = sapply(stream.obj[[1]]$data, USE.NAMES = F, FUN = function (x) x[[2]]))
}

get.stream.from.activity <- function (act.id, token) {
  stream <- GET("https://www.strava.com/",
                path = paste0("api/v3/activities/", act.id, "/streams/latlng"),
                query = list(access_token = token))
  content(stream)
}

get.activities2 <- function (token) {
  activities <- GET("https://www.strava.com/", path = "api/v3/activities",
                    query = list(access_token = token, per_page = 200))
  activities <- content(activities, "text")
  activities <- fromJSON(activities)
  res.df <- data.frame()
  for (a in activities) {
    values <- sapply(c("name", "distance", "moving_time", "elapsed_time", "total_elevation_gain",
                       "type", "id", "start_date_local",
                       "location_country", "average_speed", "max_speed", "has_heartrate", "elev_high",
                       "elev_low", "average_heartrate", "max_heartrate"), FUN = function (x) {
                         if (is.null(a[[x]])) {
                           NA } else { a[[x]] }
                       })
    res.df <- rbind(res.df, values)
  }
  names(res.df) <- c("name", "distance", "moving_time", "elapsed_time", "total_elevation_gain",
                     "type", "id", "start_date_local",
                     "location_country", "average_speed", "max_speed", "has_heartrate", "elev_high",
                     "elev_low", "average_heartrate", "max_heartrate")
  res.df
}

get.multiple.streams <- function (act.ids, token) {
  res.list <- list()
  for (act.id.i in 1:length(act.ids)) {
    if (act.id.i %% 5 == 0) cat("Actitivy no.", act.id.i, "of", length(act.ids), "\n")
    stream <- get.stream.from.activity(act.ids[act.id.i], token)
    coord.df <- get.coord.df.from.stream(stream)
    res.list[[length(res.list) + 1]] <- list(act.id = act.ids[act.id.i],
                                             coords = coord.df)
  }
  res.list
}

activities <- get.activities2(token)

stream.list <- get.multiple.streams(activities$id, token)


# Leaflet -----------------------------------------------------------------

lons.range <- c(9.156572, 9.237580)
lats.range <- c(48.74085, 48.82079)

map <- leaflet() %>%
  addProviderTiles("OpenMapSurfer.Grayscale", # nice: CartoDB.Positron, OpenMapSurfer.Grayscale, CartoDB.DarkMatterNoLabels
                   options = providerTileOptions(noWrap = T)) %>%
  fitBounds(lng1 = min(lons.range), lat1 = max(lats.range), lng2 <- max(lons.range), lat2 = min(lats.range))

add.run <- function (act.id, color, act.name, act.dist, strlist = stream.list) {
  act.ind <- sapply(stream.list, USE.NAMES = F, FUN = function (x) {
    x$act.id == act.id
  })
  act.from.list <- strlist[act.ind][[1]]
  map <<- addPolylines(map, lng = act.from.list$coords$lon,
               lat = act.from.list$coords$lat,
               color = color, opacity = 1/3, weight = 2,
               popup = paste0(act.name, ", ", round(as.numeric(act.dist) / 1000, 2), " km"))
}

# plot all

for (i in 1:nrow(activities)) {
  add.run(activities[i, "id"], ifelse(activities[i, "type"] == "Run", "red",
                                      ifelse(activities[i, "type"] == "Ride", "blue", "black")),
          activities[i, "name"], activities[i, "distance"])
}

map
3

View comments

  1. Could you direct us to your previous post?

    ReplyDelete
    Replies
    1. Hi, it's linked under "previous post". The URL is http://rcrastinate.blogspot.com/2018/01/where-do-you-run-to-map-your-strava.html

      Delete
  2. This is great blog post i have read your others blog too. you can read my blog Spotify Error Code 3

    ReplyDelete
I've been using the ggplot2 package a lot recently. When creating a legend or tick marks on the axes, ggplot2 uses the levels of a character or factor vector. Most of the time, I am working with coded variables that use some abbreviation of the "true" meaning (e.g.
png("goodbye.png", height = 625, width = 500)

par(col = "purple")

plot(1, 1, xlim = c(0,800), ylim = c(0,1600), type = "n", bty = "n", xaxt = "n", yaxt = "n", xlab = "", ylab = "")

symbols(x = 400, y = 1200, circles = 400, add = T, lwd = 40)

lines(x = c(400, 400), y = c(900, 100), lwd = 40, lend
R is great, and you can do a LOT OF stuff with it.

However, sometimes you want to do really basic stuff with huge or a lot of files. At work, I have to do that a lot because I am mostly dealing with language data that often needs some pre-processing.
I work with R on both Mac OS and Windows. On Windows, you get the option to copy the path of a file or folder by holding Shift while right-clicking on the file or folder. As useful as this feature is, it copies paths to your clipboard in Windows format, e.g.
I recently encountered some functionality in R which most of you might already know. Nevertheless, I want to share it here, because it might come in handy for those of you who do not know this yet.

Suppose you want to read in a large number of very large text tables in R.
I used knitr to hack together a very short tutorial about XML in R.

It's in German. And it's not very long. But, hey, it's free :)

I hope it can be of help to someone who wants to get started with XML processing in R.

Please feel free to post or send any comments about the thing.
As long as I can't find the time to post my newest adventuRes, why don't you check out the great collection of other R-blogs on the web:

www.r-bloggers.com 

Have fun!
Just a fast note: I came across the R-package "knitr" which enables you to generate PDF files by mixing LaTeX and R code in one document. The result looks very nice and is great to create documentations, manuals and so on.
Blog Archive
BlogRoll
BlogRoll
Loading
Dynamic Views theme. Powered by Blogger. Report Abuse.