javascript - 如何在Shiny中用JavaScript改变UI元素的属性？

Question

我知道有一个名为 renderUI 的服务器端方法，但在某些情况下它会使更新 UI 变得非常慢，所以我现在依赖于 JavaScript。

我的问题如下。我想更新shinymaterial包中material_card的标题属性。每次我从单独的下拉菜单中选择替代项时，我希望看到标题发生变化。

到目前为止，我的 UI 组件列表包含tags$script() 对象，该对象应该观察 selectInput 中的变化(带有 id“dropdown”)。

我的代码如下所示:

library(shinymaterial)
library(shiny)

ui <- material_page(

    titlePanel("Soon to be working JavaScript example!"),

    sidebarLayout(
        sidebarPanel(
            selectInput(
                "dropdown",
                "Dropdown menu",
                c('Hat','Shoes','Jacket')),
                tags$script('
              $(document).on("shiny:inputchanged", function(event) {
                if (event.name === "dropdown") {
                    if(input.dropdown === "Jacket") {
                  //Even this alert is not working, possibly because input.name is not recognized. :(
                  alert("You chose Jacket, now the material card title will be changed to: Jacket selected");
                  //What am I supposed to put here to update the material_card title?
                    } else {
                  //...and here as well...
                }
              });'
            ),
            material_card(
                depth=5,
                title = 'This value needs to be changed according what was chosen in the dropdown menu!')
        ),
        mainPanel(
           h5('Nothing here!')
        )
    )
)

server <- function(input, output) {

    #The server is empty, as it should. :)
}

shinyApp(ui = ui, server = server)

我设法在没有 if(input.dropdown === "Jacket") 验证的情况下使警报正常工作，但此验证不起作用:很可能 input.dropdown 甚至无法识别，尽管它与条件面板配合得很好.

此外，我更迷失了逻辑:在观察到 selectInput(下拉)值的变化后，我应该如何实际使用 JavaScript 来更新material_card标题？

Answer 1

一个 Shiny 的纯 UI 解决方案:

library(shinymaterial)
library(shiny)

dropdownChoices <- c('Hat','Shoes','Jacket')

ui <- material_page(
  
  titlePanel("Soon to be working JavaScript example!"),
  
  sidebarLayout(
    sidebarPanel(
      selectInput(
        "dropdown",
        "Dropdown menu",
        dropdownChoices),
      material_card(
        depth = 5,
        title = lapply(dropdownChoices, function(i){
          conditionalPanel(sprintf('input.dropdown == "%s"', i), i)
        })
      )),
    mainPanel(
      h5('Nothing here!')
    )
  )
)

server <- function(input, output) {}

shinyApp(ui = ui, server = server)