Can you increase size of column names/headers in R formattable

Question

I'm using formattable to produce a table in RShiny. I know how to increase the size of the font of the data in the table, but cannot figure out how to increase the the size of the column names/headers.

The dput data:

structure(list(athlete = c("Joe Bloggs", "Joe Bloggs"), WeekEnding = structure(c(18329, 
18336), class = "Date"), Total.Training..hrs. = c(14.2, 15.7), 
    TimeInZones = c(7.9, 11.4), TimeInZones.percent = c(55.7, 
    72.7), T2.hrs = c(2.3, 5.6), HR_complete_percent = c(100, 
    100), Time...task..hrs. = c(11.6, 7.2), Rowing.volume.km. = c(118.0552, 
    101.9185), On.water..km. = c(108.3552, 74.1185), Ergo..km. = c(9.7, 
    27.8)), row.names = 1:2, class = "data.frame")

The Shiny app code

library(tidyverse)
library(rmarkdown)
library(shiny)
library(shinythemes)
library(dplyr)
library(readr)
library(data.table)
library(formattable)


ui <- (fluidPage( 
  titlePanel("Training Report"), 
  sidebarPanel(



    selectInput("dateInput", "Week Ending", choices = Data$WeekEnding, width = "50%"),


    selectInput("athleteInput", "Athlete", choices = Data$athlete, width ="50%"),



    mainPanel(

      br(),

      strong(h3("Data")), 

      formattableOutput("results", width = "170%")))))



server <- (function(input, output){
output$results <- renderFormattable({
  tableFilter <- filter(Data, Data$athlete == input$athleteInput)


  Table <- data.table(
    "Variable" = c( "Total training (hrs)", 
                    "HR data (%)",
                    "T2 hours", 
                    "Time @ task (hrs)", 
                    "Rowing volume (km)"), 

    "Last Week" = c(sum(tableFilter$Total.Training..hrs.[tableFilter$WeekEnding == as.Date(input$dateInput)]), 

                    (sum(tableFilter$HR_complete_percent[tableFilter$WeekEnding == as.Date(input$dateInput)])),

                    sum(tableFilter$T2.hrs[tableFilter$WeekEnding == as.Date(input$dateInput)]),

                    sum(tableFilter$Time...task..hrs.[tableFilter$WeekEnding == as.Date(input$dateInput)]), 

                    sum(tableFilter$Rowing.volume.km.[tableFilter$WeekEnding == as.Date(input$dateInput)])), 



    "Change" = percent(c((sum(tableFilter$Total.Training..hrs.[tableFilter$WeekEnding == as.Date(input$dateInput)]) - 
                            sum(tableFilter$Total.Training..hrs.[tableFilter$WeekEnding == as.Date(input$dateInput)-7]))/
                           sum(tableFilter$Total.Training..hrs.[tableFilter$WeekEnding == as.Date(input$dateInput)-7]),

                         " ", 

                         (sum(tableFilter$T2.hrs[tableFilter$WeekEnding == as.Date(input$dateInput)]) - 
                            sum(tableFilter$T2.hrs[tableFilter$WeekEnding == as.Date(input$dateInput)-7]))/
                           sum(tableFilter$T2.hrs[tableFilter$WeekEnding == as.Date(input$dateInput)-7]),

                         (sum(tableFilter$Time...task..hrs.[tableFilter$WeekEnding == as.Date(input$dateInput)]) -
                            sum(tableFilter$Time...task..hrs.[tableFilter$WeekEnding == as.Date(input$dateInput)-7]))/
                           sum(tableFilter$Time...task..hrs.[tableFilter$WeekEnding == as.Date(input$dateInput)-7]),

                         (sum(tableFilter$Rowing.volume.km.[tableFilter$WeekEnding == as.Date(input$dateInput)]) - 
                            sum(tableFilter$Rowing.volume.km.[tableFilter$WeekEnding == as.Date(input$dateInput)-7]))/
                           sum(tableFilter$Rowing.volume.km.[tableFilter$WeekEnding == as.Date(input$dateInput)-7])), d=0))



  Table$Change[is.nan(Table$Change)] <- NA
  Table$Change[is.infinite(Table$Change)] <- NA


  Table$Change <- as.character(Table$Change)   
  Table$Change <- ifelse(Table$Change == "NA", " ", Table$Change)


  formattable(Table,  align= c("l", "c", "c", "c", "c"), 
              list(Change =  
                     formatter("span", 
                               style = 
                                 x ~ style(font.weight = "bold", "font-size" = "20px",  color = ifelse(x =="0%"| x == "-0%", "black", ifelse(x > 0, "green", ifelse(x < 0, "red", "black")))),
                               x ~ icontext(ifelse(x ==" " | x =="0%"| x == "-0%", "", ifelse(x>0,  "arrow-up", ifelse(x < 0, "arrow-down", " "))),x)),

                   Variable = 
                     formatter("span", style = ~ style(color = "black", font.weight = "bold", "font-size" = "20px")),

                   `Last Week` = 
                     formatter("span", style = ~ style(color = "black","font-size" = "20px"))))

})

})

  shinyApp(ui = ui, server = server)

Take the above code for example, my column headings are Variable, and Last Week and I would like to increase the size of the text. The "font.size" = "20px" only increases the font size of the text within the table/ under those column headings.

Is there a way to do this ?

user_3460670 · Answer

You could try something similar to what was done here. Apparently, formatter will return a function to transform a vector of data to formatted data represented in HTML and CSS. So, you can pass in your column names through a custom formatter function to set the font size, before you call formattable. Let me know if this works.

library(formattable)
data(mtcars)

df <- mtcars

set_font_size <- formatter("span", style = "font-size:20px")

names(df) <- set_font_size(names(df))

formattable(df)

Edit:

Alternatively, you could change the CSS in ui with the higher font size. This appears to work with the other formattable call.

ui <- (fluidPage( 
  tags$head(
    tags$style(HTML("
      thead {
        font-size: 20px;
      }
    "))
  ),
  titlePanel("Training Report"), 
  sidebarPanel(
    selectInput("dateInput", "Week Ending", choices = Data$WeekEnding, width = "50%"),
    selectInput("athleteInput", "Athlete", choices = Data$athlete, width ="50%"),
    mainPanel(
      br(),
      strong(h3("Data")), 
      formattableOutput("results", width = "170%")))))

Output

Can you increase size of column names/headers in R formattable

1 Answers