tests/testthat/test-round-list.R

In pbs-assess/gfutilities: Groundfish Utility Functions

context("Test the round_list() and round_data_frame() functions")

scalar <- 3.1415926535897
scalar_lst <- list(scalar)
vec1 <- c(1.9832145656882,
          2.3122547858673,
          scalar,
          4.0207897891010)
vec2 <- vec1 * 2
vec3 <- vec1 * 3

df1 <- data.frame(a = vec1, b = vec2)
df2 <- data.frame(a = vec1, b = vec2, d = vec3)
m1 <- as.matrix(df1)
m2 <- as.matrix(df2)
lst <- list(lst_aa = vec1,
            lst_bb = df1)
lst_with_vec_of_chars <- list(lst,
                              c("a", "b", "c"))
lst_with_lst_of_chars <- list(lst,
                              list("a", "b", "c"))
lst_with_vec_and_lst_of_chars <- list(lst_with_vec_of_chars,
                                      lst_with_lst_of_chars)
lst_lst <- list(lst_lst_aa = vec1,
                lst_lst_bb = lst)
lst1 <- list(lst1_aa = vec1,
             lst1_bb = df1,
             lst1_cc = m1)
lst_double <- list(lst, lst1)
lst2 <- list(lst2_aa = lst,
             lst2_bb = df2,
             lst2_cc = list(lst, lst1))

df <- data.frame(a = vec1,
                 b = c("Hello", "World", "!", "!"))
df_char <- df
df_char$b <- as.character(df_char$b)

arr_3d <- array(data = rep(vec1, 10),
                dim = c(2, 4, 5),
                dimnames = list(c("a1", "a2"),
                                c("b1", "b2", "b3", "b4"),
                                c("c1", "c2", "c3", "c4", "c5")))

arr_4d <- array(data = rep(vec1, 20),
                dim = c(2, 4, 5, 2),
                dimnames = list(c("a1", "a2"),
                                c("b1", "b2", "b3", "b4"),
                                c("c1", "c2", "c3", "c4", "c5"),
                                c("d1", "d2")))

arr_5d <- array(data = rep(vec1, 60),
                dim = c(2, 4, 5, 2, 3),
                dimnames = list(c("a1", "a2"),
                                c("b1", "b2", "b3", "b4"),
                                c("c1", "c2", "c3", "c4", "c5"),
                                c("d1", "d2"),
                                c("e1", "e2", "e3")))

arr_6d <- array(data = rep(vec1, 120),
                dim = c(2, 4, 5, 2, 3, 2),
                dimnames = list(c("a1", "a2"),
                                c("b1", "b2", "b3", "b4"),
                                c("c1", "c2", "c3", "c4", "c5"),
                                c("d1", "d2"),
                                c("e1", "e2", "e3"),
                                c("f1", "f2")))

lst_with_arr <- list(vec = vec1,
                     lst = lst,
                     arr3 = arr_3d,
                     arr4 = arr_4d,
                     arr5 = arr_5d)

tbl <- tibble::tribble(
  ~a,     ~b,     ~d,
  1.0123, 2.349586, 1.29000002,
  2.4945, 3.344319, 4.29817376)

lst_zero_length_elem <- list(lst,
                             list(foo = double(),
                                  bar = integer()))

# This is class integer
ages <- 0:20

# Integer column
tbl_int <- tibble::tribble(
  ~a,       ~b,         ~d,
  1L, 2.349586, 1.29000002,
  2L, 3.344319, 4.29817376) #%>% mutate(a = as.integer(a))

test_that("round_data_frame() - Tests for correct output", {
  # Test data frame with a factor column
  j <- round_data_frame(df, 2)
  expect_equal(str(j), str(df))
  expect_equal(j$a, c(1.98, 2.31, 3.14, 4.02))
  # Test data frame with a character column
  j <- round_data_frame(df_char, 2)
  expect_equal(str(j), str(df_char))
  expect_equal(j$a, c(1.98, 2.31, 3.14, 4.02))

  # Integer column remains Integer
  j <- round_data_frame(tbl_int, 2)
  expect_equal(str(j), str(tbl_int))
  expect_equal(class(j$a), "integer")
})

test_that("round_3d_array() - Tests for correct output", {
  j <- round_3d_array(arr_3d, 2)
  expect_equal(str(j), str(arr_3d))

  expect_error(round_3d_array(arr_4d, 2))
})

