您可以增加 R 格式表中列名/标题的大小吗

Question

我正在使用 formattable 在 RShiny 中生成表格。我知道如何增加表中数据的字体大小，但不知道如何增加列名/标题的大小。

输入数据：

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")

闪亮的应用程序代码

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)

以上面的代码为例，我的列标题是Variable和Last Week，我想增加文本的大小。 "font.size" = "20px" 只会增加表格内/这些列标题下文本的字体大小。

有没有办法做到这一点？

Answer 1

您可以尝试类似于 here 所做的事情。显然，formatter 将返回一个函数，将数据向量转换为以 HTML 和 CSS 表示的格式化数据。因此，您可以在调用formattable 之前通过自定义formatter 函数传入列名来设置字体大小。让我知道这是否有效。

library(formattable)
data(mtcars)

df <- mtcars

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

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

formattable(df)

编辑：

或者，您可以将ui 中的CSS 更改为更大的字体大小。这似乎适用于另一个 formattable 呼叫。

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%")))))

输出