tests/testthat/test-cols_align.R

In gt: Easily Create Presentation-Ready Display Tables

# Create a shorter version of `mtcars`
mtcars_short <- mtcars[1:5, ]

# Create a data frame based on the internal `sp500.csv`
sp500 <-
  read.csv(
    system.file("extdata", "sp500.csv", package = "gt"),
    stringsAsFactors = FALSE
  )

# Function to skip tests if Suggested packages not available on system
check_suggests <- function() {
  skip_if_not_installed("rvest")
  skip_if_not_installed("xml2")
}

test_that("The `cols_align()` function works correctly", {

  # Check that specific suggested packages are available
  check_suggests()

  # Create a `tbl_html` object with `gt()`; the `mpg`,
  # `cyl`, and `drat` columns are aligned left
  tbl_html <-
    gt(mtcars_short) %>%
    cols_align(align = "left", columns = c(mpg, cyl, drat)) %>%
    render_as_html() %>%
    xml2::read_html()

  # Expect that the columns with class `col_heading left`
  # are those columns that were aligned left
  tbl_html %>%
    rvest::html_nodes("[class='gt_col_heading gt_columns_bottom_border gt_left']") %>%
    rvest::html_text() %>%
    expect_equal(c("mpg", "cyl", "drat"))

  # Expect that all other columns are center-aligned
  tbl_html %>%
    rvest::html_nodes("[class='gt_col_heading gt_columns_bottom_border gt_right']") %>%
    rvest::html_text() %>%
    expect_equal(base::setdiff(colnames(mtcars_short), c("mpg", "cyl", "drat")))

  # Create a `tbl_html` object with `gt()`; columns `1` (`mpg`),
  # `2` (`cyl`), and `3` (`disp`) are aligned left
  tbl_html <-
    gt(mtcars_short) %>%
    cols_align(align = "left", columns = 1:3) %>%
    render_as_html() %>%
    xml2::read_html()

  # Expect that the columns with class `gt_col_heading gt_left`
  # are those columns that were aligned left
  tbl_html %>%
    rvest::html_nodes("[class='gt_col_heading gt_columns_bottom_border gt_left']") %>%
    rvest::html_text() %>%
    expect_equal(c("mpg", "cyl", "disp"))

  # Expect that all other columns are right-aligned
  tbl_html %>%
    rvest::html_nodes("[class='gt_col_heading gt_columns_bottom_border gt_right']") %>%
    rvest::html_text() %>%
    expect_equal(base::setdiff(colnames(mtcars_short), c("mpg", "cyl", "disp")))

  # Expect that supplying an `align` value that is not `left`, `center`,
  # or `right` will result in an error
  expect_error(
    gt(mtcars_short) %>%
      cols_align(align = "righter", columns = c(mpg, cyl, drat)))

  # Expect that supplying a column name that doesn't exist in the
  # table columns will result in an error
  expect_error(
    gt(mtcars_short) %>%
      cols_align(align = "right", columns = car))

  # Expect that supplying any column index that doesn't exist in the
  # table will result in an error
  expect_error(
    gt(mtcars_short) %>%
      cols_align(align = "right", columns = c(1, 20)))

  # Create a `tbl_html` object with `gt()`; align all
  # columns to the left
  tbl_html <-
    gt(mtcars_short) %>%
    cols_align(align = "left") %>%
    render_as_html() %>%
    xml2::read_html()

  # Expect that the columns with class `col_heading left`
  # includes all columns in `mtcars_short`
  tbl_html %>%
    rvest::html_nodes("[class='gt_col_heading gt_columns_bottom_border gt_left']") %>%
    rvest::html_text() %>%
    expect_equal(colnames(mtcars_short))

  # Create a `tbl_html` object with `gt()`; align all
  # columns (using `columns = everything()`) to the left
  tbl_html <-
    gt(mtcars_short) %>%
    cols_align(align = "left", columns = everything()) %>%
    render_as_html() %>%
    xml2::read_html()

  # Expect that the columns with class `col_heading left`
  # includes all columns in `mtcars_short`
  tbl_html %>%
    rvest::html_nodes("[class='gt_col_heading gt_columns_bottom_border gt_left']") %>%
    rvest::html_text() %>%
    expect_equal(colnames(mtcars_short))

  # Create a `tbl_html` object with the `sp500` data
  # frame and `auto`-align all columns
  tbl_html <-
    gt(sp500) %>%
    cols_align(align = "auto") %>%
    render_as_html() %>%
    xml2::read_html()

  # Expect that the `Date` column is left-formatted because
  # the column is of the `character` class
  tbl_html %>%
    rvest::html_nodes("[class='gt_col_heading gt_columns_bottom_border gt_right']") %>%
    rvest::html_text() %>%
    expect_equal(c("Date", "Open", "High", "Low", "Close", "Volume"))
})