test_that("round_4d_array() - Tests for correct output", {
  j <- round_4d_array(arr_4d, 2)
  expect_equal(str(j), str(arr_4d))

  expect_error(round_4d_array(arr_5d, 2))
})

test_that("round_5d_array() - Tests for correct output", {
  j <- round_5d_array(arr_5d, 2)
  expect_equal(str(j), str(arr_5d))

  expect_error(round_5d_array(arr_3d, 2))
})

test_that("round_list() - Tests for correct output", {
  expect_equal(round_list(), NULL)

  # Integer
  j <- round_list(ages)
  expect_equal(j, ages)
  expect_equal(class(j), class(ages))
  expect_equal(class(j), "integer")

  # Matrix
  j <- round_list(m1)
  act <- matrix(c(1.98, 2.31, 3.14, 4.02, 3.97, 4.62, 6.28, 8.04), nrow = 4)
  colnames(act) <- c("a", "b")
  expect_equal(j, act)

  # 6D Array (not implemented)
  expect_error(round_list(arr_6d))

  expect_equal(round_list(scalar, 2), 3.14)
  j <- round_list(scalar_lst, 2)
  expect_equal(str(j), str(scalar_lst))
  expect_equal(j[[1]], 3.14)
  j <- round_list(lst, 2)
  expect_equal(str(j), str(lst))
  j <- round_list(lst_lst, 2)
  expect_equal(str(j), str(lst_lst))
  j <- round_list(lst_with_arr, 2)
  expect_equal(str(j), str(lst_with_arr))
  # For some reason the following two tests fail on travis-CI but pass on devtools::test()
  # j <- round_list(lst2, 2)
  # expect_equal(str(j), str(lst2))
  # j <- round_list(lst_double, 2)
  # expect_equal(str(j), str(lst_double))

  # Lists with character values and lists of lists with character values
  j <- round_list(lst_with_vec_of_chars, 2)
  expect_equal(str(j), str(lst_with_vec_of_chars))
  j <- round_list(lst_with_lst_of_chars, 2)
  expect_equal(str(j), str(lst_with_lst_of_chars))
  j <- round_list(lst_with_vec_and_lst_of_chars, 2)
  expect_equal(str(j), str(lst_with_vec_and_lst_of_chars))

  # Check number of decimal points returned is correct
  j <- round_list(scalar_lst, 1)
  expect_equal(j[[1]], 3.1)
  j <- round_list(scalar_lst, 2)
  expect_equal(j[[1]], 3.14)
  j <- round_list(scalar_lst, 3)
  expect_equal(j[[1]], 3.142)
  j <- round_list(scalar_lst, 4)
  expect_equal(j[[1]], 3.1416)
  j <- round_list(scalar_lst, 5)
  expect_equal(j[[1]], 3.14159)
  j <- round_list(scalar_lst, 6)
  expect_equal(j[[1]], 3.141593)

  j <- round_list(lst, 1)
  expect_equal(j$lst_aa[2], 2.3)
  expect_equal(j$lst_aa[3], 3.1)
  expect_equal(j$lst_bb[2, 1], 2.3)
  expect_equal(j$lst_bb[3, 1], 3.1)
  expect_equal(j$lst_bb[2, 2], 4.6)
  expect_equal(j$lst_bb[3, 2], 6.3)

  j <- round_list(lst, 3)
  expect_equal(j$lst_aa[2], 2.312)
  expect_equal(j$lst_aa[3], 3.142)
  expect_equal(j$lst_bb[2, 1], 2.312)
  expect_equal(j$lst_bb[3, 1], 3.142)
  expect_equal(j$lst_bb[2, 2], 4.625)
  expect_equal(j$lst_bb[3, 2], 6.283)

  # Tibbles are still tibbles after
  j <- round_list(tbl, 2)
  expect_equal(str(j), str(tbl))
  expect_equal(unlist(j[1, 1], use.names = FALSE), 1.01)
  expect_equal(unlist(j[1, 2], use.names = FALSE), 2.35)
  expect_equal(unlist(j[1, 3], use.names = FALSE), 1.29)
  expect_equal(unlist(j[2, 1], use.names = FALSE), 2.49)
  expect_equal(unlist(j[2, 2], use.names = FALSE), 3.34)
  expect_equal(unlist(j[2, 3], use.names = FALSE), 4.3)

  # An element has zero-length
  expect_error(suppressWarnings(round_list(lst_zero_length_elem)))

})