diff --git a/R/gmd.R b/R/gmd.R index 6c1bfc3..93743bf 100644 --- a/R/gmd.R +++ b/R/gmd.R @@ -30,6 +30,13 @@ #' with \code{variables} to load only specific variables from that source. #' @param cite A string. \code{"load"} to load the full citation list as a dataframe, #' or a specific source key (e.g., \code{"GMD"}) to display its BibTeX citation. +#' @param print_option A string, \code{"GMD"} or \code{"Stata"} (case-insensitive), +#' to print the corresponding APA citation and return invisibly. Parity with the +#' Python/Stata \code{print} option. +#' @param fast Logical (or the string \code{"yes"}). If \code{TRUE}, save the +#' downloaded dataset to a local cache so subsequent calls load it from disk +#' instead of re-downloading. Once cached, the file is reused automatically. +#' Parity with the Python/Stata \code{fast} option. #' @return A dataframe containing the requested macroeconomic data. #' #' @examples @@ -94,15 +101,71 @@ #' @export gmd <- function(variables = NULL, country = NULL, version = NULL, raw = FALSE, iso = FALSE, vars = FALSE, - sources = NULL, cite = NULL) { + sources = NULL, cite = NULL, print_option = NULL, + fast = FALSE) { base_url <- "https://gmd-releases.s3.ap-southeast-2.amazonaws.com/data" ID_COLS <- c("ISO3", "year", "countryname", "id") + # [print] Print the APA citation and return early (parity with Python/Stata). + # Case-insensitive; invalid value errors. + if (!is.null(print_option)) { + if (length(print_option) != 1 || is.na(print_option)) { + stop("`print_option` must be a single non-NA value ('GMD' or 'Stata').") + } + opt <- tolower(trimws(print_option)) + if (opt == "gmd") { + message("Müller, K., Xu, C., Lehbib, M., & Chen, Z. (2025). The Global Macro Database: A New International Macroeconomic Dataset (NBER Working Paper No. 33714).") + return(invisible(NULL)) + } + if (opt == "stata") { + message("Lehbib, M. & Müller, K. (2025). gmd: The Easy Way to Access the World's Most Comprehensive Macroeconomic Database. Working Paper.") + return(invisible(NULL)) + } + stop("Invalid option for print(). valid arguments are 'GMD' or 'Stata'.") + } + message("Global Macro Database by M\u00fcller, Xu, Lehbib, and Chen (2025)") message("Website: https://www.globalmacrodata.com") message("") + # [#4] Trim surrounding whitespace consistently with Python/Stata. Blank tokens + # are dropped; an empty/all-blank value becomes NULL ("no filter") instead of + # erroring, matching Python's lenient handling. + if (!is.null(version)) { + version <- trimws(version) + version <- version[!is.na(version) & version != ""] + if (length(version) == 0) { + version <- NULL + } else if (length(version) > 1) { + stop("`version` must be a single value, e.g. \"2025_01\", \"current\", or \"list\".") + } + } + if (!is.null(country)) { + country <- trimws(country) + country <- country[!is.na(country) & country != ""] + if (length(country) == 0) country <- NULL + } + if (!is.null(variables)) { + variables <- trimws(variables) + variables <- variables[!is.na(variables) & variables != ""] + if (length(variables) == 0) variables <- NULL + } + + # Validate the logical flags `iso`/`vars`: accept only TRUE/FALSE (logical) or + # the strings "TRUE"/"FALSE" (case-insensitive). Anything else (e.g. "yes", 1, + # NA) is a clear error rather than a cryptic crash in the `&&` / `if` checks. + as_flag <- function(x, name) { + if (is.logical(x) && length(x) == 1L && !is.na(x)) return(x) + if (is.character(x) && length(x) == 1L && !is.na(x) && toupper(x) %in% c("TRUE", "FALSE")) { + return(toupper(x) == "TRUE") + } + stop(sprintf("`%s` must be TRUE or FALSE (or the string \"TRUE\"/\"FALSE\"). You supplied: %s", + name, paste(deparse(x), collapse = ""))) + } + iso <- as_flag(iso, "iso") + vars <- as_flag(vars, "vars") + # --- Internal helpers --- require_haven <- function() { @@ -234,6 +297,15 @@ gmd <- function(variables = NULL, country = NULL, version = NULL, # Cite option # ============================================================================ if (!is.null(cite)) { + # [#7] Validate an explicit version before honoring cite, so an invalid + # version errors regardless of cite (matches Python/Stata precedence). + if (!is.null(version) && !tolower(version) %in% c("list", "current")) { + .v_avail <- sort(unique(.gmd_load_versions_df()$versions), decreasing = TRUE) + if (!version %in% .v_avail) { + stop(sprintf("Error: %s is not valid\nAvailable versions are: %s\nThe current version is: %s", + version, paste(sort(.v_avail), collapse = ", "), .v_avail[1])) + } + } cite_resp <- .gmd_safe_get(paste0(base_url, "/helpers/bib_dataframe.csv")) if (is.null(cite_resp)) { stop("Unable to import the list of sources to cite. Check internet connection.") @@ -329,7 +401,10 @@ gmd <- function(variables = NULL, country = NULL, version = NULL, if (!is.null(variables)) { source_vars <- paste0(sources, "_", variables) - existing <- intersect(source_vars, colnames(df)) + # Match source-variable columns case-insensitively (parity with the main + # path, which canonicalizes variable casing) and return the canonical + # column names actually present in the data. + existing <- colnames(df)[tolower(colnames(df)) %in% tolower(source_vars)] if (length(existing) == 0) { all_data_cols <- setdiff(colnames(df), ID_COLS) stop(sprintf("This source doesn't have data on %s. It has data on: %s", @@ -366,11 +441,15 @@ gmd <- function(variables = NULL, country = NULL, version = NULL, } valid_vars <- get_varlist()$variables - invalid_vars <- setdiff(variables, valid_vars) + # [#2] Match variable names case-insensitively and normalize to the dataset's + # canonical casing (e.g. "rgdp" -> "rGDP"), consistent with Python/Stata. + canonical <- valid_vars[match(tolower(variables), tolower(valid_vars))] + invalid_vars <- variables[is.na(canonical)] if (length(invalid_vars) > 0) { stop(sprintf("Invalid variable code(s): %s\n\nTo see the list of valid variable codes, use: gmd(vars = TRUE)", paste(invalid_vars, collapse = ", "))) } + variables <- unique(canonical) } # ============================================================================ @@ -414,11 +493,28 @@ gmd <- function(variables = NULL, country = NULL, version = NULL, # Main dataset # ============================================================================ require_haven() - main_resp <- .gmd_safe_get(data_url) - if (is.null(main_resp)) { - stop(sprintf("Error: Data file not found at %s\nCheck internet connection.", data_url)) + # [fast] Optional local cache of the dataset for faster reloads / offline use + # (parity with Python/Stata `fast`). Once cached, the file is reused automatically. + use_fast <- isTRUE(fast) || (is.character(fast) && tolower(trimws(fast)) == "yes") + cache_dir <- tools::R_user_dir("globalmacrodata", "cache") + cache_file <- file.path(cache_dir, sprintf("GMD_%s.dta", current_version)) + if (file.exists(cache_file)) { + df <- haven::read_dta(cache_file) + } else { + main_resp <- .gmd_safe_get(data_url) + if (is.null(main_resp)) { + stop(sprintf("Error: Data file not found at %s\nCheck internet connection.", data_url)) + } + raw_bytes <- httr::content(main_resp, as = "raw") + df <- haven::read_dta(raw_bytes) + if (use_fast) { + if (!dir.exists(cache_dir)) dir.create(cache_dir, recursive = TRUE, showWarnings = FALSE) + # Save the original .dta bytes verbatim so a cached read is byte-identical to a + # fresh download. + writeBin(raw_bytes, cache_file) + message(sprintf("GMD dataset loaded and saved locally in %s.", cache_dir)) + } } - df <- haven::read_dta(httr::content(main_resp, as = "raw")) if (!is.null(country)) { country <- validate_country(country, get_country_mapping()) diff --git a/reproduce_pr9_issues.R b/reproduce_pr9_issues.R new file mode 100644 index 0000000..dac4629 --- /dev/null +++ b/reproduce_pr9_issues.R @@ -0,0 +1,174 @@ +#!/usr/bin/env Rscript +# ===================================================================== +# reproduce_pr9_issues.R +# Reproduces the issues found in the review of PR #9 +# ("Fix cross-language inconsistencies; add print/fast parity"). +# +# Self-contained, OFFLINE and deterministic: it sources the package's +# R/ files and mocks only the version lookup, so no network and no live +# GMD server are required. Your real on-disk cache is backed up and +# restored, so this script does not destroy anything. +# +# HOW TO RUN (with PR branch `20260628/GMD_test_R` checked out): +# From the repo root: Rscript reproduce_pr9_issues.R +# Or in an R session: source("reproduce_pr9_issues.R") +# +# Requires the `haven` package (it is in the project's Suggests). +# ===================================================================== + +repo <- getwd() # <-- set this to the repo root if you run from elsewhere + +## ---- preflight ------------------------------------------------------- +need <- function(f) if (!file.exists(file.path(repo, f))) + stop(sprintf("Cannot find '%s' under repo = '%s'.\n Set `repo` at the top of this script to the repo root.", f, repo), + call. = FALSE) +need("R/gmd.R"); need("R/helpers.R"); need("DESCRIPTION"); need("man/gmd.Rd") + +if (!requireNamespace("haven", quietly = TRUE)) + stop("This reproduction needs the 'haven' package: install.packages('haven')", call. = FALSE) + +hr <- function(t) cat("\n", strrep("=", 70), "\n", t, "\n", strrep("=", 70), "\n", sep = "") +ok <- function(...) cat(" [REPRODUCED] ", ..., "\n", sep = "") +no <- function(...) cat(" [not reproduced]", ..., "\n", sep = "") + +# Load the package code under test into the global env. The internal +# helpers `.gmd_safe_get` / `.gmd_load_versions_df` and `gmd` end up in +# globalenv(), so we can later swap the version lookup for a stub. +suppressWarnings(source(file.path(repo, "R/helpers.R"))) +suppressWarnings(source(file.path(repo, "R/gmd.R"))) + + +## ===================================================================== +## Issue 3 — non-ASCII string literals in R/gmd.R (R CMD check WARNING) +## ===================================================================== +hr("Issue 3: non-ASCII characters in R source (CRAN check flags these)") +cat("`tools::showNonASCIIfile()` is the exact check R CMD check runs.\n", + "The PR introduced raw 'u-umlaut' bytes inside message() at lines 118 & 122,\n", + "while the rest of the file escapes them as \\u00fc (e.g. line 128).\n\n", sep = "") +flagged <- tools::showNonASCIIfile(file.path(repo, "R/gmd.R")) +cat("\n") +src <- readLines(file.path(repo, "R/gmd.R"), warn = FALSE) +non_ascii_lines <- which(grepl("[^\x01-\x7f]", src, perl = TRUE, useBytes = TRUE)) +pr_offenders <- intersect(c(118, 122), non_ascii_lines) +line128_clean <- !(128 %in% non_ascii_lines) +if (length(pr_offenders) > 0 && line128_clean) + ok("lines ", paste(pr_offenders, collapse = " & "), + " carry raw non-ASCII bytes; line 128 uses the escaped \\u00fc form (clean).") +if (!line128_clean) no("line 128 unexpectedly also flagged - file layout may have shifted.") + + +## ===================================================================== +## Issue 4 — `tools` used via :: but not declared in DESCRIPTION Imports +## ===================================================================== +hr("Issue 4: tools::R_user_dir used but 'tools' not in DESCRIPTION Imports") +dcf <- read.dcf(file.path(repo, "DESCRIPTION")) +imp <- if ("Imports" %in% colnames(dcf)) dcf[, "Imports"] else "" +deps <- if ("Depends" %in% colnames(dcf)) dcf[, "Depends"] else "" +imp_pkgs <- trimws(gsub("\\s*\\(.*?\\)", "", strsplit(imp, ",")[[1]])) +uses_tools <- any(grepl("tools::", src, fixed = TRUE)) +cat("DESCRIPTION Imports :", paste(imp_pkgs, collapse = ", "), "\n") +cat("DESCRIPTION Depends :", if (nzchar(deps)) deps else "(none)", "\n") +cat("R/gmd.R uses tools:::", uses_tools, "\n\n") +if (uses_tools && !("tools" %in% imp_pkgs)) + ok("tools::R_user_dir() is called but 'tools' is absent from Imports -> R CMD check NOTE.") +if (!grepl("R \\(>=", deps)) + ok("no 'R (>= 4.0)' floor declared, yet R_user_dir() needs R >= 4.0 (it runs on EVERY gmd() call).") + + +## ===================================================================== +## Issue 2 — man/gmd.Rd not regenerated: new args undocumented +## ===================================================================== +hr("Issue 2: man/gmd.Rd does not document the new args (R CMD check WARNING)") +sig <- names(formals(gmd)) +rd <- readLines(file.path(repo, "man/gmd.Rd"), warn = FALSE) +undocumented <- sig[!vapply(sig, + function(a) any(grepl(paste0("\\b", a, "\\b"), rd)), logical(1))] +cat("gmd() formals :", paste(sig, collapse = ", "), "\n") +cat("Missing from Rd :", paste(undocumented, collapse = ", "), "\n\n") +if (length(undocumented) > 0) + ok("man/gmd.Rd is stale; undocumented argument(s): ", paste(undocumented, collapse = ", "), + " -> 'Undocumented arguments' WARNING.") + + +## ===================================================================== +## Issues 1 & 5 — the cache READ is not gated on `fast` +## #1: a planted cache is served even when fast = FALSE (stale data) +## #5: a corrupt cache then breaks EVERY call, with no recovery path +## These run fully offline: we stub the version lookup and pre-seed the +## cache, so gmd() never touches the network. +## ===================================================================== +hr("Issues 1 & 5: cache read ignores `fast` (headline bug)") + +orig_versions <- .gmd_load_versions_df +# Stub: pretend the current version is 2026_03, no network. +assign(".gmd_load_versions_df", + function() data.frame(versions = c("2026_03", "2026_02"), + stringsAsFactors = FALSE), + envir = globalenv()) + +cache_dir <- tools::R_user_dir("globalmacrodata", "cache") +cache_file <- file.path(cache_dir, "GMD_2026_03.dta") + +backup <- NULL +restore <- function() { + if (file.exists(cache_file)) file.remove(cache_file) + if (!is.null(backup) && file.exists(backup)) file.rename(backup, cache_file) + assign(".gmd_load_versions_df", orig_versions, envir = globalenv()) +} + +tryCatch({ + if (file.exists(cache_file)) { # protect a real cache + backup <- paste0(cache_file, ".pr9bak") + file.rename(cache_file, backup) + } + if (!dir.exists(cache_dir)) dir.create(cache_dir, recursive = TRUE, showWarnings = FALSE) + + ## ---- Issue 1: plant a SENTINEL dataset as the cache ---- + sentinel <- data.frame( + ISO3 = "ZZZ", + year = 1900L, + countryname = "SENTINEL_FROM_CACHE", + id = 1L, + rGDP = 42, + stringsAsFactors = FALSE + ) + haven::write_dta(sentinel, cache_file) + cat("Planted a fake cache at:\n ", cache_file, "\n", + "(ISO3 = 'ZZZ', rGDP = 42). A correct fresh download would never contain this.\n\n", sep = "") + + res1 <- suppressWarnings(suppressMessages(gmd())) # DEFAULT: fast = FALSE + res2 <- suppressWarnings(suppressMessages(gmd(fast = FALSE)))# explicit opt-out attempt + + hit1 <- "ZZZ" %in% res1$ISO3 + hit2 <- "ZZZ" %in% res2$ISO3 + cat("gmd() -> ISO3 contains 'ZZZ'? ", hit1, "\n") + cat("gmd(fast=FALSE) -> ISO3 contains 'ZZZ'? ", hit2, "\n\n") + if (hit1) ok("gmd() with the DEFAULT fast=FALSE served the planted cache instead of downloading.") + if (hit2) ok("gmd(fast=FALSE) ALSO served the cache - there is no way to force a fresh download.") + if (!hit1 && !hit2) no("default calls did not read the planted cache (bug not present).") + + ## ---- Issue 5: a corrupt cache then poisons every call ---- + cat("\n-- corrupt-cache consequence (Issue 5) --\n") + writeBin(as.raw(c(0x00, 0x01, 0x02, 0x03, 0x04)), cache_file) # truncated/garbage .dta + err <- tryCatch({ + suppressWarnings(suppressMessages(gmd())); NA_character_ + }, error = function(e) conditionMessage(e)) + if (!is.na(err)) + ok("a truncated cache makes plain gmd() error every time (no temp-write, no recovery):\n", + " ", strtrim(gsub("\n", " ", err), 100)) + else + no("corrupt cache did not surface an error.") + +}, finally = restore()) + + +## ===================================================================== +hr("Summary") +cat( +" Issue 1 (HIGH) cache read not gated on `fast` -> stale data, no refresh path.\n", +" Issue 2 (HIGH) man/gmd.Rd stale -> R CMD check WARNING (undocumented args).\n", +" Issue 3 (MED) raw non-ASCII literals in R/gmd.R lines 118 & 122.\n", +" Issue 4 (MED) `tools` not in Imports / no 'R (>= 4.0)' floor.\n", +" Issue 5 (LOW) non-atomic cache write -> a corrupt cache breaks every call.\n", +"\n (This script created only ", "reproduce_pr9_issues.R", " and a temporary cache file,\n", +" which has been cleaned up / your original cache restored.)\n", sep = "")