在 Shiny 中发送 Javascript

Question

我正在尝试使用 JS 和来自服务器的输入来更改 Shiny 上的输入（因此该值可以是有条件的）。 在此示例中，我已将值固定为“NJ”，但最后 id 就像这个值一样是动态的。我试图实现的最终结果是在单击按钮时让下拉菜单更改为一个值（此处为“NJ”）。下面的工作示例。

我的 JS 知识很浅，大部分来自阅读 R 文档，例如下面的文档。

https://shiny.rstudio.com/articles/communicating-with-js.html

library("shiny")

ui <- fluidPage(

        tags$script("Shiny.addCustomMessageHandler('change_sel', function(x){
                     Shiny.setInputValue('state', x,{priority: 'event'});
                });")
    ,
    column(6,
           selectInput("state", "Choose a state:",
                        c("NY", "NJ", "CT")
           ),
           column(6,
                  actionButton("but1", "Change to NJ"
                  )

               )))

server <- function(input, output, session) {
    observeEvent(input$but1, {
        session$sendCustomMessage("change_sel", "NJ")
    })

    observe(print(input$state))
}

shinyApp(ui, server)

Answer 1

如果您正在使用闪亮的输入组件并希望通过其他方式（例如，单击按钮）更新输入元素的值，则使用update- 函数之一（在闪亮包中提供）。但是，这些更新功能不太可能对非 Shiny 小部件起作用（甚至不可用）。

另一种方法是创建自定义输入绑定，在 Shiny 和客户端之间发送数据。这种方法最适合自定义输入组件或围绕现有组件库（非 R/Shiny 包）创建包装器。 （有关更多信息，请查看以下 RStudio 指南构建自定义输入对象和如何创建自定义输入绑定。我不会在这里详细介绍输入绑定回答很长）。

可以使用session$sendInputMessage() 将消息从 Shiny 发送到客户端。在输入绑定中（使用 jQuery 编写；vanilla JS 不起作用），使用 receiveInputMessage 方法来检索和响应数据。使用您问题中提供的示例，我提供了有关如何更新自定义选择输入小部件以响应按钮单击的演示。

如果您有任何问题，请告诉我！

library(shiny)

ui <- tagList(
    tags$main(
        tags$h1("Receive Message Input"),
        tags$label(
            `for` = "state",
            "Select a State"
        ),
        tags$select(
            id = "state",
            class = "select__input",
            tags$option(value = "NONE", "--- Select ---"),
            tags$option(value = "NY", "New York"),
            tags$option(value = "NJ", "New Jersey"),
            tags$option(value = "CT", "Connecticut")
        ),
        tags$button(
            id = "state_ny",
            class = "shiny-bound-input action-button",
            "Select New York"
        ),
        tags$button(
            id = "state_nj",
            class = "shiny-bound-input action-button",
            "Select New Jersey"
        ),
        tags$button(
            id = "state_reset",
            class = "shiny-bound-input action-button",
            "Reset"
        )
    ),
    tags$script(
        type = "text/javascript",
        HTML(
            "const myCustomBinding = new Shiny.InputBinding();",
            "$.extend(myCustomBinding, {
                find = function(scope) {
                    return $(scope).find('.select__input');
                },
                getValue = function(el) {
                    return $(scope).value;
                },
                subscribe = function(el, callback) {
                    $(el).on('change', function(e) {
                        callback();
                    });
                },
                receiveInputMessage = function(el, message) {
                    if (message.type === 'update') {
                        $(el).value = data.value
                    }
                },
                unsubscribe = function(el) {
                    $(el).off('myCustomBinding');
                }
            });",
            "Shiny.inputBindings.register(myCustomBinding);"
        )
    )
)

server <- function(input, output, session) {

    # server-side function for sending data for use in `receiveInputMessage`
    setSelectValue <- function(inputId, value) {
        session$sendInputMessage(
            inputId = inputId,
            message = list(
                type = "update",
                value = value
            )
        )
    }

    # onClick Events
    observeEvent(input$state_ny, setSelectValue("state", "NY"))
    observeEvent(input$state_nj, setSelectValue("state", "NJ"))
    observeEvent(input$state_reset, setSelectValue("state", "NONE"))

    observe(print(input$state))
}

shinyApp(ui, server)