highcharter
highcharter copied to clipboard
jbkunst
Strange reactive update behaviour with div wrapped around highcharter objects
Hey Joshua (@jbkunst),
first of all: I really love your package! It makes shiny apps even better! And I would like to thank you for your quick responses here and over at Stackoverflow - saved my developer-life quit a few times now ;-)
However, I've discovered a strange reactive update/render behaviour with the charts when you wrap an object with a div and set the same name for both IDs, the div ID and the highcharter ID. I know, setting the same name for something like an ID isn't really a good idea, but I wasn't thinking about it and thus spent the last days debugging this problem. However, base R objects like barplots or a data tables do not have said problem with the same ID, i.e. they update/render properly.
Here is a small working example wich reproduces the bug. If the user changes the input in the dropdown, both charts should be redrawn. However, sometimes both do not react on the change. Sometimes only the waterfall chart reacts to the changes, but not the barchart:
library(shiny)
library(dplyr)
library(highcharter)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("cars")
),
mainPanel(
tabsetPanel(
tabPanel("Linechart",
div(id = "hc_linechart",
highchartOutput("hc_linechart", height = "500px")
)
),
tabPanel("Waterfall",
div(id = "hc_waterfall",
highchartOutput("hc_waterfall", height = "500px")
)
)
)
)
)
)
server <- function(input, output) {
output$cars <- renderUI({
selectizeInput(
inputId = "cars",
label = NULL,
choices = rownames(mtcars),
options = list(placeholder = 'Cars')
)
})
output$hc_linechart <- renderHighchart({
data_line <- subset(mtcars, rownames(mtcars) %in% input$cars)
hc <- highchart() %>%
hc_chart(type = "column") %>%
hc_title(text = rownames(data_line), useHTML = TRUE) %>%
hc_yAxis(title = "") %>%
hc_xAxis(title = "")
for(i in 1:(ncol(data_line)))
{
hc <- hc %>%
hc_add_series(data = data_line[,i], name = names(data_line)[i])
}
hc
})
output$hc_waterfall <- renderHighchart({
data_line <- subset(mtcars, rownames(mtcars) %in% input$cars)
name <- c(names(data_line),"Sum")
y <- data_line[,1]
color <- "#377EB8"
for(i in 2:(ncol(data_line)))
{
y <- c(y, data_line[,i]-data_line[,i-1])
if(y[i] > 0)
{
color <- c(color, "#4DAF4A")
}else
{
color = c(color, "#E41A1C")
}
}
y <- c(y, NA)
color = c(color, "#377EB8")
isIntermediateSum = rep(FALSE, times = 12)
isSum <- rep(FALSE, times = 11)
isSum <- c(isSum, TRUE)
dataframe = data.frame(name, y, isIntermediateSum, isSum, color, stringsAsFactors = F)
hc <- highchart() %>%
hc_chart(type = "waterfall") %>%
hc_title(text = rownames(data_line), useHTML = TRUE) %>%
hc_yAxis(title = "") %>%
hc_xAxis(title = "") %>%
hc_add_series(data = dataframe,
dataLabels = list(
enabled=TRUE,
formatter= JS("function(){ return Highcharts.numberFormat(this.y, 2, ',');}"),
style=list(
color="#FFFFFF",
fontWeight="bold",
textShadow="0px 0px 3px black"
)
)
)
hc
})
}
# Run the application
shinyApp(ui = ui, server = server)
If you change the ID of the divs or the highcharter objects, the update mechanism works as expected. Here I change the div IDs to "css_hc_linechart" and "css_hc_waterfall":
tabPanel("Linechart",
div(id = "css_hc_linechart",
highchartOutput("hc_linechart", height = "500px")
)
),
tabPanel("Waterfall",
div(id = "css_hc_waterfall",
highchartOutput("hc_waterfall", height = "500px")
)
)
Now let's take other R objects instead of the highcharter object, but use again the same IDs:
library(shiny)
library(reshape2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("cars")
),
mainPanel(
tabsetPanel(
tabPanel("Linechart",
div(id = "hc_linechart",
plotOutput("hc_linechart")
)
),
tabPanel("Waterfall",
div(id = "hc_waterfall",
dataTableOutput("hc_waterfall")
)
)
)
)
)
)
server <- function(input, output) {
output$cars <- renderUI({
selectizeInput(
inputId = "cars",
label = NULL,
choices = rownames(mtcars),
options = list(placeholder = 'Cars')
)
})
output$hc_waterfall <- renderDataTable({
data_line <- subset(mtcars, rownames(mtcars) %in% input$cars)
return(data_line)
}, options = list(orderClasses = TRUE, pageLength = 20)
)
output$hc_linechart <- renderPlot({
data_line <- subset(mtcars, rownames(mtcars) %in% input$cars)
data_line <- melt(data_line, measure.vars = 1:11)
barplot(data_line$value,
main=rownames(data_line),
ylab="Numbers",
xlab="Parts"
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
As you can see, the chart and the data table update properly when the user changes the input.
Lastly, my session info:
> sessionInfo()
R version 3.3.3 (2017-03-06)
Platform: x86_64-redhat-linux-gnu (64-bit)
Running under: Red Hat Enterprise Linux
locale:
[1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8 LC_MONETARY=en_US.UTF-8
[6] LC_MESSAGES=en_US.UTF-8 LC_PAPER=en_US.UTF-8 LC_NAME=C LC_ADDRESS=C LC_TELEPHONE=C
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
attached base packages:
[1] grid stats graphics grDevices utils datasets methods base
other attached packages:
[1] gtools_3.5.0 reshape2_1.4.2 readxl_1.0.0 microbenchmark_1.4-2.1 purrr_0.2.2 feather_0.3.1
[7] highcharter_0.5.0 ggplot2_2.2.1 tidyr_0.6.1 dplyr_0.5.0 rintrojs_0.1.2 shinyjs_0.9
[13] shinyBS_0.61 data.table_1.10.4 htmlTable_1.9 shiny_1.0.3
loaded via a namespace (and not attached):
[1] Rcpp_0.12.10 cellranger_1.1.0 plyr_1.8.4 xts_0.9-7 tools_3.3.3 digest_0.6.12 lubridate_1.6.0 jsonlite_1.5
[9] tibble_1.3.0 checkmate_1.8.2 gtable_0.2.0 nlme_3.1-131 lattice_0.20-35 igraph_1.0.1 psych_1.7.5 DBI_0.6-1
[17] yaml_2.1.14 parallel_3.3.3 stringr_1.2.0 knitr_1.15.1 hms_0.3 htmlwidgets_0.9 R6_2.2.2 foreign_0.8-68
[25] TTR_0.23-1 magrittr_1.5 backports_1.0.5 scales_0.4.1 htmltools_0.3.6 rlist_0.4.6.1 quantmod_0.4-9 assertthat_0.2.0
[33] mnormt_1.5-5 mime_0.5 xtable_1.8-2 colorspace_1.3-2 httpuv_1.3.3 stringi_1.1.5 miniUI_0.1.1 lazyeval_0.2.0
[41] munsell_0.4.3 broom_0.4.2 zoo_1.8-0
