rcolorsflextableboldcrosstable

R - Crosstable highlights with Flextable library


I need to highlight (with bold face or some color) the max counts, rowwise, in a crosstable, according to the example below. But i can't seem to find anywhere how to do it in crosstables. Does anyone have an hint? Thanks in advance!

library(tidyverse)
library(gtsummary)
library(flextable)

tib <- tibble(x=c(1,2,3,2,2,1,3,2,4,1,2,3,2,2,1,3,2,4),
              y=c("a","b","c","a","b","b","b","b",NA,"a","b","c","a","b","b","b","c",NA))


tib %>%  
  tbl_cross(percent = "row",
            missing_text = "NA") %>% 
  as_flex_table() 

Solution

  • David Gohel is correct...it's possible, but it's not a simple solution. The unformatted (i.e. numeric) versions of the counts are saved internally in the gtsummary object. We can access them, find the max count, and construct calls to bold the cell using the modify_table_styling() function.

    Example below.

    library(gtsummary)
    packageVersion("gtsummary")
    #> [1] '1.5.2'
    
    tib <- tibble::tibble(
      x=c(1,2,3,2,2,1,3,2,4,1,2,3,2,2,1,3,2,4),
      y=c("a","b","c","a","b","b","b","b",NA,"a","b","c","a","b","b","b","c",NA))
    
    
    tbl <- 
      tib %>%  
      tbl_cross(percent = "row",
                missing_text = "NA")
    
    # find cell(s) with max count per row
    df_max_count <- 
      purrr::pluck(tbl, "meta_data", "df_stats", 1) %>% 
      dplyr::filter(!is.na(by)) %>% 
      dplyr::group_by(variable_levels) %>%
      dplyr::filter(n == max(n)) %>%
      dplyr::select(variable_levels, col_name, n) %>%
      dplyr::ungroup()
    
    # construct calls to bold cells
    call_list <-
      purrr::map2(
        df_max_count$variable_levels,
        df_max_count$col_name,
        ~rlang::expr(
          modify_table_styling(columns = !!.y,
                               rows = label %in% !!.x,
                               text_format = "bold")
        )
      )
    
    # evaluate calls in tbl_cross
    tbl_final <-
      call_list %>%
      purrr::reduce(~ rlang::expr(!!.x %>% !!.y) %>% eval(), .init = tbl)
    

    enter image description here Created on 2022-01-31 by the reprex package (v2.0.1)