Search code examples
javascriptrshinyshinyjsr-highcharter

Highcharter plot updates only after second click - R Shiny


This is my Code, similar like the question I already posted today. Now I have another issue I can not get my head around. When I click the actionButton to update the chart, the chart only updates after the second click. The print statement works after the first click. What is going wrong here?

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)

Solution

  • I guess the problem is, that you are attaching the event handler for your plot after observeEvent(input$data, {...}) is executed for the first time (actually you are adding a the CustomMessageHandler after every button click). Accordingly the event handler isn't already attached during the first button click (and can't react).

    If you initialize the CustomMessageHandler once on session-startup and only send new messages on a button click it works as expected:

    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)
    

    In the end that's also what ignoreNULL = FALSE does: It attaches the CustomMessageHandler during session-startup.

    Please also check this useful article