From 5fe53c8115ac9a01e0666a676673780dc00735a4 Mon Sep 17 00:00:00 2001 From: Enrico Schumann Date: Thu, 31 Aug 2023 11:26:45 +0200 Subject: [PATCH] Prepare version 0.1.0 --- DESCRIPTION | 6 +-- NEWS | 6 +-- R/functions.R | 100 ++++++++++++++++++++++++++++++++++++++----------- man/SNBdata.Rd | 23 +++++++++--- 4 files changed, 101 insertions(+), 34 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0243443..d6de9a8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: SNBdata Type: Package Title: Download Data from the Swiss National Bank (SNB) -Version: 0.0-1 -Date: 2023-08-30 +Version: 0.1.0 +Date: 2023-08-31 Maintainer: Enrico Schumann Authors@R: person("Enrico", "Schumann", role = c("aut", "cre"), @@ -16,7 +16,7 @@ Description: Functions for downloading data from the Swiss particular data structures, for instance into 'zoo' objects. Downloaded data can optionally be cached, to avoid repeated downloads of the same files. -Suggests: jsonlite,zoo +Suggests: jsonlite, zoo License: GPL-3 URL: http://enricoschumann.net/R/packages/SNBdata/ , https://git.sr.ht/~enricoschumann/SNBdata diff --git a/NEWS b/NEWS index f5f72d1..6db8309 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,4 @@ -v0.0-1 (2023-08-30; not yet released) +v0.1.0 (2023-08-31) - o initial version: allows to download tables and datasets - from the SNB website; see https://data.snb.ch + o Initial version: Allows to download tables from the + SNB website; see https://data.snb.ch diff --git a/R/functions.R b/R/functions.R index a055810..714ac4d 100644 --- a/R/functions.R +++ b/R/functions.R @@ -1,10 +1,3 @@ - -## Relevant URLs -## https://data.snb.ch/de/topics/snb/cube/snbbipo -## https://data.snb.ch/de/topics/snb/cube/rendoblid -## https://data.snb.ch/en/topics/ziredev/cube/ -## https://data.snb.ch/api/cube/rendoblid/dimensions/en - fetch_table_date <- function(table = "rendoblid", dest.dir = NULL, verbose = TRUE, @@ -19,25 +12,65 @@ fetch_table_date <- function(table = "rendoblid", ans <- try(readLines(con, warn = FALSE), silent = TRUE) try(close(con), silent = TRUE) em <- geterrmessage() - jsonlite::fromJSON(ans) + if (requireNamespace("jsonlite")) + jsonlite::fromJSON(ans) + else + ans } fetch_table_info <- function(table = "rendoblid", dest.dir = NULL, return.class = NULL, verbose = TRUE, - language = "en", ...) { + language = "en", + method, ...) { - if (!is.null(dest.dir)) - message("currently not supported") + site <- paste0("https://data.snb.ch/api/cube/", + table, "/dimensions/", + language) + if (!is.null(dest.dir)) { + filename <- paste0(format(Sys.Date(), "%Y%m%d"), + "__", table, + "__info.csv") + filename <- file.path(dest.dir, filename) + if (!file.exists(filename)) { + if (verbose) + message("Downloading data from SNB ... ", appendLF = FALSE) + download.file(url = site, destfile = filename, + method = method, + quiet = TRUE) + } else + if (verbose) + message("Using cache ... ", appendLF = FALSE) - site <- paste0("https://data.snb.ch/api/cube/", table, "/dimensions/", language) + dats <- try(readLines(filename, warn = FALSE), silent = TRUE) + em <- geterrmessage() - con <- url(site) - dats <- try(readLines(con, warn = FALSE), silent = TRUE) - close(con) - em <- geterrmessage() - jsonlite::fromJSON(dats, FALSE) + } else { + if (verbose) + message("Downloading data from SNB ... ", appendLF = FALSE) + + con <- url(site) + dats <- try(readLines(con), silent = TRUE) + close(con) + em <- geterrmessage() + } + if (inherits(dats, "try-error")) { + if (verbose) { + message("failed") + message(em) + } + return(invisible(NULL)) + } else { + if (verbose) + message("done") + } + + + if (requireNamespace("jsonlite")) + jsonlite::fromJSON(dats, FALSE) + else + dats } fetch_table <- function(table = "rendoblid", @@ -49,9 +82,32 @@ fetch_table <- function(table = "rendoblid", name.sep = " :: ", na.drop = TRUE, ...) { - info <- fetch_table_info(table, language = language) - tmp <- info$dimensions[[1]] - items <- tmp$dimensionItems ## overview + .do_item <- function(item, path = "", name.sep = " :: ") { + if (length(item) == 2 && + identical(names(item), c("id", "name"))) { + id.info[[item$id]] <<- paste0(path, name.sep, item$name) + } else { + if (!is.null(item$name)) + path <- paste0(path, + if (path != "") name.sep, + item$name) + for (i in item) { + if (is.list(i)) + .do_item(i, path, name.sep) + } + } +} + + info <- fetch_table_info(table, + language = language, + dest.dir = dest.dir, + method = method) + items <- info$dimensions ## overview + id.info <- list() + if (requireNamespace("jsonlite")) + .do_item(items, path = "", name.sep = name.sep) + else + id.info <- info site <- paste0("https://data.snb.ch/api/cube/", table, "/data/csv/", language) @@ -101,7 +157,7 @@ fetch_table <- function(table = "rendoblid", sep = ";", header = TRUE, stringsAsFactors = FALSE, - as.is = TRUE, skip = empty) + as.is = TRUE, skip = empty, ...) id <- dats[[2]][seq(1, min(which(duplicated(dats[[2]]))) - 1)] ans <- vector("list", length(id)) @@ -132,6 +188,6 @@ fetch_table <- function(table = "rendoblid", } - attr(result, "info") <- info + attr(result, "info") <- unlist(id.info) result } diff --git a/man/SNBdata.Rd b/man/SNBdata.Rd index e857f31..2954aaa 100644 --- a/man/SNBdata.Rd +++ b/man/SNBdata.Rd @@ -17,13 +17,17 @@ \usage{ fetch_table(table = "rendoblid", dest.dir = NULL, return.class = NULL, verbose = TRUE, - method, ...) -fetch_table_date(table = "rendoblid", dest.dir = NULL, + method, + language = "en", + name.sep = " :: ", + na.drop = TRUE, ...) +fetch_table_date(table = "rendoblid", + dest.dir = NULL, verbose = TRUE, language = "en", ...) fetch_table_info(table = "rendoblid", dest.dir = NULL, return.class = NULL, verbose = TRUE, - language = "en", ...) + language = "en", method, ...) } \arguments{ \item{dest.dir}{% @@ -33,13 +37,13 @@ fetch_table_info(table = "rendoblid", dest.dir = NULL, the name of the table } \item{method}{% - see \code{\link{download.file}} + see \code{\link{download.file}} } \item{verbose}{ - logical: print messages about download progress? + logical: print messages, e.g. about download progress? } \item{return.class}{\code{NULL} or character: - not yet implemented (but in future version,, only + not yet implemented (but in future versions, \code{\link[zoo]{zoo}} will be supported) } \item{language}{ @@ -48,6 +52,13 @@ fetch_table_info(table = "rendoblid", dest.dir = NULL, \item{\dots}{ passed on to \code{\link{read.table}} } + \item{name.sep}{ + string used when pasting description hierarchies + } + \item{na.drop}{ + logical. If \code{TRUE}, rows with no finite values at all + are dropped. + } } \details{ -- 2.45.2