tests/testthat/test-row-to-names.R

In sfirke/janitor: Simple Tools for Examining and Cleaning Dirty Data

example_data_row_to_names <-
  list(
    non_factor_data.frame =
      data.frame(
        X__1 = c(NA, "Title", 1:3),
        X__2 = c(NA, "Title2", 4:6),
        stringsAsFactors = FALSE
      ),
    factor_data.frame =
      data.frame(
        X__1 = c(NA, "Title", 1:3),
        X__2 = c(NA, "Title2", 4:6),
        stringsAsFactors = TRUE
      )
  )

example_data_row_to_names[[3]] <- tibble::as_tibble(example_data_row_to_names[[1]])
names(example_data_row_to_names)[3] <- "tibble"

test_that("row_to_names invalid and semi-valid input checking", {
  expect_error(
    row_to_names(example_data_row_to_names[[1]], row_number = 1, remove_row = "A"),
    regexp = "remove_row must be either TRUE or FALSE, not A",
    fixed = TRUE
  )
  expect_error(
    row_to_names(example_data_row_to_names[[1]], row_number = 1, remove_rows_above = "A"),
    regexp = "remove_rows_above must be either TRUE or FALSE, not A",
    fixed = TRUE
  )

  for (nm in names(example_data_row_to_names)) {
    expect_warning(
      example_data_row_to_names[[nm]] %>%
        row_to_names(row_number = 1),
      regexp = "Row 1 does not provide unique names. Consider running clean_names() after row_to_names()",
      info = paste("Unique name warning,", nm),
      fixed = TRUE
    )
  }

  # This loop is a test of issue 452 silencing the warning
  for (nm in names(example_data_row_to_names)) {
    expect_silent(
      suppressWarnings(
        example_data_row_to_names[[nm]] %>%
          row_to_names(row_number = 1),
        classes = "janitor_warn_row_to_names_not_unique"
      )
    )
  }

  expect_error(
    row_to_names(example_data_row_to_names[[1]], row_number = "foo"),
    regexp = "row_number must be a numeric value or 'find_header'",
    fixed = TRUE
  )

  expect_error(
    row_to_names(
      example_data_row_to_names[[1]],
      row_number = 1, remove_row = TRUE, remove_rows_above = TRUE,
      "foo"
    ),
    regexp = "Extra arguments (...) may only be given if row_number = 'find_header'.",
    fixed = TRUE
  )

  expect_error(
    row_to_names(
      example_data_row_to_names[[1]],
      row_number = 1, remove_row = TRUE, remove_rows_above = TRUE,
      sep = 8
    ),
    regexp = "`sep` must be of type `character`.",
    fixed = TRUE
  )

  expect_error(
    row_to_names(
      example_data_row_to_names[[1]],
      row_number = 1, remove_row = TRUE, remove_rows_above = TRUE,
      sep = c("_", "-")
    ),
    regexp = "`sep` must be of length 1.",
    fixed = TRUE
  )

  expect_error(
    row_to_names(
      example_data_row_to_names[[1]],
      row_number = 1, remove_row = TRUE, remove_rows_above = TRUE,
      sep = NA_character_
    ),
    regexp = "`sep` can't be of type `NA_character_`.",
    fixed = TRUE
  )
})

test_that("row_to_names works on factor columns", {
  expect_equal(
    example_data_row_to_names$factor_data.frame %>%
      row_to_names(row_number = 2) %>%
      names(),
    c("Title", "Title2"),
    info = "Works on factors"
  )
})

test_that("row_to_names rows are accurately removed", {
  for (nm in names(example_data_row_to_names)) {
    expect_equal(
      example_data_row_to_names[[nm]] %>%
        row_to_names(row_number = 2),
      example_data_row_to_names[[nm]][3:nrow(example_data_row_to_names[[nm]]), , drop = FALSE] %>%
        setNames(nm = c("Title", "Title2")),
      info = paste("All rows are dropped when requested,", nm)
    )
    for (remove_row_flag in c(FALSE, TRUE)) {
      remove_row_drop <- 2[remove_row_flag]
      for (remove_row_above_flag in c(FALSE, TRUE)) {
        remove_row_above_drop <- 1[remove_row_above_flag]
        keep_rows <- setdiff(
          seq_len(nrow(example_data_row_to_names[[nm]])),
          c(remove_row_drop, remove_row_above_drop)
        )
        expect_equal(
          example_data_row_to_names[[nm]] %>%
            row_to_names(
              row_number = 2,
              remove_row = remove_row_flag,
              remove_rows_above = remove_row_above_flag
            ),
          example_data_row_to_names[[nm]][keep_rows, , drop = FALSE] %>%
            setNames(nm = c("Title", "Title2")),
          info = paste0(
            "Appropriate rows are dropped when requested with explicit information about remove_row=",
            remove_row_flag,
            " and remove_rows_above=",
            remove_row_above_flag, ",", nm
          )
        )

        expect_equal(
          example_data_row_to_names[[nm]][, 1, drop = FALSE] %>%
            row_to_names(
              row_number = 2,
              remove_row = remove_row_flag,
              remove_rows_above = remove_row_above_flag
            ),
          example_data_row_to_names[[nm]][keep_rows, 1, drop = FALSE] %>%
            setNames(nm = c("Title")),
          info = paste0(
            "With single-column data the result is single-column data.frame still (not a vector) and appropriate rows are dropped when requested with explicit information about remove_row=",
            remove_row_flag,
            " and remove_rows_above=",
            remove_row_above_flag, ",", nm
          )
        )
      }
    }
  }
})

