4 files changed, 37 insertions(+), 24 deletions(-)

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

@@ 2,7 2,7 @@ Package: SNBdata
 Type: Package
 Title: Download Data from the Swiss National Bank (SNB)
 Version: 0.0-1
-Date: 2023-05-14
+Date: 2023-08-30
 Maintainer: Enrico Schumann <es@enricoschumann.net>
 Authors@R: person("Enrico", "Schumann",
                   role  = c("aut", "cre"),

@@ 1,4 1,4 @@
-v0.0-1  (2023-05-14; not yet released)
+v0.0-1  (2023-08-30; not yet released)
 
   o initial version: allows to download tables and datasets
     from the SNB website; see https://data.snb.ch

@@ 1,8 1,8 @@
 
-## https://data.snb.ch/en/help#data_api
+## Relevant URLs
 ## https://data.snb.ch/de/topics/snb/cube/snbbipo
-
-## https://data.snb.ch/en/topics/ziredev/cube/rendoblid
+## 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",


@@ 44,10 44,17 @@ fetch_table <- function(table = "rendoblid",
                         dest.dir = NULL,
                         return.class = NULL,
                         verbose = TRUE,
-                        method, ...) {
+                        method,
+                        language = "en",
+                        name.sep = " :: ",
+                        na.drop = TRUE, ...) {
+
+    info <- fetch_table_info(table, language = language)
+    tmp <- info$dimensions[[1]]
+    items <- tmp$dimensionItems  ## overview
 
     site <- paste0("https://data.snb.ch/api/cube/",
-                   table, "/data/csv/en")
+                   table, "/data/csv/", language)
 
     if (!is.null(dest.dir)) {
         filename <- paste0(format(Sys.Date(), "%Y%m%d"),


@@ 89,15 96,26 @@ fetch_table <- function(table = "rendoblid",
     }
 
     empty <- grep("^ *$", dats)
+    header <- dats[1:empty]
     dats <- read.table(text = dats,
                        sep = ";",
                        header = TRUE,
                        stringsAsFactors = FALSE,
                        as.is = TRUE, skip = empty)
-    ans <- tapply(dats$Value, list(dats$Date, dats[, 2]), identity)
-    i <- min(which(!is.na(dats$Value)))
-    ans <- ans[, dats[1:(i-1), 2]]
 
+    id <- dats[[2]][seq(1, min(which(duplicated(dats[[2]]))) - 1)]
+    ans <- vector("list", length(id))
+    names(ans) <- as.character(id)
+    for (i in as.character(id)) {
+        ans[[i]] <- dats[dats[, 2] == i, -2]
+    }
+    result <- do.call(cbind, lapply(ans, `[[`, 2))
+    row.names(result) <- ans[[1]][[1]]
+
+    if (na.drop) {
+        drop <- apply(result, 1, function(x) all(!is.finite(x)))
+        result <- result[!drop,, drop = FALSE]
+    }
     if (!is.null(return.class)) {
         stop("not yet supported")
         if (return.class == "zoo")


@@ 110,12 128,10 @@ fetch_table <- function(table = "rendoblid",
             result <- ans
 
         else if (return.class == "list")
-            result <- NA 
+            result <- NA
 
-    } else
-        result <- ans
+    }
 
-        ## attr(result, "info") <-  doc
+    attr(result, "info") <- info
     result
-
 }

@@ 56,14 56,11 @@ fetch_table_info(table = "rendoblid", dest.dir = NULL,
 \value{
   typically a \code{\link{data.frame}}.
 
-  \code{bis_datasets} returns a \code{\link{data.frame}}
-    with three columns:
-    \item{filename}{the dataset filename}
-    \item{description}{a brief description of the dataset}
-    \item{updated}{if available, the date when the
-      dataset was last updated}
 
 }
+\references{
+  \url{https://data.snb.ch/en/help#data_api}
+}
 \author{
   Enrico Schumann
 }


@@ 73,7 70,7 @@ fetch_table_info(table = "rendoblid", dest.dir = NULL,
 \examples{
 \donttest{
 ## (Internet connection required)
-datasets()
-bis.data <- fetch_dataset(dest.dir = tempdir(),
-                          "full_bis_total_credit_csv.zip")
+fetch_table("rendoblim",
+            dest.dir = "~/Downloads/SNBdata/",
+            language = "de")
 }}