Corrects handling of partially labelled data

R/utils.R

@@ -230,41 +230,54 @@ times_summary <- function(dataset, column) {
 
 
 label_summary <- function(dataset, column) {
-  label_values <-
-    as.data.frame(attributes(dataset[[column]])$labels) |>
-    rownames_to_column()
 
-  names(label_values)[1] <- "label"
-  names(label_values)[2] <- "value"
+  if (length(unique(dataset[[column]])) ==
+      length(attr(dataset[[column]], "labels"))) {
 
-  label_values$summary <-
-    paste(label_values$label, " (", label_values$value, ")",
-          sep = "")
+    label_values <-
+      as.data.frame(attributes(dataset[[column]])$labels) |>
+      tibble::rownames_to_column()
 
-  a <- as.data.frame(table(dataset[[column]]))
-  names(a)[1] <- "num_val"
-  names(a)[2] <- "value"
+    names(label_values)[1] <- "label"
+    names(label_values)[2] <- "value"
 
-  a <- merge(a, label_values, by.x = "num_val", by.y = "value")
+    label_values$summary <-
+      paste(label_values$label, " (", label_values$value, ")",
+            sep = "")
 
-  a$item <- ""
-  a$item[1] <- gsub('"', '', deparse(column))
+    a <- as.data.frame(table(dataset[[column]]))
+    names(a)[1] <- "num_val"
+    names(a)[2] <- "value"
 
-  a$class <- ""
-  a$class[1] <-
-    paste(class(dataset[[column]]), sep = " ", collapse = " ")
+    a <- merge(a, label_values, by.x = "num_val", by.y = "value")
 
-  a$label <- ""
-  a$label[1] <- ifelse(is.null(attr(dataset[[column]], "label")),
-                       "No label", attr(dataset[[column]], "label"))
+    a$item <- ""
+    a$item[1] <- gsub('"', '', deparse(column))
 
-  vars <- c("item", "label", "class", "summary", "value")
-  a <- a[, vars]
-  a[nrow(a) + 1, ] <-
-    c("", "", "", "missing", sum(is.na(dataset[[column]])))
-  a$value <- as.character(a$value)
+    a$class <- ""
+    a$class[1] <-
+      paste(class(dataset[[column]]), sep = " ", collapse = " ")
 
-  return(a)
+    a$label <- ""
+    a$label[1] <- ifelse(is.null(attr(dataset[[column]], "label")),
+                         "No label", attr(dataset[[column]], "label"))
+
+    vars <- c("item", "label", "class", "summary", "value")
+    a <- a[, vars]
+    a[nrow(a) + 1, ] <-
+      c("", "", "", "missing", sum(is.na(dataset[[column]])))
+    a$value <- as.character(a$value)
+
+    return(a)
+
+  } else {
+
+    msg <- paste0(column, " has different numbers of labels and levels. It has been treated as numeric")
+    warning(msg)
+
+    numeric_summary(dataset = dataset, column = column)
+
+  }
 
 }
 

tests/testthat/test-create_dictionary.R

@@ -25,7 +25,7 @@ testthat::test_that("dictionary",{
   )
 
   testthat::expect_equal(over$value[2],
-                         "14"
+                         "15"
   )
 
   # dimensions of object
@@ -34,7 +34,7 @@ testthat::test_that("dictionary",{
     id_var = "id")
 
   testthat::expect_equal(nrow(len),
-    62
+    67
   )
 
   # id var properly summarised
@@ -59,7 +59,8 @@ testthat::test_that("dictionary",{
     lab_location = "Location",
     effective_date = "Date recorded",
     all_missing = "Missing data",
-    time_recorded = "Time recorded"
+    time_recorded = "Time recorded",
+    labelled_data = "Labelled"
                    )
 
   lab <- create_dictionary(

tests/testthat/test-summarise_variable.R

@@ -26,6 +26,14 @@ testthat::test_that("error", {
       "bad_factor"),
     "bad_factor has more than 10 levels, did you want a character variable?"
   )
+
+  testthat::expect_warning(
+    summarise_variable(
+      readRDS(file = testthat::test_path("testdata", 'tester.rds')),
+      "bad_labels"),
+    "bad_labels has different numbers of labels and levels. It has been treated as numeric"
+    )
+
 })
 
 # test each data class
@@ -78,7 +86,17 @@ testthat::test_that("classes", {
 
   testthat::expect_equal(
     s$summary[3],
-    "Vic (4)"
+    "Qld (3)"
+  )
+
+  # haven partially labelled
+  p <- summarise_variable(
+    readRDS(file = testthat::test_path("testdata", 'tester.rds')),
+    "bad_labels")
+
+  testthat::expect_equal(
+    p$summary[1],
+    "mean"
   )
 
   # difftime