R Shiny 中的自定义值框被压缩，中间有大的空白

编程问答 2022-04-24

问题描述

我正在尝试在 R Shiny 中制作自定义值框。我已经发现如何更改背景的颜色，但有些东西使我的值框变得粗短并在它们之间留下很大的间隙。理想情况下，我想在一行上显示 3，但即使宽度为 4，它们也会显得压扁。我怎样才能让它们有更多的红色，中间只有一小部分白色。

以下是可重现的示例和屏幕截图。

enter image description here

library(shinydashboard)
library(shiny)
library(dplyr)

red_Box_format <- ".inner,p,h3 { background-color: red};"


ui <- fluidPage(
    
    sidebarLayout(
        sidebarPanel(
            textInput(inputId = "greeting",label = "Say hi!"),actionButton(inputId = "submit",label = "Submit")
            
        ),mainPanel(
            tags$style(red_Box_format),column(4,align="center",div(valueBoxOutput("total_perfect"),style= "color: #FFFFFF")),div(valueBoxOutput("total_fails"),style= "color: #FFFFFF"))
        )
    ))
server <- function(input,output) {
    
    data <- tibble(name = c("Justin","Corey","Sibley"),grade = c(50,100,100))
    
    
    output$total_perfect <- renderValueBox({
        shiny::req(input$greeting)
        shiny::req(input$submit)
        if(input$greeting == "hi!") {
            num_100s <- data %>% filter(grade == 100) %>% nrow()
            valueBox(value = num_100s,subtitle = "Number of Perfect scores")
        }
    })
    
    output$total_fails <- renderValueBox({
        shiny::req(input$greeting)
        shiny::req(input$submit)
        if(input$greeting == "hi!") {
            num_50s <- data %>% filter(grade == 50) %>% nrow()
            valueBox(value = num_50s,subtitle = "Number of Failures")
        }
    })
    
}
shinyApp(ui,server)

解决方法

在 fluidRow 中插入输出；它们将更好地放置在引导网格中：

mainPanel(
      fluidRow(
      tags$style(red_box_format),valueBoxOutput("total_perfect"),valueBoxOutput("total_fails")
    ))

然后，您必须在 server 中像这样呈现它们：

valueBox(value = tags$p(num_100s,style = "text-align:center;color: #FFFFFF;"),subtitle = tags$p("Number of Perfect Scores",style = "text-align:center;color: #FFFFFF;"))
,

如果这是有用的，我扩展了上面的答案以允许对每个单独的框进行颜色编码，包括如果您愿意，如何将多种颜色合并到一个值框中。 （下面的屏幕截图、代码和解释/提示[特别是如果您像我一样不熟悉 CSS]）。

截图

enter image description here

代码

library(shinydashboard)
library(shiny)
library(dplyr)

navy_inner_box <- "#total_fails .inner{ background-color: navy};"
yellow_inner_box <- "#total_perfect .inner,p,h3 { background-color: yellow};"


ui <- fluidPage(
    
    sidebarLayout(
        sidebarPanel(
            textInput(inputId = "greeting",label = "Say hi!"),actionButton(inputId = "submit",label = "Submit")
            
        ),mainPanel(
            fluidRow(
                tags$style(yellow_inner_box),tags$style(navy_inner_box),valueBoxOutput("total_fails")
            ))
    ))
server <- function(input,output) {
    
    data <- tibble(name = c("Justin","Corey","Sibley"),grade = c(50,100,100))
    
    
    output$total_perfect <- renderValueBox({
        shiny::req(input$greeting)
        shiny::req(input$submit)
        if(input$greeting == "hi!") {
            num_100s <- data %>% filter(grade == 100) %>% nrow()
            valueBox(value = tags$p(num_100s,style = "text-align:center;color: #FFFFFF; background-color: red"),style = "text-align:center;color: #FFFFFF; background-color: red"))        }
    })
    
    output$total_fails <- renderValueBox({
        shiny::req(input$greeting)
        shiny::req(input$submit)
        if(input$greeting == "hi!") {
            num_50s <- data %>% filter(grade == 50) %>% nrow()
            valueBox(value = tags$p(num_50s,style = "text-align:center;color: #FFFFFF; background-color: navy"),subtitle = tags$p("Number of Total Failures",style = "text-align:center;color: #FFFFFF; background-color: navy"))}
    })
    
}
shinyApp(ui,server)

说明/提示

作为 CSS 新手，我不明白为什么当我指定背景颜色参数时，这些框要么不改变颜色，要么只改变其中的一部分。值框分为 3 部分：值（我截图中的 2 和 1）、字幕和内部部分（没有文本的地方）。其中每一个都有自己的背景，所以如果你想让每个框都是不同的颜色，你需要通过它们的名称来指定每个框的颜色（注意navy_inner_box中#total_fails的CSS名称如何与输出名称对应，输出$total_fails。

其他背景颜色在服务器中分别包装值和字幕的调用中指定。

如果不是通过免费的 Google Chrome 扩展程序 CSS Selector，我不会发现这些框的内部名称。如果您不熟悉 CSS 并且标签对您没有直观意义，我强烈建议您查看一下。

rrreactive-programmingrenderuishinyshinydashboard