inst/tinytest/test-retain.R

In qol: Powerful 'SAS' Inspired Concepts for more Efficient Bigger Outputs

set_no_print(TRUE)

###############################################################################
# Suppressing some functions messages because they only output the information
# on how much time they took.
###############################################################################

test_df <- data.frame(
    var_by   = c(1, 1, 2, 3, 3),
    var_num  = c(1, NA, NA, 2, NA),
    var_num2 = c(1, 2, 3, 4, 5),
    var_char = c("a", NA, NA, "b", NA),
    var_sum  = c(1, 1, 1, 1, 1))

test_df2 <- data.frame(
    var1 = c(1, 1, 2, 2, 2, 3, 3, 3),
    var2 = c(3, 3, 2, 2, 2, 1, 1, 1))

dummy_df <- dummy_data(10)


# Generate running number without by
test_df[["run_nr"]] <- test_df |> running_number()

expect_equal(test_df[["run_nr"]], c(1, 2, 3, 4, 5), info = "Generate running number without by")


# Generate running number with by
test_df[["run_nr"]] <- test_df |> running_number(by = var_by)

expect_equal(test_df[["run_nr"]], c(1, 2, 1, 1, 2), info = "Generate running number with by")


# Generate running number with by and sort
test_df2[["run_nr"]] <- test_df2 |> running_number(by = c(var2, var1), sort = TRUE)

expect_equal(test_df2[["run_nr"]], c(1, 2, 3, 1, 2, 3, 1, 2), info = "Generate running number with by and sort")


# Generate running number with by and group
test_df2[["run_nr"]] <- test_df2 |> running_number(by = c(var2, var1), sort = TRUE, group_nr = TRUE)

expect_equal(test_df2[["run_nr"]], c(1, 1, 1, 2, 2, 2, 3, 3), info = "Generate running number with by and group")


# Mark first and last cases without by
test_df[["first"]] <- test_df |> mark_case()
test_df[["last"]]  <- test_df |> mark_case(first = FALSE)

expect_equal(test_df[["first"]], c(1, 0, 0, 0, 0), info = "Mark first and last cases without by")
expect_equal(test_df[["last"]],  c(0, 0, 0, 0, 1), info = "Mark first and last cases without by")


# Mark first and last cases with by
test_df[["first"]] <- test_df |> mark_case(by = var_by)
test_df[["last"]]  <- test_df |> mark_case(by = var_by, first = FALSE)

expect_equal(test_df[["first"]], c(1, 0, 1, 1, 0), info = "Mark first and last cases with by")
expect_equal(test_df[["last"]],  c(0, 1, 1, 0, 1), info = "Mark first and last cases with by")


# Retain value without by
test_df[["retain_value"]] <- test_df |>
    retain_value(values = var_num)

expect_equal(test_df[["retain_value"]], c(1, 1, 1, 1, 1), info = "Retain value without by")


# Retain value with by
test_df[["retain_value"]] <- test_df |>
      retain_value(values = var_num, by = var_by)

expect_equal(test_df[["retain_value"]], c(1, 1, NA, 2, 2), info = "Retain value with by")


# Retain character value
test_df[["retain_value"]] <- test_df |>
      retain_value(values = var_char)

expect_equal(test_df[["retain_value"]], c("a", "a", "a", "a", "a"), info = "Retain character value")


# Retain multiple values
test_df[, c("var_num_first", "var_char_first")] <-
    test_df |>
      retain_value(values = c(var_num, var_char),
                   by    = c(var_sum, var_by))

expect_equal(test_df[["var_num_first"]],  c(1, 1, NA, 2, 2), info = "Retain multiple values")
expect_equal(test_df[["var_char_first"]], c("a", "a", NA, "b", "b"), info = "Retain multiple values")


# Retain sum without by
test_df[["retain_stat"]] <- test_df |>
      retain_stat(values = var_sum)

expect_equal(test_df[["retain_stat"]], c(5, 5, 5, 5, 5), info = "Retain sum without by")


# Retain sum with by
test_df[["retain_stat"]] <- test_df |>
      retain_stat(values = var_sum, by = var_by)

expect_equal(test_df[["retain_stat"]], c(2, 2, 1, 2, 2), info = "Retain sum with by")


# Retain multiple sums
test_df[, c("var_num_sum", "var_num2_sum")] <-
    test_df |>
      retain_stat(values = c(var_num, var_num2),
                  by    = c(var_sum, var_by))

expect_equal(test_df[["var_num_sum"]],  c(1, 1, NA, 2, 2), info = "Retain multiple sums")
expect_equal(test_df[["var_num2_sum"]], c(3, 3, 3, 9, 9), info = "Retain multiple sums")


# Retain columns in a data frame and order them to the front
retain_df <- dummy_df |>
      retain_variables(age, sex, income)

