Search code examples
rheatmapapexcharts

Interactive heatmap in R using apexcharter fails at reactivity


at the moment I try to create an interactive heatmap in R with apexcharter. This works fine at manual chart creation but fails on interactive use within shiny.

library(shiny)
library(tidyverse)
library(apexcharter)

# Define UI for application that draws a histogram
ui <- fluidPage(
    
    # Application title
    titlePanel("Test Heatmap"),
    
    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            selectInput(
                inputId = "heatmap_filter",
                label = "heatmap filter",
                choices = c(1999, 2008),
                selected = 2008
            )
        ),
        mainPanel(
            apexchartOutput("heatmap")
        )
    )
)

        
# Define server logic required to draw a histogram
server <- function(input, output) {
    
    output$heatmap <- renderApexchart({

        df <- mpg %>% filter(year == input$heatmap_filter) %>% mutate_if(is.character, as.factor) %>% group_by(manufacturer, class) %>% summarise(cnt = n()) %>% tidyr::complete(class, fill = list(cnt = 0)) 
        
        q20 <-   round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[2],0)
        q40 <-   round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[3],0)
        q60 <-   round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[4],0)
        q80 <-   round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[5],0)
        
        apex(
            data = df,
            type = "heatmap", 
            mapping = aes(x = manufacturer, y = class, fill = cnt)
        ) %>% 
            ax_dataLabels(enabled = TRUE) %>% 
            ax_plotOptions(
                heatmap = heatmap_opts(
                    enableShades = FALSE,
                    colorScale = list(
                        ranges = list(
                            list(from = 0, to = q20, color = "#106e45"), #grün
                            list(from = q20, to = q40, color = "#90dbba"), #leichtes grün
                            list(from = q40, to = q60, color = "#fff33b"), #gelb
                            list(from = q60, to = q80, color = "#f3903f"), # orange
                            list(from = q80, to = 20, color = "#e93e3a") #rot
                        )
                    )
                )
            )  %>% 
            ax_title(
                text = paste("Test interactive heatmap", 
                             input$heatmap_filter
                ), align = "center"
            )
    })
    
}

# Run the application 
shinyApp(ui = ui, server = server)

With the manual approach everthing works as expected. But when I change the input select only the values changes but not the heatmap quantil ranges and not the title input. Its seems like the input value is not pushing the changes to already calculated variables. I already tried to use an reactive df or reactive variables but so far nothing works.

I added a minimal example where you could change the year input and this should change the title and the color ranges.

Can you help me?

Thanks in advance.


Solution

  • Try setting auto_update to FALSE in the call to apex

    apex(
        data = df,
        type = "heatmap", 
        auto_update = FALSE,
        ...