只有在第二次单击后，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函数中添加ignoreNULL=FALSE observeEvent

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

工作守则

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)

Answer 2

我想问题是，您是在第一次执行observeEvent(input$data, {...})之后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 。

请同时查看此有用的文章