test_that("row_to_names works on matrices (Fix #320)", {
  expect_equal(
    row_to_names(matrix(LETTERS[1:4], nrow = 2, ncol = 2), row_number = 1),
    matrix(c("B", "D"), nrow = 1, dimnames = list(NULL, c("A", "C")))
  )
})

test_that("find_header works", {
  no_complete <-
    data.frame(
      A = NA_character_,
      stringsAsFactors = FALSE
    )
  expect_error(
    find_header(no_complete, "A", "B"),
    regexp = "Either zero or one arguments other than 'dat' may be provided.",
    fixed = TRUE
  )
  expect_error(
    find_header(no_complete),
    regexp = "No complete rows (rows with zero NA values) were found.",
    fixed = TRUE
  )
  all_partial <-
    data.frame(
      A = c(NA_character_, "A"),
      B = c("B", NA_character_),
      stringsAsFactors = FALSE
    )
  expect_error(
    find_header(all_partial),
    regexp = "No complete rows (rows with zero NA values) were found.",
    fixed = TRUE
  )
  single_complete <-
    data.frame(
      A = c(NA_character_, "A"),
      B = c("B", "B"),
      stringsAsFactors = FALSE
    )
  expect_equal(find_header(single_complete), 2)
  expect_equal(find_header(single_complete, "A"), 2)
  expect_error(
    find_header(single_complete, "C"),
    regexp = "The string 'C' was not found in column 1",
    fixed = TRUE
  )
  expect_warning(
    expect_equal(
      find_header(single_complete, "B" = 2),
      1
    ),
    regexp = "The string 'B' was found 2 times in column 2, using the first row where it was found"
  )
  multiple_complete <-
    data.frame(
      A = c("A", "A"),
      B = c("B", "B"),
      stringsAsFactors = FALSE
    )
  expect_equal(find_header(multiple_complete), 1)
  expect_equal(
    find_header(data.frame(A = c(NA, "B", "C", "D"), B = c("C", "D", "E", "F")), "E" = 2),
    3,
    info = "Use a nontrivial example of finding a row value"
  )
})

test_that("find_header works within row_to_names", {
  single_complete <-
    data.frame(
      A = c(NA_character_, "C"),
      B = c("D", "D"),
      stringsAsFactors = FALSE
    )
  expect_equal(
    row_to_names(dat = single_complete, row_number = "find_header"),
    data.frame(C = NA_character_, D = NA_character_, stringsAsFactors = FALSE)[-1, ]
  )

  find_correct <-
    data.frame(
      A = c(NA_character_, "C", "D", "E"),
      B = c("D", "D", "E", "F"),
      stringsAsFactors = FALSE
    )
  expect_equal(
    row_to_names(dat = find_correct, row_number = "find_header"),
    setNames(find_correct[3:nrow(find_correct), ], c("C", "D"))
  )
  expect_equal(
    row_to_names(dat = find_correct, row_number = "find_header", "D"),
    setNames(find_correct[4:nrow(find_correct), ], c("D", "E"))
  )
  expect_equal(
    row_to_names(dat = find_correct, row_number = "find_header", "E" = 2),
    setNames(find_correct[4:nrow(find_correct), ], c("D", "E"))
  )
})

test_that("multiple rows input works", {
  df_multiple_na <- example_data_row_to_names[[1]]
  df_multiple_na[6:7, ] <- NA
  df_multiple_na[8:10, ] <- ""

  expect_equal(
    suppressWarnings(
      row_to_names(example_data_row_to_names[[1]], row_number = 1) %>%
        names()
    ),
    c("NA", "NA")
  )

  expect_equal(
    suppressWarnings(
      row_to_names(example_data_row_to_names[[1]], row_number = c(1, 1)) %>%
        names()
    ),
    c("NA", "NA")
  )

  expect_equal(
    row_to_names(example_data_row_to_names[[1]], row_number = 1:2) %>%
      names(),
    c("Title", "Title2")
  )

  expect_equal(
    row_to_names(example_data_row_to_names[[1]], row_number = 1:5) %>%
      names(),
    c("Title_1_2_3", "Title2_4_5_6")
  )

  expect_equal(
    suppressWarnings(
      row_to_names(df_multiple_na, row_number = c(1, 6, 7), remove_rows_above = FALSE) %>%
        names()
    ),
    c("NA", "NA")
  )

  expect_equal(
    row_to_names(example_data_row_to_names[[1]][, 1, drop = FALSE], row_number = 1:5) %>%
      names(),
    "Title_1_2_3"
  )

  expect_equal(
    suppressWarnings(
      row_to_names(df_multiple_na, row_number = c(8:10), remove_rows_above = FALSE) %>%
        names()
    ),
    c("__", "__")
  )
})