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")