根据用户输入在 R Shiny 中格式化表格输出答案

【问题标题】：Format table output in R shiny based on user inputs根据用户输入在 R Shiny 中格式化表格输出
【发布时间】：2019-02-05 12:25:17
【问题描述】：

我在闪亮的应用程序中显示了一张表格。我想根据值格式化表格并相应地着色。我已经看到了可格式化区域着色，它根据值的范围定义了中断，然后生成了应用于表格的颜色渐变。我想要做的是允许用户填写最小值和最大值，并根据它对表中的值进行着色。因此，如果值的范围是 1-20 并且用户输入是 5 和 15 ，则低于 5 和高于 15 的值不应应用任何颜色渐变。以下是我目前使用可格式化区域格式的代码。

library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(DT)

sidebar <- dashboardSidebar(
  sidebarMenu(id = "tab",
              menuItem("1", tabName = "1")
  )
)
body <-   ## Body content
  dashboardBody(box(width = 12,fluidRow(
    fluidRow(  column(
      width = 3,  textInput("text1", label = h5("Min"), value = "Enter min")),
      column(
        width = 3, textInput("text2", label = h5("Max"), value = "Enter max"))),
    DT::dataTableOutput("op")
  )))

ui <-   dashboardPage(dashboardHeader(title = "Scorecard"),
                      sidebar,
                      body)

# Define the server code
server <- function(input, output,session) {
  df <- data.frame(month = c("mazda 3", "mazda cx5", "mazda 6","mazda miata","honda civic","honda accord"),
                   april = c(.1,.2,.3,.3,.4,.5),
                   may = c(.3,.4,.5,.2,.1,.5),
                   june = c(.2,.1,.5,.1,.2,.3))

  brks <- reactive({ quantile(df$april, probs = seq(.05, .95, .05), na.rm = TRUE)})
  clrs <- reactive({ round(seq(255, 175, length.out = length(brks()) + 1), 0) %>%
  {paste0("rgb(",.,",", ., ",255 )")}})

  df_format<- reactive ({datatable(df,options = list(searching = FALSE,pageLength = 15, lengthChange = FALSE))%>%
           formatStyle(names(df),backgroundColor = styleInterval(brks(), clrs()))})

  output$op <-renderDataTable({
    df_format()
  })

}

shinyApp(ui = ui, server = server)

【问题讨论】：

最低分位数已经没有颜色（白色），您想如何处理？
如果用户选择 5-15，颜色可能是从绿色到红色的渐变。所以 5 为绿色，15 为红色
但是您给定的示例从白色变为蓝色。
我没有考虑用户输入的另一个示例的颜色范围

标签： r shiny dt formattable

【解决方案1】：

这是你的工作代码。

您必须使用 input 最小值和最大值作为序列的限制（我只是将其更改为范围 - 用户更容易设置这样的范围）然后你生成序列 - 根据你的符号 - brks() - 在我的情况下，我使用 10 个的 length.out 但你可以根据需要或动态放置尽可能多的中断。然后在

上生成

颜色数量 - 1

最后在styleInterval() 为背景添加white 的限制 - 或您想要的任何其他颜色。

library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(DT)

sidebar <- dashboardSidebar(
   sidebarMenu(id = "tab",
            menuItem("1", tabName = "1")
   )
)
body <-   ## Body content
   dashboardBody(box(width = 12,fluidRow(
      fluidRow(column(
                width = 3, 
                sliderInput("range_value", 
                            label = h3("Put a range value"), 
                            min = 0, 
                            max = 100, 
                            value = c(5, 15)
                            )
                    )
             ),
    DT::dataTableOutput("op")
)))

ui <-   dashboardPage(dashboardHeader(title = "Scorecard"),
                      sidebar,
                      body)

# Define the server code
server <- function(input, output,session) {
df <- data.frame(month = c("mazda 3", "mazda cx5", "mazda 6","mazda miata","honda 
                 civic","honda accord"),
                 april = c(9, 8, 11,14,16,1),
                 may = c(3,4,15,12,11, 19),
                 june = c(2,11,9,7,14,1))
brks <- reactive({
    seq(input$range_value[1], input$range_value[2], length.out = 10) 
})

clrs <- reactive({ round(seq(255, 175, length.out = length(brks()) - 1), 0) %>%
{paste0("rgb(",.,",", ., ",255)")}})

df_format<- reactive ({datatable(df,options = list(searching = FALSE, pageLength = 15, lengthChange = FALSE)) %>%
            formatStyle(names(df), 
                        backgroundColor = styleInterval(c(brks()), c('white', clrs() ,'white'))
                        )
    })

output$op <-renderDataTable({
    df_format()
  })
}

shinyApp(ui = ui, server = server)

【讨论】：