how to automatically select first row of a df within a column-CodePudding

I am loving flextable however, incorporating it within my workflow is causing issues in that I am not able to write general purpose functions.

I want a function that would automatically highlight the header and the last row of the table. I am able to do this but I have to specify the name of the first column name. This is simply too much work, is there a work around?

library(tidyverse)
require(flextable)
require(rlang)

# Function that works
my_table <- function(x){
  
  require(flextable)
  require(rlang)
  
  
  x %>% 
    flextable() %>% 
    
    # Header colour and bold
    bg(bg = "#e05297", part = "header") %>% 
    flextable::color(color = "white", part = "header") %>% 
    
    # Last row bold and highlight
    bold(i = ~rowname == "Total", bold = TRUE) %>%
    
    bg(i    = ~rowname == "Total",
       bg    = "grey",
       part = "body")
  
}

mtcars %>% 
  rownames_to_column() %>% 
  adorn_totals("row") %>% 
    
  my_table()


# This is a general purpose function which is not working
my_table <- function(x){
  
  require(flextable)
  require(rlang)
  
  
  first_col_name <- colnames(x) %>% .[1]
  
  x %>% 
    flextable() %>% 
    
    # Header colour and bold
    bg(bg = "#e05297", part = "header") %>% 
    flextable::color(color = "white", part = "header") #%>% 

    
    # Last row bold and highlight
    bold(i = ~eval(rlang::sym(first_col_name)) == "Total", bold = TRUE) %>%
    
    bg(i    = ~eval(rlang::sym(first_col_name)) == "Total",
      bg    = "grey",
       part = "body")
  
}

Any ideas how to make the general purpose my_table function to work

CodePudding user response：

i argument also accepts position (row number) of the dataframe to highlight so you may use nrow to get the last row in the dataframe.

library(flextable)
library(janitor)

my_table <- function(x){
  
  x %>% 
    flextable() %>% 
    
    # Header colour and bold
    bg(bg = "#e05297", part = "header") %>% 
    flextable::color(color = "white", part = "header") %>% 
    bold(i = nrow(x), bold = TRUE) %>%
    bg(i = nrow(x),bg = "grey",part = "body")
}

mtcars %>% 
  rownames_to_column() %>% 
  adorn_totals("row") %>% 
  my_table()