data-raw/ski_evaluations_history.R

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

#' Retrive and parse skitouring ski evaluations from Skitour for a month and a route
#'
#' Skitour's API returns ski evaluations encoded as JSON. JSON is parsed to produce a data.frame object and then wrapped with tibble.
#'
#' @param a character. month and year in the form: mm.yyyy
#' @param rid numerical. route of interest
#'
#' @return tibble
request_ski_evaluations_once <- function(params) {
  a <- params[1]
  rid <- params[2]
  evals_url <- paste0("https://skitour.fr/api/conditions?", "a=", a, "&t=", rid)
  evals_get <- request_skitour(evals_url)

  evals_tb <- list()
  if (evals_get$status_code == 200) {
    txt <- httr::content(evals_get, "text")
    evals_df <- tryCatch(
      {
        jsonlite::fromJSON(txt, simplifyDataFrame = TRUE)
      },
      error = function(e) {
        # remove some problematic char
        txt <- gsub(pattern = "\t", " ", txt) %>% # \t (tab)
          gsub(pattern = "\\\\'", "'", txt) %>% # \\'
          gsub(pattern = '\\\\\\\\\\"', "", txt) # \\\\\"
        return(
          tryCatch(
            {
              jsonlite::fromJSON(txt, simplifyDataFrame = TRUE)
            },
            error = function(e) {
              print(txt)
              return(list())
            }
          )
        )
      }
    )

    if (length(evals_df) > 0) {
      evals_tb <- tibble::as_tibble(evals_df)
      evals_tb$id <- rid
      evals_tb <- evals_tb[, c("id", "date", "skiabilite")]
    }
  } else {
    print(paste("Status code", res$status_code, "at", a, rid))
  }

  evals_tb
}

#' Retrive and parse skitouring ski evaluations from Skitour
#'
#' Sadly Skitour's API conception forced us to issue a request per month and per ski route of interest.
#'
#' @return tibble
request_ski_evaluations_history <- function() {
  start_year <- 2010
  end_year <- 2021
  winter_months <- formatC(c(1:5, 12), width = 2, flag = 0)

  params <- list()
  for (i in start_year:end_year) {
    for (j in winter_months) {
      if (i == end_year & j == "12") {
        break
      }
      a <- paste(j, i, sep = ".")
      for (rid in ski_routes$id) {
        params[[length(params)+1]] <- list(a, rid)
      }
    }
  }

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

  furrr::future_map(params, request_ski_evaluations_once) %>%
    data.table::rbindlist() %>%
    tibble::as_tibble() %>%
    dplyr::rename(route = id) %>%
    dplyr::mutate(route = as.integer(route),
                  date = lubridate::as_date(readr::parse_integer(date)),
                  skiabilite = readr::parse_integer(skiabilite)) %>%
    dplyr::filter(skiabilite %in% 1:5)
}

#' Get and save ski evaluations data
#'
#' @return
use_ski_evaluations_history <- function() {
  ski_evaluations_history <- request_ski_evaluations_history()
  usethis::use_data(ski_evaluations_history, overwrite = TRUE)
}