movefunction to R file

This commit is contained in:
Simon 2024-08-16 10:42:51 +02:00
parent d4632b7862
commit 12cebe247a
6 changed files with 95 additions and 73 deletions

35
R/getStationData.R Normal file
View file

@ -0,0 +1,35 @@
getStationData <- function(start_date, end_date, station_id,headers = headers,dpclim = "public/DPClim/v1/") {
start_date <- as.Date(start_date)
end_date <- as.Date(end_date)
url <- 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")
parameters <- list("id-station" = station_id, "date-deb-periode" = formatted_start_date, "date-fin-periode" = formatted_end_date)
# Create the complete URL with parameters
url_with_params <- modify_url(url, query = parameters)
# Add headers
# Make the GET request
response <- GET(url_with_params, headers)
if(response$status_code == 202){
url <- modify_url(base,path = paste0(dpclim,"commande/fichier"))
parameters <- list("id-cmde" = content(response)[[1]][[1]] )
# Create the complete URL with parameters
url_with_params <- modify_url(url, query = parameters)
response <- GET(url_with_params, headers)
while(response$status_code == 204){
response <- GET(url_with_params, headers)
print("file not finisehed")
Sys.sleep(5)
}
if(response$status_code == 201){
return(read.csv(text=content(response,as="text")[[1]],sep=";",header=T,dec = ","))
}
}
stop(sprintf("Failed to retrieve data from the API. Status code: %s", response$status_code))
}

14
R/getStationInfo.R Normal file
View file

@ -0,0 +1,14 @@
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)
# Check if the request was successful
if (http_status(response)$category == "Success") { # Ensure 'success' is lowercase as typically returned by the http_status() function
# Properly parsing the content as CSV by directly reading the response text
data <- read.csv(text = 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))
}

15
R/getStationPaquet.R Normal file
View file

@ -0,0 +1,15 @@
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))
}
}

19
R/getStationsList.R Normal file
View file

@ -0,0 +1,19 @@
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))
# Better error handling
if (http_status(response)$category == "success") {
# Directly parse the content as a CSV
data <- content(response, as = "text")
# Return the data frame
return(read.csv(text = data, sep = ";", header = TRUE))
} else {
# Optionally: return an informative error message or an empty data frame
# stop("Failed to retrieve data from the API"), or
print("Failed to retrieve data from the API")
return(data.frame()) # Returns an empty data frame as a graceful fallback
}
}

9
R/tools.R Normal file
View file

@ -0,0 +1,9 @@
base <- "https://public-api.meteofrance.fr"
dpclim <- "public/DPClim/v1/"
dpPaquetObs="public/DPPaquetObs/v1/paquet/"
liststat <- "liste-stations"
infostat <- "information-station"
getDate <- function(var)as.POSIXlt(as.character(var), format = "%Y%m%d%H%M")

View file

