4 files changed, 101 insertions(+), 34 deletions(-)

M DESCRIPTION
M NEWS
M R/functions.R
M man/SNBdata.Rd

@@ 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 <es@enricoschumann.net>
 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

@@ 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

@@ 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
 }

@@ 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{