r - 闪亮的仪表板框折叠

Question

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

trtall <- rbind(rep("A",100),rep("B",100), rep("C",100))
trt <- sample(trtall,80)
agecat.temp <- c(rep("18-40",100), rep("> 40", 100))
agecat <- sample(agecat.temp, 80)
sex <- sample(rbind(rep("M",100),rep("F",100)),80)
race <- sample(rbind(rep("Asian",50),rep("Hispanic",50),rep("Other",50)),80)

df <- data.frame(trt, agecat, sex, race)

 
body <- dashboardBody(
  fluidRow(box(width=12,collapsed=F, collapsible = T, title="Filters", solidHeader = T,status="primary",
               box(width=5, height="220px", status="primary",
                   fluidRow(column(6,uiOutput("uivr1")),
                            column(6,uiOutput("uivl1")))))))
 
ui <- dashboardPage(
  dashboardHeader(disable = T),
  dashboardSidebar(disable = T),
  body, skin = "green"
)

 server = function(input, output) {
  reacui1 <- reactiveVal()

   observeEvent(input$vr1,{
      reacui1(as.list(df %>% distinct(!!input$vr1) %>% arrange(!!input$vr1)))
  })

  output$uivr1 <- renderUI(varSelectInput(width = "200px", "vr1",NULL,df))
  output$uivl1 <- renderUI(selectInput("vl1",width="200px",multiple=T,NULL,choices=reacui1()))
  
}

shinyApp(ui,server)

你好，

我正在动态尝试在闪亮的应用程序中创建 UI。在我折叠闪亮仪表板中的框之前，逻辑工作正常。

我做了以下步骤并得到了意想不到的结果。

我在“ vr1 ”中选择“trt”，然后从“ vl1 ”中选择“A” 。
我把盒子弄塌了。
然后解开盒子。
我在“vr1”中选择了“ agecat ”——现在我仍然在“ vl1 ”中看到各种治疗方法（A、B、C），但看不到不同的年龄类别（18-40、>40）

你能帮忙吗？

score 0 · Accepted Answer

问题来自这样一个事实，即shown事件没有传递给折叠框内的框内的元素。

将此与这个稍作改动的示例进行比较：

body <- dashboardBody(
  fluidRow(
    box(width = 12, collapsed = FALSE, collapsible = TRUE,
        title = "Filters", solidHeader = TRUE, status = "primary",
        # box(width=5, height="220px", status="primary",
            fluidRow(column(6, uiOutput("uivr1")),
                     column(6, uiOutput("uivl1"))
        #     )
        )
    )
  )
)

您会看到在这种情况下，第二个输入已正确更新。

您也可以使用您的示例，转到 JS 控制台并键入$('.box').trigger('shown')，您会看到选择输入突然更新。

这意味着问题在于，shiny仍然认为输入是隐藏的，并且由于隐藏的输入没有更新，您会观察到这种行为。

但这告诉我们如何解决它：

解决方法是关闭该suspendWhenHidden属性。将此添加到您的服务器：
```
  session$onFlushed(function() {
    outputOptions(output, "uivl1", suspendWhenHidden = FALSE)
  })
```
然而，这只是解决症状而不是解决问题。

另一种方法是确保shown.bs.collapse在盒子内的盒子上也触发事件。为此，我们可以监听shown.bs.collapse事件，一旦接收到，稍等片刻（800 毫秒），使框完全可见，然后通知所有shiny-bound-output孩子应该显示它们：

js <- "$(() => $('body').on('shown.bs.collapse', '.box', function(evt) { 
      setTimeout(function(){
         $(evt.target).find('.shiny-bound-output').trigger('shown.bs.collapse');
      }, 800);
   }))"

body <- dashboardBody(
  tags$head(tags$script(HTML(js))),
  fluidRow(
    box(width = 12, collapsed = FALSE, collapsible = TRUE,
        title = "Filters", solidHeader = TRUE, status = "primary",
        box(width = 5, height = "220px", status = "primary",
            fluidRow(column(6, uiOutput("uivr1")),
                     column(6, uiOutput("uivl1"))
            )
        )
    )
  )
)

这是，顺便说一句，已经报告为错误：https ://github.com/rstudio/shinydashboard/issues/234

r - 闪亮的仪表板框折叠

1 回答 1

Related

Reference