@ -1,90 +1,20 @@
library(jsonlite) library(jsonlite)
library(httr) library(httr)
base <- "https://public-api.meteofrance.fr" devtools::load_all()
dpobs <- "public/DPObs/v1/"
dpclim <- "public/DPClim/v1/" source("secrets")
dpPaquetObs="public/DPPaquetObs/v1/paquet/"
liststat <- "liste-stations"
infostat <- "information-station"
# Create a Bearer token header # Create a Bearer token header
headersLIM <- add_headers( headersLIM <- add_headers(
accept = "*/*", accept = "*/*",
apikey = token2 apikey = token2
) )
getDate <- function(var)as.POSIXlt(as.character(var), format = "%Y%m%d%H%M")
token2="eyJ4NXQiOiJZV0kxTTJZNE1qWTNOemsyTkRZeU5XTTRPV014TXpjek1UVmhNbU14T1RSa09ETXlOVEE0Tnc9PSIsImtpZCI6ImdhdGV3YXlfY2VydGlmaWNhdGVfYWxpYXMiLCJ0eXAiOiJKV1QiLCJhbGciOiJSUzI1NiJ9.eyJzdWIiOiJzaW1vbkNhcnJpZ25vbkBjYXJib24uc3VwZXIiLCJhcHBsaWNhdGlvbiI6eyJvd25lciI6InNpbW9uQ2Fycmlnbm9uIiwidGllclF1b3RhVHlwZSI6bnVsbCwidGllciI6IlVubGltaXRlZCIsIm5hbWUiOiJEZWZhdWx0QXBwbGljYXRpb24iLCJpZCI6MTIxODksInV1aWQiOiI1NGE5MTcyMy1iMzMwLTQ0MmMtODI0Ni1jNTc1MzMzZTMwZWQifSwiaXNzIjoiaHR0cHM6XC9cL3BvcnRhaWwtYXBpLm1ldGVvZnJhbmNlLmZyOjQ0M1wvb2F1dGgyXC90b2tlbiIsInRpZXJJbmZvIjp7IjUwUGVyTWluIjp7InRpZXJRdW90YVR5cGUiOiJyZXF1ZXN0Q291bnQiLCJncmFwaFFMTWF4Q29tcGxleGl0eSI6MCwiZ3JhcGhRTE1heERlcHRoIjowLCJzdG9wT25RdW90YVJlYWNoIjp0cnVlLCJzcGlrZUFycmVzdExpbWl0IjowLCJzcGlrZUFycmVzdFVuaXQiOiJzZWMifX0sImtleXR5cGUiOiJQUk9EVUNUSU9OIiwic3Vic2NyaWJlZEFQSXMiOlt7InN1YnNjcmliZXJUZW5hbnREb21haW4iOiJjYXJib24uc3VwZXIiLCJuYW1lIjoiRG9ubmVlc1B1YmxpcXVlc09ic2VydmF0aW9uIiwiY29udGV4dCI6IlwvcHVibGljXC9EUE9ic1wvdjEiLCJwdWJsaXNoZXIiOiJiYXN0aWVuZyIsInZlcnNpb24iOiJ2MSIsInN1YnNjcmlwdGlvblRpZXIiOiI1MFBlck1pbiJ9LHsic3Vic2NyaWJlclRlbmFudERvbWFpbiI6ImNhcmJvbi5zdXBlciIsIm5hbWUiOiJEb25uZWVzUHVibGlxdWVzQ2xpbWF0b2xvZ2llIiwiY29udGV4dCI6IlwvcHVibGljXC9EUENsaW1cL3YxIiwicHVibGlzaGVyIjoiYWRtaW5fbWYiLCJ2ZXJzaW9uIjoidjEiLCJzdWJzY3JpcHRpb25UaWVyIjoiNTBQZXJNaW4ifV0sInRva2VuX3R5cGUiOiJhcGlLZXkiLCJpYXQiOjE3MTM4NjM2MjAsImp0aSI6IjMyMjliZTAxLTU5YWQtNDBmNi1hYWViLWY4YzQ1YzY1MDIyZSJ9.BqODnmumpJ0HoAwtPsiUNYbsocj7YEusnE7lY_5pCxAHXCmMJ9GMKaA7E3_x7hfACSJx05m5Ekm_Fs2zHs4RmAmLO258jdvGWnRcf_3wjl-fO_Rm1I1atsmW4gLGkk0krZRhdbnVwml6S-pyvMmoO9vjy-lpr64bFndCLA2xqmfrhjJhwAh5RSx7PFF-MVikUpyb4pIw0emQ9T3vSP8aOYBruKs9l4jrsfphHBxleSVX-UM6nExueAAY15uIVUefOq3eaGncstERODHZpalW59nD-BZApHF1UuEJbZeEPB_dRhEE0IfLF8cTwiuupGapPQrFebwFyZDgCFiF8gSu_g=="
token='eyJ4NXQiOiJZV0kxTTJZNE1qWTNOemsyTkRZeU5XTTRPV014TXpjek1UVmhNbU14T1RSa09ETXlOVEE0Tnc9PSIsImtpZCI6ImdhdGV3YXlfY2VydGlmaWNhdGVfYWxpYXMiLCJ0eXAiOiJKV1QiLCJhbGciOiJSUzI1NiJ9.eyJzdWIiOiJzaW1vbkNhcnJpZ25vbkBjYXJib24uc3VwZXIiLCJhcHBsaWNhdGlvbiI6eyJvd25lciI6InNpbW9uQ2Fycmlnbm9uIiwidGllclF1b3RhVHlwZSI6bnVsbCwidGllciI6IlVubGltaXRlZCIsIm5hbWUiOiJEZWZhdWx0QXBwbGljYXRpb24iLCJpZCI6MTIxODksInV1aWQiOiI1NGE5MTcyMy1iMzMwLTQ0MmMtODI0Ni1jNTc1MzMzZTMwZWQifSwiaXNzIjoiaHR0cHM6XC9cL3BvcnRhaWwtYXBpLm1ldGVvZnJhbmNlLmZyOjQ0M1wvb2F1dGgyXC90b2tlbiIsInRpZXJJbmZvIjp7IjUwUGVyTWluIjp7InRpZXJRdW90YVR5cGUiOiJyZXF1ZXN0Q291bnQiLCJncmFwaFFMTWF4Q29tcGxleGl0eSI6MCwiZ3JhcGhRTE1heERlcHRoIjowLCJzdG9wT25RdW90YVJlYWNoIjp0cnVlLCJzcGlrZUFycmVzdExpbWl0IjowLCJzcGlrZUFycmVzdFVuaXQiOiJzZWMifX0sImtleXR5cGUiOiJQUk9EVUNUSU9OIiwic3Vic2NyaWJlZEFQSXMiOlt7InN1YnNjcmliZXJUZW5hbnREb21haW4iOiJjYXJib24uc3VwZXIiLCJuYW1lIjoiRG9ubmVlc1B1YmxpcXVlc09ic2VydmF0aW9uIiwiY29udGV4dCI6IlwvcHVibGljXC9EUE9ic1wvdjEiLCJwdWJsaXNoZXIiOiJiYXN0aWVuZyIsInZlcnNpb24iOiJ2MSIsInN1YnNjcmlwdGlvblRpZXIiOiI1MFBlck1pbiJ9XSwiZXhwIjoxNzE0MTEwNjgxLCJ0b2tlbl90eXBlIjoiYXBpS2V5IiwiaWF0IjoxNzEzODYwNjgxLCJqdGkiOiI2NzczMjNjMy1hN2Q5LTQ0MDctOGZhOC1hOTg0MTY2ZjljZGUifQ==.WMSDZ7_oK3OjsA_1LV2goF0Gs6tybLO26MeiskuUKtPoxG-1pikWdPbT1GvsWLuu3CoAx_1IWNKbGIEXFB9l_ZIiqLCYkSEnjOlOj_ipDj3Ic4kmzBkk-FZO5SEe-de9kOPVPSWvrMuznR9BCeyOWNep-HhP0XB-gW4JsFcSo5n0rDGd_t2CWCxZos4nZwFubo1ReFxVceLOsSfE4q06qQFEcY8WucDO9nGIk_xM4n85ma8HuNXM7iJ4YOYgcWnqgEDjWSatDr-xeQFltceStzUjv9YofyEDsNmVU5f3LyuYJtSl7TIf4PeoW_RURpgfbzpT-gsxUpT1BxfF5HTYgA=='
yearTokenPaquer = "eyJ4NXQiOiJZV0kxTTJZNE1qWTNOemsyTkRZeU5XTTRPV014TXpjek1UVmhNbU14T1RSa09ETXlOVEE0Tnc9PSIsImtpZCI6ImdhdGV3YXlfY2VydGlmaWNhdGVfYWxpYXMiLCJ0eXAiOiJKV1QiLCJhbGciOiJSUzI1NiJ9.eyJzdWIiOiJzaW1vbkNhcnJpZ25vbkBjYXJib24uc3VwZXIiLCJhcHBsaWNhdGlvbiI6eyJvd25lciI6InNpbW9uQ2Fycmlnbm9uIiwidGllclF1b3RhVHlwZSI6bnVsbCwidGllciI6IlVubGltaXRlZCIsIm5hbWUiOiJEZWZhdWx0QXBwbGljYXRpb24iLCJpZCI6MTIxODksInV1aWQiOiI1NGE5MTcyMy1iMzMwLTQ0MmMtODI0Ni1jNTc1MzMzZTMwZWQifSwiaXNzIjoiaHR0cHM6XC9cL3BvcnRhaWwtYXBpLm1ldGVvZnJhbmNlLmZyOjQ0M1wvb2F1dGgyXC90b2tlbiIsInRpZXJJbmZvIjp7IjUwUGVyTWluIjp7InRpZXJRdW90YVR5cGUiOiJyZXF1ZXN0Q291bnQiLCJncmFwaFFMTWF4Q29tcGxleGl0eSI6MCwiZ3JhcGhRTE1heERlcHRoIjowLCJzdG9wT25RdW90YVJlYWNoIjp0cnVlLCJzcGlrZUFycmVzdExpbWl0IjowLCJzcGlrZUFycmVzdFVuaXQiOiJzZWMifX0sImtleXR5cGUiOiJQUk9EVUNUSU9OIiwic3Vic2NyaWJlZEFQSXMiOlt7InN1YnNjcmliZXJUZW5hbnREb21haW4iOiJjYXJib24uc3VwZXIiLCJuYW1lIjoiRG9ubmVlc1B1YmxpcXVlc09ic2VydmF0aW9uIiwiY29udGV4dCI6IlwvcHVibGljXC9EUE9ic1wvdjEiLCJwdWJsaXNoZXIiOiJiYXN0aWVuZyIsInZlcnNpb24iOiJ2MSIsInN1YnNjcmlwdGlvblRpZXIiOiI1MFBlck1pbiJ9LHsic3Vic2NyaWJlclRlbmFudERvbWFpbiI6ImNhcmJvbi5zdXBlciIsIm5hbWUiOiJEb25uZWVzUHVibGlxdWVzQ2xpbWF0b2xvZ2llIiwiY29udGV4dCI6IlwvcHVibGljXC9EUENsaW1cL3YxIiwicHVibGlzaGVyIjoiYWRtaW5fbWYiLCJ2ZXJzaW9uIjoidjEiLCJzdWJzY3JpcHRpb25UaWVyIjoiNTBQZXJNaW4ifSx7InN1YnNjcmliZXJUZW5hbnREb21haW4iOiJjYXJib24uc3VwZXIiLCJuYW1lIjoiRG9ubmVlc1B1YmxpcXVlc1BhcXVldE9ic2VydmF0aW9uIiwiY29udGV4dCI6IlwvcHVibGljXC9EUFBhcXVldE9ic1wvdjEiLCJwdWJsaXNoZXIiOiJiYXN0aWVuZyIsInZlcnNpb24iOiJ2MSIsInN1YnNjcmlwdGlvblRpZXIiOiI1MFBlck1pbiJ9XSwiZXhwIjoxNzQ1NDA1MzkyLCJ0b2tlbl90eXBlIjoiYXBpS2V5IiwiaWF0IjoxNzEzODY5MzkyLCJqdGkiOiIyMzQ1NTMyOS0xMTM1LTQ4NmQtOTk5Zi0yYWNlOTYwZWQ0ZGQifQ==.Ia61uXDUbxouhP-wRhJJkIsIBq38Ju3fxFbiirlzR_dQY-LzWhyY_WpCvdOadVFDIeEoPzhav469tcP2HlWCtEmrRa_cms8dZYFqdOCkjRr_vuJc-q7VvQfe29dpZWh347utQR8qg9C-yMU_N6M94h0RhF_KuEMuzfBXaL4vvTeVc7zfRt75gewOS8pOJtJabpzOefZ9GlCtfiYWWRjaQM-3U5PmEj6_Dl-CwbiNEpage8ieYBinx54Z8Wq1i0sVsFv4IA9ukFZyagexq1L0xNs0l3zjY5tc3E8GSF--IGf5hoIhI73K5On3WQq8nmyaa1QiyhP0UqhpXgkCSYKevg=="
headersPaquet <- add_headers( headersPaquet <- add_headers(
accept = "*/*", accept = "*/*",
apikey = yearTokenPaquer apikey = yearTokenPaquer
) )
getStations <- function(headers=headers){
url <- modify_url(base,path = paste0(dpobs,"liste-stations"))
response <- GET(url, headers)
# Check if the request was successful
if (http_status(response)$category == "Success") {
# Get the content of the response
data <- as.data.frame(content(response, as = "text"),delim=";")
} else print("Failed to retrieve data from the API")
read.csv(text=data[[1]], sep=";", header=TRUE)
}
getStationInfo <- function(station,headers=headers){
url <- modify_url(base,path = paste0(dpclim,infostat),query=list("id-station"=station))
response <- GET(url, headersLIM)
# Check if the request was successful
if (http_status(response)$category == "Success") {
# Get the content of the response
data <- as.data.frame(content(response, as = "text"),delim=";")
print(data)
} else print("Failed to retrieve data from the API")
}
getStationData <- function(start_date, end_date, station_id, headers = headers) {
url <- modify_url(base,
path = paste0(dpclim, "commande-station/infrahoraire-6m"),
query = list("id-station" = station_id,
"date-deb-periode" = format(as.Date(start_date), "%Y-%m-%dT00:00:00Z", tz = "GMT"),
"date-fin-periode" = format(as.Date(end_date), "%Y-%m-%dT00:00:00Z", tz = "GMT")))
response <- GET(url, add_headers(.headers = headers))
if (response$status_code == 202) {
cmd_url <- modify_url(base, path = paste0(dpclim, "commande/fichier"), query = list("id-cmde" = content(response)[[1]][[1]]))
repeat {
response <- GET(cmd_url, add_headers(.headers = headers))
if (response$status_code == 201) {
return(read.csv(text = content(response, "text"), sep = ";", header = TRUE, dec = ","))
} else if (response$status_code == 204) {
message("File not finished, retrying in 5 seconds...")
Sys.sleep(5)
} else {
stop(paste("Failed with", http_status(response)$message))
}
}
} else {
stop(paste("Failed to initiate data retrieval with status code:", response$status_code))
}
}
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 from the API. Status code: %s", response$status_code))
}
}
# Test the function with dates and station ID # Test the function with dates and station ID
start_date <- as.Date("2024-03-24") start_date <- as.Date("2024-03-24")