some minor improvements

Author: marcburri

DESCRIPTION

@@ -3,18 +3,14 @@ Type: Package
 Title: Tools for Studying Revision Properties in Real-Time Time Series Vintages
 Version: 0.1.0.9000
 Authors@R: c(
-    person("Marc", "Burri", ,"marc.burri91@gmail.com", role = c("aut", "cre", "cph"),
+    person(given = "Marc", family = "Burri", email = "marc.burri91@gmail.com", role = c("aut", "cre", "cph"),
            comment = c(ORCID = "0000-0001-8974-9090")),
     person(given = "Philipp", family = "Wegmueller", 
         email = "philipp.wemueller@seco.admin.ch", role = c("aut", "cph"))
   )
 Description: Provides tools to analyze revision properties in real-time time series data.
-Maintainers: c(
-    person("Marc", "Burri", ,"marc.burri91@gmail.com",
-           comment = c(ORCID = "0000-0001-8974-9090")),
-    person(given = "Philipp", family = "Wegmueller", 
-        email = "philipp.wemueller@seco.admin.ch")
-  )
+Author: Marc Burri [aut, cre, cph] (ORCID: <https://orcid.org/0000-0001-8974-9090>), Philipp Wegmueller [aut, cph]
+Maintainer: Marc Burri <marc.burri91@gmail.com>
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true

R/jvn.R

@@ -7,7 +7,7 @@
 #'   vintage estimate for the same time period. Rows are time periods.
 #' @param e An integer indicating the number of data vintages to include in the
 #'  model. Must be greater than 0.
-#' @param ar_order Integer specifying AR order for true values (default = 2).
+#' @param ar_order Integer specifying AR order for true values (default = 1).
 #' @param h Integer specifying the forecast horizon (default = 0).
 #' @param include_news Logical, whether to include news component in
 #'   measurement error (default = TRUE).
@@ -28,7 +28,7 @@
 #'   - startvals: Named vector of starting values (optional)
 #'   - transform_se: T/F whether standard errors should be constrained to be
 #'     positive in optimization.
-#' .  - method: String specifying optimization method (default = "L-BFGS-B").
+#'   - method: String specifying optimization method (default = "L-BFGS-B").
 #'   - se_method: Method for standard error calculation (default = "hessian")
 #'   - n_starts: Number of random starting points for multi-start optimization
 #'
@@ -153,10 +153,10 @@ jvn_nowcast <- function(
   if (
     length(setdiff(names(solver_options), names(default_solver_options))) > 0
   ) {
-    rlang::abort(
+    rlang::abort(paste0(
       "Invalid solver options provided. Valid options are: ",
       paste(names(default_solver_options), collapse = ", ")
-    )
+    ))
   }
 
   # Update default options with user-provided options

R/kk.R

@@ -146,10 +146,10 @@ kk_nowcast <- function(
   if (
     length(setdiff(names(solver_options), names(default_solver_options))) > 0
   ) {
-    rlang::abort(
+    rlang::abort(paste0(
       "Invalid solver options provided. Valid options are: ",
       paste(names(default_solver_options), collapse = ", ")
-    )
+    ))
   }
 
   # Update default options with user-provided options
@@ -1454,8 +1454,11 @@ kk_matrices <- function(e, model, params = NULL, type = "numeric") {
   }
 
   # Check params are named
-  if (!is.null(params) && !all(!is.na(names(params)))) {
-    rlang::abort("All parameters must be named!")
+  if (!is.null(params)) {
+    param_names <- names(params)
+    if (is.null(param_names) || anyNA(param_names) || any(param_names == "")) {
+      rlang::abort("All parameters must be named!")
+    }
   }
 
   # Check params input

R/revisions.R

@@ -2252,7 +2252,7 @@ friedman_test <- function(series, frequency = 12) {
 #' - Positive integer or vector (e.g., 0 for first release, 1 for  second, etc.)
 #' - `"first"` to extract the first release.
 #' - `"latest"` to extract the most recent release.
-#' Default is 1 (the first release).
+#' Default is 0 (the first release).
 #' @param diagonal Logical. If `TRUE`, the function only returns real
 #' first releases.
 #'
@@ -2338,22 +2338,21 @@ get_nth_release <- function(df, n = 0, diagonal = FALSE) {
       nth_release <- get_first_release(df)
     }
     if (diagonal) {
-      min_pub_date <- df %>%
-        dplyr::group_by("id") %>%
-        dplyr::summarize(min_pub_date = min(.data$pub_date)) %>%
-        dplyr::pull("min_pub_date", "id") %>%
-        as.Date()
-
-      max_time <- df %>%
-        dplyr::filter(.data$pub_date == min_pub_date) %>%
+      diagonal_thresholds <- df %>%
         dplyr::group_by(.data$id) %>%
-        dplyr::summarize(max_time = max(.data$time)) %>%
-        dplyr::pull("max_time", "id") %>%
-        as.Date()
+        dplyr::summarise(min_pub_date = min(.data$pub_date), .groups = "drop") %>%
+        dplyr::left_join(
+          df %>%
+            dplyr::group_by(.data$id, .data$pub_date) %>%
+            dplyr::summarise(max_time = max(.data$time), .groups = "drop"),
+          by = c("id", "min_pub_date" = "pub_date")
+        ) %>%
+        dplyr::select(.data$id, .data$max_time)
 
-      # Filter using direct vectorized lookup
-      df <- df %>%
-        dplyr::filter(.data$time >= max_time[.data$id])
+      nth_release <- nth_release %>%
+        dplyr::left_join(diagonal_thresholds, by = "id") %>%
+        dplyr::filter(.data$time >= .data$max_time) %>%
+        dplyr::select(-"max_time")
     }
   } else {
     # Ensure data is sorted by pub_date and time
@@ -2380,7 +2379,7 @@ get_nth_release <- function(df, n = 0, diagonal = FALSE) {
     if (diagonal) {
       min_pub_date <- min(df$pub_date)
       max_time <- max(df$time[df$pub_date == min_pub_date])
-      df <- df %>%
+      nth_release <- nth_release %>%
         dplyr::filter(
           .data$time >= max_time
         )
@@ -2508,7 +2507,7 @@ get_latest_release <- function(df) {
       dplyr::arrange(.data$id, .data$pub_date, .data$time)
     df <- df %>%
       dplyr::group_by(.data$id, .data$time) %>%
-      dplyr::mutate("release" = paste0("release_", dplyr::n())) %>%
+      dplyr::mutate("release" = paste0("release_", dplyr::n() - 1)) %>%
       dplyr::filter(.data$pub_date == max(.data$pub_date)) %>%
       dplyr::ungroup()
   } else {
@@ -2517,7 +2516,7 @@ get_latest_release <- function(df) {
       dplyr::arrange(.data$pub_date, .data$time)
     df <- df %>%
       dplyr::group_by(.data$time) %>%
-      dplyr::mutate("release" = paste0("release_", dplyr::n())) %>%
+      dplyr::mutate("release" = paste0("release_", dplyr::n() - 1)) %>%
       dplyr::filter(.data$pub_date == max(.data$pub_date)) %>%
       dplyr::ungroup()
   }
@@ -2538,10 +2537,12 @@ get_latest_release <- function(df) {
 #' time` (observation date).
 #' @param month An optional parameter specifying the target month as a name
 #' ("July") or an integer (7). Cannot be used with `quarter`.
+#' At least one of `month` or `quarter` must be supplied.
 #' @param quarter An optional parameter specifying the target quarter (1-4).
-#' Cannot be used with `month`.
-#' @param years The integer number of unrestricted years after `pub_date` for
-#' which the values should be extracted.
+#' Cannot be used with `month`. At least one of `month` or `quarter` must be
+#' supplied.
+#' @param years A single whole number of years after `pub_date` for which the
+#' values should be extracted.
 #'
 #' @return A filtered data frame containing values matching the
 #' specified criteria.
@@ -2559,26 +2560,45 @@ get_fixed_release <- function(df, years, month = NULL, quarter = NULL) {
     rlang::abort("Specify either a month or a quarter, not both.")
   }
 
-  # Ensure years is numeric and integer or can be converted to integer
-  if (is.numeric(years)) {
-    if (years %% 1 != 0) {
-      rlang::abort("years' must be  a whole number.")
-    }
-    years <- as.integer(years)
+  # Ensure one target period is specified
+  if (is.null(month) && is.null(quarter)) {
+    rlang::abort("Specify one of 'month' or 'quarter'.")
   }
 
+  # Ensure years is a single whole number
+  if (!is.numeric(years) || length(years) != 1 || is.na(years) || years %% 1 != 0) {
+    rlang::abort("'years' must be a single whole number.")
+  }
+  years <- as.integer(years)
+
   # Ensure the month is in numeric format if provided
   if (!is.null(month)) {
     if (is.character(month)) {
+      if (length(month) != 1) {
+        rlang::abort("Invalid 'month'. Must be a single month name or integer.")
+      }
       month <- match(tolower(month), tolower(month.name))
       if (is.na(month)) rlang::abort("Invalid 'month' name")
+    } else if (
+      !is.numeric(month) || length(month) != 1 || is.na(month) ||
+        month %% 1 != 0 || month < 1 || month > 12
+    ) {
+      rlang::abort(
+        "Invalid 'month'. Must be an integer between 1 and 12 or a month name."
+      )
     }
+    month <- as.integer(month)
   }
+
   # Ensure quarter is in numeric format if provided
   if (!is.null(quarter)) {
-    if (!quarter %in% 1:4) {
+    if (
+      !is.numeric(quarter) || length(quarter) != 1 || is.na(quarter) ||
+        quarter %% 1 != 0 || !quarter %in% 1:4
+    ) {
       rlang::abort("Invalid quarter number. Must be between 1 and 4.")
     }
+    quarter <- as.integer(quarter)
   }
 
   check <- vintages_check(df)

man/get_fixed_release.Rd

@@ -320,6 +320,56 @@ test_that("get_nth_release case insensitivity", {
   expect_equal(nrow(result1), nrow(result2))
 })
 
+test_that("get_nth_release diagonal filters historical rows", {
+  df_diag <- tibble::tibble(
+    time = as.Date(c(
+      "2020-01-01", "2020-02-01", "2020-01-01", "2020-02-01", "2020-03-01"
+    )),
+    pub_date = as.Date(c(
+      "2020-02-01", "2020-02-01", "2020-03-01", "2020-03-01", "2020-03-01"
+    )),
+    value = c(1, 2, 1.1, 2.1, 3.1)
+  )
+
+  result_all <- get_nth_release(df_diag, n = 0, diagonal = FALSE)
+  result_diag <- get_nth_release(df_diag, n = 0, diagonal = TRUE)
+
+  expect_lt(nrow(result_diag), nrow(result_all))
+  expect_true(all(result_diag$time >= as.Date("2020-02-01")))
+})
+
+test_that("get_nth_release diagonal works for multiple IDs", {
+  df_a <- tibble::tibble(
+    id = "A",
+    time = as.Date(c(
+      "2020-01-01", "2020-02-01", "2020-01-01", "2020-02-01", "2020-03-01"
+    )),
+    pub_date = as.Date(c(
+      "2020-02-01", "2020-02-01", "2020-03-01", "2020-03-01", "2020-03-01"
+    )),
+    value = c(1, 2, 1.1, 2.1, 3.1)
+  )
+  df_b <- tibble::tibble(
+    id = "B",
+    time = as.Date(c(
+      "2020-01-01", "2020-01-01", "2020-02-01", "2020-03-01"
+    )),
+    pub_date = as.Date(c(
+      "2020-02-01", "2020-03-01", "2020-03-01", "2020-03-01"
+    )),
+    value = c(5, 5.1, 6.1, 7.1)
+  )
+  df_multi <- dplyr::bind_rows(df_a, df_b)
+
+  result <- get_nth_release(df_multi, n = "first", diagonal = TRUE)
+  counts <- result %>%
+    dplyr::count(id) %>%
+    dplyr::arrange(id)
+
+  expect_equal(counts$n[counts$id == "A"], 2)
+  expect_equal(counts$n[counts$id == "B"], 3)
+})
+
 # ===== Tests for get_first_release =====
 
 test_that("get_first_release returns first release", {
@@ -336,6 +386,7 @@ test_that("get_latest_release returns latest release", {
 
   expect_true(inherits(result, "tbl_pubdate") || inherits(result, "tbl_release"))
   expect_true("release" %in% colnames(result))
+  expect_true(all(result$release == "release_4"))
 })
 
 # ===== Tests for get_fixed_release =====
@@ -365,6 +416,13 @@ test_that("get_fixed_release validates exclusive parameters", {
   )
 })
 
+test_that("get_fixed_release requires month or quarter", {
+  expect_error(
+    get_fixed_release(df_long_rev, years = 1),
+    "Specify one of 'month' or 'quarter'"
+  )
+})
+
 test_that("get_fixed_release validates years parameter", {
   expect_error(
     get_fixed_release(df_long_rev, month = 7, years = 1.5),
@@ -521,4 +579,4 @@ test_that("summary.lst_efficient handles NA efficient release", {
 
   expect_s3_class(df_out, "data.frame")
   expect_true(is.na(df_out$e))
-})
+})

man/get_nth_release.Rd

@@ -520,9 +520,12 @@ test_that("kk_matrices validates params length", {
 })
 
 test_that("kk_matrices validates params are named", {
-  # Skip - the function tries to access params by name before validating they are named
-  # This is a design issue in kk_matrices that causes subscript out of bounds error
-  skip("kk_matrices accesses params before validating names")
+  params <- rep(0.2, 5) # Correct length for e = 1 KK model, but unnamed
+
+  expect_error(
+    kk_matrices(e = 1, model = "KK", params = params, type = "numeric"),
+    "All parameters must be named"
+  )
 })
 
 test_that("kk_matrices handles Howrey model correctly", {
@@ -893,4 +896,4 @@ test_that("kk_nowcast confidence intervals have correct coverage", {
   states <- result$states
   expect_true(all(states$lower <= states$estimate, na.rm = TRUE))
   expect_true(all(states$estimate <= states$upper, na.rm = TRUE))
-})
+})