From d622b19d3455b18c4eb63d33c39800558901e444 Mon Sep 17 00:00:00 2001 From: Jentoft Date: Thu, 14 Nov 2024 14:42:53 +0100 Subject: [PATCH 1/5] Added R dependency for cran submission --- DESCRIPTION | 2 ++ 1 file changed, 2 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 155f042..9e7cee4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -21,6 +21,8 @@ Description: Functions to search, retrieve, apply and update classifications and codelists using Statistics Norway's API 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 From 09b282ed9ad3ad1c526ebff72c13e7433c53430c Mon Sep 17 00:00:00 2001 From: Jentoft Date: Fri, 15 Nov 2024 10:46:09 +0100 Subject: [PATCH 2/5] Updated documentation --- man/MakeUrl.Rd | 4 ++-- man/apply_klass.Rd | 10 +++++++--- man/correspond_list.Rd | 8 ++++---- man/formattering.Rd | 4 ++-- man/get_family.Rd | 6 +++--- man/get_klass.Rd | 10 +++++----- man/get_version.Rd | 4 ++-- man/klass_graph.Rd | 6 ++++-- man/klass_node.Rd | 6 ++++-- man/update_klass.Rd | 2 ++ man/update_klass_node.Rd | 3 +-- vignettes/klassR-vignette.Rmd | 10 +++++----- 12 files changed, 41 insertions(+), 32 deletions(-) diff --git a/man/MakeUrl.Rd b/man/MakeUrl.Rd index 2bdbc35..0143b10 100644 --- a/man/MakeUrl.Rd +++ b/man/MakeUrl.Rd @@ -5,7 +5,7 @@ \title{Internal function to create URL address} \usage{ MakeUrl( - klass, + classification, correspond = NULL, correspondID = NULL, variant_name = NULL, @@ -17,7 +17,7 @@ MakeUrl( ) } \arguments{ -\item{klass}{Classification number} +\item{classification}{Classification number} \item{correspond}{Target number for correspondence table} diff --git a/man/apply_klass.Rd b/man/apply_klass.Rd index f31b4ea..7209f85 100644 --- a/man/apply_klass.Rd +++ b/man/apply_klass.Rd @@ -7,7 +7,7 @@ \usage{ apply_klass( x, - klass, + classification, date = NULL, variant = NULL, correspond = NULL, @@ -32,7 +32,7 @@ ApplyKlass( \arguments{ \item{x}{Input vector of classification codes. Vector must match "code" column from a call to get_klass().} -\item{klass}{Classification number} +\item{classification}{Classification number} \item{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.} @@ -56,6 +56,10 @@ Match and convert a classification } \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 + ) } \keyword{internal} diff --git a/man/correspond_list.Rd b/man/correspond_list.Rd index b76c1ef..567a397 100644 --- a/man/correspond_list.Rd +++ b/man/correspond_list.Rd @@ -4,14 +4,14 @@ \alias{correspond_list} \alias{CorrespondList} \title{Correspondence list -Print a list of correspondence tables for a given klass with source and target IDs} +Print a list of correspondence tables for a given classification with source and target IDs} \usage{ -correspond_list(klass, date = NULL) +correspond_list(classification, date = NULL) CorrespondList(klass, date = NULL) } \arguments{ -\item{klass}{Classification number} +\item{classification}{Classification number} \item{date}{Date for classification (format = "YYYY-mm-dd"). Default is current date} } @@ -20,7 +20,7 @@ Data frame with list of corrsepondence tables, source ID and target ID. } \description{ Correspondence list -Print a list of correspondence tables for a given klass with source and target IDs +Print a list of correspondence tables for a given classification with source and target IDs } \examples{ \donttest{ diff --git a/man/formattering.Rd b/man/formattering.Rd index cfeb462..7c3263c 100644 --- a/man/formattering.Rd +++ b/man/formattering.Rd @@ -4,12 +4,12 @@ \alias{formattering} \title{Format vector for industry codes} \usage{ -formattering(x, klass) +formattering(x, classification) } \arguments{ \item{x}{- vector of character} -\item{klass}{- classification number} +\item{classification}{- classification number} } \value{ vector of character diff --git a/man/get_family.Rd b/man/get_family.Rd index 5f27aaf..2a4df4a 100644 --- a/man/get_family.Rd +++ b/man/get_family.Rd @@ -5,12 +5,12 @@ \alias{GetFamily} \title{Identify corresponding family from a classification number} \usage{ -get_family(klass) +get_family(classification) GetFamily(klass) } \arguments{ -\item{klass}{Classification number} +\item{classification}{Classification number} } \value{ Family number @@ -19,6 +19,6 @@ Family number Identify corresponding family from a classification number } \examples{ -get_family(klass = 7) +get_family(classification = 7) } \keyword{internal} diff --git a/man/get_klass.Rd b/man/get_klass.Rd index b863447..0a3aa80 100644 --- a/man/get_klass.Rd +++ b/man/get_klass.Rd @@ -6,7 +6,7 @@ \title{Fetch Statistics Norway classification data using API} \usage{ get_klass( - klass, + classification, date = NULL, correspond = NULL, correspondID = NULL, @@ -32,11 +32,11 @@ GetKlass( ) } \arguments{ -\item{klass}{Number/string of the classification ID/number. (use klass_list() to find this)} +\item{classification}{Number/string of the classification ID/number. (use klass_list() to find this)} \item{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.} -\item{correspond}{Number/string of the target klass for correspondence table (if a correspondence table is requested).} +\item{correspond}{Number/string of the target classification for correspondence table (if a correspondence table is requested).} \item{correspondID}{ID number of the correspondence table to retrieve. Use as an alternative to correspond.} @@ -65,8 +65,8 @@ Fetch Statistics Norway classification data using API } \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")) +head(get_klass(classification = "7", language = "en")) } \keyword{internal} diff --git a/man/get_version.Rd b/man/get_version.Rd index 61ae7cf..44a6557 100644 --- a/man/get_version.Rd +++ b/man/get_version.Rd @@ -5,12 +5,12 @@ \alias{GetVersion} \title{Get version number of a class given a date} \usage{ -get_version(klass = NULL, date = NULL, family = NULL, klassNr = FALSE) +get_version(classification = NULL, date = NULL, family = NULL, klassNr = FALSE) GetVersion(klass = NULL, date = NULL, family = NULL, klassNr = FALSE) } \arguments{ -\item{klass}{Classification number} +\item{classification}{Classification number} \item{date}{Date for version to be valid} diff --git a/man/klass_graph.Rd b/man/klass_graph.Rd index d8e6b5a..ed2c368 100644 --- a/man/klass_graph.Rd +++ b/man/klass_graph.Rd @@ -26,11 +26,13 @@ Build a directed graph of code changes based on a Klass classification library(klassR) # Build a graph directed towards the most recent codes - +\dontrun{ klass_131 <- klass_graph(131) +} # Build a graph directed towards valid codes in 2020. - +\dontrun{ klass_131_2020 <- klass_graph(131, "2020-01-01") +} } diff --git a/man/klass_node.Rd b/man/klass_node.Rd index 301abdd..9fa30be 100644 --- a/man/klass_node.Rd +++ b/man/klass_node.Rd @@ -28,11 +28,13 @@ date. # Build a graph directed towards the most recent codes. library(klassR) +\dontrun{ klass_131 <- klass_graph(131) +} # Find the most recent node in the graph representing the code "0101" (Halden, # valid to 2020.) - +\dontrun{ halden_node <- klass_node(klass_131, "0101") - +} } diff --git a/man/update_klass.Rd b/man/update_klass.Rd index abb3f80..74b3328 100644 --- a/man/update_klass.Rd +++ b/man/update_klass.Rd @@ -100,9 +100,11 @@ Update multiple Klass codes to a desired date. library(klassR) codes <- get_klass(131, date = "2020-01-01")[["code"]] +\dontrun{ updated_codes <- update_klass(codes, dates = "2020-01-01", classification = 131 ) +} } diff --git a/man/update_klass_node.Rd b/man/update_klass_node.Rd index f85b299..2d779fa 100644 --- a/man/update_klass_node.Rd +++ b/man/update_klass_node.Rd @@ -27,11 +27,10 @@ klass_131 <- klass_graph(131) # Find the most recent node in the graph representing the code "0101" (Halden, # valid to 2020.) - halden_node <- klass_node(klass_131, "0101") # Find the most recent code corresponding to 0101 Halden - halden_node_updated <- update_klass_node(klass_131, halden_node) + } diff --git a/vignettes/klassR-vignette.Rmd b/vignettes/klassR-vignette.Rmd index 29927ec..78223d8 100644 --- a/vignettes/klassR-vignette.Rmd +++ b/vignettes/klassR-vignette.Rmd @@ -199,7 +199,7 @@ We can use `apply_klass` to create a variable for the municipality names (classi ```{r, eval=F} klassdata$kommune_names <- apply_klass(klassdata$kommune, - klass = 131 + classification = 131 ) head(klassdata) ``` @@ -207,7 +207,7 @@ head(klassdata) ```{r, echo=F, warning=F} klassdata$kommune_names <- apply_klass(klassdata$kommune, - klass = 131, + classification = 131, date = "2016-01-01" ) kable(head(klassdata)) @@ -308,7 +308,7 @@ We can apply this correspondence between municipality and region in our example ```{r, eval =F} klassdata$region <- apply_klass(klassdata$kommune, - klass = 131, + classification = 131, correspond = 106, date = "2020-01-01" ) @@ -330,9 +330,9 @@ kable(head(klassdata)) ## 7. Variants It is also possible to fetch a variant of a classification. You need to provide both the classification number and the variant number. ```{r, eval = FALSE} -get_klass(klass = 6, variant = 1616, date = "2021-01-02") +get_klass(6, variant = 1616, date = "2021-01-02") ``` ```{r, echo = FALSE} -kable(head(get_klass(klass = 6, variant = 1616, date = "2021-01-02"))) +kable(head(get_klass(6, variant = 1616, date = "2021-01-02"))) ``` From c4fd88765db491a37efdf2067b8803847c327913 Mon Sep 17 00:00:00 2001 From: Jentoft Date: Fri, 15 Nov 2024 10:47:15 +0100 Subject: [PATCH 3/5] Swapped klass parameter to classification. --- R/Hent_data.R | 50 ++++---- R/KLASS.R | 115 ++++++++++++------- R/Klass_list.R | 44 ++++---- R/format.R | 8 +- tests/testthat/test_ApplyKlass.R | 176 +++++++++++++---------------- tests/testthat/test_GetKlass.R | 46 ++++---- tests/testthat/test_formattering.R | 14 +-- 7 files changed, 224 insertions(+), 229 deletions(-) diff --git a/R/Hent_data.R b/R/Hent_data.R index 04235ab..ae204f7 100644 --- 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 index 35e043e..ba9f345 100644 --- 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,9 +31,13 @@ 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, @@ -41,93 +45,115 @@ apply_klass <- function(x, 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.") } x <- MakeChar(x) - + if (is.null(date)) { date <- Sys.Date() } - + type <- ifelse(is.null(correspond), "vanlig", "kor") 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 (!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 + 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.") + + # 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)) { x_level <- klass_data[klass_data$level == input_level, ] x_level[, paste("level", input_level, sep = "")] <- x_level$code x_level[, paste("name", input_level, sep = "")] <- x_level$name } - - - # 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 } - + if (type == "kor") { m1 <- match(x_level[, levelcode], cor_table[, "sourceCode"]) m2 <- match(x_formatted, cor_table[, "sourceCode"]) m3 <- match(cor_table[, "targetCode"], new_table[, "code"]) ## ? } - + if (type == "change") { m1 <- match(x_formatted, x_level[, levelcode]) 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 +204,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, diff --git a/R/Klass_list.R b/R/Klass_list.R index f10fc55..6a03f20 100644 --- a/R/Klass_list.R +++ b/R/Klass_list.R @@ -157,7 +157,7 @@ SearchKlass <- function(query, codelists = FALSE, size = 20) { #' Get version number of a class given a date #' -#' @param klass Classification number +#' @param classification Classification number #' @param date Date for version to be valid #' @param family Family ID number if a list of version number for all classes is desired #' @param klassNr True/False for whether to output classification numbers. Default = FALSE @@ -167,12 +167,12 @@ SearchKlass <- function(query, codelists = FALSE, size = 20) { #' #' @examples #' get_version(7) -get_version <- function(klass = NULL, date = NULL, family = NULL, klassNr = FALSE) { +get_version <- function(classification = NULL, date = NULL, family = NULL, klassNr = FALSE) { if (is.null(date)) date <- Sys.Date() if (is.null(family)) { - if (klassNr == TRUE) stop("To output Klass number from this function you need to input a family number") - klass <- MakeChar(klass) - url <- paste(GetBaseUrl(), "classifications/", klass, sep = "") + if (klassNr == TRUE) stop("To output classification number from this function you need to input a family number") + classification <- MakeChar(classification) + url <- paste(GetBaseUrl(), "classifications/", classification, sep = "") df <- as.data.frame(GetUrl(url)$versions) df$validTo[is.na(df$validTo)] <- as.character(Sys.Date() + 1) for (i in 1:nrow(df)) { @@ -213,7 +213,7 @@ get_version <- function(klass = NULL, date = NULL, family = NULL, klassNr = FALS #' @export GetVersion <- function(klass = NULL, date = NULL, family = NULL, klassNr = FALSE) { .Deprecated("get_version") - get_version(klass = klass, date = date, family = family, klassNr = klassNr) + get_version(classification = klass, date = date, family = family, klassNr = klassNr) } @@ -248,17 +248,17 @@ GetName <- function(version) { #' Identify corresponding family from a classification number #' -#' @param klass Classification number +#' @param classification Classification number #' #' @return Family number #' @export #' #' @examples -#' get_family(klass = 7) -get_family <- function(klass) { - klass <- MakeChar(klass) +#' get_family(classification = 7) +get_family <- function(classification) { + classification <- MakeChar(classification) K <- list_klass(codelists = TRUE) - m <- match(klass, K$klass_nr) + m <- match(classification, K$klass_nr) return(K$klass_family[m]) } @@ -268,15 +268,15 @@ get_family <- function(klass) { #' @export GetFamily <- function(klass) { .Deprecated("get_family") - get_family(klass = klass) + get_family(classification = klass) } #' Correspondence list -#' Print a list of correspondence tables for a given klass with source and target IDs +#' Print a list of correspondence tables for a given classification with source and target IDs #' -#' @param klass Classification number +#' @param classification Classification number #' @param date Date for classification (format = "YYYY-mm-dd"). Default is current date #' #' @return Data frame with list of corrsepondence tables, source ID and target ID. @@ -286,18 +286,18 @@ GetFamily <- function(klass) { #' \donttest{ #' correspond_list("7") #' } -correspond_list <- function(klass, date = NULL) { +correspond_list <- function(classification, date = NULL) { cat("Finding correspondence tables ...") - klass <- MakeChar(klass) + classification <- MakeChar(classification) if (is.null(date)) { date <- Sys.Date() } - vers <- get_version(klass = klass, date = date) + vers <- get_version(classification = classification, date = date) url <- paste(GetBaseUrl(), "versions/", vers, sep = "") df <- GetUrl(url) versName <- df$name dt <- data.frame(df$correspondenceTables) - fam <- get_family(klass = klass) + fam <- get_family(classification = classification) versValid <- get_version(family = fam, date = date, klassNr = TRUE) vers_names <- get_name(versValid$vers) source_klass <- NULL @@ -318,8 +318,8 @@ correspond_list <- function(klass, date = NULL) { cat(".") } sourceTarget <- ifelse(is.na(m2), NA, as.character(versValid[m2, "klass_nr"])) - source_klass[i] <- ifelse(m == 1, klass, sourceTarget) - target_klass[i] <- ifelse(m == 1, sourceTarget, klass) + source_klass[i] <- ifelse(m == 1, classification, sourceTarget) + target_klass[i] <- ifelse(m == 1, sourceTarget, classification) } correspondence_table <- sapply(dt$X_links$self$href, GetNums) dt2 <- data.frame( @@ -334,7 +334,7 @@ correspond_list <- function(klass, date = NULL) { if (any(is.na(dt2$target_klass))) { message( "\n\n There are correspondence tables within classification ", - klass, + classification, " (between different time points). Use the changes = TRUE option in the apply_klass and get_klass functions to get these\n " ) } @@ -347,5 +347,5 @@ correspond_list <- function(klass, date = NULL) { #' @export CorrespondList <- function(klass, date = NULL) { .Deprecated("correspond_list") - correspond_list(klass = klass, date = date) + correspond_list(classification = klass, date = date) } diff --git a/R/format.R b/R/format.R index 0264f43..0e7bbf3 100644 --- a/R/format.R +++ b/R/format.R @@ -3,10 +3,10 @@ #' Format vector for industry codes #' @param x - vector of character -#' @param klass - classification number +#' @param classification - classification number #' @return vector of character #' @keywords internal -formattering <- function(x, klass) { +formattering <- function(x, classification) { # Check for missing values miss <- sum(is.na(x) | x == "") if (miss != 0) { @@ -14,10 +14,10 @@ formattering <- function(x, klass) { } # Check and format - if (klass == 6) { + if (classification == 6) { x_formatted <- formattering_nace(x) } - if (klass == 131) { + if (classification == 131) { x_formatted <- formattering_kommune(x) } diff --git a/tests/testthat/test_ApplyKlass.R b/tests/testthat/test_ApplyKlass.R index 8fca4d5..45494b5 100644 --- a/tests/testthat/test_ApplyKlass.R +++ b/tests/testthat/test_ApplyKlass.R @@ -1,8 +1,8 @@ test_that("apply_klass returns correct names for numeric codes", { data(klassdata) kommune_names <- apply_klass(klassdata$kommune, - klass = 131, date = "2015-01-01" - ) + classification = 131, + date = "2015-01-01") expect_equal(kommune_names[1], "Sandefjord") }) @@ -11,8 +11,8 @@ test_that("apply_klass returns correct names for numeric codes", { test_that("apply_klass returns correct names for numeric codes", { data(klassdata) kommune_names <- apply_klass(klassdata$kommune, - klass = 131, date = "2015-01-01" - ) + classification = 131, + date = "2015-01-01") expect_equal(kommune_names[1], "Sandefjord") }) @@ -20,24 +20,28 @@ test_that("apply_klass returns correct names for numeric codes", { test_that("apply_klass returns correct names for character codes", { data(klassdata) sektor_names <- apply_klass(c("INNL", "UTL", "B_FIN"), - klass = 39, date = "2019-01-01" - ) + classification = 39, + date = "2019-01-01") expect_equal(sektor_names[2], "Utlandet") }) test_that("apply_klass returns correct language", { data(klassdata) - occ <- apply_klass(klassdata$occupation, - klass = 7, + occ <- apply_klass( + klassdata$occupation, + classification = 7, language = "en", - date = "2015-01-01", format = F + date = "2015-01-01", + format = F ) expect_equal(occ[1], "Bartenders") - occ <- apply_klass(klassdata$occupation, - klass = 7, + occ <- apply_klass( + klassdata$occupation, + classification = 7, language = "nb", - date = "2015-01-01", format = F + date = "2015-01-01", + format = F ) expect_equal(occ[4], "Elektronikkingeniører") }) @@ -70,16 +74,16 @@ test_that("Check levelCheck for character codes", { test_that("apply_klass can return a variant classification", { dat <- c("000", "101", "102", "103") dat <- c("01.21", "01.46", "10.61") - + dat_new <- klassR::apply_klass(dat, - klass = 6, - variant = 1616, - date = "2021-01-02" - ) + classification = 6, + variant = 1616, + date = "2021-01-02") expect_equal(dat_new[2], "Svinehold") - - dat_new <- klassR::apply_klass(dat, - klass = 6, + + dat_new <- klassR::apply_klass( + dat, + classification = 6, variant = 1616, output_level = 1, date = "2021-01-02" @@ -88,17 +92,21 @@ test_that("apply_klass can return a variant classification", { }) -test_that("apply_klass works for variant classification with Norwegian characters in the variant name", { - dat <- c("05", "01") - new <- apply_klass(dat, - klass = 6, - variant = 1616, - output_level = 1, - output = "name", - date = "2020-01-01" - ) - expect_equal(new[1], "Bergverksdrift og utvinning") -}) +test_that( + "apply_klass works for variant classification with Norwegian characters in the variant name", + { + dat <- c("05", "01") + new <- apply_klass( + dat, + classification = 6, + variant = 1616, + output_level = 1, + output = "name", + date = "2020-01-01" + ) + expect_equal(new[1], "Bergverksdrift og utvinning") + } +) test_that("An error is correctly returned in the case of a null vector", { @@ -106,50 +114,35 @@ test_that("An error is correctly returned in the case of a null vector", { }) -test_that("apply_klass works for classifications with varying number of digits", { - dat <- c("56", "580") - new <- apply_klass(dat, - klass = 270, - date = "2024-01-01" - ) - expect_false(new[1] == new[2]) - expect_false(all(is.na(new))) -}) +test_that("apply_klass works for classifications with varying number of digits", + { + dat <- c("56", "580") + new <- apply_klass(dat, classification = 270, date = "2024-01-01") + expect_false(new[1] == new[2]) + expect_false(all(is.na(new))) + }) test_that("Nace classification with missing formatting", { # simple example with all missing formatting dat <- c("01460", "45112", "45111", "45310") - expect_warning( - new <- apply_klass(dat, - klass = 6, - date = "2024-01-01" - ), - "Number missing .: 4" - ) + expect_warning(new <- apply_klass(dat, classification = 6, date = "2024-01-01"), + "Number missing .: 4") expect_equal(new[1], "Svinehold") - + # Check mixture of formatting dat <- c("45112", "45.111") - expect_warning( - new <- apply_klass(dat, - klass = 6, - date = "2024-01-01" - ), - "Number missing .: 1" - ) - expect_equal(new[1], "Detaljhandel med biler og lette motorvogner, unntatt motorsykler") - + expect_warning(new <- apply_klass(dat, classification = 6, date = "2024-01-01"), + "Number missing .: 1") + expect_equal(new[1], + "Detaljhandel med biler og lette motorvogner, unntatt motorsykler") + # checking NAs dat <- c("45.112", "45.111", NA) - expect_warning( - new <- apply_klass(dat, - klass = 6, - date = "2024-01-01" - ), - "Number of NA: 1" - ) - expect_equal(new[1], "Detaljhandel med biler og lette motorvogner, unntatt motorsykler") + expect_warning(new <- apply_klass(dat, classification = 6, date = "2024-01-01"), + "Number of NA: 1") + expect_equal(new[1], + "Detaljhandel med biler og lette motorvogner, unntatt motorsykler") expect_true(is.na(new[3])) }) @@ -158,54 +151,39 @@ test_that("Municipality classification with missing formatting", { # example with all missing leading 0 dat <- c("301", "301") expect_warning( - new <- apply_klass(dat, - klass = 131, - date = "2024-01-01" - ), + new <- apply_klass(dat, classification = 131, date = "2024-01-01"), "Number missing leading 0: 2" ) expect_equal(new[1], "Oslo") - + # simple example with all missing leading 0 dat <- c("301", "301") expect_warning( - new <- apply_klass(dat, - klass = 131, - date = "2024-01-01" - ), + new <- apply_klass(dat, classification = 131, date = "2024-01-01"), "Number missing leading 0: 2" ) expect_equal(new[1], "Oslo") - - + + # Check mixture of formatting dat <- c("45112", "45.111") - expect_warning( - new <- apply_klass(dat, - klass = 6, - date = "2024-01-01" - ), - "Number missing .: 1" - ) - expect_equal(new[1], "Detaljhandel med biler og lette motorvogner, unntatt motorsykler") + expect_warning(new <- apply_klass(dat, classification = 6, date = "2024-01-01"), + "Number missing .: 1") + expect_equal(new[1], + "Detaljhandel med biler og lette motorvogner, unntatt motorsykler") }) -test_that("apply_klass works for classifications with varying digits and letters", { - dat <- c("56", "580", "KG1") - new <- apply_klass(dat, - klass = 270, - date = "2024-01-01" - ) - expect_false(all(is.na(new))) - - dat <- c("01", "03b") - new2 <- apply_klass(dat, - klass = 207, - date = "2024-01-01" - ) - expect_false(all(is.na(new2))) -}) +test_that("apply_klass works for classifications with varying digits and letters", + { + dat <- c("56", "580", "KG1") + new <- apply_klass(dat, classification = 270, date = "2024-01-01") + expect_false(all(is.na(new))) + + dat <- c("01", "03b") + new2 <- apply_klass(dat, classification = 207, date = "2024-01-01") + expect_false(all(is.na(new2))) + }) test_that("An error is correctly returned in the case of a null vector", { diff --git a/tests/testthat/test_GetKlass.R b/tests/testthat/test_GetKlass.R index e6bbfc4..cdcc7d3 100644 --- a/tests/testthat/test_GetKlass.R +++ b/tests/testthat/test_GetKlass.R @@ -1,36 +1,35 @@ # Code for tests for the function get_klass test_that("get_klass returns a classification", { - class_data <- get_klass(klass = 131, date = "2015-01-01") + class_data <- get_klass(131, date = "2015-01-01") expect_equal(class_data$code[1], "0101") }) test_that("get_klass returns a classification with Norwegian letters", { - class_data <- get_klass(klass = 131, date = "2015-01-01") + class_data <- get_klass(131, date = "2015-01-01") expect_equal(class_data$name[8], "Rømskog") }) test_that("get_klass returns no error when no date given", { - expect_type(get_klass(klass = 131), type = "list") + expect_type(get_klass(131), type = "list") }) test_that("get_klass returns error when date in wrong format", { expect_error( - x <- get_klass(klass = 2, date = "01-01-2024"), + x <- get_klass(2, date = "01-01-2024"), "An incorrect date format was given. Please use format 'YYYY-mm-dd'." ) expect_error( - x <- get_klass(klass = 2, date = "20240101"), + x <- get_klass(2, date = "20240101"), "An incorrect date format was given. Please use format 'YYYY-mm-dd'." ) expect_error( - x <- get_klass( - klass = 2, date = c("2024-01-01", "2023-01-01", "2022-01-01"), + x <- get_klass(2, date = c("2024-01-01", "2023-01-01", "2022-01-01"), "You have provided too many dates." ) ) @@ -38,15 +37,15 @@ test_that("get_klass returns error when date in wrong format", { test_that("get_klass returns changes when two dates given", { - class_data1 <- get_klass(klass = 131, date = c("2022-01-01", "2023-01-01")) - class_data2 <- get_klass(klass = 131, date = c("2023-01-01", "2022-01-01")) + class_data1 <- get_klass(131, date = c("2022-01-01", "2023-01-01")) + class_data2 <- get_klass(131, date = c("2023-01-01", "2022-01-01")) expect_equal(nrow(class_data1), nrow(class_data2)) }) test_that("get_klass returns classifications with future date", { expect_message( - class_data <- get_klass(klass = 2, date = "2100-01-01"), + class_data <- get_klass(2, date = "2100-01-01"), "The date you selected is in the future. You may be viewing a future classification that is not currently valid" ) expect_equal(nrow(class_data), 2) @@ -54,8 +53,7 @@ test_that("get_klass returns classifications with future date", { test_that("get_klass returns correct output level", { - class_data <- get_klass( - klass = 7, date = "2024-01-01", + class_data <- get_klass(7, date = "2024-01-01", output_level = 1 ) expect_equal(nrow(class_data), 10) @@ -64,8 +62,7 @@ test_that("get_klass returns correct output level", { test_that("get_klass returns english language", { - class_data <- get_klass( - klass = 2, date = "2024-01-01", + class_data <- get_klass(2, date = "2024-01-01", language = "en" ) expect_equal(class_data$name, c("Male", "Female")) @@ -73,8 +70,7 @@ test_that("get_klass returns english language", { test_that("get_klass returns a correspondence table", { - class_data <- get_klass( - klass = 104, correspond = 131, + class_data <- get_klass(104, correspond = 131, date = "2015-01-01" ) expect_equal(class_data$sourceCode[1], "01") @@ -82,12 +78,10 @@ test_that("get_klass returns a correspondence table", { test_that("get_klass returns a correspondence table in both directions", { - class_data1 <- get_klass( - klass = 104, correspond = 131, + class_data1 <- get_klass(104, correspond = 131, date = "2020-02-01" ) - class_data2 <- get_klass( - klass = 131, correspond = 104, + class_data2 <- get_klass(131, correspond = 104, date = "2020-02-01" ) expect_equal(class_data1$sourceCode[1], "03") @@ -96,16 +90,16 @@ test_that("get_klass returns a correspondence table in both directions", { test_that("get_klass returns a valid variant including ones with spaces in name", { - variant_data <- get_klass(klass = 6, variant = 1616, date = "2021-01-02") + variant_data <- get_klass(6, variant = 1616, date = "2021-01-02") expect_equal(variant_data$name[2], "Jordbruk, skogbruk og fiske") - variant_data <- get_klass(klass = 6, variant = 1615, date = "2021-01-02") + variant_data <- get_klass(6, variant = 1615, date = "2021-01-02") expect_equal(variant_data$name[6], "Dyrking av ris") }) test_that("get_klass returns a correspondence table", { - cor_data1 <- get_klass(klass = 131, correspond = 127, date = "2024-01-02") - cor_data2 <- get_klass(klass = 127, correspond = 131, date = "2024-01-02") + cor_data1 <- get_klass(131, correspond = 127, date = "2024-01-02") + cor_data2 <- get_klass(127, correspond = 131, date = "2024-01-02") expect_gt(nrow(cor_data1), 1) @@ -125,7 +119,7 @@ test_that("get_klass fails quietly with invalid variant", { err <- NULL result <- tryCatch( { - variant_data <- get_klass(klass = 6, variant = 1, date = "2021-01-02") + variant_data <- get_klass(6, variant = 1, date = "2021-01-02") }, error = function(e) { err <<- e @@ -163,6 +157,6 @@ test_that("get_klass returns valid dates for a date range", { class_data <- get_klass(131, date = c("2020-01-01", "2024-01-02")) expect_equal(class_data$validFromInRequestedRange[1], "2020-01-01") - variant_data <- get_klass(klass = 6, variant = 1616, date = c("2020-01-01", "2024-01-02")) + variant_data <- get_klass(6, variant = 1616, date = c("2020-01-01", "2024-01-02")) expect_equal(variant_data$validFromInRequestedRange[1], "2020-01-01") }) diff --git a/tests/testthat/test_formattering.R b/tests/testthat/test_formattering.R index d3e6583..795b2a6 100644 --- a/tests/testthat/test_formattering.R +++ b/tests/testthat/test_formattering.R @@ -1,28 +1,22 @@ test_that("Formatting works for nace codes of differnt levels", { x <- c("01", "011", "0110", "01110") - suppressWarnings(codes <- klassR:::formattering(x, - klass = 6 - )) + suppressWarnings(codes <- klassR:::formattering(x, classification = 6)) expect_equal(codes, c("01", "01.1", "01.10", "01.110")) }) test_that("Formatting works for nace codes with letters", { x <- c("A", "01", "011", "0110", "01110") - suppressWarnings(codes <- klassR:::formattering(x, - klass = 6 - )) + suppressWarnings(codes <- klassR:::formattering(x, classification = 6)) expect_equal(codes, c("A", "01", "01.1", "01.10", "01.110")) }) test_that("Formatting works for kommune", { x <- c("301", "0301", "1101", "1103") - suppressWarnings(codes <- klassR:::formattering(x, - klass = 131 - )) + suppressWarnings(codes <- klassR:::formattering(x, classification = 131)) expect_equal(codes, c("0301", "0301", "1101", "1103")) }) test_that("Kommune fails when letters present", { x <- c("Oslo", "0301", "1101", "1103") - expect_error(codes <- klassR:::formattering(x, klass = 131)) + expect_error(codes <- klassR:::formattering(x, classification = 131)) }) From 57d88e37a0a0ad925c6b227cf672a8dc3a3cbd1d Mon Sep 17 00:00:00 2001 From: Jentoft Date: Fri, 15 Nov 2024 10:47:49 +0100 Subject: [PATCH 4/5] Wrapped slow examples in dontrun. --- R/UpdateKlass-graph-build.R | 8 +++++--- R/UpdateKlass-graph-navigate.R | 11 ++++++----- R/UpdateKlass.R | 2 ++ 3 files changed, 13 insertions(+), 8 deletions(-) diff --git a/R/UpdateKlass-graph-build.R b/R/UpdateKlass-graph-build.R index 50850af..2dc0c1a 100644 --- a/R/UpdateKlass-graph-build.R +++ b/R/UpdateKlass-graph-build.R @@ -39,13 +39,15 @@ get_klass_changes <- function(classification) { #' library(klassR) #' #' # Build a graph directed towards the most recent codes -#' +#' \dontrun{ #' klass_131 <- klass_graph(131) +#' } #' #' # Build a graph directed towards valid codes in 2020. -#' +#' \dontrun{ #' klass_131_2020 <- klass_graph(131, "2020-01-01") -#' +#' } +#' klass_graph <- function(classification, date = NULL) { if (is.null(classification)) stop("Please provide a classification ID.") diff --git a/R/UpdateKlass-graph-navigate.R b/R/UpdateKlass-graph-navigate.R index 433937e..ebf29bb 100644 --- a/R/UpdateKlass-graph-navigate.R +++ b/R/UpdateKlass-graph-navigate.R @@ -15,13 +15,15 @@ #' #' # Build a graph directed towards the most recent codes. #' library(klassR) +#' \dontrun{ #' klass_131 <- klass_graph(131) +#' } #' #' # Find the most recent node in the graph representing the code "0101" (Halden, #' # valid to 2020.) -#' +#' \dontrun{ #' halden_node <- klass_node(klass_131, "0101") -#' +#' } klass_node <- function(graph, x, date = NA) { if (!is.na(date)) { date <- as.Date(date[[1]]) @@ -154,12 +156,11 @@ is_combined <- function(graph, node, compare_node = NULL) { #' #' # Find the most recent node in the graph representing the code "0101" (Halden, #' # valid to 2020.) -#' #' halden_node <- klass_node(klass_131, "0101") -#' +#' #' # Find the most recent code corresponding to 0101 Halden -#' #' halden_node_updated <- update_klass_node(klass_131, halden_node) +#' #' update_klass_node <- function(graph, node) { bfs_result <- igraph::bfs( diff --git a/R/UpdateKlass.R b/R/UpdateKlass.R index 628278c..49ddc22 100644 --- a/R/UpdateKlass.R +++ b/R/UpdateKlass.R @@ -161,10 +161,12 @@ update_code <- function(graph, #' library(klassR) #' codes <- get_klass(131, date = "2020-01-01")[["code"]] #' +#' \dontrun{ #' updated_codes <- update_klass(codes, #' dates = "2020-01-01", #' classification = 131 #' ) +#' } #' update_klass <- function(codes, dates = NA, From c4d48da47534b90bee3a3646f2cb2340b0cbf03c Mon Sep 17 00:00:00 2001 From: sjentoft Date: Fri, 15 Nov 2024 09:49:52 +0000 Subject: [PATCH 5/5] Style code (GHA) --- R/Hent_data.R | 2 +- R/KLASS.R | 57 ++++++++-------- R/UpdateKlass-graph-build.R | 2 +- R/UpdateKlass-graph-navigate.R | 3 +- tests/testthat/test_ApplyKlass.R | 110 ++++++++++++++++++------------- tests/testthat/test_GetKlass.R | 18 +++-- 6 files changed, 109 insertions(+), 83 deletions(-) diff --git a/R/Hent_data.R b/R/Hent_data.R index ae204f7..62d7092 100644 --- a/R/Hent_data.R +++ b/R/Hent_data.R @@ -172,7 +172,7 @@ get_variant_name <- function(variant) { #' @keywords internal #' @return text in json format GetUrl2 <- function(url, check = TRUE) { - # Fetch contents from classfication + # Fetch contents from classfication if (check) { hent_klass <- check_connect(url) } else { diff --git a/R/KLASS.R b/R/KLASS.R index ba9f345..7317dda 100644 --- a/R/KLASS.R +++ b/R/KLASS.R @@ -31,11 +31,12 @@ MakeChar <- function(x) { #' #' @examples #' data(klassdata) -#' kommune_names <- apply_klass(x = klassdata$kommune, -#' classification = 131, -#' language = "en", -#' format = FALSE -#' ) +#' kommune_names <- apply_klass( +#' x = klassdata$kommune, +#' classification = 131, +#' language = "en", +#' format = FALSE +#' ) apply_klass <- function(x, classification, date = NULL, @@ -45,22 +46,21 @@ apply_klass <- function(x, output_level = NULL, output = "name", format = TRUE) { - # Check and standardise variables classification <- MakeChar(classification) if (is.null(x)) { stop("The input vector is empty.") } x <- MakeChar(x) - + if (is.null(date)) { date <- Sys.Date() } - + type <- ifelse(is.null(correspond), "vanlig", "kor") type <- ifelse(isTRUE(correspond), "change", type) type <- ifelse(is.null(variant), type, "variant") - + # Fetch classification table klass_data <- get_klass( classification, @@ -70,7 +70,7 @@ apply_klass <- function(x, language = language, output_level = NULL ) - + # Extract correspondence table if (type == "kor") { cor_table <- get_klass( @@ -79,7 +79,7 @@ apply_klass <- function(x, correspond = correspond, language = language ) # , output_level = output_level) - + new_table <- get_klass( classification = correspond, date = date, @@ -96,23 +96,25 @@ apply_klass <- function(x, output_level = NULL ) } - + # Formattering - only for nace and municipality if (format == TRUE & classification %in% c("6", "131")) { x_formatted <- formattering(x, classification = classification) } else { x_formatted <- x } - + # 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)) + if (is.null(output_level)) { output_level <- input_level - + } + if (!all(input_level == output_level) & - type %in% c("kor", "change")) + type %in% c("kor", "change")) { stop("Level changes and time changes/correspondence concurrently is not programmed.") - + } + # Run level function if (!all(input_level == output_level) & is.null(correspond)) { x_level <- Levels( @@ -121,39 +123,42 @@ apply_klass <- function(x, klass_data = klass_data ) } - + if (all(input_level == output_level)) { x_level <- klass_data[klass_data$level == input_level, ] x_level[, paste("level", input_level, sep = "")] <- x_level$code x_level[, paste("name", input_level, sep = "")] <- x_level$name } - - + + # run matching levelcode <- paste("level", input_level, sep = "") if (type %in% c("vanlig", "variant")) { m <- match(x_formatted, x_level[, levelcode]) ### sjekk rekkefolge } - + if (type == "kor") { m1 <- match(x_level[, levelcode], cor_table[, "sourceCode"]) m2 <- match(x_formatted, cor_table[, "sourceCode"]) m3 <- match(cor_table[, "targetCode"], new_table[, "code"]) ## ? } - + if (type == "change") { m1 <- match(x_formatted, x_level[, levelcode]) m2 <- match(x_formatted, cor_table$sourceCode) } - + # Choose format output if (type %in% c("vanlig", "variant")) { - if (output == "code") + if (output == "code") { vars <- paste("level", output_level, sep = "") - if (output == "name") + } + if (output == "name") { vars <- paste("name", output_level, sep = "") - if (output == "both") + } + if (output == "both") { vars <- paste(c("level", "name"), output_level, sep = "") + } out <- x_level[m, vars] } if (type == "kor") { diff --git a/R/UpdateKlass-graph-build.R b/R/UpdateKlass-graph-build.R index 2dc0c1a..bec6de3 100644 --- a/R/UpdateKlass-graph-build.R +++ b/R/UpdateKlass-graph-build.R @@ -47,7 +47,7 @@ get_klass_changes <- function(classification) { #' \dontrun{ #' klass_131_2020 <- klass_graph(131, "2020-01-01") #' } -#' +#' klass_graph <- function(classification, date = NULL) { if (is.null(classification)) stop("Please provide a classification ID.") diff --git a/R/UpdateKlass-graph-navigate.R b/R/UpdateKlass-graph-navigate.R index ebf29bb..9c7b737 100644 --- a/R/UpdateKlass-graph-navigate.R +++ b/R/UpdateKlass-graph-navigate.R @@ -157,10 +157,9 @@ is_combined <- function(graph, node, compare_node = NULL) { #' # Find the most recent node in the graph representing the code "0101" (Halden, #' # valid to 2020.) #' halden_node <- klass_node(klass_131, "0101") -#' +#' #' # Find the most recent code corresponding to 0101 Halden #' halden_node_updated <- update_klass_node(klass_131, halden_node) -#' #' update_klass_node <- function(graph, node) { bfs_result <- igraph::bfs( diff --git a/tests/testthat/test_ApplyKlass.R b/tests/testthat/test_ApplyKlass.R index 45494b5..cba0aa0 100644 --- a/tests/testthat/test_ApplyKlass.R +++ b/tests/testthat/test_ApplyKlass.R @@ -1,8 +1,9 @@ test_that("apply_klass returns correct names for numeric codes", { data(klassdata) kommune_names <- apply_klass(klassdata$kommune, - classification = 131, - date = "2015-01-01") + classification = 131, + date = "2015-01-01" + ) expect_equal(kommune_names[1], "Sandefjord") }) @@ -11,8 +12,9 @@ test_that("apply_klass returns correct names for numeric codes", { test_that("apply_klass returns correct names for numeric codes", { data(klassdata) kommune_names <- apply_klass(klassdata$kommune, - classification = 131, - date = "2015-01-01") + classification = 131, + date = "2015-01-01" + ) expect_equal(kommune_names[1], "Sandefjord") }) @@ -20,8 +22,9 @@ test_that("apply_klass returns correct names for numeric codes", { test_that("apply_klass returns correct names for character codes", { data(klassdata) sektor_names <- apply_klass(c("INNL", "UTL", "B_FIN"), - classification = 39, - date = "2019-01-01") + classification = 39, + date = "2019-01-01" + ) expect_equal(sektor_names[2], "Utlandet") }) @@ -74,13 +77,14 @@ test_that("Check levelCheck for character codes", { test_that("apply_klass can return a variant classification", { dat <- c("000", "101", "102", "103") dat <- c("01.21", "01.46", "10.61") - + dat_new <- klassR::apply_klass(dat, - classification = 6, - variant = 1616, - date = "2021-01-02") + classification = 6, + variant = 1616, + date = "2021-01-02" + ) expect_equal(dat_new[2], "Svinehold") - + dat_new <- klassR::apply_klass( dat, classification = 6, @@ -114,35 +118,44 @@ test_that("An error is correctly returned in the case of a null vector", { }) -test_that("apply_klass works for classifications with varying number of digits", - { - dat <- c("56", "580") - new <- apply_klass(dat, classification = 270, date = "2024-01-01") - expect_false(new[1] == new[2]) - expect_false(all(is.na(new))) - }) +test_that("apply_klass works for classifications with varying number of digits", { + dat <- c("56", "580") + new <- apply_klass(dat, classification = 270, date = "2024-01-01") + expect_false(new[1] == new[2]) + expect_false(all(is.na(new))) +}) test_that("Nace classification with missing formatting", { # simple example with all missing formatting dat <- c("01460", "45112", "45111", "45310") - expect_warning(new <- apply_klass(dat, classification = 6, date = "2024-01-01"), - "Number missing .: 4") + expect_warning( + new <- apply_klass(dat, classification = 6, date = "2024-01-01"), + "Number missing .: 4" + ) expect_equal(new[1], "Svinehold") - + # Check mixture of formatting dat <- c("45112", "45.111") - expect_warning(new <- apply_klass(dat, classification = 6, date = "2024-01-01"), - "Number missing .: 1") - expect_equal(new[1], - "Detaljhandel med biler og lette motorvogner, unntatt motorsykler") - + expect_warning( + new <- apply_klass(dat, classification = 6, date = "2024-01-01"), + "Number missing .: 1" + ) + expect_equal( + new[1], + "Detaljhandel med biler og lette motorvogner, unntatt motorsykler" + ) + # checking NAs dat <- c("45.112", "45.111", NA) - expect_warning(new <- apply_klass(dat, classification = 6, date = "2024-01-01"), - "Number of NA: 1") - expect_equal(new[1], - "Detaljhandel med biler og lette motorvogner, unntatt motorsykler") + expect_warning( + new <- apply_klass(dat, classification = 6, date = "2024-01-01"), + "Number of NA: 1" + ) + expect_equal( + new[1], + "Detaljhandel med biler og lette motorvogner, unntatt motorsykler" + ) expect_true(is.na(new[3])) }) @@ -155,7 +168,7 @@ test_that("Municipality classification with missing formatting", { "Number missing leading 0: 2" ) expect_equal(new[1], "Oslo") - + # simple example with all missing leading 0 dat <- c("301", "301") expect_warning( @@ -163,27 +176,30 @@ test_that("Municipality classification with missing formatting", { "Number missing leading 0: 2" ) expect_equal(new[1], "Oslo") - - + + # Check mixture of formatting dat <- c("45112", "45.111") - expect_warning(new <- apply_klass(dat, classification = 6, date = "2024-01-01"), - "Number missing .: 1") - expect_equal(new[1], - "Detaljhandel med biler og lette motorvogner, unntatt motorsykler") + expect_warning( + new <- apply_klass(dat, classification = 6, date = "2024-01-01"), + "Number missing .: 1" + ) + expect_equal( + new[1], + "Detaljhandel med biler og lette motorvogner, unntatt motorsykler" + ) }) -test_that("apply_klass works for classifications with varying digits and letters", - { - dat <- c("56", "580", "KG1") - new <- apply_klass(dat, classification = 270, date = "2024-01-01") - expect_false(all(is.na(new))) - - dat <- c("01", "03b") - new2 <- apply_klass(dat, classification = 207, date = "2024-01-01") - expect_false(all(is.na(new2))) - }) +test_that("apply_klass works for classifications with varying digits and letters", { + dat <- c("56", "580", "KG1") + new <- apply_klass(dat, classification = 270, date = "2024-01-01") + expect_false(all(is.na(new))) + + dat <- c("01", "03b") + new2 <- apply_klass(dat, classification = 207, date = "2024-01-01") + expect_false(all(is.na(new2))) +}) test_that("An error is correctly returned in the case of a null vector", { diff --git a/tests/testthat/test_GetKlass.R b/tests/testthat/test_GetKlass.R index cdcc7d3..56a4db0 100644 --- a/tests/testthat/test_GetKlass.R +++ b/tests/testthat/test_GetKlass.R @@ -29,7 +29,8 @@ test_that("get_klass returns error when date in wrong format", { ) expect_error( - x <- get_klass(2, date = c("2024-01-01", "2023-01-01", "2022-01-01"), + x <- get_klass(2, + date = c("2024-01-01", "2023-01-01", "2022-01-01"), "You have provided too many dates." ) ) @@ -53,7 +54,8 @@ test_that("get_klass returns classifications with future date", { test_that("get_klass returns correct output level", { - class_data <- get_klass(7, date = "2024-01-01", + class_data <- get_klass(7, + date = "2024-01-01", output_level = 1 ) expect_equal(nrow(class_data), 10) @@ -62,7 +64,8 @@ test_that("get_klass returns correct output level", { test_that("get_klass returns english language", { - class_data <- get_klass(2, date = "2024-01-01", + class_data <- get_klass(2, + date = "2024-01-01", language = "en" ) expect_equal(class_data$name, c("Male", "Female")) @@ -70,7 +73,8 @@ test_that("get_klass returns english language", { test_that("get_klass returns a correspondence table", { - class_data <- get_klass(104, correspond = 131, + class_data <- get_klass(104, + correspond = 131, date = "2015-01-01" ) expect_equal(class_data$sourceCode[1], "01") @@ -78,10 +82,12 @@ test_that("get_klass returns a correspondence table", { test_that("get_klass returns a correspondence table in both directions", { - class_data1 <- get_klass(104, correspond = 131, + class_data1 <- get_klass(104, + correspond = 131, date = "2020-02-01" ) - class_data2 <- get_klass(131, correspond = 104, + class_data2 <- get_klass(131, + correspond = 104, date = "2020-02-01" ) expect_equal(class_data1$sourceCode[1], "03")