Highcharter 情节仅在第二次点击后更新 - R Shiny

Question

这是我的代码，类似于我今天已经发布的问题。现在我有另一个问题，我无法理解。当我单击actionButton 更新图表时，图表仅在第二次单击后更新。 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(chartid, sendid, df, session) {

    message = jsonlite::toJSON(df)
    session$sendCustomMessage(sendid, message)

    jscode <- paste0('Shiny.addCustomMessageHandler("', sendid, '", function(message) {
        var chart1 = $("', chartid, '").highcharts()

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

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

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

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

      console.log("code was run")

      chart1.redraw();
    })')

    print("execute code!")
    runjs(jscode)
}




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

    # Application title
    titlePanel("Update highcharter dynamically"),
    #includeScript("www/script.js"),
    useShinyjs(),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            actionButton("data", "Generate Data")
        ),

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


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


    observeEvent(input$data, {

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

        updaterfunction(chartid = "#plot", sendid = "handler", df = df1, session = session)

    })


    output$plot <- renderHighchart({

        highchart() %>%

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

    })
}

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

Answer 1

我想问题是，在第一次执行observeEvent(input$data, {...}) 之后，您正在为您的情节附加事件处理程序（实际上，您在每次单击按钮后都添加了一个 CustomMessageHandler）。因此，事件处理程序在第一次按钮单击期间尚未附加（并且无法做出反应）。

如果您在会话启动时初始化CustomMessageHandler 一次，并且仅在单击按钮时发送新消息，则它会按预期工作：

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(sendid, df, session) {
  message = jsonlite::toJSON(df)
  session$sendCustomMessage(sendid, message)
}

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

  # Application title
  titlePanel("Update highcharter dynamically"),
  #includeScript("www/script.js"),
  useShinyjs(),

  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      actionButton("data", "Generate Data")
    ),

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


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

  sendid <- "handler"
  chartid <- "#plot"

  jscode <- paste0('Shiny.addCustomMessageHandler("', sendid, '", function(message) {
        var chart1 = $("', chartid, '").highcharts()

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

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

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

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

      console.log("code was run")

      chart1.redraw();
    })')

  runjs(jscode)


  observeEvent(input$data, {

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

    updaterfunction(sendid = sendid, df = df1, session = session)

  })


  output$plot <- renderHighchart({

    highchart() %>%

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

  })
}

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

最后这也是ignoreNULL = FALSE 所做的：它在会话启动期间附加CustomMessageHandler。

也请查看这个有用的article

Answer 2

只需在observeEvent 函数中添加ignoreNULL=FALSE-

我注意到@ismirsehregal 在 cmets 中提到了这个技巧。

工作代码-

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(chartid, sendid, df, session) {

  message = jsonlite::toJSON(df)
  session$sendCustomMessage(sendid, message)

  jscode <- paste0('Shiny.addCustomMessageHandler("', sendid, '", function(message) {
        var chart1 = $("', chartid, '").highcharts()

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

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

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

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

      console.log("code was run")

      chart1.redraw();
    })')

  print("execute code!")
  runjs(jscode)
}




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

  # Application title
  titlePanel("Update highcharter dynamically"),
  #includeScript("www/script.js"),
  useShinyjs(),

  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      actionButton("data", "Generate Data")
    ),

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


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


  observeEvent(input$data, ignoreNULL = FALSE, {

    df1 <- data.frame(
      a = floor(runif(10, min = 1, max = 10)),
      b = floor(runif(10, min = 1, max = 10))
    )
    print(df1)
    updaterfunction(chartid = "#plot", sendid = "handler", df = df1, session = session)

  })


  output$plot <- renderHighchart({

    highchart() %>%

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

  })
}

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