test_that("The stub gets its alignment set properly with `cols_align()`", {

  # Check that specific suggested packages are available
  check_suggests()

  # Create a new tibble for testing
  tbl <-
    dplyr::tibble(
      stub = c("*one*", "**two**", "three"),
      vals = 3:1
    )

  # Create a `tbl_html` object with `gt()`; don't align any columns
  # with `cols_align()`
  tbl_html <-
    gt(tbl, rowname_col = "stub") %>%
    tab_stubhead(label = "stub") %>%
    render_as_html() %>%
    xml2::read_html()

  # Expect the stub is left aligned (because of the text content) and that the
  # other column is right aligned (because of the numerical content
  tbl_html %>%
    rvest::html_nodes("[class='gt_row gt_left gt_stub']") %>%
    rvest::html_text() %>%
    expect_equal(c("*one*", "**two**", "three"))
  tbl_html %>%
    rvest::html_nodes("[class='gt_col_heading gt_columns_bottom_border gt_right']") %>%
    rvest::html_text() %>%
    expect_equal("vals")

  # Create a `tbl_html` object with `gt()`; center align all columns
  tbl_html <-
    gt(tbl, rowname_col = "stub") %>%
    tab_stubhead(label = "stub") %>%
    cols_align(align = "center") %>%
    render_as_html() %>%
    xml2::read_html()

  # Expect both columns are center aligned
  tbl_html %>%
    rvest::html_nodes("[class='gt_row gt_center gt_stub']") %>%
    rvest::html_text() %>%
    expect_equal(c("*one*", "**two**", "three"))
  tbl_html %>%
    rvest::html_nodes("[class='gt_col_heading gt_columns_bottom_border gt_center']") %>%
    rvest::html_text() %>%
    expect_equal("vals")

  # Create a `tbl_html` object with `gt()`; center align the stub column and
  # left align the `vals` column
  tbl_html <-
    gt(tbl, rowname_col = "stub") %>%
    tab_stubhead(label = "stub") %>%
    cols_align(align = "center", columns = stub) %>%
    cols_align(align = "left", columns = vals) %>%
    render_as_html() %>%
    xml2::read_html()

  # Expect the correct alignment for each column
  tbl_html %>%
    rvest::html_nodes("[class='gt_row gt_center gt_stub']") %>%
    rvest::html_text() %>%
    expect_equal(c("*one*", "**two**", "three"))
  tbl_html %>%
    rvest::html_nodes("[class='gt_col_heading gt_columns_bottom_border gt_left']") %>%
    rvest::html_text() %>%
    expect_equal(c("stub", "vals"))

  # Expect that the use of `stub()` produces the same result as providing the
  # stub column name
  tbl_html <-
    gt(tbl, rowname_col = "stub") %>%
    tab_stubhead(label = "stub") %>%
    cols_align(align = "center", columns = stub()) %>%
    cols_align(align = "left", columns = vals) %>%
    render_as_html() %>%
    xml2::read_html()

  # Expect the correct alignment for each column
  tbl_html %>%
    rvest::html_nodes("[class='gt_row gt_center gt_stub']") %>%
    rvest::html_text() %>%
    expect_equal(c("*one*", "**two**", "three"))
  tbl_html %>%
    rvest::html_nodes("[class='gt_col_heading gt_columns_bottom_border gt_left']") %>%
    rvest::html_text() %>%
    expect_equal(c("stub", "vals"))

  # Expect an error if using `stub()` when there is no stub
  expect_error(
    gt(tbl) %>%
    cols_align(align = "center", columns = stub())
  )
})