From 0ed7d6b1654908eeab5c1285154d352624fa3576 Mon Sep 17 00:00:00 2001 From: jspijker Date: Tue, 1 Sep 2026 13:29:14 +0200 Subject: [PATCH 1/2] Add remove_time_ranges_before function (issue #30) Add a function to remove measurements based on their download time, recorded in the cache table's time_dl field. For every cached time range downloaded before the given date, the measurements of the station between the range start and end (inclusive) are removed. When no measurements for a station remain, the station is also removed from the location table. The processed cache record is removed and a named list describing the removed ranges is returned. Includes a roxygen2 header, generated documentation, testthat tests and a new "Remove data" chapter in the vignette. Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- NAMESPACE | 1 + R/remove_time_ranges_before.R | 79 +++++++++ man/remove_time_ranges_before.Rd | 37 +++++ .../testthat/test-remove_time_ranges_before.R | 153 ++++++++++++++++++ vignettes/ATdatabase.Rmd | 64 ++++++++ 5 files changed, 334 insertions(+) create mode 100644 R/remove_time_ranges_before.R create mode 100644 man/remove_time_ranges_before.Rd create mode 100644 tests/testthat/test-remove_time_ranges_before.R diff --git a/NAMESPACE b/NAMESPACE index 330390d..c57448a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,3 +12,4 @@ export(get_download_ranges) export(insert_location_info) export(list_doc) export(remove_doc) +export(remove_time_ranges_before) diff --git a/R/remove_time_ranges_before.R b/R/remove_time_ranges_before.R new file mode 100644 index 0000000..12dc99a --- /dev/null +++ b/R/remove_time_ranges_before.R @@ -0,0 +1,79 @@ +#' Remove time ranges downloaded before a given date +#' +#' Remove measurements from the database based on the moment they were +#' downloaded. Every time a time range is stored in the caching table, +#' the download time is recorded in the `time_dl` field. This function +#' removes all cached time ranges that were downloaded before the given +#' date, together with the measurements that belong to those ranges. +#' +#' For each cached time range that was downloaded before `date`, the +#' function removes the measurements of the station between the start +#' and end time of that range, including the measurements exactly at +#' the start and end time. If, after removing these measurements, no +#' other measurements for that station remain, the station is also +#' removed from the location table. The processed record is removed +#' from the caching table. +#' +#' @param date a datetime (POSIXct) object. All cached time ranges with +#' a download time before this date are removed. +#' @param conn database connection object +#' +#' @return a named list with one element per removed time range. Each +#' element is named after the station and is itself a list with the +#' `start` and `end` time of the removed range (as POSIXct) and a +#' boolean `removed` indicating whether the station was removed from +#' the location table. +#' +#' @export + +remove_time_ranges_before <- function(date, conn) { + + if(!"POSIXct" %in% class(date)) { + stop("ERROR remove_time_ranges_before: date is not a datetime (POSIXct) class") + } + + cutoff <- as.numeric(date) + + qry <- glue::glue_sql("SELECT id FROM cache WHERE time_dl < {cutoff};", + .con = conn) + ids <- pool::dbGetQuery(conn, qry)$id + + result <- list() + + for(id in ids) { + + qry <- glue::glue_sql("SELECT station, start, end FROM cache WHERE id = {id};", + .con = conn) + record <- pool::dbGetQuery(conn, qry) + + station <- record$station + start <- record$start + end <- record$end + + qry <- glue::glue_sql("DELETE FROM measurements WHERE station = {station} AND timestamp >= {start} AND timestamp <= {end};", + .con = conn) + pool::dbExecute(conn, qry) + + qry <- glue::glue_sql("SELECT count(*) AS n FROM measurements WHERE station = {station};", + .con = conn) + remaining <- pool::dbGetQuery(conn, qry)$n + + removed <- FALSE + if(remaining == 0) { + qry <- glue::glue_sql("DELETE FROM location WHERE station = {station};", + .con = conn) + pool::dbExecute(conn, qry) + removed <- TRUE + } + + qry <- glue::glue_sql("DELETE FROM cache WHERE id = {id};", + .con = conn) + pool::dbExecute(conn, qry) + + result[[station]] <- list(start = lubridate::as_datetime(start), + end = lubridate::as_datetime(end), + removed = removed) + } + + return(result) +} diff --git a/man/remove_time_ranges_before.Rd b/man/remove_time_ranges_before.Rd new file mode 100644 index 0000000..bd300c3 --- /dev/null +++ b/man/remove_time_ranges_before.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/remove_time_ranges_before.R +\name{remove_time_ranges_before} +\alias{remove_time_ranges_before} +\title{Remove time ranges downloaded before a given date} +\usage{ +remove_time_ranges_before(date, conn) +} +\arguments{ +\item{date}{a datetime (POSIXct) object. All cached time ranges with +a download time before this date are removed.} + +\item{conn}{database connection object} +} +\value{ +a named list with one element per removed time range. Each +element is named after the station and is itself a list with the +\code{start} and \code{end} time of the removed range (as POSIXct) and a +boolean \code{removed} indicating whether the station was removed from +the location table. +} +\description{ +Remove measurements from the database based on the moment they were +downloaded. Every time a time range is stored in the caching table, +the download time is recorded in the \code{time_dl} field. This function +removes all cached time ranges that were downloaded before the given +date, together with the measurements that belong to those ranges. +} +\details{ +For each cached time range that was downloaded before \code{date}, the +function removes the measurements of the station between the start +and end time of that range, including the measurements exactly at +the start and end time. If, after removing these measurements, no +other measurements for that station remain, the station is also +removed from the location table. The processed record is removed +from the caching table. +} diff --git a/tests/testthat/test-remove_time_ranges_before.R b/tests/testthat/test-remove_time_ranges_before.R new file mode 100644 index 0000000..d0222f1 --- /dev/null +++ b/tests/testthat/test-remove_time_ranges_before.R @@ -0,0 +1,153 @@ +###################################################################### +# helpers to seed the database for these tests +###################################################################### + +# insert a cache record with an explicit download time +seed_cache <- function(station, start, end, time_dl, conn) { + qry <- glue::glue_sql( + "INSERT INTO cache (station, start, end, time_dl) VALUES ({station}, {start}, {end}, {time_dl});", + .con = conn) + pool::dbExecute(conn, qry) +} + +# insert a single measurement +seed_measurement <- function(station, timestamp, conn) { + qry <- glue::glue_sql( + "INSERT INTO measurements (station, parameter, value, aggregation, timestamp) VALUES ({station}, 'pm25', 1.0, 3600, {timestamp});", + .con = conn) + pool::dbExecute(conn, qry) +} + +# insert a location record +seed_location <- function(station, conn) { + qry <- glue::glue_sql( + "INSERT INTO location (station, lat, lon, timestamp) VALUES ({station}, 52.0, 5.0, 0);", + .con = conn) + pool::dbExecute(conn, qry) +} + + +test_that("remove_time_ranges_before checks input", { + create_database_tables(dbconn) + expect_error(remove_time_ranges_before("2022-01-01", conn = dbconn)) + drop_database_tables(dbconn) +}) + + +test_that("remove_time_ranges_before removes measurements inclusive of endpoints", { + create_database_tables(dbconn) + + start <- as.numeric(lubridate::as_datetime("2022-02-01 00:00:00")) + end <- as.numeric(lubridate::as_datetime("2022-02-02 00:00:00")) + dl <- as.numeric(lubridate::as_datetime("2022-03-01 00:00:00")) + + seed_location("test-1", dbconn) + seed_cache("test-1", start, end, dl, dbconn) + + # measurement before range (kept), at start (removed), inside (removed), + # at end (removed) and after range (kept) + seed_measurement("test-1", start - 3600, dbconn) + seed_measurement("test-1", start, dbconn) + seed_measurement("test-1", start + 3600, dbconn) + seed_measurement("test-1", end, dbconn) + seed_measurement("test-1", end + 3600, dbconn) + + res <- remove_time_ranges_before(lubridate::as_datetime("2022-04-01"), conn = dbconn) + + tbls <- get_db_tables(dbconn) + remaining <- tbls$measurements$timestamp + + expect_true((start - 3600) %in% remaining) + expect_true((end + 3600) %in% remaining) + expect_false(start %in% remaining) + expect_false((start + 3600) %in% remaining) + expect_false(end %in% remaining) + expect_equal(length(remaining), 2) + + # station still has measurements, so it is not removed from location + expect_true("test-1" %in% tbls$location$station) + expect_false(res[["test-1"]]$removed) + + drop_database_tables(dbconn) +}) + + +test_that("remove_time_ranges_before removes station from location when empty", { + create_database_tables(dbconn) + + start <- as.numeric(lubridate::as_datetime("2022-02-01 00:00:00")) + end <- as.numeric(lubridate::as_datetime("2022-02-02 00:00:00")) + dl <- as.numeric(lubridate::as_datetime("2022-03-01 00:00:00")) + + seed_location("test-1", dbconn) + seed_cache("test-1", start, end, dl, dbconn) + + # all measurements fall within the removed range + seed_measurement("test-1", start, dbconn) + seed_measurement("test-1", start + 3600, dbconn) + seed_measurement("test-1", end, dbconn) + + res <- remove_time_ranges_before(lubridate::as_datetime("2022-04-01"), conn = dbconn) + + tbls <- get_db_tables(dbconn) + expect_equal(nrow(tbls$measurements), 0) + expect_false("test-1" %in% tbls$location$station) + expect_true(res[["test-1"]]$removed) + + # cache record is removed as well + expect_equal(nrow(tbls$cache), 0) + + drop_database_tables(dbconn) +}) + + +test_that("remove_time_ranges_before respects the cutoff date", { + create_database_tables(dbconn) + + start <- as.numeric(lubridate::as_datetime("2022-02-01 00:00:00")) + end <- as.numeric(lubridate::as_datetime("2022-02-02 00:00:00")) + dl_new <- as.numeric(lubridate::as_datetime("2022-05-01 00:00:00")) + + seed_location("test-1", dbconn) + seed_cache("test-1", start, end, dl_new, dbconn) + seed_measurement("test-1", start + 3600, dbconn) + + # cutoff is before the download time, nothing should be removed + res <- remove_time_ranges_before(lubridate::as_datetime("2022-04-01"), conn = dbconn) + + tbls <- get_db_tables(dbconn) + expect_equal(length(res), 0) + expect_equal(nrow(tbls$measurements), 1) + expect_true("test-1" %in% tbls$location$station) + expect_equal(nrow(tbls$cache), 1) + + drop_database_tables(dbconn) +}) + + +test_that("remove_time_ranges_before returns a named list keyed by station", { + create_database_tables(dbconn) + + start1 <- as.numeric(lubridate::as_datetime("2022-02-01 00:00:00")) + end1 <- as.numeric(lubridate::as_datetime("2022-02-02 00:00:00")) + start2 <- as.numeric(lubridate::as_datetime("2022-02-10 00:00:00")) + end2 <- as.numeric(lubridate::as_datetime("2022-02-11 00:00:00")) + dl <- as.numeric(lubridate::as_datetime("2022-03-01 00:00:00")) + + seed_location("test-1", dbconn) + seed_location("test-2", dbconn) + seed_cache("test-1", start1, end1, dl, dbconn) + seed_cache("test-2", start2, end2, dl, dbconn) + seed_measurement("test-1", start1 + 3600, dbconn) + seed_measurement("test-2", start2 + 3600, dbconn) + + res <- remove_time_ranges_before(lubridate::as_datetime("2022-04-01"), conn = dbconn) + + expect_setequal(names(res), c("test-1", "test-2")) + expect_true(all(c("start", "end", "removed") %in% names(res[["test-1"]]))) + expect_equal(as.numeric(res[["test-1"]]$start), start1) + expect_equal(as.numeric(res[["test-1"]]$end), end1) + expect_true(res[["test-1"]]$removed) + + drop_database_tables(dbconn) +}) diff --git a/vignettes/ATdatabase.Rmd b/vignettes/ATdatabase.Rmd index 7539525..9a4e484 100644 --- a/vignettes/ATdatabase.Rmd +++ b/vignettes/ATdatabase.Rmd @@ -656,6 +656,70 @@ function. A few examples of this function are shown above. Stay away from the cache table. Let the package handle this table +# Remove data + +Sometimes data that was downloaded earlier needs to be removed from the +database, for example when a data source is found to be unreliable or +when you want to force a fresh download of a certain period. The +`remove_time_ranges_before` function lets you remove data based on the +moment it was downloaded. + +Every time a time range is stored in the caching table, the download +time is recorded in the `time_dl` field. The +`remove_time_ranges_before` function takes a single date as argument +and removes all cached time ranges (and their measurements) that were +downloaded *before* that date. + +For each cached time range that was downloaded before the given date, +the function: + +* removes the measurements of the station between the start and end + time of that range, including the measurements exactly at the start + and end time; +* checks whether any measurements for that station remain. If none + remain, the station is also removed from the location table; +* removes the processed record from the caching table. + +The function returns a named list, one element per station, containing +the start and end time of the removed range and a boolean indicating +whether the station was removed from the location table. + +## Example + +Suppose we want to remove everything that was downloaded before a +certain moment. We pass that moment as a datetime object: + +```{r eval = FALSE} +cutoff <- lubridate::now() +removed <- remove_time_ranges_before(cutoff, conn = dbconn) +removed +``` + +The result is a named list, for example: + +``` +$SSK_LH003 +$SSK_LH003$start +[1] "2022-02-01 00:00:00 UTC" + +$SSK_LH003$end +[1] "2022-02-05 10:00:00 UTC" + +$SSK_LH003$removed +[1] TRUE +``` + +Here the measurements for station `SSK_LH003` between the start and end +time were removed, and because no other measurements for that station +were left, it was also removed from the location table +(`removed = TRUE`). If measurements for the station remain outside the +removed range, `removed` is `FALSE` and the station stays in the +location table. + +Be careful: this operation is destructive and cannot be undone. Make +sure you really want to remove the data before calling this function. + + ```{r echo = FALSE, messages = FALSE} # closing stuff pool::poolClose(dbconn) From f4fb275d9a7f23f542fd98722756199110cae4d1 Mon Sep 17 00:00:00 2001 From: jspijker Date: Tue, 1 Sep 2026 16:11:57 +0200 Subject: [PATCH 2/2] Address review comments on remove_time_ranges_before (issue #30) - Make the cutoff inclusive: select cached ranges with time_dl <= date and update the roxygen header wording accordingly. - Update the vignette "Remove data" chapter to say "before or equal to". - Move the seed_ test helpers into tests/testthat/helper.R and add a test for a range downloaded exactly at the cutoff. Co-authored-by: Copilot App <223556219+Copilot@users.noreply.github.com> --- R/remove_time_ranges_before.R | 17 +++--- man/remove_time_ranges_before.Rd | 15 +++--- tests/testthat/helper.R | 27 ++++++++++ .../testthat/test-remove_time_ranges_before.R | 53 ++++++++++--------- vignettes/ATdatabase.Rmd | 6 +-- 5 files changed, 75 insertions(+), 43 deletions(-) create mode 100644 tests/testthat/helper.R diff --git a/R/remove_time_ranges_before.R b/R/remove_time_ranges_before.R index 12dc99a..687530b 100644 --- a/R/remove_time_ranges_before.R +++ b/R/remove_time_ranges_before.R @@ -3,19 +3,20 @@ #' Remove measurements from the database based on the moment they were #' downloaded. Every time a time range is stored in the caching table, #' the download time is recorded in the `time_dl` field. This function -#' removes all cached time ranges that were downloaded before the given -#' date, together with the measurements that belong to those ranges. +#' removes all cached time ranges that were downloaded on or before the +#' given date, together with the measurements that belong to those +#' ranges. #' -#' For each cached time range that was downloaded before `date`, the -#' function removes the measurements of the station between the start -#' and end time of that range, including the measurements exactly at -#' the start and end time. If, after removing these measurements, no +#' For each cached time range that was downloaded on or before `date`, +#' the function removes the measurements of the station between the +#' start and end time of that range, including the measurements exactly +#' at the start and end time. If, after removing these measurements, no #' other measurements for that station remain, the station is also #' removed from the location table. The processed record is removed #' from the caching table. #' #' @param date a datetime (POSIXct) object. All cached time ranges with -#' a download time before this date are removed. +#' a download time before or equal to this date are removed. #' @param conn database connection object #' #' @return a named list with one element per removed time range. Each @@ -34,7 +35,7 @@ remove_time_ranges_before <- function(date, conn) { cutoff <- as.numeric(date) - qry <- glue::glue_sql("SELECT id FROM cache WHERE time_dl < {cutoff};", + qry <- glue::glue_sql("SELECT id FROM cache WHERE time_dl <= {cutoff};", .con = conn) ids <- pool::dbGetQuery(conn, qry)$id diff --git a/man/remove_time_ranges_before.Rd b/man/remove_time_ranges_before.Rd index bd300c3..9863267 100644 --- a/man/remove_time_ranges_before.Rd +++ b/man/remove_time_ranges_before.Rd @@ -8,7 +8,7 @@ remove_time_ranges_before(date, conn) } \arguments{ \item{date}{a datetime (POSIXct) object. All cached time ranges with -a download time before this date are removed.} +a download time before or equal to this date are removed.} \item{conn}{database connection object} } @@ -23,14 +23,15 @@ the location table. Remove measurements from the database based on the moment they were downloaded. Every time a time range is stored in the caching table, the download time is recorded in the \code{time_dl} field. This function -removes all cached time ranges that were downloaded before the given -date, together with the measurements that belong to those ranges. +removes all cached time ranges that were downloaded on or before the +given date, together with the measurements that belong to those +ranges. } \details{ -For each cached time range that was downloaded before \code{date}, the -function removes the measurements of the station between the start -and end time of that range, including the measurements exactly at -the start and end time. If, after removing these measurements, no +For each cached time range that was downloaded on or before \code{date}, +the function removes the measurements of the station between the +start and end time of that range, including the measurements exactly +at the start and end time. If, after removing these measurements, no other measurements for that station remain, the station is also removed from the location table. The processed record is removed from the caching table. diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R new file mode 100644 index 0000000..e2a5f9b --- /dev/null +++ b/tests/testthat/helper.R @@ -0,0 +1,27 @@ +###################################################################### +# test helper functions +###################################################################### + +# insert a cache record with an explicit download time +seed_cache <- function(station, start, end, time_dl, conn) { + qry <- glue::glue_sql( + "INSERT INTO cache (station, start, end, time_dl) VALUES ({station}, {start}, {end}, {time_dl});", + .con = conn) + pool::dbExecute(conn, qry) +} + +# insert a single measurement +seed_measurement <- function(station, timestamp, conn) { + qry <- glue::glue_sql( + "INSERT INTO measurements (station, parameter, value, aggregation, timestamp) VALUES ({station}, 'pm25', 1.0, 3600, {timestamp});", + .con = conn) + pool::dbExecute(conn, qry) +} + +# insert a location record +seed_location <- function(station, conn) { + qry <- glue::glue_sql( + "INSERT INTO location (station, lat, lon, timestamp) VALUES ({station}, 52.0, 5.0, 0);", + .con = conn) + pool::dbExecute(conn, qry) +} diff --git a/tests/testthat/test-remove_time_ranges_before.R b/tests/testthat/test-remove_time_ranges_before.R index d0222f1..0dbf25e 100644 --- a/tests/testthat/test-remove_time_ranges_before.R +++ b/tests/testthat/test-remove_time_ranges_before.R @@ -1,31 +1,9 @@ ###################################################################### -# helpers to seed the database for these tests +# tests for remove_time_ranges_before +# +# the seed_* helper functions used below live in helper.R ###################################################################### -# insert a cache record with an explicit download time -seed_cache <- function(station, start, end, time_dl, conn) { - qry <- glue::glue_sql( - "INSERT INTO cache (station, start, end, time_dl) VALUES ({station}, {start}, {end}, {time_dl});", - .con = conn) - pool::dbExecute(conn, qry) -} - -# insert a single measurement -seed_measurement <- function(station, timestamp, conn) { - qry <- glue::glue_sql( - "INSERT INTO measurements (station, parameter, value, aggregation, timestamp) VALUES ({station}, 'pm25', 1.0, 3600, {timestamp});", - .con = conn) - pool::dbExecute(conn, qry) -} - -# insert a location record -seed_location <- function(station, conn) { - qry <- glue::glue_sql( - "INSERT INTO location (station, lat, lon, timestamp) VALUES ({station}, 52.0, 5.0, 0);", - .con = conn) - pool::dbExecute(conn, qry) -} - test_that("remove_time_ranges_before checks input", { create_database_tables(dbconn) @@ -125,6 +103,31 @@ test_that("remove_time_ranges_before respects the cutoff date", { }) +test_that("remove_time_ranges_before includes ranges downloaded exactly at the cutoff", { + create_database_tables(dbconn) + + start <- as.numeric(lubridate::as_datetime("2022-02-01 00:00:00")) + end <- as.numeric(lubridate::as_datetime("2022-02-02 00:00:00")) + cutoff <- lubridate::as_datetime("2022-04-01") + dl_equal <- as.numeric(cutoff) + + seed_location("test-1", dbconn) + seed_cache("test-1", start, end, dl_equal, dbconn) + seed_measurement("test-1", start + 3600, dbconn) + + # download time is exactly the cutoff, so the range must be removed + res <- remove_time_ranges_before(cutoff, conn = dbconn) + + tbls <- get_db_tables(dbconn) + expect_equal(length(res), 1) + expect_true(res[["test-1"]]$removed) + expect_equal(nrow(tbls$measurements), 0) + expect_equal(nrow(tbls$cache), 0) + + drop_database_tables(dbconn) +}) + + test_that("remove_time_ranges_before returns a named list keyed by station", { create_database_tables(dbconn) diff --git a/vignettes/ATdatabase.Rmd b/vignettes/ATdatabase.Rmd index 9a4e484..cd8d562 100644 --- a/vignettes/ATdatabase.Rmd +++ b/vignettes/ATdatabase.Rmd @@ -668,10 +668,10 @@ Every time a time range is stored in the caching table, the download time is recorded in the `time_dl` field. The `remove_time_ranges_before` function takes a single date as argument and removes all cached time ranges (and their measurements) that were -downloaded *before* that date. +downloaded *before or equal to* that date. -For each cached time range that was downloaded before the given date, -the function: +For each cached time range that was downloaded before or equal to the +given date, the function: * removes the measurements of the station between the start and end time of that range, including the measurements exactly at the start