R/default_data_service_functions.R

In xaviermiles/portalLite: Generic shiny app configurable through JSON files.

load_from_store <- function(indicator, group_name) {
  key <- paste(indicator$class, indicator$type, indicator$indicator_name, group_name, sep = "_")
  if (length(key) > 0) {
    data_object <- DATA_STORE[[key]]
  } else {
    return(NULL)
  }
  return(data_object)
}

stats_odata_api_optimized <- function(indicator, group_name) {

  indicator <- surface_group_level_info(indicator, group_name)
  if (is.null(indicator$parameter)) {
    indicator$parameter <- "Period"  # default to time-indexed
  }

  # Fetch data
  odata_url <- paste0(ODATA_URL,
                      get_api_query_str(indicator, group_name))
  result <- NULL
  while (!is.null(odata_url)) {
    response <- odata_url %>%
      httr::GET(httr::add_headers("Ocp-Apim-Subscription-Key" = ODATA_TOKEN))
    if (response$status_code != 200) {
      return(NULL)
    }
    Observations <- response %>%
      httr::content("text", encoding = "UTF-8") %>%
      jsonlite::fromJSON(flatten = TRUE)

    result <- rbind(result, Observations$value)
    odata_url <- Observations$'@odata.nextLink'
  }
  if (length(result) == 0) {
    return(NULL)  # no data returned
  }
  if (!is.null(result$Period)) {
    result$Period <- lubridate::ymd(result$Period)
  }

  Resources_df <- get_api_df("Resources", indicator$api_resource_id)
  if (is.null(Resources_df)) {
    return(NULL)
  }

  # Wrangle data into DATA_TYPE (R6) object
  data_group <- result %>%
    dplyr::rename(Parameter = rlang::sym(indicator$parameter))
  if (!is.null(indicator$group_names) || !is.null(indicator$value_names)) {
    value_names_ordered <- get_data_config(indicator$api_resource_id) %>%
      .$value_names %>%
      unlist()
    # TODO: what if value_names_ordered and value names in API don't match?
    # Note: this type of custom ordering cannot be done in the API request :(
    data_group <- data_group %>%
      dplyr::arrange(
        Parameter, factor(!!rlang::sym(indicator$value_names), value_names_ordered)
      ) %>%
      tidyr::pivot_wider(names_from = indicator$value_names, values_from = Value)
    value_names <- colnames(data_group)[which(names(data_group) != "Parameter")]
  } else {
    value_names <- dplyr::if_else(group_name != "undefined_name", group_name,
                                  Resources_df$Title)
  }

  update_date <- as.Date(lubridate::now(), tz = 'NZ')

  data_type_name <- get_data_config(Resources_df$ResourceID) %>%
    get_indicator_parameter("data_type", .)
  data_object_list <- JSON_OPTIONS$get_data_type(data_type_name)$new(
    data_group,
    value_names,
    update_date
  )
  return(unlist(data_object_list))
}

stats_odata_api_trade <- function(indicator, group_name) {
  api_id <- indicator$api_resource_id
  result <- NULL
  odata_url <- URLencode(paste0(ODATA_URL,
                                "Covid-19Indicators/Observations",
                                "?$filter=(ResourceID eq '",
                                api_id, "')&",
                                "$select=Period,Label1,Label2,Geo,Value"))
  while (!is.null(odata_url)) {
    Observations <- httr::GET(odata_url,
                        httr::add_headers("Ocp-Apim-Subscription-Key" = ODATA_TOKEN))  %>%
      httr::content("text", encoding = "UTF-8") %>%
      jsonlite::fromJSON(flatten = TRUE)
    result <- rbind(Observations$value, if (exists("result")) result)
    odata_url <- Observations$'@odata.nextLink'

  }


  Resource <- htrr::GET(
    URLencode(paste0(ODATA_URL,
                     "Covid-19Indicators/Resources",
                     "?$filter=(ResourceID eq '",
                     api_id,
                     "')")),
    httr::add_headers("Ocp-Apim-Subscription-Key" = ODATA_TOKEN))  %>%
    httr::content("text", encoding = "UTF-8") %>%
    jsonlite::fromJSON(flatten = TRUE)



  if (length(result$Value) == 0) {return(NULL)}

  data <- result

  data_group <- data %>%
    dplyr::mutate(
      Parameter = format(lubridate::ymd(as.Date(data$Period)), "%d-%b"),
      Year = format(ymd(result$Period), "%Y")
    ) %>%
    dplyr::arrange(Period)


  value_names <- unique(data_group$Year)
  data_group <- data_group %>%
    dplyr::filter(Label1 == group_name) %>%
    dplyr::select(Parameter, Year, Value) %>%
    tibble::add_row(Parameter = "29-Feb", Year = "2015", Value = NA, .before = 60) %>%
    tidyr::pivot_wider(names_from = Year, values_from = Value) %>%
    as.data.frame()

  data_object <- api_to_data_frame_helper(data_group, Resource$value, group_name, value_names)
}

load_environmental_data <- function(indicator, group_name) {
  if (is.null(group_name) || group_name == "") {
    return(NULL)
  }
  url <- get_indicator_parameter("data_service_url", indicator, group_name)
  id <- get_indicator_parameter("data_service_id", indicator, group_name)
  response <- POST(
    url,
    body = jsonlite::toJSON(list(action = unbox("get_flows"), id = id)),
    add_headers("Content-Type" = "application/json"),
    encode = "json"
  )
  result <- parse_httr_response(response)
  data <- result$flows %>%
    dplyr::mutate(Parameter = ymd_hms(time, tz = "NZ")) %>%
    dplyr::arrange(Parameter) %>%
    unique()

  data_object <- TimeSeries$new(
    data %>%
      dplyr::select(c("Parameter", get_indicator_parameter("data_service_filter", indicator, group_name))),
    c(group_name),
    as.Date(lubridate::now())
  )
  return(data_object)
}