data-raw/ski_routes.R

In vadmbertr/bonski.data: Data To Tell Where Ski Is Good

#' Request ski routes in a given range
#'
#' @param m char. range of interest id's
#'
#' @return tibble
request_ski_routes_massif <- function(m) {
  routes_url <- paste0("https://skitour.fr/api/topos?m=", m)
  routes_get <- request_skitour(routes_url)

  routes_tb <- list()
  if (routes_get$status_code == 200) {
    routes_tb <- httr::content(routes_get, "text") %>%
      jsonlite::fromJSON(simplifyDataFrame = TRUE) %>%
      tibble::as_tibble()
    # inlining of altitude and latlon data
    routes_tb <- tibble::add_column(routes_tb,
                                    altitude = routes_tb$depart$altitude,
                                    latlon = routes_tb$depart$latlon,
                                    m = routes_tb$massif$nom) %>%
      # we don't need all the columns
      dplyr::select(c(id, nom, orientation, denivele, dif_ski, expo, altitude, m, latlon))
  } else {
    print(paste("Status code", res$status_code, "at", a, rid))
  }

  routes_tb
}

unescape_html <- function(str){
  xml2::xml_text(xml2::read_html(paste0("<x>", str, "</x>")))
}

#' Retrive and parse skitouring ski routes from Skitour
#'
#' Skitour's API returns routes encoded as JSON. JSON is parsed to produce a data.frame object and then wrapped with tibble.
#'
#' @return tibble
request_ski_routes <- function() {
  massifs <- seq(1, 25)

  n_cores <- future::availableCores()
  future::plan(future::multisession, workers = n_cores)

  ski_routes <- furrr::future_map(massifs, request_ski_routes_massif) %>%
    data.table::rbindlist() %>%
    tibble::as_tibble() %>%
    tidyr::unnest_wider(latlon) %>% # inlining of latlon data
    # use of explicit labels
    dplyr::rename(route = id,
                  difficulte = dif_ski,
                  exposition = expo,
                  massif = m,
                  lat = ...1, lon = ...2) %>%
    # cast
    dplyr::mutate(route = readr::parse_integer(route),
                  orientation = factor(orientation),
                  denivele = readr::parse_integer(denivele),
                  difficulte = readr::parse_double(difficulte),
                  exposition = readr::parse_integer(exposition),
                  altitude = readr::parse_integer(altitude),
                  latitude = readr::parse_double(lat),
                  longitude = readr::parse_double(lon)) %>%
    dplyr::mutate(lat = latitude,
                  lon = longitude) %>%
    sf::st_as_sf(coords = c("lon", "lat"), crs = 4326) %>%
    restrict_to_french_alps()
  # replace escaped html characters
  ski_routes$nom <- sapply(ski_routes[["nom"]], unescape_html)
  ski_routes
}

#' Get and save ski routes data
#'
#' @return
use_ski_routes <- function() {
  ski_routes <- request_ski_routes()
  usethis::use_data(ski_routes, overwrite = TRUE)
}