只有在第二次单击后,Highcharter剧情才会更新-R Shiny

时间:2019-07-16 12:16:06

标签: javascript r shiny shinyjs r-highcharter

这是我的代码,类似于我今天已经发布的问题。现在我有另一个问题,我无法解决。当我单击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)

2 个答案:

答案 0 :(得分:1)

只需在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)

答案 1 :(得分: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