Merge pull request #48 from statisticsnorway/develop

Develop
statisticsnorway · Nov 15, 2024 · 2946c69 · 2946c69
2 parents 0c42d1e + c4d48da
commit 2946c69
Show file tree

Hide file tree

Showing 23 changed files with 252 additions and 215 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -21,6 +21,8 @@ Description: Functions to search, retrieve, apply and update classifications
   and codelists using Statistics Norway's API <https://www.ssb.no/klass> 
   from the system 'KLASS'. Retrieves classifications by date with options 
   to choose language, hierarchical level and formatting.
+Depends:
+    R (>= 3.5.0)
 Imports: tm, httr, jsonlite, igraph, methods
 URL: https://statisticsnorway.github.io/ssb-klassr/
 BugReports: https://github.com/statisticsnorway/ssb-klassr/issues

diff --git a/R/Hent_data.R b/R/Hent_data.R
@@ -15,7 +15,7 @@ CheckDate <- function(date) {
 
 #' Internal function to create URL address
 #'
-#' @param klass Classification number
+#' @param classification Classification number
 #' @param correspond Target number for correspondence table
 #' @param variant_name The name of the variant of the classification
 #' @param type String describing type. "vanlig" for normal classification and "kor" for correspondence. Default = "vanlig"
@@ -26,7 +26,7 @@ CheckDate <- function(date) {
 #' @keywords internal
 #'
 #' @return String url adress
-MakeUrl <- function(klass, correspond = NULL, correspondID = NULL,
+MakeUrl <- function(classification, correspond = NULL, correspondID = NULL,
                     variant_name = NULL,
                     type = "vanlig",
                     fratil = FALSE, date = NULL,
@@ -51,7 +51,7 @@ MakeUrl <- function(klass, correspond = NULL, correspondID = NULL,
   if (type == "korID") {
     coding <- paste0("correspondencetables/", MakeChar(correspondID))
     # Tables with given ID can not be combined with other parameters in the call
-    klass <- ""
+    classification <- ""
     language_coding <- ""
     output_level_coding <- ""
   }
@@ -92,7 +92,7 @@ MakeUrl <- function(klass, correspond = NULL, correspondID = NULL,
   # Paste together to an URL
   url <- paste(GetBaseUrl(),
     classifics,
-    klass,
+    classification,
     coding,
     output_level_coding,
     language_coding,
@@ -172,7 +172,7 @@ get_variant_name <- function(variant) {
 #' @keywords internal
 #' @return text in json format
 GetUrl2 <- function(url, check = TRUE) {
-  # henter innholdet fra klass med acceptheader json
+  # Fetch contents from classfication
   if (check) {
     hent_klass <- check_connect(url)
   } else {
@@ -181,15 +181,15 @@ GetUrl2 <- function(url, check = TRUE) {
   if (is.null(hent_klass)) {
     return(invisible(NULL))
   }
-  klass_text <- httr::content(hent_klass, "text", encoding = "UTF-8") #### ## deserialisering med httr funksjonen content
+  klass_text <- httr::content(hent_klass, "text", encoding = "UTF-8") ## deserialisering with httr function
   return(klass_text)
 }
 
 #' Fetch Statistics Norway classification data using API
 #'
-#' @param klass Number/string of the classification ID/number. (use klass_list() to find this)
+#' @param classification Number/string of the classification ID/number. (use klass_list() to find this)
 #' @param date String for the required date of the classification. Format must be "yyyy-mm-dd". For an inverval, provide two dates as a vector. If blank, will default to today's date.
-#' @param correspond Number/string of the target klass for correspondence table (if a correspondence table is requested).
+#' @param correspond Number/string of the target classification for correspondence table (if a correspondence table is requested).
 #' @param correspondID ID number of the correspondence table to retrieve. Use as an alternative to correspond.
 #' @param variant The classification variant to fetch (if a variant is wanted).
 #' @param output_level Number/string specifying the requested hierarchy level (optional).
@@ -208,10 +208,10 @@ GetUrl2 <- function(url, check = TRUE) {
 #'
 #' @examples
 #' # Get classification for occupation classifications
-#' head(get_klass(klass = "7"))
+#' head(get_klass(classification = "7"))
 #' # Get classification for occupation classifications in English
-#' head(get_klass(klass = "7", language = "en"))
-get_klass <- function(klass,
+#' head(get_klass(classification = "7", language = "en"))
+get_klass <- function(classification,
                       date = NULL,
                       correspond = NULL,
                       correspondID = NULL,
@@ -221,17 +221,17 @@ get_klass <- function(klass,
                       output_style = "normal",
                       notes = FALSE,
                       quiet = TRUE) {
-  # create type of klassification for using later
+  # create type of classification for using later
   type <- ifelse(is.null(correspond) & is.null(correspondID), "vanlig", "kor")
   type <- ifelse(isTRUE(correspond), "change", type)
   type <- ifelse(is.null(correspond) & type == "kor", "korID", type)
   type <- ifelse(is.null(variant), type, "variant")
 
-  # sjekk klass er char
+  # check classification is a character
   if (is.null(correspondID)) {
-    klass <- MakeChar(klass)
+    classification <- MakeChar(classification)
   } else {
-    klass <- ""
+    classification <- ""
   }
 
 
@@ -291,7 +291,7 @@ get_klass <- function(klass,
     }
   }
   url <- MakeUrl(
-    klass = klass, correspond = correspond, correspondID = correspondID,
+    classification = classification, correspond = correspond, correspondID = correspondID,
     variant_name = variant_name,
     type = type,
     fratil = fratil, date = date, output_level_coding = output_level_coding,
@@ -307,13 +307,13 @@ get_klass <- function(klass,
     if (grepl("no correspondence table", klass_text)) {
       targetswap <- TRUE
       url <- MakeUrl(
-        klass = correspond, correspond = klass, type = type, fratil = fratil, date = date,
+        classification = correspond, correspond = classification, type = type, fratil = fratil, date = date,
         output_level_coding = output_level_coding, language_coding = language_coding
       )
       klass_text <- GetUrl2(url)
       if (grepl("no correspondence table", klass_text)) {
         stop(
-          "No correspondence table found between classes ", klass, " and ", correspond, " for the date ", date,
+          "No correspondence table found between classes ", classification, " and ", correspond, " for the date ", date,
           "For a list of valid correspondence tables use the function correspond_list()"
         )
       }
@@ -325,15 +325,15 @@ get_klass <- function(klass,
   if (is.null(klass_text)) stop_quietly()
 
   if (grepl("not found", klass_text)) {
-    stop("No KLASS table was found for KLASS number ", klass, ".
-    Please try again with a different KLASS number.
-    For a list of possible KLASS's use the function list_klass() or list_family()")
+    stop("No classification table was found for classification number ", classification, ".
+    Please try again with a different classification number.
+    For a list of possible classification's use the function list_klass() or list_family()")
   }
   if (grepl("not published in language", klass_text)) {
     stop("The classification requested was not found for language = ", gsub(".*=", "", language_coding))
   }
   if (grepl("does not have a variant named", klass_text)) {
-    stop("The variant ", variant, " was not found for KLASS number ", klass)
+    stop("The variant ", variant, " was not found for classification number ", classification)
   }
 
   if (type %in% c("vanlig", "variant")) {
@@ -344,7 +344,7 @@ get_klass <- function(klass,
     klass_data <- jsonlite::fromJSON(klass_text, flatten = TRUE)$correspondenceItems
     if (length(klass_data) == 0) {
       stop(
-        "No correspondence table found between classes ", klass, " and ", correspond, " for the date ", date,
+        "No correspondence table found between classes ", classification, " and ", correspond, " for the date ", date,
         "For a list of valid correspondence tables use the function correspond_list()"
       )
     }
@@ -384,7 +384,7 @@ get_klass <- function(klass,
 
     # check several levels exist
     if (maxlength == minlength) {
-      warning("Only one level was detected. Klassification returned with output_style normal. ")
+      warning("Only one level was detected. Classification returned with output_style normal. ")
       return(as.data.frame(klass_data))
     }
 
@@ -426,7 +426,7 @@ GetKlass <- function(klass,
                      quiet = TRUE) {
   # .Deprecated("get_klass") # Add in for future versions
   get_klass(
-    klass = klass,
+    classification = klass,
     date = date,
     correspond = correspond,
     correspondID = correspondID,

diff --git a/R/KLASS.R b/R/KLASS.R
@@ -17,7 +17,7 @@ MakeChar <- function(x) {
 #' Match and convert a classification
 #'
 #' @param x Input vector of classification codes. Vector must match "code" column from a call to get_klass().
-#' @param klass Classification number
+#' @param classification Classification number
 #' @param date String for the required date of the classification. Format must be "yyyy-mm-dd". For an inverval, provide two dates as a vector. If blank, will default to today's date.
 #' @param variant The classification variant to fetch (if a variant is wanted).
 #' @param correspond ID number for target in correspondence table. For correspondence between two dates within the same classification, use correspond = TRUE.
@@ -31,18 +31,23 @@ MakeChar <- function(x) {
 #'
 #' @examples
 #' data(klassdata)
-#' kommune_names <- apply_klass(x = klassdata$kommune, klass = 131, language = "en", format = FALSE)
+#' kommune_names <- apply_klass(
+#'   x = klassdata$kommune,
+#'   classification = 131,
+#'   language = "en",
+#'   format = FALSE
+#' )
 apply_klass <- function(x,
-                        klass,
+                        classification,
                         date = NULL,
                         variant = NULL,
                         correspond = NULL,
                         language = "nb",
                         output_level = NULL,
                         output = "name",
                         format = TRUE) {
-  # sjekk og standardisere varible
-  klass <- MakeChar(klass)
+  # Check and standardise variables
+  classification <- MakeChar(classification)
   if (is.null(x)) {
     stop("The input vector is empty.")
   }
@@ -56,47 +61,67 @@ apply_klass <- function(x,
   type <- ifelse(isTRUE(correspond), "change", type)
   type <- ifelse(is.null(variant), type, "variant")
 
-  # Ta ut klass tabell
-  klass_data <- get_klass(klass,
-    date = date, correspond = NULL, variant = variant,
-    language = language, output_level = NULL
+  # Fetch classification table
+  klass_data <- get_klass(
+    classification,
+    date = date,
+    correspond = NULL,
+    variant = variant,
+    language = language,
+    output_level = NULL
   )
 
-  # Ta ut korrespond tabell
+  # Extract correspondence table
   if (type == "kor") {
-    cor_table <- get_klass(klass,
-      date = date, correspond = correspond,
+    cor_table <- get_klass(
+      classification,
+      date = date,
+      correspond = correspond,
       language = language
     ) # , output_level = output_level)
 
     new_table <- get_klass(
-      klass = correspond, date = date, correspond = NULL,
+      classification = correspond,
+      date = date,
+      correspond = NULL,
       language = language
     ) # , output_level = output_level)
   }
   if (type == "change") {
     cor_table <- get_klass(
-      klass = klass, date = date, correspond = TRUE,
-      language = language, output_level = NULL
+      classification = classification,
+      date = date,
+      correspond = TRUE,
+      language = language,
+      output_level = NULL
     )
   }
 
   # Formattering - only for nace and municipality
-  if (format == TRUE & klass %in% c("6", "131")) {
-    x_formatted <- formattering(x, klass = klass)
+  if (format == TRUE & classification %in% c("6", "131")) {
+    x_formatted <- formattering(x, classification = classification)
   } else {
     x_formatted <- x
   }
 
-  # kjor indata sjekk
+  # Check input data for level
   input_level <- levelCheck(x = x_formatted, klass_data = klass_data) # implies all are same level!
-  if (is.null(output_level)) output_level <- input_level
+  if (is.null(output_level)) {
+    output_level <- input_level
+  }
 
-  if (!all(input_level == output_level) & type %in% c("kor", "change")) stop("Level changes and time changes/correspondence concurrently is not programmed.")
+  if (!all(input_level == output_level) &
+    type %in% c("kor", "change")) {
+    stop("Level changes and time changes/correspondence concurrently is not programmed.")
+  }
 
-  # kjøre nivå funksjon
+  # Run level function
   if (!all(input_level == output_level) & is.null(correspond)) {
-    x_level <- Levels(input_level = input_level, output_level = output_level, klass_data = klass_data)
+    x_level <- Levels(
+      input_level = input_level,
+      output_level = output_level,
+      klass_data = klass_data
+    )
   }
 
   if (all(input_level == output_level)) {
@@ -106,7 +131,7 @@ apply_klass <- function(x,
   }
 
 
-  # kjøre matching
+  # run matching
   levelcode <- paste("level", input_level, sep = "")
   if (type %in% c("vanlig", "variant")) {
     m <- match(x_formatted, x_level[, levelcode]) ### sjekk rekkefolge
@@ -123,11 +148,17 @@ apply_klass <- function(x,
     m2 <- match(x_formatted, cor_table$sourceCode)
   }
 
-  # velge format output
+  # Choose format output
   if (type %in% c("vanlig", "variant")) {
-    if (output == "code") vars <- paste("level", output_level, sep = "")
-    if (output == "name") vars <- paste("name", output_level, sep = "")
-    if (output == "both") vars <- paste(c("level", "name"), output_level, sep = "")
+    if (output == "code") {
+      vars <- paste("level", output_level, sep = "")
+    }
+    if (output == "name") {
+      vars <- paste("name", output_level, sep = "")
+    }
+    if (output == "both") {
+      vars <- paste(c("level", "name"), output_level, sep = "")
+    }
     out <- x_level[m, vars]
   }
   if (type == "kor") {
@@ -178,7 +209,10 @@ ApplyKlass <- function(x,
                        format = TRUE) {
   # .Deprecated("apply_klass") # add in for future versions
   apply_klass(
-    x = x, klass = klass, date = date, variant = variant,
+    x = x,
+    classification = klass,
+    date = date,
+    variant = variant,
     correspond = correspond,
     language = language,
     output_level = output_level,