Question

我尝试对highcharter软件包使用一种解决方法来更新图表，而不是重新呈现它，这看起来更加平滑。到目前为止，只要我在单独的JS文件中运行代码，我的函数就可以正常工作。但是要使其更加灵活，我想使用R编写函数。当我单击input$data按钮时，该代码运行的次数似乎是值input$data获得的次数（请参见print语句）。为什么会发生这种情况，我该怎么做才能防止此问题？

library(highcharter)
library(shiny)
library(shinyjs)

df <- data.frame(
    a = floor(runif(10, min = 1, max = 10)),
    b = floor(runif(10, min = 1, max = 10))
)


updaterfunction <- function() {

    jscode <- 
        '$("#data").on("click",function() {

        console.log("code was run")

    Shiny.addCustomMessageHandler("handler1", function(message1){
        var chart1 = $("#plot").highcharts()

        var newArray1 = new Array(message1.length)
        var newArray2 = new Array(message1.length)

        for(var i in message1) {
            newArray1[i] = message1[i].a
            newArray2[i] = message1[i].b
        }

        chart1.series[0].update({
            // type: "line",
            data: newArray1
        }, false)

        chart1.series[1].update({
        //   type: "line",
          data: newArray2
      }, false)

      chart1.redraw();
    })

    });'

    runjs(jscode)
}




# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Old Faithful Geyser Data"),
    #includeScript("www/script.js"),
    useShinyjs(),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            sliderInput("bins",
                        "Number of bins:",
                        min = 1,
                        max = 50,
                        value = 30),
            actionButton("data2", "Generate Data"),
            actionButton("data", "Generate Data")
        ),

        # Show a plot of the generated distribution
        mainPanel(
           highchartOutput("plot"),
           highchartOutput("plot2")
        )
    )
)


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


    observeEvent(input$data, {

    print(input$data)

        df <- data.frame(
            a = floor(runif(10, min = 1, max = 10)),
            b = floor(runif(10, min = 1, max = 10))
        )

        message1 = jsonlite::toJSON(df)
        session$sendCustomMessage("handler1", message1)

        updaterfunction()

    })


    reactivedata <- eventReactive(input$data2, {

        df <- data.frame(
            a = floor(runif(10, min = 1, max = 10)),
            b = floor(runif(10, min = 1, max = 10))
        )
    })

    output$plot <- renderHighchart({

        highchart() %>%

            hc_add_series(type = "bar", data = df$a) %>%
            hc_add_series(type = "bar", data = df$b)

    })


    output$plot2 <- renderHighchart({

        highchart() %>%

            hc_add_series(type = "bar", data = reactivedata()$a) %>%
            hc_add_series(type = "bar", data = reactivedata()$b)
    })


}

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

Answer 1

那是因为每次您运行JS代码时，它都会在按钮上附加一个新的click事件。您可以使用off("click")删除以前的事件处理程序：

  jscode <- 
    '$("#data").off("click").on("click",function() {

但是我不确定这是否会产生预期的行为。是吗？

如何防止JS代码在R Shiny中多次运行？

1 个答案: