只有在第二次單擊后，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 。

請同時查看此有用的文章