From 8b8255bab583193080f9ff1faedf413d24d64b0d Mon Sep 17 00:00:00 2001 From: Simon Date: Sat, 11 Apr 2026 09:24:56 +0100 Subject: [PATCH] Fix sourced Meteo France API helpers --- R/getAllFromCoord.R | 29 +++++++++++---- R/getStationData.R | 86 ++++++++++++++++++++++++-------------------- R/getStationInfo.R | 9 +++-- R/getStationPaquet.R | 44 +++++++++++++++-------- R/getStationsList.R | 9 +++-- R/request.R | 3 +- 6 files changed, 108 insertions(+), 72 deletions(-) diff --git a/R/getAllFromCoord.R b/R/getAllFromCoord.R index 70ecf7a..3410551 100644 --- a/R/getAllFromCoord.R +++ b/R/getAllFromCoord.R @@ -1,3 +1,21 @@ +combine_station_payloads <- function(station_payloads, station_lookup) { + station_payloads <- Filter(function(x) !is.null(x) && nrow(x), station_payloads) + if (!length(station_payloads)) { + return(NULL) + } + + combined <- do.call("rbind.data.frame", station_payloads) + station_column <- c("POSTE", "geo_id_insee") + station_column <- station_column[station_column %in% names(combined)][1] + + if (is.na(station_column)) { + return(combined) + } + + combined$Nom_usuel <- unname(station_lookup[as.character(combined[[station_column]])]) + combined +} + # Define function getAllFromCoord <- function(coord, start_date, end_date, allstations, N = 3, headers, base = "https://public-api.meteofrance.fr",btw_station_sleep = 1, within_statio_sleep=5,endpoint="public/DPClim/v1/") { three_station = getIdFromCoords(coord, allstations, N = N) @@ -12,11 +30,10 @@ getAllFromCoord <- function(coord, start_date, end_date, allstations, N = 3, hea Sys.sleep(btw_station_sleep) return(allstat) }) - - alldata = do.call("rbind.data.frame", alldata) + ids = three_station$Nom_usuel names(ids) = three_station$Id_station - cbind.data.frame(alldata, Nom_usuel = ids[as.character(alldata[,1])]) + combine_station_payloads(alldata, ids) } # Define function @@ -33,10 +50,8 @@ getAllFromCoordDPObs <- function(coord, start_date, end_date, allstations, N = 3 Sys.sleep(btw_station_sleep) return(allstat) }) - - alldata = do.call("rbind.data.frame", alldata) + ids = three_station$Nom_usuel names(ids) = three_station$Id_station - cbind.data.frame(alldata, Nom_usuel = ids[as.character(alldata[,1])]) + combine_station_payloads(alldata, ids) } - diff --git a/R/getStationData.R b/R/getStationData.R index 8ab77fe..7f256a5 100644 --- a/R/getStationData.R +++ b/R/getStationData.R @@ -1,7 +1,7 @@ getStationData <- function(start_date, end_date, station_id,headers ,dpclim = "public/DPClim/v1/",timesleep=5,base="https://public-api.meteofrance.fr") { start_date <- as.Date(start_date) end_date <- as.Date(end_date) - url <- modify_url(base,path = paste0(dpclim,"commande-station/infrahoraire-6m")) + url <- httr::modify_url(base,path = paste0(dpclim,"commande-station/infrahoraire-6m")) # Format dates in ISO8601 format formatted_start_date <- format(start_date, "%Y-%m-%dT00:00:00Z", tz = "GMT") formatted_end_date <- format(end_date, "%Y-%m-%dT00:00:00Z", tz = "GMT") @@ -9,31 +9,34 @@ getStationData <- function(start_date, end_date, station_id,headers ,dpclim = "p parameters <- list("id-station" = station_id, "date-deb-periode" = formatted_start_date, "date-fin-periode" = formatted_end_date) # Create the URL with parameters to ask for the csv file - url_query_file <- modify_url(url, query = parameters) + url_query_file <- httr::modify_url(url, query = parameters) response <- request_api(url_query_file, headers=headers,code=202) - if(response$status_code == 202){ - url_fichier <- modify_url(base,path = paste0(dpclim,"commande/fichier")) - parameters <- list("id-cmde" = content(response)[[1]][[1]] ) + if(!is.null(response) && response$status_code == 202){ + url_fichier <- httr::modify_url(base,path = paste0(dpclim,"commande/fichier")) + parameters <- list("id-cmde" = httr::content(response)[[1]][[1]] ) print(paste("Waiting for file",parameters[["id-cmde"]],"wait",timesleep,"secs")) Sys.sleep(timesleep) - url_get_file <- modify_url(url_fichier, query = parameters) + url_get_file <- httr::modify_url(url_fichier, query = parameters) response <- request_api(url_get_file, headers=headers,code=c(204,201,500)) - while(response$status_code %in% c(204,500)){ + while(!is.null(response) && response$status_code %in% c(204,500)){ print("file not ready yet, wait a minute more") Sys.sleep(60) response <- request_api(url_get_file, headers=headers,code=c(204,201,500)) - if(response$status_code == 500){ + if(!is.null(response) && response$status_code == 500){ print("problem with file generation, retry") response <- request_api(url_query_file, headers=headers,code=202) - parameters <- list("id-cmde" = content(response)[[1]][[1]] ) + if (is.null(response)) { + break + } + parameters <- list("id-cmde" = httr::content(response)[[1]][[1]] ) print(paste("Waiting for file",parameters[["id-cmde"]],"wait 25 sec")) Sys.sleep(25) - url_get_file <- modify_url(url_fichier, query = parameters) + url_get_file <- httr::modify_url(url_fichier, query = parameters) response <- request_api(url_get_file, headers=headers,code=c(204,201,500)) } } - if(response$status_code == 201){ - return(read.csv(text=content(response,as="text")[[1]],sep=";",header=T,dec = ",")) + if(!is.null(response) && response$status_code == 201){ + return(read.csv(text=httr::content(response,as="text")[[1]],sep=";",header=T,dec = ",")) } } print("Failed to retrieve data from the API. Why? not sure..") @@ -44,7 +47,7 @@ getStationData <- function(start_date, end_date, station_id,headers ,dpclim = "p getStationDataDPObs <- function(start_date, end_date, station_id,headers ,dpclim = "public/DPClim/v1/",timesleep=5,base="https://public-api.meteofrance.fr") { start_date <- as.Date(start_date) end_date <- as.Date(end_date) - url <- modify_url(base,path = paste0(dpclim,"commande-station/infrahoraire-6m")) + url <- httr::modify_url(base,path = paste0(dpclim,"commande-station/infrahoraire-6m")) # Format dates in ISO8601 format formatted_start_date <- format(start_date, "%Y-%m-%dT00:00:00Z", tz = "GMT") formatted_end_date <- format(end_date, "%Y-%m-%dT00:00:00Z", tz = "GMT") @@ -52,31 +55,34 @@ getStationDataDPObs <- function(start_date, end_date, station_id,headers ,dpclim parameters <- list("id-station" = station_id, "date-deb-periode" = formatted_start_date, "date-fin-periode" = formatted_end_date) # Create the URL with parameters to ask for the csv file - url_query_file <- modify_url(url, query = parameters) + url_query_file <- httr::modify_url(url, query = parameters) response <- request_api(url_query_file, headers=headers,code=202) - if(response$status_code == 202){ - url_fichier <- modify_url(base,path = paste0(dpclim,"commande/fichier")) - parameters <- list("id-cmde" = content(response)[[1]][[1]] ) + if(!is.null(response) && response$status_code == 202){ + url_fichier <- httr::modify_url(base,path = paste0(dpclim,"commande/fichier")) + parameters <- list("id-cmde" = httr::content(response)[[1]][[1]] ) print(paste("Waiting for file",parameters[["id-cmde"]],"wait",timesleep,"secs")) Sys.sleep(timesleep) - url_get_file <- modify_url(url_fichier, query = parameters) + url_get_file <- httr::modify_url(url_fichier, query = parameters) response <- request_api(url_get_file, headers=headers,code=c(204,201,500)) - while(response$status_code %in% c(204,500)){ + while(!is.null(response) && response$status_code %in% c(204,500)){ print("file not ready yet, wait a minute more") Sys.sleep(60) response <- request_api(url_get_file, headers=headers,code=c(204,201,500)) - if(response$status_code == 500){ + if(!is.null(response) && response$status_code == 500){ print("problem with file generation, retry") response <- request_api(url_query_file, headers=headers,code=202) - parameters <- list("id-cmde" = content(response)[[1]][[1]] ) + if (is.null(response)) { + break + } + parameters <- list("id-cmde" = httr::content(response)[[1]][[1]] ) print(paste("Waiting for file",parameters[["id-cmde"]],"wait 25 sec")) Sys.sleep(25) - url_get_file <- modify_url(url_fichier, query = parameters) + url_get_file <- httr::modify_url(url_fichier, query = parameters) response <- request_api(url_get_file, headers=headers,code=c(204,201,500)) } } - if(response$status_code == 201){ - return(read.csv(text=content(response,as="text")[[1]],sep=";",header=T,dec = ",")) + if(!is.null(response) && response$status_code == 201){ + return(read.csv(text=httr::content(response,as="text")[[1]],sep=";",header=T,dec = ",")) } } print("Failed to retrieve data from the API. Why? not sure..") @@ -86,7 +92,7 @@ getStationDataDPObs <- function(start_date, end_date, station_id,headers ,dpclim getStationDataTemp <- function(start_date, end_date, station_id,headers ,dpclim = "public/DPClim/v1/",timesleep=5,base="https://public-api.meteofrance.fr") { start_date <- as.Date(start_date) end_date <- as.Date(end_date) - url <- modify_url(base,path = paste0(dpclim,"commande-station/infrahoraire-6m")) + url <- httr::modify_url(base,path = paste0(dpclim,"commande-station/infrahoraire-6m")) # Format dates in ISO8601 format formatted_start_date <- format(start_date, "%Y-%m-%dT00:00:00Z", tz = "GMT") formatted_end_date <- format(end_date, "%Y-%m-%dT00:00:00Z", tz = "GMT") @@ -94,31 +100,34 @@ getStationDataTemp <- function(start_date, end_date, station_id,headers ,dpclim parameters <- list("id-station" = station_id, "date-deb-periode" = formatted_start_date, "date-fin-periode" = formatted_end_date) # Create the URL with parameters to ask for the csv file - url_query_file <- modify_url(url, query = parameters) + url_query_file <- httr::modify_url(url, query = parameters) response <- request_api(url_query_file, headers=headers,code=202) - if(response$status_code == 202){ - url_fichier <- modify_url(base,path = paste0(dpclim,"commande/fichier")) - parameters <- list("id-cmde" = content(response)[[1]][[1]] ) + if(!is.null(response) && response$status_code == 202){ + url_fichier <- httr::modify_url(base,path = paste0(dpclim,"commande/fichier")) + parameters <- list("id-cmde" = httr::content(response)[[1]][[1]] ) print(paste("Waiting for file",parameters[["id-cmde"]],"wait",timesleep,"secs")) Sys.sleep(timesleep) - url_get_file <- modify_url(url_fichier, query = parameters) + url_get_file <- httr::modify_url(url_fichier, query = parameters) response <- request_api(url_get_file, headers=headers,code=c(204,201,500)) - while(response$status_code %in% c(204,500)){ + while(!is.null(response) && response$status_code %in% c(204,500)){ print("file not ready yet, wait a minute more") Sys.sleep(60) response <- request_api(url_get_file, headers=headers,code=c(204,201,500)) - if(response$status_code == 500){ + if(!is.null(response) && response$status_code == 500){ print("problem with file generation, retry") response <- request_api(url_query_file, headers=headers,code=202) - parameters <- list("id-cmde" = content(response)[[1]][[1]] ) + if (is.null(response)) { + break + } + parameters <- list("id-cmde" = httr::content(response)[[1]][[1]] ) print(paste("Waiting for file",parameters[["id-cmde"]],"wait 25 sec")) Sys.sleep(25) - url_get_file <- modify_url(url_fichier, query = parameters) + url_get_file <- httr::modify_url(url_fichier, query = parameters) response <- request_api(url_get_file, headers=headers,code=c(204,201,500)) } } - if(response$status_code == 201){ - return(read.csv(text=content(response,as="text")[[1]],sep=";",header=T,dec = ",")) + if(!is.null(response) && response$status_code == 201){ + return(read.csv(text=httr::content(response,as="text")[[1]],sep=";",header=T,dec = ",")) } } print("Failed to retrieve data from the API. Why? not sure..") @@ -129,7 +138,7 @@ getStationDataTemp <- function(start_date, end_date, station_id,headers ,dpclim getStationDataDPObs <- function(start_date, end_date, station_id,headers ,dpclim = "public/DPObs/v1/",timesleep=5,base="https://public-api.meteofrance.fr") { start_date <- as.Date(start_date) end_date <- as.Date(end_date) - url <- modify_url(base,path = paste0(dpclim,"station/infrahoraire-6m")) + url <- httr::modify_url(base,path = paste0(dpclim,"station/infrahoraire-6m")) # Format dates in ISO8601 format formatted_start_date <- format(start_date, "%Y-%m-%dT12:00:00Z", tz = "GMT") formatted_end_date <- format(end_date, "%Y-%m-%dT00:00:00Z", tz = "GMT") @@ -137,7 +146,7 @@ getStationDataDPObs <- function(start_date, end_date, station_id,headers ,dpclim parameters <- list("id_station" = station_id, "date" = formatted_start_date,'format'='csv') # Create the URL with parameters to ask for the csv file - url_query_file <- modify_url(url, query = parameters) + url_query_file <- httr::modify_url(url, query = parameters) response <- request_api(url_query_file, headers=headers,code=200) print(response) #if(response$status_code == 202){ @@ -168,4 +177,3 @@ getStationDataDPObs <- function(start_date, end_date, station_id,headers ,dpclim #print("Failed to retrieve data from the API. Why? not sure..") #return(NULL) } - diff --git a/R/getStationInfo.R b/R/getStationInfo.R index 1164705..15d954e 100644 --- a/R/getStationInfo.R +++ b/R/getStationInfo.R @@ -1,14 +1,13 @@ getStationInfo <- function(station, headers,infostat = "information-station",dpclim = "public/DPClim/v1/") { # Assuming 'base' and 'dpclim' are defined externally; include 'infostat' parameter appropriately - url <- modify_url(base, path = paste0(dpclim, infostat), query = list("id-station" = station)) - response <- GET(url, headers) + url <- httr::modify_url(base, path = paste0(dpclim, infostat), query = list("id-station" = station)) + response <- httr::GET(url, headers) # Check if the request was successful - if (http_status(response)$category == "Success") { # Ensure 'success' is lowercase as typically returned by the http_status() function + if (httr::http_status(response)$category == "Success") { # Properly parsing the content as CSV by directly reading the response text - data <- read.csv(text = content(response, as = "text"), sep = ";", header = TRUE) + data <- read.csv(text = httr::content(response, as = "text"), sep = ";", header = TRUE) return(data) } stop(sprintf("Failed to get station info from the API. Status code: %s", response$status_code)) } - diff --git a/R/getStationPaquet.R b/R/getStationPaquet.R index 82eadeb..b0b4d44 100644 --- a/R/getStationPaquet.R +++ b/R/getStationPaquet.R @@ -1,15 +1,31 @@ -getStationPaquet <- function(id_station, format = "csv", headers = headersPaquet) { - base_url <- modify_url(base, path = paste0(dpPaquetObs, "infrahoraire-6m")) - url_with_params <- modify_url(base_url, query = list(id_station = id_station, format = format)) - - response <- GET(url_with_params, add_headers(.headers = headers)) - - if (response$status_code == 200) { - # Successfully retrieved the data - return(read.csv(text = content(response, "text"), sep = ";", header = TRUE)) - } else { - # If the request failed, it's useful to provide the status code in the error message for debugging - stop(sprintf("Failed to retrieve data as paquet from the API. Status code: %s", response$status_code)) - } -} +getStationPaquet <- function( + id_station, + format = "csv", + headers, + endpoint = paste0(dpPaquetObs, "infrahoraire-6m") +) { + url_with_params <- httr::modify_url( + base, + path = endpoint, + query = list(id_station = id_station, format = format) + ) + response <- request_api( + url_with_params = url_with_params, + headers = headers, + code = 200, + retry_limit = 3, + timesleep = 5 + ) + + if (is.null(response)) { + return(NULL) + } + + read.csv( + text = httr::content(response, "text", encoding = "UTF-8"), + sep = ";", + header = TRUE, + stringsAsFactors = FALSE + ) +} diff --git a/R/getStationsList.R b/R/getStationsList.R index d2fba18..cc9e5b8 100644 --- a/R/getStationsList.R +++ b/R/getStationsList.R @@ -1,11 +1,11 @@ getStations <- function(headers = headers,dpobs = "public/DPObs/v1/") { # Ensure dpobs is defined externally or provide a default/argument for it - url <- modify_url(base, path = paste0(dpobs, "liste-stations")) - response <- GET(url, add_headers(.headers = headers)) + url <- httr::modify_url(base, path = paste0(dpobs, "liste-stations")) + response <- httr::GET(url, httr::add_headers(.headers = headers)) # Better error handling - if (http_status(response)$category == "success") { + if (httr::http_status(response)$category == "Success") { # Directly parse the content as a CSV - data <- content(response, as = "text") + data <- httr::content(response, as = "text") # Return the data frame return(read.csv(text = data, sep = ";", header = TRUE)) } else { @@ -16,4 +16,3 @@ getStations <- function(headers = headers,dpobs = "public/DPObs/v1/") { } } - diff --git a/R/request.R b/R/request.R index c3167d4..33eb0e6 100644 --- a/R/request.R +++ b/R/request.R @@ -29,7 +29,7 @@ request_api <- function(url_with_params,headers,code,retry_limit=5,timesleep=20) success <- FALSE while(retry_count < retry_limit && !success) { - response <- tryCatch(GET(url_with_params, headers),error=function(e){print(e);NULL}) + response <- tryCatch(httr::GET(url_with_params, headers),error=function(e){print(e);NULL}) print(response) if(!is.null(response) && (response$status_code %in% code)) { success <- TRUE @@ -44,4 +44,3 @@ request_api <- function(url_with_params,headers,code,retry_limit=5,timesleep=20) else return(response) } -