Search code examples
rshinyr-highcharter

renderHighchart output not displaying in Shiny App


I have some data which looks like:

# A tibble: 100 × 4
    price  habs  mts2 type    
    <dbl> <dbl> <dbl> <chr>   
 1 338000     3    92 comprar 
 2 288000     4    79 comprar 
 3   3000     2    55 alquiler
 4    775     1    10 alquiler
 5 288000     4    76 comprar 

In R I can plot the data using the following:

library(highcharter)
library(tidyverse)
library(broom)

highcharterPlotterFunction = function(TYPE){
  filteredDF = df %>%
    filter(type == TYPE)
  
  # formula = as.formula(y ~ x + I(x^2))
  
  lm.model <- augment(lm(price ~ mts2, data = filteredDF)) %>%
    mutate(
      .fitted = round(.fitted, 0)
    )
  
  highchart() %>%
    hc_add_series(data = lm.model,
                  type = "scatter",
                  hcaes(x = price, y = mts2, color = mts2),
                  showInLegend = FALSE,
                  dataLabels = list(enabled = TRUE, format='{point.games}')
    ) %>%
    hc_add_series(data = lm.model,
                  type = "line",
                  hcaes(x = .fitted, y = mts2),
                  color = "#0099F9",
                  showInLegend = FALSE,
                  dataLabels = list(enabled = TRUE, format='{point.games}')
    ) %>%
    hc_title(text = str_to_title(TYPE))
}


c("comprar", "alquiler") %>%
  map(., ~highcharterPlotterFunction(.x)) %>%
  hw_grid(rowheight = 300, ncol = 1) %>%
  htmltools::browsable()

Which plots two highercharter graphics on top of each other. However, when I try to put it into a shiny App I do not get any output:

Shiny App:

library(shiny)


ui <- fluidPage(
  fluidRow(
    p("plot goes below here"),
    highchartOutput('regressionPlots')
  )
)


server <- function(input, output) {

  highcharterPlotterFunction = function(TYPE){
    filteredDF = reactive_regression_data() %>%
      filter(type == TYPE)

    # formula = as.formula(y ~ x + I(x^2))

    lm.model <- augment(lm(price ~ mts2, data = filteredDF)) %>%
      mutate(
        .fitted = round(.fitted, 0)
      )

    highchart() %>%
      hc_add_series(data = lm.model,
                    type = "scatter",
                    hcaes(x = price, y = mts2, color = mts2),
                    showInLegend = FALSE
      ) %>%
      hc_add_series(data = lm.model,
                    type = "line",
                    hcaes(x = .fitted, y = mts2),
                    color = "#0099F9",
                    showInLegend = FALSE
      ) %>%
      hc_title(text = str_to_title(TYPE))
  }

  reactive_regression_data = reactive(
    df %>%
      # filter(provincia == input$provinceSelect) %>%
      # filter(municipio == input$municipioSelect) %>%
      # filter(distrito == input$distritoSelect) %>%
      filter(price <= 1000000) %>%
      filter(mts2 <= 200)
  )

  output$regressionPlots <- renderHighchart({
    c("comprar", "alquiler") %>%
      map(., ~highcharterPlotterFunction(.x)) %>%
      hw_grid(rowheight = 300, ncol = 1) %>%
      htmltools::browsable()
  })
}


shinyApp(ui = ui, server = server)

Data:

