Fix lint issues

.lintr

@@ -1,2 +1,4 @@
 linters: linters_with_defaults() # see vignette("lintr")
 encoding: "UTF-8"
+exclusions: list(
+  "tests")

R/dst_correct_url.R

@@ -1,13 +1,25 @@
 #' Corrects url encoding for Danish letters.
 #'
 #' @param url A build url.
-dst_correct_url <- function(url){
-  url <- stringr::str_replace_all(string = url, pattern = "%C6", replacement = "%C3%86") # ?
-  url <- stringr::str_replace_all(string = url, pattern = "%D8", replacement = "%C3%98") # ?
-  url <- stringr::str_replace_all(string = url, pattern = "%C5", replacement = "%C3%85") # ?
-  url <- stringr::str_replace_all(string = url, pattern = "%E6", replacement = "%C3%A6") # ?
-  url <- stringr::str_replace_all(string = url, pattern = "%F8", replacement = "%C3%B8") # ?
-  url <- stringr::str_replace_all(string = url, pattern = "%E5", replacement = "%C3%A5") # ?
-
+dst_correct_url <- function(url) {
+  url <- stringr::str_replace_all(string = url,
+                                  pattern = "%C6",
+                                  replacement = "%C3%86") # ?
+  url <- stringr::str_replace_all(string = url,
+                                  pattern = "%D8",
+                                  replacement = "%C3%98") # ?
+  url <- stringr::str_replace_all(string = url,
+                                  pattern = "%C5",
+                                  replacement = "%C3%85") # ?
+  url <- stringr::str_replace_all(string = url,
+                                  pattern = "%E6",
+                                  replacement = "%C3%A6") # ?
+  url <- stringr::str_replace_all(string = url,
+                                  pattern = "%F8",
+                                  replacement = "%C3%B8") # ?
+  url <- stringr::str_replace_all(string = url,
+                                  pattern = "%E5",
+                                  replacement = "%C3%A5") # ?
+
   return(url)
-}
+}

R/dst_date_parse.R

@@ -1,58 +1,74 @@
 
+
+
 #' Helper function to parse the dates from the statbank.
 #'
 #' @param dst_date A vector of length one or more with date formats like
 #'   1982M12D09, 1982M12, 1982Q4 or 1982
 #' @returns Returns the input date formatted to be Europe/Copenhagen
