From 2399716cb115eeb4b810934467e3ca8bb93d9cca Mon Sep 17 00:00:00 2001 From: Codex Date: Mon, 19 Oct 2026 08:59:03 -0300 Subject: [PATCH 1/2] fix: preserve legacy pipeline and history contracts --- R/alert_functions.R | 37 ++++++++++++++++++++++++----- R/api.R | 5 ++-- man/pipe_infodengue.Rd | 8 +++---- man/tabela_historico.Rd | 2 +- tests/testthat/test-api.R | 31 ++++++++++++++++++++++++ tests/testthat/test-core-pipeline.R | 2 +- 6 files changed, 71 insertions(+), 14 deletions(-) diff --git a/R/alert_functions.R b/R/alert_functions.R index dba6a25..1ffc9ed 100644 --- a/R/alert_functions.R +++ b/R/alert_functions.R @@ -253,15 +253,15 @@ #'@param completetail if sinan data is older than final_day, fill in the tail with NA (default) or 0. #'@param dataini "notif" (default) or "sinpri" #'@param writedb TRUE if it should write into the database, default is FALSE. -#'@param datasource posgreSQL connection to project's database +#'@param datasource Database connection; defaults to the legacy global `con`. #'@param workers Positive number of workers. Defaults to portable serial execution. #'@param seed Optional seed for stochastic nowcasting. #'@param verbose Whether to emit progress messages. #'@param version_date Explicit model-version date used when writing results. #'@param firstday First date of the notification series passed to fetch_cases(). #' Defaults to 2018-01-01; supply an earlier date for historical backfills. -#'@return data.frame with the week condition and the number of weeks within the -#'last lag weeks with conditions = TRUE. +#'@return A named list of municipal `alerta` objects, preserving the legacy +#' result structure. #'@examplesIf FALSE #'cidades <- getCidades(uf = "Rio de Janeiro",datasource = connection) #'t1 <- Sys.time() @@ -277,7 +277,7 @@ pipe_infodengue <- function(cities, cid10="A90", datarelatorio, finalday = NULL, iniSE = 201001, nowcasting="none", narule=NULL, - writedb = FALSE, datasource, completetail = NA, + writedb = FALSE, datasource = con, completetail = NA, dataini = "notific", workers = 1L, seed = NULL, verbose = FALSE, version_date = finalday, firstday = as.Date("2018-01-01")){ @@ -344,7 +344,32 @@ pipe_infodengue <- function(cities, cid10="A90", datarelatorio, finalday = NULL, write_alert_results(datasource, res, version_date = version_date, conflict = "update") } - res + .as_legacy_alert_objects(res) +} + +.as_legacy_alert_objects <- function(result) { + data <- result$data + groups <- split(seq_len(nrow(data)), factor(data$cidade, + levels = unique(data$cidade))) + legacy <- lapply(names(groups), function(city) { + rows <- groups[[city]] + parameters <- result$parameters[ + result$parameters$municipio_geocodigo == as.numeric(city), , drop = FALSE + ] + values <- structure(as.character(parameters[1, ]), names = names(parameters)) + criteria <- define_alert_rules(parameters$codmodelo[[1]], values) + alert <- list( + data = data[rows, , drop = FALSE], + indices = result$alerts[rows, , drop = FALSE], + crit = criteria, + n = 4L + ) + class(alert) <- "alerta" + alert + }) + names(legacy) <- names(groups) + attr(legacy, "parameters") <- result$parameters + legacy } @@ -414,7 +439,7 @@ calc.alerta <- function(x, pars, level = "municipio",...){ #x = cities[i] #'@param lastSE last week of the table. Default is the last date in obj. #'@param type "notified", if it should return total counts, disregarding the #'final classification. For compatibility reasons. -#'@param versao Explicit model-version date. +#'@param versao Model-version date; defaults to the current date for legacy calls. #'@param parameters Parameter data frame. Pipeline results carry it as an attribute; #'direct alert objects must supply it explicitly. #'@return data.frame with the data to be written. diff --git a/R/api.R b/R/api.R index f35f438..b8a6c06 100644 --- a/R/api.R +++ b/R/api.R @@ -512,13 +512,14 @@ fouralert <- function(obj, crit, miss = "last", dy = 4) { #' Legacy history converter #' @param obj,iniSE,lastSE,type,versao,parameters Legacy arguments. #' @export -tabela_historico <- function(obj, iniSE, lastSE, type = "all", versao, +tabela_historico <- function(obj, iniSE, lastSE, type = "all", versao = Sys.Date(), parameters = if (inherits(obj, "alerttools_result")) obj$parameters else attr(obj, "parameters")) { .deprecate_api("tabela_historico()", "as_alert_history()") + if (missing(versao)) versao <- Sys.Date() args <- list(obj = obj, type = type, parameters = parameters) if (!missing(iniSE)) args$iniSE <- iniSE if (!missing(lastSE)) args$lastSE <- lastSE - if (!missing(versao)) args$versao <- versao + args$versao <- versao do.call(.as_alert_history_impl, args) } diff --git a/man/pipe_infodengue.Rd b/man/pipe_infodengue.Rd index 8bf131f..ad27653 100644 --- a/man/pipe_infodengue.Rd +++ b/man/pipe_infodengue.Rd @@ -13,7 +13,7 @@ pipe_infodengue( nowcasting = "none", narule = NULL, writedb = FALSE, - datasource, + datasource = con, completetail = NA, dataini = "notific", workers = 1L, @@ -43,7 +43,7 @@ with zeros, "linear" for linear interpolation, "arima" for inter and extrapolati \item{writedb}{TRUE if it should write into the database, default is FALSE.} -\item{datasource}{posgreSQL connection to project's database} +\item{datasource}{Database connection; defaults to the legacy global `con`.} \item{completetail}{if sinan data is older than final_day, fill in the tail with NA (default) or 0.} @@ -61,8 +61,8 @@ with zeros, "linear" for linear interpolation, "arima" for inter and extrapolati Defaults to 2018-01-01; supply an earlier date for historical backfills.} } \value{ -data.frame with the week condition and the number of weeks within the -last lag weeks with conditions = TRUE. +A named list of municipal `alerta` objects, preserving the legacy + result structure. } \description{ wrap of functions used by Infodengue. diff --git a/man/tabela_historico.Rd b/man/tabela_historico.Rd index 523ff4d..0a25b73 100644 --- a/man/tabela_historico.Rd +++ b/man/tabela_historico.Rd @@ -9,7 +9,7 @@ tabela_historico( iniSE, lastSE, type = "all", - versao, + versao = Sys.Date(), parameters = if (inherits(obj, "alerttools_result")) obj$parameters else attr(obj, "parameters") ) diff --git a/tests/testthat/test-api.R b/tests/testthat/test-api.R index 1bb9ccc..e23898c 100644 --- a/tests/testthat/test-api.R +++ b/tests/testthat/test-api.R @@ -157,6 +157,37 @@ test_that("legacy wrappers warn and preserve argument and result adapters", { ) }) +test_that("legacy pipeline and history wrappers preserve their public contracts", { + withr::local_options(list(lifecycle_verbosity = "quiet")) + expect_identical(formals(pipe_infodengue)$datasource, quote(con)) + expect_identical(formals(tabela_historico)$versao, quote(Sys.Date())) + + connection <- sqlite_fixture_connection(environment()) + had_global_con <- exists("con", envir = .GlobalEnv, inherits = FALSE) + if (had_global_con) old_global_con <- get("con", envir = .GlobalEnv) + assign("con", connection, envir = .GlobalEnv) + withr::defer({ + if (had_global_con) { + assign("con", old_global_con, envir = .GlobalEnv) + } else if (exists("con", envir = .GlobalEnv, inherits = FALSE)) { + rm("con", envir = .GlobalEnv) + } + }) + result <- pipe_infodengue( + cities = 3304557, cid10 = "A90", datarelatorio = 202106, + nowcasting = "none", firstday = as.Date("2020-12-20"), completetail = 0 + ) + + expect_named(result, "3304557") + expect_s3_class(result[[1]], "alerta") + expect_named(result[[1]], c("data", "indices", "crit", "n")) + expect_equal(result[[1]]$data$SE, c(202052, 202053, 202101:202106)) + + history <- tabela_historico(result, iniSE = 202052) + expect_s3_class(history, "data.frame") + expect_equal(nrow(history), 8) +}) + test_that("snake_case computational aliases preserve baseline results", { withr::local_options(list(lifecycle_verbosity = "quiet")) cases <- read_fixture("cases.csv") diff --git a/tests/testthat/test-core-pipeline.R b/tests/testthat/test-core-pipeline.R index 451a92c..ed67e7b 100644 --- a/tests/testthat/test-core-pipeline.R +++ b/tests/testthat/test-core-pipeline.R @@ -52,7 +52,7 @@ test_that("alerttools_result methods expose a stable result contract", { expect_s3_class(history, "data.frame") expect_equal(nrow(history), 8) expect_true(all(c("data_iniSE", "municipio_geocodigo", "nivel_inc") %in% names(history))) - expect_error(tabela_historico(result), "explicit.*versao") + expect_equal(nrow(tabela_historico(result)), 8) }) test_that("alerttools_result constructor handles empty and invalid inputs", { From 99311771234637520af8f55dbaba172290512caa Mon Sep 17 00:00:00 2001 From: Quemuel Baruque Date: Tue, 20 Oct 2026 10:57:39 -0300 Subject: [PATCH 2/2] test: respect legacy pipeline connection default --- tests/testthat/test-data-repository.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-data-repository.R b/tests/testthat/test-data-repository.R index 61bae8e..036c9fc 100644 --- a/tests/testthat/test-data-repository.R +++ b/tests/testthat/test-data-repository.R @@ -194,7 +194,7 @@ test_that("SQL file export quotes literals instead of interpolating user values" expect_match(sql, "INSERT INTO \"Municipio\".\"Historico_alerta\"", fixed = TRUE) }) -test_that("database functions never fall back to a global con object", { +test_that("database functions require an explicit connection", { withr::local_options(list(lifecycle_verbosity = "quiet")) connection <- sqlite_fixture_connection(environment()) assign("con", connection, envir = .GlobalEnv) @@ -203,7 +203,7 @@ test_that("database functions never fall back to a global con object", { database_functions <- list(getCases, getCaseslist, getClima, getWU, getTweet, getCidades, getRegionais, read.parameters, write_parameters, getWUstation, setWUstation, - read.cases, getdelaydata, pipe_infodengue, + read.cases, getdelaydata, write_alerta, applyGenTimeDist) expect_true(all(vapply(database_functions, function(fun) { identical(formals(fun)$datasource, quote(expr = ))