你能在 R formattable 中增加列 names/headers 的大小吗

Question

我正在使用格式table 在 RShiny 中生成 table。我知道如何增加 table 中数据字体的大小，但不知道如何增加列 names/headers 的大小。

输出数据：

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

Shiny 应用程序代码

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" 只会增加这些列标题下 table/ 中文本的字体大小。

有办法吗？

Answer 1

您可以尝试类似于所做的事情。显然，formatter 将 return 一个将数据向量转换为 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%")))))

输出

你能在 R formattable 中增加列 names/headers 的大小吗

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

r

font-size

formattable