tidytlg/tests/testthat/test-gentlg.R at 5a8a66426f0b69112905fd7eb9c89508491b5b0f · pharmaverse/tidytlg · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
df <- data.frame(label = c("boy", "girl"), name = c("Bob", "Lily"), age = c(12, 15))

test_that("custom alignments work", {
  df <- data.frame(label = c("boy", "girl"), name = c("Bob", "Lily"), age = c(12, 15))

  # `alignments` must be a list of named lists
  expect_error(gentlg(huxme = df, print.hux = FALSE, alignments = 1), "`alignments` must be a list")

  expect_error(gentlg(huxme = df, print.hux = FALSE, alignments = list(1)), "Each item of `alignments` must be a list")

  # Apply alignments to one data frame
  hux_table <- gentlg(
    huxme = df,
    print.hux = FALSE,
    alignments = list(
      list(
        row = 1:4, col = 2, value = "left"
      ), # Column `name` to the left
      list(row = 3, col = 3, value = "right") # Cell `12` to the right
    )
  )[[
    1
  ]]

  align_property <- huxtable::align(hux_table)
  expect_equal(align_property[4, 2], "left")
  expect_equal(align_property[3, 3], "right")

  # Apply alignments to two data frames
  hux_tables <- gentlg(
    huxme = list(df, df),
    print.hux = FALSE,
    alignments = list( # Column `name` to the left for the first data frame
      list(list(row = 1:4, col = 2, value = "left")), # Cell `12` to the right for the second data frame
      list(list(row = 3, col = 3, value = "right"))
    )
  )

  align_property_1 <- huxtable::align(hux_tables[[1]])
  expect_equal(align_property_1[4, 2], "left")
  expect_equal(align_property_1[3, 3], "center")

  align_property_2 <- huxtable::align(hux_tables[[2]])
  expect_equal(align_property_2[4, 2], "center")
  expect_equal(align_property_2[3, 3], "right")
})

test_that("gentlg() sets the right colwidths when passing a combination of vectors and numeric values", {
  wcol <- list(c(0.5, 0.3, 0.2), c(0.25))
  expect_no_error(hux_tables <- gentlg(
    huxme = list(df, df),
    wcol = wcol,
    print.hux = FALSE
  ))

  for (i in seq_along(wcol)) {
    ht <- hux_tables[[i]]
    num_cols <- ncol(ht)
    actual_colwidths <- as.numeric(huxtable::col_width(ht))
    if (length(wcol[[i]]) == 1) {
      expected_colwidths <- c(wcol[[i]], rep((1 - wcol[[i]])/(num_cols - 1), num_cols - 1))
    } else {
      expected_colwidths <- wcol[[i]]
    }
    expect_equal(actual_colwidths, expected_colwidths)
  }
})

test_that("gentlg() sets the right colwidths when passing all colwidths explicitly", {
  wcol <- list(c(0.5, 0.3, 0.2), c(0.25, 0.5, 0.25))
  expect_no_error(hux_tables <- gentlg(
    huxme = list(df, df),
    wcol = wcol,
    print.hux = FALSE
  ))

  for (i in seq_along(wcol)) {
    ht <- hux_tables[[i]]
    num_cols <- ncol(ht)
    expected_colwidths <- wcol[[i]]
    actual_colwidths <- as.numeric(huxtable::col_width(ht))
    expect_equal(expected_colwidths, actual_colwidths)
  }
})

test_that("gentlg() validates that if hux is a single data.frame, wcol cannot be a list", {
  wcol <- list(c(0.5), c(0.4, 0.4, 0.2))
  expect_error(hux_tables <- gentlg(
    huxme = df,
    wcol = wcol,
    print.hux = FALSE
  ),
  "\\'wcol\\' appears to be"
  )
})

test_that("gentlg() validates each element in wcol has the correct length", {
  wcol <- list(c(0.5, 0.3), c(0.4, 0.4, 0.2))
  expect_error(hux_tables <- gentlg(
    huxme = list(df, df),
    wcol = wcol,
    print.hux = FALSE
  ),
  "wcol\\'s length must be 1 or the length of final output"
  )
})

test_that("gentlg() validates that the sum of colwidths is 1", {
  wcol <- list(c(0.5, 0.2, 0.5), c(0.4, 0.4, 0.2))
  expect_error(hux_tables <- gentlg(
    huxme = list(df, df),
    wcol = wcol,
    print.hux = FALSE
  ),
  "wcol not defined properly"
  )
})

test_that("gentlg() validates hux length equals wcol length if wcol is a list", {
  wcol <- list(c(0.5), c(0.4, 0.4, 0.2))
  expect_error(hux_tables <- gentlg(
    huxme = list(df, df, df),
    wcol = wcol,
    print.hux = FALSE
  ),
  "Arguments \\'wcol\\' and \\'huxme\\' must have the same length."
  )
})