如何在闪亮的动态生成的条件面板中格式化活动值框？

Question

有一个与this solved one 相关的问题。我正在使用 lapply 生成一个动态的 R Shiny Dashboard。每个动态生成的盒子需要：

• 做一堆我已经想到的事情（显示适当的图像，可折叠等）
• 包含一个表，其中的值因框而异
• 拥有一个接收输入的条件面板
• 有一个 valueBox 显示取决于条件面板输入和单个侧边栏输入的计算结果

以下代码完成了大部分工作。但是，我有两个主要问题：

1. 如果框开始折叠，则表和 valueBox 为空
2. 在进行 valueBox 计算时，我不知道如何访问输入到条件窗格中的值。我在下面的代码中突出显示了这一点。

欢迎任何帮助。

library('shiny')
library('shinydashboard')

ui <- dashboardPage( title="sample code",
   dashboardHeader( title="sample code",disable=TRUE ),
   
   dashboardSidebar(
      box( width=12,title="sidebar input",solidHeader=TRUE,status="warning",background = "black",
         tags$style(".skin-blue .sidebar a:link { color:orange; } a:visited {color:green;}"),
         "Some text in the sidebar",
         sliderInput(inputId = 'inputRatio', label='hello', 
         min = 0, max = 1, value = 0.5, ticks=FALSE, width = '200px'),
      )
   ),
   
   dashboardBody(
      uiOutput("boxes")
   )
)

server <- function(input, output, session) {
   
   tableWithData <- data.frame('colA'=c(1:10), 'colB'=c(11:20), 'colC'=c(21:30) )

   output$boxes <- renderUI({
      lapply( 1:5, function( inputRow ) {
         fluidRow(
            box( width=NULL, title=paste0('Row ',inputRow), status='warning',collapsible=TRUE,collapsed=FALSE,
               fluidRow(
                  box( width=5,
                       p("table output", style="font-weight:bold"),
                       renderTable( tableWithData[ inputRow, ] )
                  ),
                  box( width=5,
                       radioButtons( paste0( 'row', inputRow, 'Param' ), 'Set a:' , inline=TRUE, selected = "min",  c("min"="min", "max"="max", "range"="range", "none"="none")),
                       
                       conditionalPanel(condition = paste0( "input.", 'row', inputRow, "Param != 'none'") ),
      
                       conditionalPanel(condition = paste0( "input.", 'row', inputRow, "Param == 'min'" ),
                                        numericInput( paste0(  'row', inputRow,'MinLimit' ), label="Minimum", value = 0, width = "90%") ),

                       conditionalPanel(condition = paste0( "input.", 'row', inputRow, "Param == 'max'" ),
                                        numericInput( paste0(  'row', inputRow,'MaxLimit' ), label="Maximum", value = 100, width = "90%") ),
                       
                       conditionalPanel(condition = paste0( "input.", 'row', inputRow, "Param == 'range'" ),
                                        numericInput( paste0(  'row', inputRow,'MinLimit' ), label="Minimum", value = 0, width = "90%"),
                                        numericInput( paste0(  'row', inputRow,'MaxLimit' ), label="Maximum", value = 100, width = "90%") )
                  ),
# ***** This is where I need the most help **********
                  box( width=4,
                       renderValueBox({
                          valueBox( input$inputRatio * eval( paste0(  'row', inputRow,'MinLimit' ) ), subtitle="i am stuck", icon = icon("list"), color = "purple" )
                       })                  
# ***************************************************
                  )

               )
            )
         )
      })
   })

}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

您可以像通过[[ 列出项目一样以编程方式调用闪亮的输入。

eval 是邪恶的 - 避免它。

我想这就是你所追求的：

library('shiny')
library('shinydashboard')

ui <- dashboardPage( title="sample code",
                     dashboardHeader( title="sample code",disable=TRUE ),
                     
                     dashboardSidebar(
                       box( width=12,title="sidebar input",solidHeader=TRUE,status="warning",background = "black",
                            tags$style(".skin-blue .sidebar a:link { color:orange; } a:visited {color:green;}"),
                            "Some text in the sidebar",
                            sliderInput(inputId = 'inputRatio', label='hello', 
                                        min = 0, max = 1, value = 0.5, ticks=FALSE, width = '200px'),
                       )
                     ),
                     
                     dashboardBody(
                       uiOutput("boxes")
                     )
)

server <- function(input, output, session) {
  
  tableWithData <- data.frame('colA'=c(1:10), 'colB'=c(11:20), 'colC'=c(21:30) )
  
  output$boxes <- renderUI({
    lapply( 1:5, function( inputRow ) {
      fluidRow(
        box( width=NULL, title=paste0('Row ',inputRow), status='warning',collapsible=TRUE,collapsed=FALSE,
             fluidRow(
               box( width=5,
                    p("table output", style="font-weight:bold"),
                    renderTable( tableWithData[ inputRow, ] )
               ),
               box( width=5,
                    radioButtons( paste0( 'row', inputRow, 'Param' ), 'Set a:' , inline=TRUE, selected = "min",  c("min"="min", "max"="max", "range"="range", "none"="none")),
                    conditionalPanel(condition = sprintf( "input.row%sParam != 'none'", inputRow) ),
                    conditionalPanel(condition = sprintf("(input.row%sParam == 'min' || input.row%sParam == 'range')", inputRow, inputRow),
                                     numericInput( paste0(  'row', inputRow,'MinLimit' ), label="Minimum", value = NULL, width = "90%") ),
                    conditionalPanel(condition = sprintf("(input.row%sParam == 'max' || input.row%sParam == 'range')", inputRow, inputRow),
                                     numericInput( paste0(  'row', inputRow,'MaxLimit' ), label="Maximum", value = NULL, width = "90%") )
               ),
               box( width=4,
                    renderValueBox({
                      names(input)
                      inputID <- paste0('row', inputRow,'MinLimit')
                      valueBox( input$inputRatio * input[[inputID]], subtitle="i am stuck", icon = icon("list"), color = "purple" )
                    })
               )
               
             )
        )
      )
    })
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)