Build cached weather app and sync tooling
This commit is contained in:
Simon
parent
b09eb2c473
commit
26f9d4da8a
11 changed files with 2708 additions and 103 deletions
10
.gitignore
vendored
Normal file
10
.gitignore
vendored
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
*.swp
|
||||
*.swo
|
||||
*.swj
|
||||
*.swk
|
||||
*.swl
|
||||
*.swm
|
||||
*.swn
|
||||
data/*.sqlite
|
||||
data/*.sqlite-shm
|
||||
data/*.sqlite-wal
|
||||
11
DESCRIPTION
11
DESCRIPTION
|
|
@ -1,15 +1,22 @@
|
|||
Package: beaumontmeteo
|
||||
Title: What the Package Does (One Line, Title Case)
|
||||
Title: Cache Local Weather Observations for Beaumont
|
||||
Version: 0.0.0.9000
|
||||
Authors@R:
|
||||
person("First", "Last", , "first.last@example.com", role = c("aut", "cre"),
|
||||
comment = c(ORCID = "YOUR-ORCID-ID"))
|
||||
Description: What the package does (one paragraph).
|
||||
Description: Shiny app and helper functions to cache Meteo France rainfall
|
||||
and station observation metrics locally and browse them without
|
||||
re-querying the API every time.
|
||||
License: `use_mit_license()`, `use_gpl3_license()` or friends to pick a
|
||||
license
|
||||
Encoding: UTF-8
|
||||
Imports:
|
||||
httr,
|
||||
shiny,
|
||||
shinycssloaders
|
||||
Roxygen: list(markdown = TRUE)
|
||||
RoxygenNote: 7.3.2
|
||||
Suggests:
|
||||
testthat (>= 3.0.0)
|
||||
SystemRequirements: sqlite3
|
||||
Config/testthat/edition: 3
|
||||
|
|
|
|||
|
|
@ -1,12 +1,23 @@
|
|||
getStationData <- function(start_date, end_date, station_id,headers ,dpclim = "public/DPClim/v1/",timesleep=5,base="https://public-api.meteofrance.fr") {
|
||||
get_dpclim_period_bounds <- function(start_date, end_date) {
|
||||
start_date <- as.Date(start_date)
|
||||
end_date <- as.Date(end_date)
|
||||
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")
|
||||
|
||||
parameters <- list("id-station" = station_id, "date-deb-periode" = formatted_start_date, "date-fin-periode" = formatted_end_date)
|
||||
list(
|
||||
start = format(start_date, "%Y-%m-%dT00:00:00Z", tz = "GMT"),
|
||||
end = format(end_date + 1L, "%Y-%m-%dT00:00:00Z", tz = "GMT")
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
getStationData <- function(start_date, end_date, station_id,headers ,dpclim = "public/DPClim/v1/",timesleep=5,base="https://public-api.meteofrance.fr") {
|
||||
url <- httr::modify_url(base,path = paste0(dpclim,"commande-station/infrahoraire-6m"))
|
||||
period_bounds <- get_dpclim_period_bounds(start_date, end_date)
|
||||
|
||||
parameters <- list(
|
||||
"id-station" = station_id,
|
||||
"date-deb-periode" = period_bounds$start,
|
||||
"date-fin-periode" = period_bounds$end
|
||||
)
|
||||
|
||||
# Create the URL with parameters to ask for the csv file
|
||||
url_query_file <- httr::modify_url(url, query = parameters)
|
||||
|
|
@ -45,14 +56,14 @@ 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 <- 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")
|
||||
period_bounds <- get_dpclim_period_bounds(start_date, end_date)
|
||||
|
||||
parameters <- list("id-station" = station_id, "date-deb-periode" = formatted_start_date, "date-fin-periode" = formatted_end_date)
|
||||
parameters <- list(
|
||||
"id-station" = station_id,
|
||||
"date-deb-periode" = period_bounds$start,
|
||||
"date-fin-periode" = period_bounds$end
|
||||
)
|
||||
|
||||
# Create the URL with parameters to ask for the csv file
|
||||
url_query_file <- httr::modify_url(url, query = parameters)
|
||||
|
|
@ -90,14 +101,14 @@ 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 <- 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")
|
||||
period_bounds <- get_dpclim_period_bounds(start_date, end_date)
|
||||
|
||||
parameters <- list("id-station" = station_id, "date-deb-periode" = formatted_start_date, "date-fin-periode" = formatted_end_date)
|
||||
parameters <- list(
|
||||
"id-station" = station_id,
|
||||
"date-deb-periode" = period_bounds$start,
|
||||
"date-fin-periode" = period_bounds$end
|
||||
)
|
||||
|
||||
# Create the URL with parameters to ask for the csv file
|
||||
url_query_file <- httr::modify_url(url, query = parameters)
|
||||
|
|
|
|||
1522
R/rain_db.R
Normal file
1522
R/rain_db.R
Normal file
File diff suppressed because it is too large
Load diff
87
README.md
87
README.md
|
|
@ -1,8 +1,89 @@
|
|||
# Beaumontmeteo
|
||||
|
||||
Quick and dirty R interface for meteofrance API.
|
||||
Shiny app and helper scripts to cache Meteo France station data around Beaumont in a local SQLite database.
|
||||
|
||||
project perso to monitor rain in the Beaumont and elsewhere.
|
||||
## What is stored
|
||||
|
||||
you need api keys and stuff and I am not sure how it all works but yeah, one day I'll clean all.
|
||||
The cache now uses one unified dataset called `weather_measurements` inside `data/rain_history.sqlite`.
|
||||
|
||||
Each row stores:
|
||||
|
||||
- location,
|
||||
- station,
|
||||
- observation timestamp,
|
||||
- metric id,
|
||||
- numeric value,
|
||||
- source metadata.
|
||||
|
||||
That means rain, temperature, humidity, wind and pressure can all be compared on the same time axis later.
|
||||
|
||||
## App
|
||||
|
||||
Run from the project root:
|
||||
|
||||
```r
|
||||
shiny::runApp()
|
||||
```
|
||||
|
||||
The UI now has two panels:
|
||||
|
||||
- a rain panel backed by historical `DPClim` rainfall,
|
||||
- a second panel backed by the same SQLite dataset, with a selector for temperature and other station metrics.
|
||||
|
||||
## Syncing the cache
|
||||
|
||||
Put your Meteo France API key in `data/secrets` as `token4`, then run:
|
||||
|
||||
```bash
|
||||
Rscript scripts/update_rain_db.R
|
||||
```
|
||||
|
||||
For a slow historical rainfall backfill into the same SQLite dataset:
|
||||
|
||||
```bash
|
||||
Rscript scripts/backfill_two_years.R
|
||||
```
|
||||
|
||||
Useful options:
|
||||
|
||||
- `update_rain_db.R --location=vignasses`
|
||||
- `update_rain_db.R --location=vignasses,la_mure`
|
||||
- `update_rain_db.R --days=60`
|
||||
- `update_rain_db.R --db-path=/somewhere/else/rain.sqlite`
|
||||
- `backfill_two_years.R --location=vignasses`
|
||||
- `backfill_two_years.R --db-path=/somewhere/else/rain.sqlite`
|
||||
- `backfill_two_years.R --chunk-days=30`
|
||||
- `backfill_two_years.R --resume=false`
|
||||
- `backfill_two_years.R --between-chunk-sleep=20`
|
||||
|
||||
## Important note about frequency
|
||||
|
||||
Historical rain can be backfilled from the climatology endpoint, so a weekly sync is fine there.
|
||||
|
||||
Temperature, humidity, wind and pressure come from the rolling station observation feed. To keep those metrics continuous in the database, run the sync daily rather than weekly.
|
||||
|
||||
## Cron examples
|
||||
|
||||
Daily full weather sync:
|
||||
|
||||
```bash
|
||||
0 7 * * * cd /path/to/beaumontmeteo && Rscript scripts/update_rain_db.R >> /tmp/beaumontmeteo-sync.log 2>&1
|
||||
```
|
||||
|
||||
If you only care about rain history, the same script can still be run weekly because rainfall is backfilled on each sync.
|
||||
|
||||
## Why SQLite
|
||||
|
||||
SQLite is a good fit here because this is a local, read-heavy app with a small periodic write job.
|
||||
|
||||
- No database server to install or operate.
|
||||
- One file to move, back up and inspect.
|
||||
- Proper indexed queries and deduplication, unlike CSV or RDS files.
|
||||
- The app still works offline once data has been cached.
|
||||
|
||||
If this ever becomes a shared multi-user service with concurrent writers, Postgres would be the next upgrade.
|
||||
|
||||
## Notes
|
||||
|
||||
- The database path can be overridden with `BEAUMONT_RAIN_DB`.
|
||||
- The repo ignores `data/*.sqlite` so the cache file stays local.
|
||||
|
|
|
|||
517
app.R
517
app.R
|
|
@ -1,96 +1,493 @@
|
|||
# Load necessary libraries
|
||||
library(shiny)
|
||||
library(jsonlite)
|
||||
library(httr)
|
||||
library(shinycssloaders) # For the spinner
|
||||
library(shinycssloaders)
|
||||
|
||||
# Assuming you have your custom functions in a file called 'your_functions.R'
|
||||
invisible(lapply(
|
||||
list.files(path = "R", pattern = "\\.R$", full.names = TRUE),
|
||||
source
|
||||
))
|
||||
|
||||
# List all R files in the directory and source them
|
||||
locations <- get_rain_locations()
|
||||
secondary_metrics <- get_weather_metric_catalog(include_rain = FALSE)
|
||||
db_path <- default_rain_db_path()
|
||||
ensure_weather_db(db_path)
|
||||
|
||||
|
||||
lapply(list.files(path = "R", pattern = "\\.R$", full.names = T), source)
|
||||
|
||||
source("data/secrets")
|
||||
|
||||
# Create a Bearer token header
|
||||
headers.default <- add_headers(
|
||||
accept = "*/*",
|
||||
apikey = token4
|
||||
get_window_slider_config <- function(unit = "days") {
|
||||
switch(
|
||||
unit,
|
||||
days = list(label = "Past days", max = 60L, value = 10L),
|
||||
months = list(label = "Past months", max = 24L, value = 6L),
|
||||
years = list(label = "Past years", max = 10L, value = 1L),
|
||||
list(label = "Past days", max = 60L, value = 10L)
|
||||
)
|
||||
}
|
||||
|
||||
# Load station data
|
||||
|
||||
# Define UI for application
|
||||
last_day_of_month <- function(year, month) {
|
||||
next_month_year <- year + if (month == 12L) 1L else 0L
|
||||
next_month <- if (month == 12L) 1L else month + 1L
|
||||
next_month_start <- as.Date(sprintf("%04d-%02d-01", next_month_year, next_month))
|
||||
as.integer(format(next_month_start - 1L, "%d"))
|
||||
}
|
||||
|
||||
|
||||
subtract_calendar_period <- function(date, amount, unit) {
|
||||
date <- as.Date(date)
|
||||
amount <- as.integer(amount)
|
||||
|
||||
if (amount <= 0L) {
|
||||
return(date)
|
||||
}
|
||||
|
||||
date_lt <- as.POSIXlt(date, tz = "UTC")
|
||||
year <- date_lt$year + 1900L
|
||||
month <- date_lt$mon + 1L
|
||||
day <- date_lt$mday
|
||||
|
||||
if (identical(unit, "months")) {
|
||||
total_months <- year * 12L + (month - 1L) - amount
|
||||
target_year <- total_months %/% 12L
|
||||
target_month <- total_months %% 12L + 1L
|
||||
target_day <- min(day, last_day_of_month(target_year, target_month))
|
||||
|
||||
return(as.Date(sprintf("%04d-%02d-%02d", target_year, target_month, target_day)))
|
||||
}
|
||||
|
||||
if (identical(unit, "years")) {
|
||||
target_year <- year - amount
|
||||
target_day <- min(day, last_day_of_month(target_year, month))
|
||||
|
||||
return(as.Date(sprintf("%04d-%02d-%02d", target_year, month, target_day)))
|
||||
}
|
||||
|
||||
date - amount
|
||||
}
|
||||
|
||||
|
||||
window_start_date <- function(end_date, amount, unit) {
|
||||
end_date <- as.Date(end_date)
|
||||
amount <- max(1L, as.integer(amount))
|
||||
|
||||
if (identical(unit, "days")) {
|
||||
return(end_date - amount + 1L)
|
||||
}
|
||||
|
||||
subtract_calendar_period(end_date, amount, unit) + 1L
|
||||
}
|
||||
|
||||
|
||||
format_window_label <- function(amount, unit) {
|
||||
amount <- max(1L, as.integer(amount))
|
||||
unit_label <- if (amount == 1L) sub("s$", "", unit) else unit
|
||||
|
||||
sprintf("last %s %s", amount, unit_label)
|
||||
}
|
||||
|
||||
ui <- fluidPage(
|
||||
tags$head(
|
||||
tags$style(HTML("
|
||||
#main {
|
||||
height: 100vh; /* Full height of the viewport */
|
||||
overflow-y: auto; /* Scroll if content overflows */
|
||||
}
|
||||
.container-fluid {
|
||||
height: 100vh; /* Full height of the viewport */
|
||||
display: flex;
|
||||
flex-direction: column;
|
||||
max-width: 1480px;
|
||||
}
|
||||
.row {
|
||||
flex-grow: 1;
|
||||
display: flex;
|
||||
.status-block {
|
||||
margin-top: 16px;
|
||||
padding: 12px;
|
||||
background: #f6f8f9;
|
||||
border: 1px solid #d9e1e5;
|
||||
border-radius: 6px;
|
||||
}
|
||||
.col-sm-8 {
|
||||
flex-grow: 1; /* Allow the main panel to grow */
|
||||
.help-block {
|
||||
margin-top: 12px;
|
||||
}
|
||||
.panel-card {
|
||||
min-height: 100%;
|
||||
padding: 16px;
|
||||
background: #fbfcfd;
|
||||
border: 1px solid #d9e1e5;
|
||||
border-radius: 8px;
|
||||
}
|
||||
.panel-title {
|
||||
margin-top: 0;
|
||||
}
|
||||
"))
|
||||
),
|
||||
|
||||
# Application title
|
||||
titlePanel("Beaumont aka SECMONT"),
|
||||
titlePanel("Beaumont Weather Cache"),
|
||||
|
||||
# Sidebar for user inputs
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
width=2,
|
||||
numericInput(inputId = "daysBefore", label = "Nb jour à check:", value=10, min=1)
|
||||
width = 3,
|
||||
selectInput(
|
||||
inputId = "location_id",
|
||||
label = "Location",
|
||||
choices = stats::setNames(locations$location_id, locations$label),
|
||||
selected = locations$location_id[1]
|
||||
),
|
||||
radioButtons(
|
||||
inputId = "window_unit",
|
||||
label = "Time window",
|
||||
choices = c(
|
||||
"Days" = "days",
|
||||
"Months" = "months",
|
||||
"Years" = "years"
|
||||
),
|
||||
selected = "days",
|
||||
inline = TRUE
|
||||
),
|
||||
sliderInput(
|
||||
inputId = "window_amount",
|
||||
label = "Past days",
|
||||
min = 1,
|
||||
max = 60,
|
||||
value = 10,
|
||||
step = 1
|
||||
),
|
||||
radioButtons(
|
||||
inputId = "rain_view_mode",
|
||||
label = "Rain display",
|
||||
choices = c(
|
||||
"6-minute rain" = "raw",
|
||||
"Daily total" = "daily"
|
||||
),
|
||||
selected = "raw"
|
||||
),
|
||||
checkboxInput(
|
||||
inputId = "hide_zero",
|
||||
label = "Hide zero rainfall",
|
||||
value = TRUE
|
||||
),
|
||||
selectInput(
|
||||
inputId = "metric_id",
|
||||
label = "Second panel",
|
||||
choices = stats::setNames(secondary_metrics$metric_id, secondary_metrics$label),
|
||||
selected = "air_temperature"
|
||||
),
|
||||
radioButtons(
|
||||
inputId = "metric_view_mode",
|
||||
label = "Second panel display",
|
||||
choices = c(
|
||||
"Raw observations" = "raw",
|
||||
"Daily aggregate" = "daily"
|
||||
),
|
||||
selected = "raw"
|
||||
),
|
||||
uiOutput("syncControls"),
|
||||
div(
|
||||
class = "status-block",
|
||||
verbatimTextOutput("cacheStatus")
|
||||
)
|
||||
),
|
||||
|
||||
# Main panel for displaying plot
|
||||
mainPanel(
|
||||
width = 9,
|
||||
fluidRow(
|
||||
column(
|
||||
width = 6,
|
||||
withSpinner( plotOutput("dataPlot"))
|
||||
div(
|
||||
class = "panel-card",
|
||||
h3(class = "panel-title", "Rain"),
|
||||
withSpinner(plotOutput("rainPlot", height = "420px")),
|
||||
h4("Daily rain totals"),
|
||||
tableOutput("dailySummary")
|
||||
)
|
||||
),
|
||||
column(
|
||||
width = 6,
|
||||
div(
|
||||
class = "panel-card",
|
||||
h3(class = "panel-title", textOutput("metricTitle", container = span)),
|
||||
withSpinner(plotOutput("metricPlot", height = "420px")),
|
||||
h4("Latest values by station"),
|
||||
tableOutput("metricLatest")
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
# Define server logic required to generate and plot data
|
||||
server <- function(input, output) {
|
||||
# Reactive expression to fetch data based on input and display spinner while loading
|
||||
|
||||
server <- function(input, output, session) {
|
||||
api_headers <- load_api_headers()
|
||||
data_version <- reactiveVal(0L)
|
||||
last_sync_message <- reactiveVal("")
|
||||
|
||||
# Render the plot
|
||||
output$dataPlot <- renderPlot({
|
||||
startdate <- format(Sys.Date() - input$daysBefore, "%Y-%m-%d")
|
||||
vignass.coor=c(44.8550665,5.8441789)
|
||||
allstations <- read.csv("data/allstations.csv")
|
||||
test1 <- getAllFromCoord(vignass.coor, start_date = startdate, end_date = format(Sys.Date(), "%Y-%m-%d"), allstations, headers = headers.default,btw_station_sleep = .5,within_statio_sleep = 1)
|
||||
|
||||
# Prepare colors
|
||||
cols <- palette.colors()[1:length(unique(test1$Nom_usuel))]
|
||||
names(cols) <- unique(test1$Nom_usuel)
|
||||
|
||||
# Filter data
|
||||
testsep <- test1
|
||||
testsep[testsep[,3] == 0 & !is.na(testsep[,3]), c(3,4)] <- NA
|
||||
|
||||
plot(getDate(testsep[,2]), testsep[,3], pch = 20, col = adjustcolor(cols[testsep$Nom_usuel], .4), cex = 1.3, ylim = c(0, 8))
|
||||
|
||||
# Add legend
|
||||
legend("topleft", col = cols, legend = names(cols), pch = 20, cex = 1)
|
||||
|
||||
# Highlight specific date
|
||||
abline(v = as.numeric(as.POSIXlt("2024-08-07", format = "%Y-%m-%d")), lwd = 3, col = "red")
|
||||
selected_location <- reactive({
|
||||
get_rain_location(input$location_id, locations = locations)
|
||||
})
|
||||
|
||||
selected_metric <- reactive({
|
||||
get_weather_metric(input$metric_id)
|
||||
})
|
||||
|
||||
observeEvent(input$window_unit, {
|
||||
settings <- get_window_slider_config(input$window_unit)
|
||||
current_value <- if (is.null(input$window_amount)) {
|
||||
settings$value
|
||||
} else {
|
||||
as.integer(input$window_amount)
|
||||
}
|
||||
|
||||
# Run the application
|
||||
updateSliderInput(
|
||||
session = session,
|
||||
inputId = "window_amount",
|
||||
label = settings$label,
|
||||
min = 1,
|
||||
max = settings$max,
|
||||
value = min(max(current_value, 1L), settings$max),
|
||||
step = 1
|
||||
)
|
||||
}, ignoreInit = TRUE)
|
||||
|
||||
selected_start_date <- reactive({
|
||||
window_start_date(
|
||||
end_date = Sys.Date(),
|
||||
amount = input$window_amount,
|
||||
unit = input$window_unit
|
||||
)
|
||||
})
|
||||
|
||||
selected_window_label <- reactive({
|
||||
format_window_label(
|
||||
amount = input$window_amount,
|
||||
unit = input$window_unit
|
||||
)
|
||||
})
|
||||
|
||||
selected_window_days <- reactive({
|
||||
as.integer(Sys.Date() - selected_start_date()) + 1L
|
||||
})
|
||||
|
||||
cached_rain <- reactive({
|
||||
data_version()
|
||||
|
||||
query_cached_rainfall(
|
||||
location_id = input$location_id,
|
||||
start_date = selected_start_date(),
|
||||
end_date = Sys.Date(),
|
||||
aggregate = input$rain_view_mode,
|
||||
db_path = db_path
|
||||
)
|
||||
})
|
||||
|
||||
cached_metric <- reactive({
|
||||
data_version()
|
||||
|
||||
query_cached_metric(
|
||||
location_id = input$location_id,
|
||||
metric_id = input$metric_id,
|
||||
start_date = selected_start_date(),
|
||||
end_date = Sys.Date(),
|
||||
aggregate = input$metric_view_mode,
|
||||
db_path = db_path
|
||||
)
|
||||
})
|
||||
|
||||
daily_summary <- reactive({
|
||||
data_version()
|
||||
|
||||
query_cached_rainfall(
|
||||
location_id = input$location_id,
|
||||
start_date = selected_start_date(),
|
||||
end_date = Sys.Date(),
|
||||
aggregate = "daily",
|
||||
db_path = db_path
|
||||
)
|
||||
})
|
||||
|
||||
metric_latest <- reactive({
|
||||
data_version()
|
||||
|
||||
query_latest_metric_values(
|
||||
location_id = input$location_id,
|
||||
metric_id = input$metric_id,
|
||||
db_path = db_path
|
||||
)
|
||||
})
|
||||
|
||||
output$metricTitle <- renderText({
|
||||
selected_metric()$label
|
||||
})
|
||||
|
||||
output$syncControls <- renderUI({
|
||||
if (is.null(api_headers)) {
|
||||
return(
|
||||
div(
|
||||
class = "help-block",
|
||||
helpText(
|
||||
"This app is reading the local SQLite cache only. Add token4 to data/secrets and run",
|
||||
"`Rscript scripts/update_rain_db.R`",
|
||||
"to refresh rain plus the second-panel weather metrics."
|
||||
),
|
||||
helpText(
|
||||
"Rain can be backfilled. Temperature, humidity, wind and pressure come from the rolling observation feed, so sync that script daily if you want a continuous history."
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
tagList(
|
||||
actionButton("sync_now", "Sync location from API"),
|
||||
div(
|
||||
class = "help-block",
|
||||
helpText(
|
||||
"This refresh pulls historical rain plus the latest station observations into the same SQLite dataset."
|
||||
)
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
observeEvent(input$sync_now, {
|
||||
req(!is.null(api_headers))
|
||||
|
||||
location <- selected_location()
|
||||
result <- tryCatch(
|
||||
withProgress(
|
||||
message = sprintf("Syncing %s into SQLite", location$label[1]),
|
||||
value = 0.3,
|
||||
{
|
||||
sync_location_weather(
|
||||
location_id = input$location_id,
|
||||
db_path = db_path,
|
||||
headers = api_headers,
|
||||
initial_backfill_days = max(21L, selected_window_days() + 7L)
|
||||
)
|
||||
}
|
||||
),
|
||||
error = function(error) {
|
||||
last_sync_message(
|
||||
sprintf("Last sync failed: %s", conditionMessage(error))
|
||||
)
|
||||
NULL
|
||||
}
|
||||
)
|
||||
|
||||
if (is.null(result)) {
|
||||
return()
|
||||
}
|
||||
|
||||
latest_observed_at <- result$latest_observed_at[1]
|
||||
if (is.na(latest_observed_at) || !nzchar(latest_observed_at)) {
|
||||
latest_observed_at <- "no data returned"
|
||||
}
|
||||
|
||||
last_sync_message(
|
||||
sprintf(
|
||||
paste(
|
||||
"Last sync: %s rows written",
|
||||
"(rain %s, observations %s).",
|
||||
"Cache now reaches %s."
|
||||
),
|
||||
format(result$rows_written[1], big.mark = ","),
|
||||
format(result$rain_rows_written[1], big.mark = ","),
|
||||
format(result$observation_rows_written[1], big.mark = ","),
|
||||
latest_observed_at
|
||||
)
|
||||
)
|
||||
data_version(data_version() + 1L)
|
||||
})
|
||||
|
||||
output$cacheStatus <- renderText({
|
||||
data_version()
|
||||
|
||||
status_text <- describe_cache_status(
|
||||
location_id = input$location_id,
|
||||
db_path = db_path,
|
||||
locations = locations
|
||||
)
|
||||
|
||||
if (!nzchar(last_sync_message())) {
|
||||
return(status_text)
|
||||
}
|
||||
|
||||
paste(status_text, last_sync_message(), sep = "\n\n")
|
||||
})
|
||||
|
||||
output$rainPlot <- renderPlot({
|
||||
plot_data <- cached_rain()
|
||||
|
||||
shiny::validate(
|
||||
shiny::need(
|
||||
nrow(plot_data) > 0,
|
||||
"No cached rainfall for this period yet. Run the sync script or use the API sync button if credentials are configured."
|
||||
)
|
||||
)
|
||||
|
||||
if (input$hide_zero) {
|
||||
plot_data <- plot_data[
|
||||
is.na(plot_data$rain_mm) | plot_data$rain_mm > 0,
|
||||
,
|
||||
drop = FALSE
|
||||
]
|
||||
}
|
||||
|
||||
shiny::validate(
|
||||
shiny::need(
|
||||
nrow(plot_data) > 0,
|
||||
"No non-zero rainfall in this window. Untick 'Hide zero rainfall' if you want to inspect dry periods too."
|
||||
)
|
||||
)
|
||||
|
||||
plot_cached_rainfall(
|
||||
rain_data = plot_data,
|
||||
view = input$rain_view_mode,
|
||||
hide_zero = FALSE,
|
||||
main = sprintf(
|
||||
"%s - %s",
|
||||
selected_location()$label[1],
|
||||
selected_window_label()
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
output$metricPlot <- renderPlot({
|
||||
plot_data <- cached_metric()
|
||||
metric <- selected_metric()
|
||||
|
||||
shiny::validate(
|
||||
shiny::need(
|
||||
nrow(plot_data) > 0,
|
||||
sprintf(
|
||||
"No cached %s data for this window yet. Run the sync script more frequently if you want a continuous history for that metric.",
|
||||
tolower(metric$label)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
plot_cached_metric(
|
||||
metric_data = plot_data,
|
||||
metric_id = input$metric_id,
|
||||
view = input$metric_view_mode,
|
||||
main = sprintf(
|
||||
"%s - %s - %s",
|
||||
selected_location()$label[1],
|
||||
metric$label,
|
||||
selected_window_label()
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
output$dailySummary <- renderTable({
|
||||
summary_data <- daily_summary()
|
||||
if (!nrow(summary_data)) {
|
||||
return(NULL)
|
||||
}
|
||||
|
||||
names(summary_data) <- c("Station ID", "Station", "Day", "Metric", "Label", "Unit", "Rain")
|
||||
summary_data[, c("Station", "Day", "Rain")]
|
||||
}, striped = TRUE, spacing = "s", digits = 2)
|
||||
|
||||
output$metricLatest <- renderTable({
|
||||
latest_data <- metric_latest()
|
||||
if (!nrow(latest_data)) {
|
||||
return(NULL)
|
||||
}
|
||||
|
||||
names(latest_data) <- c("Station ID", "Station", "Observed At", "Metric", "Label", "Unit", "Value")
|
||||
latest_data[, c("Station", "Observed At", "Value", "Unit")]
|
||||
}, striped = TRUE, spacing = "s", digits = 2)
|
||||
}
|
||||
|
||||
|
||||
shinyApp(ui = ui, server = server)
|
||||
|
|
|
|||
299
scripts/backfill_two_years.R
Normal file
299
scripts/backfill_two_years.R
Normal file
|
|
@ -0,0 +1,299 @@
|
|||
command_line_args <- commandArgs(trailingOnly = TRUE)
|
||||
|
||||
parse_cli_args <- function(args) {
|
||||
parsed <- list()
|
||||
|
||||
for (arg in args) {
|
||||
if (!grepl("^--", arg)) {
|
||||
next
|
||||
}
|
||||
|
||||
parts <- strsplit(sub("^--", "", arg), "=", fixed = TRUE)[[1]]
|
||||
key <- parts[1]
|
||||
value <- if (length(parts) > 1) paste(parts[-1], collapse = "=") else TRUE
|
||||
parsed[[key]] <- value
|
||||
}
|
||||
|
||||
parsed
|
||||
}
|
||||
|
||||
|
||||
parse_flag <- function(value, default = FALSE) {
|
||||
if (is.null(value)) {
|
||||
return(default)
|
||||
}
|
||||
|
||||
normalized <- tolower(as.character(value))
|
||||
if (normalized %in% c("true", "t", "1", "yes", "y")) {
|
||||
return(TRUE)
|
||||
}
|
||||
if (normalized %in% c("false", "f", "0", "no", "n")) {
|
||||
return(FALSE)
|
||||
}
|
||||
|
||||
default
|
||||
}
|
||||
|
||||
|
||||
sleep_with_message <- function(seconds, reason) {
|
||||
seconds <- as.numeric(seconds)
|
||||
|
||||
if (!is.finite(seconds) || seconds <= 0) {
|
||||
return(invisible(NULL))
|
||||
}
|
||||
|
||||
cat(sprintf("%s Sleeping %.1f seconds.\n", reason, seconds))
|
||||
Sys.sleep(seconds)
|
||||
}
|
||||
|
||||
|
||||
script_file_arg <- grep("^--file=", commandArgs(FALSE), value = TRUE)
|
||||
script_path <- normalizePath(sub("^--file=", "", script_file_arg[1]), winslash = "/")
|
||||
project_root <- normalizePath(file.path(dirname(script_path), ".."), winslash = "/")
|
||||
|
||||
setwd(project_root)
|
||||
invisible(lapply(
|
||||
list.files(path = "R", pattern = "\\.R$", full.names = TRUE),
|
||||
source
|
||||
))
|
||||
|
||||
args <- parse_cli_args(command_line_args)
|
||||
db_path <- if (!is.null(args[["db-path"]])) {
|
||||
normalizePath(args[["db-path"]], winslash = "/", mustWork = FALSE)
|
||||
} else {
|
||||
default_rain_db_path()
|
||||
}
|
||||
|
||||
location_ids <- if (!is.null(args[["location"]])) {
|
||||
strsplit(args[["location"]], ",", fixed = TRUE)[[1]]
|
||||
} else {
|
||||
get_rain_locations()$location_id
|
||||
}
|
||||
|
||||
days_back <- if (!is.null(args[["days"]])) {
|
||||
as.integer(args[["days"]])
|
||||
} else {
|
||||
730L
|
||||
}
|
||||
|
||||
chunk_days <- if (!is.null(args[["chunk-days"]])) {
|
||||
as.integer(args[["chunk-days"]])
|
||||
} else {
|
||||
30L
|
||||
}
|
||||
|
||||
btw_station_sleep <- if (!is.null(args[["btw-station-sleep"]])) {
|
||||
as.numeric(args[["btw-station-sleep"]])
|
||||
} else {
|
||||
4
|
||||
}
|
||||
|
||||
within_station_sleep <- if (!is.null(args[["within-station-sleep"]])) {
|
||||
as.numeric(args[["within-station-sleep"]])
|
||||
} else {
|
||||
10
|
||||
}
|
||||
|
||||
between_chunk_sleep <- if (!is.null(args[["between-chunk-sleep"]])) {
|
||||
as.numeric(args[["between-chunk-sleep"]])
|
||||
} else {
|
||||
20
|
||||
}
|
||||
|
||||
between_location_sleep <- if (!is.null(args[["between-location-sleep"]])) {
|
||||
as.numeric(args[["between-location-sleep"]])
|
||||
} else {
|
||||
60
|
||||
}
|
||||
|
||||
resume <- parse_flag(args[["resume"]], default = TRUE)
|
||||
end_date <- if (!is.null(args[["end-date"]])) {
|
||||
as.Date(args[["end-date"]])
|
||||
} else {
|
||||
Sys.Date() - 1L
|
||||
}
|
||||
|
||||
headers <- load_api_headers()
|
||||
if (is.null(headers)) {
|
||||
stop("No API credentials found. Add token4 to data/secrets before running the backfill.")
|
||||
}
|
||||
|
||||
allstations <- load_station_catalog()
|
||||
locations <- get_rain_locations()
|
||||
ensure_weather_db(db_path)
|
||||
|
||||
cat("Starting slow historical backfill.\n")
|
||||
cat(sprintf("Database: %s\n", db_path))
|
||||
cat(sprintf("Locations: %s\n", paste(location_ids, collapse = ", ")))
|
||||
cat(sprintf("Rainfall window: last %s days ending on %s\n", days_back, as.character(end_date)))
|
||||
cat(sprintf("Chunk size: %s days\n", chunk_days))
|
||||
cat(sprintf("Sleep between stations: %.1f seconds\n", btw_station_sleep))
|
||||
cat(sprintf("Sleep while waiting for station files: %.1f seconds\n", within_station_sleep))
|
||||
cat(sprintf("Sleep between chunks: %.1f seconds\n", between_chunk_sleep))
|
||||
cat(sprintf("Sleep between locations: %.1f seconds\n", between_location_sleep))
|
||||
cat(sprintf("Resume mode: %s\n\n", if (resume) "on" else "off"))
|
||||
|
||||
overall_start_date <- end_date - days_back + 1L
|
||||
results <- vector("list", length(location_ids))
|
||||
|
||||
for (location_index in seq_along(location_ids)) {
|
||||
location_id <- location_ids[location_index]
|
||||
location_label <- get_rain_location(location_id, locations = locations)$label[1]
|
||||
|
||||
location_start_date <- overall_start_date
|
||||
if (resume) {
|
||||
resume_start_date <- get_sync_start_date(
|
||||
location_id = location_id,
|
||||
db_path = db_path,
|
||||
end_date = end_date,
|
||||
initial_backfill_days = days_back,
|
||||
overlap_days = 1L,
|
||||
metric_id = "rain_6m"
|
||||
)
|
||||
location_start_date <- as.Date(max(location_start_date, resume_start_date))
|
||||
}
|
||||
|
||||
if (location_start_date > end_date) {
|
||||
cat(sprintf("[%s] %s already has data up to %s. Skipping.\n", location_id, location_label, as.character(end_date)))
|
||||
status <- get_location_cache_status(location_id, db_path = db_path)
|
||||
results[[location_index]] <- data.frame(
|
||||
location_id = location_id,
|
||||
start_date = as.character(location_start_date),
|
||||
end_date = as.character(end_date),
|
||||
chunk_days = chunk_days,
|
||||
rows_fetched = 0L,
|
||||
rows_written = 0L,
|
||||
latest_observed_at = status$latest_observed_at[1],
|
||||
status = "up_to_date",
|
||||
message = "",
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
next
|
||||
}
|
||||
|
||||
ranges <- split_sync_ranges(
|
||||
start_date = location_start_date,
|
||||
end_date = end_date,
|
||||
chunk_days = chunk_days
|
||||
)
|
||||
|
||||
cat(sprintf("[%s] Backfilling %s from %s to %s in %s chunk(s).\n",
|
||||
location_id,
|
||||
location_label,
|
||||
as.character(location_start_date),
|
||||
as.character(end_date),
|
||||
nrow(ranges)
|
||||
))
|
||||
|
||||
location_rows_fetched <- 0L
|
||||
location_rows_written <- 0L
|
||||
location_status <- "ok"
|
||||
location_message <- ""
|
||||
|
||||
for (range_index in seq_len(nrow(ranges))) {
|
||||
chunk_start <- ranges$start_date[range_index]
|
||||
chunk_end <- ranges$end_date[range_index]
|
||||
|
||||
cat(sprintf(
|
||||
"[%s] Chunk %s/%s: %s -> %s\n",
|
||||
location_id,
|
||||
range_index,
|
||||
nrow(ranges),
|
||||
as.character(chunk_start),
|
||||
as.character(chunk_end)
|
||||
))
|
||||
|
||||
chunk_result <- tryCatch(
|
||||
{
|
||||
raw_data <- fetch_rainfall_from_api(
|
||||
location_id = location_id,
|
||||
start_date = chunk_start,
|
||||
end_date = chunk_end,
|
||||
headers = headers,
|
||||
allstations = allstations,
|
||||
locations = locations,
|
||||
btw_station_sleep = btw_station_sleep,
|
||||
within_station_sleep = within_station_sleep
|
||||
)
|
||||
|
||||
weather_data <- normalise_rainfall_data(
|
||||
raw_data = raw_data,
|
||||
location_id = location_id
|
||||
)
|
||||
|
||||
rows_written <- upsert_weather_measurements(
|
||||
weather_data = weather_data,
|
||||
db_path = db_path
|
||||
)
|
||||
|
||||
list(
|
||||
rows_fetched = nrow(weather_data),
|
||||
rows_written = rows_written,
|
||||
status = "ok",
|
||||
message = ""
|
||||
)
|
||||
},
|
||||
error = function(error) {
|
||||
list(
|
||||
rows_fetched = 0L,
|
||||
rows_written = 0L,
|
||||
status = "error",
|
||||
message = conditionMessage(error)
|
||||
)
|
||||
}
|
||||
)
|
||||
|
||||
location_rows_fetched <- location_rows_fetched + chunk_result$rows_fetched
|
||||
location_rows_written <- location_rows_written + chunk_result$rows_written
|
||||
|
||||
cat(sprintf(
|
||||
"[%s] Chunk result: fetched %s rows, wrote %s rows.\n",
|
||||
location_id,
|
||||
format(chunk_result$rows_fetched, big.mark = ","),
|
||||
format(chunk_result$rows_written, big.mark = ",")
|
||||
))
|
||||
|
||||
if (!identical(chunk_result$status, "ok")) {
|
||||
location_status <- "error"
|
||||
location_message <- chunk_result$message
|
||||
cat(sprintf("[%s] Stopping because of error: %s\n", location_id, location_message))
|
||||
break
|
||||
}
|
||||
|
||||
if (range_index < nrow(ranges)) {
|
||||
sleep_with_message(
|
||||
seconds = between_chunk_sleep,
|
||||
reason = sprintf("[%s] Chunk complete.", location_id)
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
status <- get_location_cache_status(location_id, db_path = db_path)
|
||||
results[[location_index]] <- data.frame(
|
||||
location_id = location_id,
|
||||
start_date = as.character(location_start_date),
|
||||
end_date = as.character(end_date),
|
||||
chunk_days = chunk_days,
|
||||
rows_fetched = location_rows_fetched,
|
||||
rows_written = location_rows_written,
|
||||
latest_observed_at = status$latest_observed_at[1],
|
||||
status = location_status,
|
||||
message = location_message,
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
if (location_index < length(location_ids)) {
|
||||
sleep_with_message(
|
||||
seconds = between_location_sleep,
|
||||
reason = sprintf("[%s] Location complete.", location_id)
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
results <- do.call(rbind, results)
|
||||
cat("\nBackfill summary:\n")
|
||||
print(results, row.names = FALSE)
|
||||
|
||||
if (any(results$status == "error")) {
|
||||
stop("At least one location failed during the historical backfill.")
|
||||
}
|
||||
66
scripts/update_rain_db.R
Normal file
66
scripts/update_rain_db.R
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
command_line_args <- commandArgs(trailingOnly = TRUE)
|
||||
|
||||
parse_cli_args <- function(args) {
|
||||
parsed <- list()
|
||||
|
||||
for (arg in args) {
|
||||
if (!grepl("^--", arg)) {
|
||||
next
|
||||
}
|
||||
|
||||
parts <- strsplit(sub("^--", "", arg), "=", fixed = TRUE)[[1]]
|
||||
key <- parts[1]
|
||||
value <- if (length(parts) > 1) paste(parts[-1], collapse = "=") else TRUE
|
||||
parsed[[key]] <- value
|
||||
}
|
||||
|
||||
parsed
|
||||
}
|
||||
|
||||
|
||||
script_file_arg <- grep("^--file=", commandArgs(FALSE), value = TRUE)
|
||||
script_path <- normalizePath(sub("^--file=", "", script_file_arg[1]), winslash = "/")
|
||||
project_root <- normalizePath(file.path(dirname(script_path), ".."), winslash = "/")
|
||||
|
||||
setwd(project_root)
|
||||
invisible(lapply(
|
||||
list.files(path = "R", pattern = "\\.R$", full.names = TRUE),
|
||||
source
|
||||
))
|
||||
|
||||
args <- parse_cli_args(command_line_args)
|
||||
db_path <- if (!is.null(args[["db-path"]])) {
|
||||
normalizePath(args[["db-path"]], winslash = "/", mustWork = FALSE)
|
||||
} else {
|
||||
default_rain_db_path()
|
||||
}
|
||||
|
||||
location_ids <- if (!is.null(args[["location"]])) {
|
||||
strsplit(args[["location"]], ",", fixed = TRUE)[[1]]
|
||||
} else {
|
||||
get_rain_locations()$location_id
|
||||
}
|
||||
|
||||
initial_backfill_days <- if (!is.null(args[["days"]])) {
|
||||
as.integer(args[["days"]])
|
||||
} else {
|
||||
21L
|
||||
}
|
||||
|
||||
headers <- load_api_headers()
|
||||
if (is.null(headers)) {
|
||||
stop("No API credentials found. Add token4 to data/secrets before running the sync.")
|
||||
}
|
||||
|
||||
results <- sync_all_weather_locations(
|
||||
location_ids = location_ids,
|
||||
db_path = db_path,
|
||||
headers = headers,
|
||||
initial_backfill_days = initial_backfill_days
|
||||
)
|
||||
|
||||
print(results, row.names = FALSE)
|
||||
|
||||
if (any(results$status == "error")) {
|
||||
stop("At least one location failed to sync.")
|
||||
}
|
||||
|
|
@ -1,19 +1,37 @@
|
|||
library(jsonlite)
|
||||
library(httr)
|
||||
|
||||
|
||||
source(file.path(here::here(),"secrets"))
|
||||
# Create a Bearer token header
|
||||
headers.default <- add_headers(
|
||||
accept = "*/*",
|
||||
apikey = token2
|
||||
testthat::skip_if_not(
|
||||
identical(tolower(Sys.getenv("BEAUMONT_RUN_LIVE_API_TESTS", "false")), "true"),
|
||||
"Set BEAUMONT_RUN_LIVE_API_TESTS=true to run live Meteo France API tests."
|
||||
)
|
||||
|
||||
test_that("get station return something right",
|
||||
{
|
||||
test=getStationData(start_date="2024-06-24",end_date="2024-08-14",station_id="38269004",headers=headers.default)
|
||||
if(!is.null(test)){testthat::expect_length(test,3)}
|
||||
else testthat::expect_null(test)
|
||||
testthat::skip_if_not(
|
||||
file.exists(file.path("data", "secrets")),
|
||||
"Live API tests require data/secrets."
|
||||
)
|
||||
|
||||
library(httr)
|
||||
|
||||
source(file.path("R", "request.R"))
|
||||
source(file.path("R", "getStationData.R"))
|
||||
|
||||
secret_env <- new.env(parent = baseenv())
|
||||
sys.source(file.path("data", "secrets"), envir = secret_env)
|
||||
|
||||
headers.default <- add_headers(
|
||||
accept = "*/*",
|
||||
apikey = secret_env$token2
|
||||
)
|
||||
|
||||
test_that("get station return something right", {
|
||||
test <- getStationData(
|
||||
start_date = "2024-06-24",
|
||||
end_date = "2024-08-14",
|
||||
station_id = "38269004",
|
||||
headers = headers.default
|
||||
)
|
||||
|
||||
if (!is.null(test)) {
|
||||
testthat::expect_length(test, 3)
|
||||
} else {
|
||||
testthat::expect_null(test)
|
||||
}
|
||||
})
|
||||
|
||||
|
||||
|
|
|
|||
180
tests/testthat/test-rain-db.R
Normal file
180
tests/testthat/test-rain-db.R
Normal file
|
|
@ -0,0 +1,180 @@
|
|||
source(testthat::test_path("..", "..", "R", "rain_db.R"))
|
||||
|
||||
test_that("normalise_rainfall_data converts API payload into unified metric rows", {
|
||||
raw_data <- data.frame(
|
||||
POSTE = c("1001", "1001"),
|
||||
DATE = c(202401020000, 202401020006),
|
||||
RR6 = c(0, 1.5),
|
||||
Nom_usuel = c("Station A", "Station A"),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
cache_rows <- normalise_rainfall_data(
|
||||
raw_data = raw_data,
|
||||
location_id = "vignasses",
|
||||
fetched_at = as.POSIXct("2026-04-08 09:00:00", tz = "UTC")
|
||||
)
|
||||
|
||||
expect_identical(
|
||||
names(cache_rows),
|
||||
c(
|
||||
"location_id",
|
||||
"station_id",
|
||||
"station_name",
|
||||
"observed_at",
|
||||
"observed_day",
|
||||
"metric_id",
|
||||
"metric_label",
|
||||
"unit",
|
||||
"source_name",
|
||||
"value_num",
|
||||
"fetched_at"
|
||||
)
|
||||
)
|
||||
expect_equal(cache_rows$metric_id[1], "rain_6m")
|
||||
expect_equal(cache_rows$observed_at[2], "2024-01-02T00:06:00Z")
|
||||
expect_equal(cache_rows$fetched_at[1], "2026-04-08T09:00:00Z")
|
||||
})
|
||||
|
||||
|
||||
test_that("normalise_observation_package_data extracts temperature and other metrics", {
|
||||
raw_data <- data.frame(
|
||||
geo_id_insee = c("1001", "1001"),
|
||||
validity_time = c("2026-04-08T09:24:00Z", "2026-04-08T09:30:00Z"),
|
||||
t = c(293.15, 294.15),
|
||||
td = c(289.15, 290.15),
|
||||
u = c(40, 42),
|
||||
ff = c(1.5, 2.0),
|
||||
fxi10 = c(3.5, 4.0),
|
||||
pres = c(101325, 101425),
|
||||
pmer = c(101525, 101625),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
cache_rows <- normalise_observation_package_data(
|
||||
raw_data = raw_data,
|
||||
location_id = "vignasses",
|
||||
station_name = "Station A",
|
||||
fetched_at = as.POSIXct("2026-04-08 10:00:00", tz = "UTC")
|
||||
)
|
||||
|
||||
expect_true(all(c(
|
||||
"air_temperature",
|
||||
"dew_point",
|
||||
"humidity",
|
||||
"wind_speed",
|
||||
"wind_gust",
|
||||
"station_pressure",
|
||||
"sea_level_pressure"
|
||||
) %in% unique(cache_rows$metric_id)))
|
||||
expect_equal(cache_rows$value_num[cache_rows$metric_id == "air_temperature"][1], 20)
|
||||
expect_equal(cache_rows$value_num[cache_rows$metric_id == "station_pressure"][1], 1013.2)
|
||||
})
|
||||
|
||||
|
||||
test_that("SQLite cache upserts and queries multiple metrics from one dataset", {
|
||||
skip_if_not(nzchar(Sys.which("sqlite3")), "sqlite3 is required for cache tests.")
|
||||
|
||||
db_path <- tempfile(fileext = ".sqlite")
|
||||
on.exit(unlink(c(db_path, paste0(db_path, c("-shm", "-wal")))), add = TRUE)
|
||||
|
||||
ensure_weather_db(db_path)
|
||||
|
||||
rain_rows <- normalise_rainfall_data(
|
||||
raw_data = data.frame(
|
||||
POSTE = c("1001", "1001"),
|
||||
DATE = c(202401020000, 202401020006),
|
||||
RR6 = c(1.25, 0.5),
|
||||
Nom_usuel = c("Station A", "Station A"),
|
||||
stringsAsFactors = FALSE
|
||||
),
|
||||
location_id = "vignasses",
|
||||
fetched_at = as.POSIXct("2026-04-08 09:00:00", tz = "UTC")
|
||||
)
|
||||
|
||||
obs_rows <- normalise_observation_package_data(
|
||||
raw_data = data.frame(
|
||||
geo_id_insee = c("1001", "1001"),
|
||||
validity_time = c("2024-01-02T00:00:00Z", "2024-01-02T06:00:00Z"),
|
||||
t = c(293.15, 295.15),
|
||||
u = c(40, 44),
|
||||
ff = c(1.5, 2.5),
|
||||
pres = c(101325, 101225),
|
||||
stringsAsFactors = FALSE
|
||||
),
|
||||
location_id = "vignasses",
|
||||
station_name = "Station A",
|
||||
fetched_at = as.POSIXct("2026-04-08 09:00:00", tz = "UTC")
|
||||
)
|
||||
|
||||
expect_equal(upsert_weather_measurements(rain_rows, db_path), 2)
|
||||
expect_true(upsert_weather_measurements(obs_rows, db_path) >= 6)
|
||||
|
||||
updated_rain <- rain_rows[1, , drop = FALSE]
|
||||
updated_rain$value_num <- 2
|
||||
expect_true(upsert_rainfall_observations(updated_rain, db_path) >= 1)
|
||||
|
||||
rain_raw <- query_cached_rainfall(
|
||||
location_id = "vignasses",
|
||||
start_date = "2024-01-02",
|
||||
end_date = "2024-01-02",
|
||||
aggregate = "raw",
|
||||
db_path = db_path
|
||||
)
|
||||
|
||||
rain_daily <- query_cached_rainfall(
|
||||
location_id = "vignasses",
|
||||
start_date = "2024-01-02",
|
||||
end_date = "2024-01-02",
|
||||
aggregate = "daily",
|
||||
db_path = db_path
|
||||
)
|
||||
|
||||
temperature_raw <- query_cached_metric(
|
||||
location_id = "vignasses",
|
||||
metric_id = "air_temperature",
|
||||
start_date = "2024-01-02",
|
||||
end_date = "2024-01-02",
|
||||
aggregate = "raw",
|
||||
db_path = db_path
|
||||
)
|
||||
|
||||
temperature_daily <- query_cached_metric(
|
||||
location_id = "vignasses",
|
||||
metric_id = "air_temperature",
|
||||
start_date = "2024-01-02",
|
||||
end_date = "2024-01-02",
|
||||
aggregate = "daily",
|
||||
db_path = db_path
|
||||
)
|
||||
|
||||
latest_temperature <- query_latest_metric_values(
|
||||
location_id = "vignasses",
|
||||
metric_id = "air_temperature",
|
||||
db_path = db_path
|
||||
)
|
||||
|
||||
expect_equal(nrow(rain_raw), 2)
|
||||
expect_equal(rain_raw$rain_mm[1], 2)
|
||||
expect_equal(rain_daily$rain_mm[1], 2.5)
|
||||
expect_equal(nrow(temperature_raw), 2)
|
||||
expect_equal(temperature_daily$value_num[1], 21)
|
||||
expect_equal(latest_temperature$value_num[1], 22)
|
||||
expect_equal(
|
||||
as.character(get_sync_start_date("vignasses", db_path, end_date = as.Date("2024-01-10"))),
|
||||
"2024-01-01"
|
||||
)
|
||||
})
|
||||
|
||||
|
||||
test_that("sync ranges are chunked predictably", {
|
||||
ranges <- split_sync_ranges(
|
||||
start_date = as.Date("2024-01-01"),
|
||||
end_date = as.Date("2024-05-15"),
|
||||
chunk_days = 60L
|
||||
)
|
||||
|
||||
expect_equal(nrow(ranges), 3)
|
||||
expect_equal(as.character(ranges$start_date[1]), "2024-01-01")
|
||||
expect_equal(as.character(ranges$end_date[3]), "2024-05-15")
|
||||
})
|
||||
|
|
@ -16,6 +16,20 @@ test_that("sourced getStationData handles request failure without attached httr"
|
|||
})
|
||||
|
||||
|
||||
test_that("DPClim period bounds include the full end day", {
|
||||
helper_env <- new.env(parent = globalenv())
|
||||
sys.source(testthat::test_path("..", "..", "R", "getStationData.R"), envir = helper_env)
|
||||
|
||||
bounds <- helper_env$get_dpclim_period_bounds(
|
||||
start_date = "2024-08-09",
|
||||
end_date = "2024-09-07"
|
||||
)
|
||||
|
||||
expect_identical(bounds$start, "2024-08-09T00:00:00Z")
|
||||
expect_identical(bounds$end, "2024-09-08T00:00:00Z")
|
||||
})
|
||||
|
||||
|
||||
test_that("getAllFromCoord returns NULL when every station fetch fails", {
|
||||
helper_env <- new.env(parent = globalenv())
|
||||
sys.source(testthat::test_path("..", "..", "R", "getAllFromCoord.R"), envir = helper_env)
|
||||
|
|
|
|||
Loading…
Reference in a new issue