df <- structure(list(price = c(338000, 288000, 3000, 775, 288000, 230000, 
218000, 2900, 845000, 1250, 288000, 299000, 356000, 1500, 300000, 
1300, 1500, 288000, 405000, 715000, 225000, 294000, 790, 329000, 
320000, 1200, 1150, 715000, 415000, 715000, 295000, 1500, 348000, 
1100, 3000, 249000, 379000, 761000, 320000, 1995, 715000, 715000, 
229000, 1600, 389000, 330000, 212000, 415000, 288000, 950, 1850, 
365000, 1050, 1650, 1750, 350000, 288000, 715000, 1200, 990, 
260000, 234500, 1400, 288000, 1100, 1650, 348000, 332000, 288000, 
350000, 1350, 360000, 2800, 379000, 799000, 288000, 685000, 1700, 
890, 294000, 338000, 590000, 294000, 1050, 320000, 1990, 350000, 
1100, 365000, 365000, 294000, 299000, 288000, 490000, 229000, 
2095, 560000, 288000, 715000, 360000), habs = c(3, 4, 2, 1, 4, 
3, 2, 4, 3, 2, 4, 2, 2, 4, 2, 4, 2, 4, 3, 3, 1, 2, 1, 4, 3, 3, 
NA, NA, 3, NA, 3, 2, 4, 2, 4, 2, 3, 3, 2, 2, 3, 3, 3, 1, 4, 4, 
2, 4, 4, 1, 4, 3, 1, 2, 2, 4, 4, 3, 3, 2, NA, 3, 4, 4, 3, 1, 
4, 4, 4, 4, 3, 4, 2, 3, 4, 4, 4, 4, 2, 2, 3, 4, 2, 1, 3, 1, 4, 
3, 3, 3, 2, 2, 4, 4, 3, 3, 4, 4, 3, 2), mts2 = c(92, 79, 55, 
10, 76, 65, 57, 95, 121, 57, 76, 90, 70, 102, 74, 83, 88, 79, 
83, 109, 60, 75, 47, 75, 68, 70, 30, 109, 80, 109, 100, 75, 80, 
70, 135, 65, 95, 121, 68, 110, 109, 109, 63, 70, 100, 85, 54, 
100, 76, 45, 100, 94, 46, 71, 92, 87, 76, 109, 88, 68, 58, 65, 
104, 75, 75, 40, 80, 80, 76, 87, 75, 112, 95, 111, 135, 79, 88, 
115, 43, 75, 92, 145, 75, 46, 92, 47, 87, 75, 90, 63, 70, 85, 
76, 111, 60, 132, 140, 79, 109, 70), type = c("comprar", "comprar", 
"alquiler", "alquiler", "comprar", "comprar", "comprar", "alquiler", 
"comprar", "alquiler", "comprar", "comprar", "comprar", "alquiler", 
"comprar", "alquiler", "alquiler", "comprar", "comprar", "comprar", 
"comprar", "comprar", "alquiler", "comprar", "comprar", "alquiler", 
"alquiler", "comprar", "comprar", "comprar", "comprar", "alquiler", 
"comprar", "alquiler", "alquiler", "comprar", "comprar", "comprar", 
"comprar", "alquiler", "comprar", "comprar", "comprar", "alquiler", 
"comprar", "comprar", "comprar", "comprar", "comprar", "alquiler", 
"alquiler", "comprar", "alquiler", "alquiler", "alquiler", "comprar", 
"comprar", "comprar", "alquiler", "alquiler", "comprar", "comprar", 
"alquiler", "comprar", "alquiler", "alquiler", "comprar", "comprar", 
"comprar", "comprar", "alquiler", "comprar", "alquiler", "comprar", 
"comprar", "comprar", "comprar", "alquiler", "alquiler", "comprar", 
"comprar", "comprar", "comprar", "alquiler", "comprar", "alquiler", 
"comprar", "alquiler", "comprar", "comprar", "comprar", "comprar", 
"comprar", "comprar", "comprar", "alquiler", "comprar", "comprar", 
"comprar", "comprar")), row.names = c(NA, -100L), class = c("tbl_df", 
"tbl", "data.frame"))

Solution

  • You when you use renderHighchart(), the expression in the curly braces expects a return value of class highchart. However, when you combine multiple charts using hw_grid(), the return value is of class shiny.tag. Therefore, the output binding is not able to render the output and (silently) fails.

    The simplest fix for this is to replace renderHighchart() with renderUI() and highchartOutput() with uiOutput().

    shiny::shinyApp(
      shiny::fluidPage(
        shiny::uiOutput("chart")
      ),
      function(input, output, session) {
        output$chart <- shiny::renderUI({
          highcharter::hw_grid(
            highcharter::highcharts_demo(),
            highcharter::highcharts_demo()
          )
        })
      }
    )
    

    Annother approach would be to use two separate calls to renderHighchart()/highchartOutput() and combine the charts inside the UI. However, with this approach you won't be able to use hw_grid()

    A third way, which is probably the most challenging yet the most flexible is to use the highcharts.js API to generate multiple axes as in the examples here. This way, the dual-axis chart will be represented as a single highcharter object which means that it can be passed to renderHighchart().