expect_equal(names(retain_df)[1:3], c("age", "sex", "income"), info = "Retain columns in a data frame and order them to the front")


# Retain columns in a data frame and order them to the end
retain_df <- dummy_df |>
      retain_variables(age, sex, income, order_last = TRUE)

expect_equal(utils::tail(names(retain_df), 3), c("age", "sex", "income"), info = "Retain columns in a data frame and order them to the end")


# Retain column ranges in a data frame
retain_df <- dummy_df |>
      retain_variables(age:education)

expect_equal(names(retain_df)[1:3], c("age", "sex", "education"), info = "Retain column ranges in a data frame")


# Add new single NA columns with retain
retain_df <- dummy_df |>
      retain_variables(status, new_var, test_var)

expect_equal(names(retain_df)[1:3], c("status", "new_var", "test_var"), info = "Add new single NA columns with retain")


# Add new NA column range with retain
retain_df <- dummy_df |>
      retain_variables(status1:status3)

expect_equal(names(retain_df)[1:3], c("status1", "status2", "status3"), info = "Add new NA column range with retain")


# Retain variables starting with letter
retain_df1 <- dummy_df |>
      retain_variables("s:")

retain_df2 <- dummy_df |>
      retain_variables("s:", order_last = TRUE)

expect_equal(names(retain_df1)[1:2], c("state", "sex"), info = "Retain variables starting with letter")
expect_equal(utils::tail(names(retain_df2), 2), c("state", "sex"), info = "Retain variables starting with letter")


# Retain variables ending with letter
retain_df1 <- dummy_df |>
      retain_variables(":id")

retain_df2 <- dummy_df |>
      retain_variables(":id", order_last = TRUE)

expect_equal(names(retain_df1)[1:2], c("household_id", "person_id"), info = "Retain variables ending with letter")
expect_equal(utils::tail(names(retain_df2), 2), c("household_id", "person_id"), info = "Retain variables ending with letter")


# Retain variables containing letter
retain_df1 <- dummy_df |>
      retain_variables(":on:")

retain_df2 <- dummy_df |>
      retain_variables(":on:", order_last = TRUE)

expect_equal(names(retain_df1)[1:3], c("person_id", "number_of_persons", "first_person"), info = "Retain variables containing letter")
expect_equal(utils::tail(names(retain_df2), 3), c("number_of_persons", "first_person", "education"), info = "Retain variables containing letter")


# Retain variables with all actions together doesn't break
retain_df <- dummy_df |>
      retain_variables(age:education, "s:", ":id", ":on:", status1:status3, income)

expect_equal(names(retain_df)[1:12], c("age", "sex", "education", "state", "household_id", "person_id",
                                       "number_of_persons", "first_person", "status1", "status2", "status3",
                                       "income"), info = "Retain variables with all actions together doesn't break")

###############################################################################
# Note checks
###############################################################################

# Generate running number with multiple by variables
dummy_df[["run_nr"]] <- dummy_df |> running_number(by = c(year, sex))

expect_message(print_stack_as_messages("NOTE"), "Running number is generated in current data frame order.", info = "Generate running number with multiple by variables")


# Mark first and last cases with multiple by variables
dummy_df[["first"]] <- dummy_df |> mark_case(by = c(sex, household_id))

expect_message(print_stack_as_messages("NOTE"), "Cases are marked in current data frame order.", info = "Mark first and last cases with multiple by variables")


dummy_df[["last"]] <- dummy_df |> mark_case(by = c(sex, household_id), first = FALSE)

expect_message(print_stack_as_messages("NOTE"), "Cases are marked in current data frame order.", info = "Mark first and last cases with multiple by variables")

expect_true(all(c("first", "last") %in% names(dummy_df)), info = "Mark first and last cases with multiple by variables")

###############################################################################
# Abort checks
###############################################################################

# Retain value without providing a value
dummy_df[["retain_value"]] <- dummy_df |> retain_value()

expect_error(print_stack_as_messages("ERROR"), "Must provide <values> to retain. Retain will be aborted.", info = "Retain value without providing a value")


# Retain sum without providing sum_of
dummy_df[["retain_stat"]] <- dummy_df |> retain_stat()

expect_error(print_stack_as_messages("ERROR"), "Must provide a <values> to retain. Retain will be aborted.", info = "Retain sum without providing sum_of")


# Add new NA column range with wrong pattern returns original data frame
retain_df <- (dummy_df |>
     retain_variables(status1:age3))

expect_error(print_stack_as_messages("ERROR"), "Variable range has to be provided in the form 'var_name1:var_name10'.", info = "Add new NA column range with wrong pattern returns original data frame")

expect_equal(dummy_df, retain_df, info = "Add new NA column range with wrong pattern returns original data frame")


set_no_print()