-dst_date_parse <- function(dst_date){
-
+dst_date_parse <- function(dst_date) {
   tz <- "Europe/Copenhagen"
 
-  if(all(stringr::str_detect(dst_date, "[0-9]{4}+[M]{1}+[0-1]{1}+[0-9]{1}+[D]{1}+(([0-2]{1}+[0-9]{1})|([3]{1}+[0-1]{1}))")) &
-     all(stringr::str_length(string = dst_date) == 10)){
-
+  if (all(stringr::str_detect(dst_date,
+      "[0-9]{4}+[M]{1}+[0-1]{1}+[0-9]{1}+[D]{1}+(([0-2]{1}+[0-9]{1})|([3]{1}+[0-1]{1}))" # nolint
+    )) && all(stringr::str_length(string = dst_date) == 10)) {
     # Daily
-    dst_date <- lubridate::ymd(paste0(stringr::str_sub(dst_date, start = 1L, end = 4L), "-",
-                                      stringr::str_sub(dst_date, start = -5L, end = -4L), "-",
-                                      stringr::str_sub(dst_date, start = -2L)),
-                               tz = tz)
-  } else if(all(stringr::str_detect(dst_date, "^[0-9]{4}+[M]{1}+(([0]{1}+[0-9]{1})|([1]{1}+[0-2]{1}))")) &
-            all(stringr::str_length(string = dst_date) == 7)){
-
+    dst_date <- lubridate::ymd(paste0(
+      stringr::str_sub(dst_date, start = 1L, end = 4L),
+      "-",
+      stringr::str_sub(dst_date, start = -5L, end = -4L),
+      "-",
+      stringr::str_sub(dst_date, start = -2L)
+    ),
+    tz = tz)
+  } else if (
+    # nolint start
+    all(stringr::str_detect(dst_date,
+      "^[0-9]{4}+[M]{1}+(([0]{1}+[0-9]{1})|([1]{1}+[0-2]{1}))")) &&
+    all(stringr::str_length(string = dst_date) == 7)) {
+    # nolint end
     # Monthly
-    dst_date <- lubridate::ymd(paste0(stringr::str_sub(dst_date, start = 1L, end = 4L), "-",
-                                      stringr::str_sub(dst_date, start = -2L), "-",
-                                      "-01"),
-                               tz = tz)
-  } else if(all(stringr::str_detect(dst_date, "^[0-9]{4}+([Q]{1}|[K]{1})+[1-4]{1}")) &
-            all(stringr::str_length(string = dst_date) == 6)){
-
+    dst_date <- lubridate::ymd(paste0(
+      stringr::str_sub(dst_date, start = 1L, end = 4L),
+      "-",
+      stringr::str_sub(dst_date, start = -2L),
+      "-",
+      "-01"
+    ),
+    tz = tz)
+  } else if (
+    # nolint start
+    all(stringr::str_detect(dst_date, "^[0-9]{4}+([Q]{1}|[K]{1})+[1-4]{1}")) &&
+    all(stringr::str_length(string = dst_date) == 6)) {
+    # nolint end
     # Quarterly
-    dst_date <- lubridate::ymd(paste0(stringr::str_sub(dst_date, start = 1L, end = 4L), "-",
-                                      as.numeric(stringr::str_sub(dst_date, start = -1L)) * 3 - 2, "-",
-                                      "-01"),
-                               tz = tz)
-  } else if(all(stringr::str_detect(dst_date, "^[0-9]{4}")) &
-            all(stringr::str_length(dst_date) == 4)){
-
+    dst_date <- lubridate::ymd(paste0(
+      stringr::str_sub(dst_date, start = 1L, end = 4L),
+      "-",
+      as.numeric(stringr::str_sub(dst_date, start = -1L)) * 3 - 2,
+      "-",
+      "-01"
+    ),
+    tz = tz)
+  } else if (all(stringr::str_detect(dst_date, "^[0-9]{4}")) &&
+               all(stringr::str_length(dst_date) == 4)) {
     # Yearly
-    dst_date <- lubridate::ymd(paste0(stringr::str_sub(dst_date, start = 1L, end = 4L), "-01-01"),
-                               tz = tz)
-  } else if(all(stringr::str_detect(dst_date, "^[0-9]{4}+[H]{1}+[1-2]{1}")) &
-            all(stringr::str_length(dst_date) == 6)){
-
+    dst_date <- lubridate::ymd(paste0(stringr::str_sub(
+      dst_date, start = 1L, end = 4L
+    ), "-01-01"), tz = tz)
+  } else if (
+    # nolint start
+    all(stringr::str_detect(dst_date, "^[0-9]{4}+[H]{1}+[1-2]{1}")) &
+    all(stringr::str_length(dst_date) == 6)) {
+    # nolint end
     # Half yearly
-    dst_date[stringr::str_sub(dst_date, start = -1L) == 1] <- paste0(stringr::str_sub(dst_date[stringr::str_sub(dst_date, start = -1L) == 1], start = 1L, end = 4L),
-                                                                     "-01-01")
-    dst_date[stringr::str_sub(dst_date, start = -1L) == 2] <- paste0(stringr::str_sub(dst_date[stringr::str_sub(dst_date, start = -1L) == 2], start = 1L, end = 4L),
-                                                                     "-07-01")
-    dst_date <- lubridate::ymd(dst_date,
-                               tz = tz)
+    dst_date[stringr::str_sub(dst_date, start = -1L) == 1] <- paste0(stringr::str_sub(dst_date[stringr::str_sub(dst_date, start = -1L) == 1], start = 1L, end = 4L), "-01-01") # nolint
+    dst_date[stringr::str_sub(dst_date, start = -1L) == 2] <- paste0(stringr::str_sub(dst_date[stringr::str_sub(dst_date, start = -1L) == 2], start = 1L, end = 4L), "-07-01") # nolint
+    dst_date <- lubridate::ymd(dst_date, tz = tz)
 
   } else {
-    stop("None of the regular expressions were matched. Please inspect the dates.")
+    stop("None of the regular expressions were matched. Please inspect the dates.") # nolint
   }
 
   return(dst_date)
 }
-

R/dst_find_val_id.R

@@ -1,42 +1,43 @@
-
-
-#' This is a helper function to extract the ID's in the values list
-#' that the dst_meta function returns.
+#' This is a helper function to extract the ID's in the values list that the
+#' dst_meta function returns.
 #'
 #' @param meta_data The meta data object.
 #' @param variable The variable to search in.
-#' @param values_text Character vector. The values you want to extract the IDs for. If NULL, the returned value will be "*".
-dst_find_val_id <- function(meta_data, variable, values_text = NULL){
-
+#' @param values_text Character vector. The values you want to extract the IDs
+#'   for. If NULL, the returned value will be "*".
+dst_find_val_id <- function(meta_data, variable, values_text = NULL) {
   names(meta_data$values) <- toupper(names(meta_data$values))
 
-  if(!is.null(values_text)){
-    ids <- list(meta_data$values[[variable]]$id[meta_data$values[[variable]]$text %in% values_text])
+  if (!is.null(values_text)) {
+    ids <- list(meta_data$values[[variable]]$id[meta_data$values[[variable]]$text %in% values_text]) #nolint
     names(ids) <- variable
 
     # Test that all the values_text can be matched. If not, stop.
+
+    # nolint start
     id_test <- as.character(values_text) %in% meta_data$values[[variable]]$text
-    if(sum(id_test) != length(values_text)){
-      stop(paste0("All the values_text could not be matched in the text field of the values column of ",
-                  variable,
-                  ". It might be a typo or maybe the value isn't present in the variable."))
+    if (sum(id_test) != length(values_text)) {
+      stop(
+        paste0(
+          "All the values_text could not be matched in the text field of the values column of ",
+          variable,
+          ". It might be a typo or maybe the value isn't present in the variable."
+        )
+      )
     }
+    # nolint end
 
   } else {
     ids <- list("*")
     names(ids) <- variable
   }
 
-  if(length(ids) > 1){
-    warning("Results couldn't be transformed to a vector as results are in a list bigger than length 1.")
+  if (length(ids) > 1) {
+    warning(
+      "Results couldn't be transformed to a vector as results are in a list bigger than length 1." #nolint
+    )
   } else {
     ids <- ids[[variable]]
   }
   return(ids)
 }
-
-# Lav unit test.
-# dst_find_val_id(meta_data = folk1, variable = "OMRÅDE", values_text = c("København", "Frederiksberg", "Odense")) # OK
-# dst_find_val_id(meta_data = folk1, variable = "OMRÅDE", values_text = c("København", "frederiksberg", "Odense")) # fejl eller advarsel??
-# dst_find_val_id(meta_data = folk1, variable = "OMRÅDE") # Return "*".
-

R/dst_get_data.R

@@ -6,26 +6,32 @@
 #' @param table Table from StatBank.
 #' @param ... Build your own query.
 #' @param query A list object with your query.
-#' @param parse_dst_tid Logical. Default is TRUE. The date will be the first
-#'   day of the period and the time zone is "UTC" and not the Danish "CET".
+#' @param parse_dst_tid Logical. Default is TRUE. The date will be the first day
+#'   of the period and the time zone is "UTC" and not the Danish "CET".
 #' @param lang language. "en" for english or "da" for danish.
-#' @param meta_data Meta data for the table. If NULL the meta data will be requested.
+#' @param meta_data Meta data for the table. If NULL the meta data will be
+#'   requested.
 #' @param format character value. "CSV" or "BULK". If you choose BULK then you
 #'   need to select a value for each of the parameters.
 #' @param value_presentation For now, "value" or "default"
 #' @export
 #' @family Data retrival functions
 #' @importFrom utils read.csv read.csv2
-dst_get_data <- function(table, ..., query = NULL, parse_dst_tid = TRUE, lang = "da",
-                         meta_data = NULL, format = "CSV", value_presentation = "Value"){
-
+dst_get_data <- function(table,
+                         ...,
+                         query = NULL,
+                         parse_dst_tid = TRUE,
+                         lang = "da",
+                         meta_data = NULL,
+                         format = "CSV",
+                         value_presentation = "Value") {
   # Test that the language is either da or english
-  if(!stringr::str_detect(lang, "da|en")){
+  if (!stringr::str_detect(lang, "da|en")) {
     stop("The lang parameter can only be 'da' or 'en'")
   }
 
   # Test that the format is either CSV and BULK
-  if(!stringr::str_detect(format, "CSV|BULK")){
+  if (!stringr::str_detect(format, "CSV|BULK")) {
     stop("The format parameter can only be CSV or BULK")
   }
 
@@ -34,25 +40,34 @@ dst_get_data <- function(table, ..., query = NULL, parse_dst_tid = TRUE, lang =
   dst_url <- httr::parse_url(url = dst_url)
 
   ## If query is NULL, then use ... as query
-  if(is.null(query)){
+  if (is.null(query)) {
     query <- list(...)
-    if(length(query) == 0) stop("You need to build a query in ... or supply one to 'query'")
+    if (length(query) == 0)
+      stop("You need to build a query in ... or supply one to 'query'")
   }
 
   # Force the names to be uppercase to match requirements from API
   names(query) <- toupper(names(query))
   dst_names <- names(query)
 
   # Match the text values with ids that needs to be supplied in the api request.
-  query <- dst_query_match(table = table, lang = lang, meta_data = meta_data, query = query, format = format)
+  query <- dst_query_match(
+    table = table,
+    lang = lang,
+    meta_data = meta_data,
+    query = query,
+    format = format
+  )
 
   query$valuePresentation <- value_presentation
   query$lang <- lang
 
   ## Insert request into url
   dst_url$query <- query
 
-  dst_url$query <- lapply(X = dst_url$query, FUN = paste, collapse = ',')
+  dst_url$query <- lapply(X = dst_url$query,
+                          FUN = paste,
+                          collapse = ",")
 
   dst_url <- httr::build_url(dst_url)
   dst_url <- dst_correct_url(dst_url)
@@ -61,24 +76,33 @@ dst_get_data <- function(table, ..., query = NULL, parse_dst_tid = TRUE, lang =
   dst_data <- httr::GET(dst_url)
 
   # Make sure the returned status is OK
-  if(httr::status_code(dst_data) != 200){
+  if (httr::status_code(dst_data) != 200) {
     stop(httr::content(dst_data, as = "text", encoding = "UTF-8")$message)
   }
 
   # Get the content
   dst_data <- httr::content(x = dst_data, as = "text", encoding = "UTF-8")
 
-  if(lang == "da"){
-    dst_data <- read.csv2(text = dst_data, stringsAsFactors = FALSE, na.strings = c(".."))
-  } else if(lang == "en"){
-    dst_data <- read.csv(text = dst_data, stringsAsFactors = FALSE, sep = ";", na.strings = "..")
+  if (lang == "da") {
+    dst_data <- read.csv2(
+      text = dst_data,
+      stringsAsFactors = FALSE,
+      na.strings = c("..")
+    )
+  } else if (lang == "en") {
+    dst_data <- read.csv(
+      text = dst_data,
+      stringsAsFactors = FALSE,
+      sep = ";",
+      na.strings = ".."
+    )
   } else {
     stop("You haven't selected an appropiate language ('da' or 'en'")
   }
   names(dst_data) <- c(dst_names, "value")
 
   # Parse the dates if param is TRUE
-  if(parse_dst_tid){
+  if (parse_dst_tid) {
     dst_data$TID <- dst_date_parse(dst_date = dst_data$TID)
   }
 

R/dst_get_tables.R

@@ -1,28 +1,30 @@
-
-
 #' This functions downloads all the available tables.
-#' 
+#'
 #' @param lang "da" (danish) or "en" (english)
 #' @export
-dst_get_tables <- function(lang = "da"){
-
+dst_get_tables <- function(lang = "da") {
   # Test that the language is either da or english
-  if(!stringr::str_detect(lang, "da|en")){
+  if (!stringr::str_detect(lang, "da|en")) {
     stop("The lang parameter can only be 'da' or 'en'")
   }
-  
+
   # prepare the url
-  dst_url <- paste0("http://api.statbank.dk/v1/tables?lang=", lang, "&format=JSON")
-
+  dst_url <- paste0("http://api.statbank.dk/v1/tables?lang=",
+                    lang,
+                    "&format=JSON")
+
   # get data
   dst_tables <- httr::GET(url = dst_url)
   dst_tables <- httr::content(dst_tables, encoding = "UTF-8")
-  
+
   # parse JSON
   dst_tables <- jsonlite::fromJSON(dst_tables)
-  dst_tables$variables <- unlist(lapply(dst_tables$variables, paste, sep = ",", collapse = ","))
-
+  dst_tables$variables <- unlist(lapply(
+    dst_tables$variables,
+    paste,
+    sep = ",",
+    collapse = ","
+  ))
+
   return(dst_tables)
 }
-
-