rshinydplyrd3heatmap

Sort Heatmap with dplyr


I'm working on building an interactive heatmap Shiny app and would like select columns to sort from a drop down menu (example: sort "mpg" or "wt" in mtcars from low to high). I'm implementing the heatmap with the d3heatmap package and want to reactivity short the dataframe using dplyr. I get the following error when running the code:

Error in eval(substitute(expr), envir, enclos) : invalid subscript type 'closure'

I have also tried using reactiveValues instead of reactive and included the code as a comment. Using the reactiveValues approach I get the following error:

Warning: Unhandled error in observer: invalid subscript type 'closure'

Any help getting the heatmap sorting to work would be greatly appreciated!

app.R

library(ggplot2)
library(d3heatmap)
library(dplyr)
library(shiny)

## ui.R
ui <- fluidPage(
  sidebarPanel(
    h5(strong("Dendrogram:")),
    checkboxInput("cluster_row", "Cluster Rows", value=FALSE),
    checkboxInput("cluster_col", "Cluster Columns", value=FALSE),
    selectInput("sort", "Sort By:", c(names(mtcars),"none"), selected="mpg")
  ),
  mainPanel(
    h4("Heatmap"),
    d3heatmapOutput("heatmap", width = "100%", height="600px") ##
  )
)

## server.R
server <- function(input, output) {

#   values <- reactiveValues(df=mtcars)
#   
#   observe({
#     if(input$sort != "none"){
#       values$df <- arrange(mtcars, input$sort)
#     }else{
#       values$df <- mtcars
#     }
#   })

  df_sort <- reactive({
    df <- mtcars
    if(input$sort != "none"){
      df <- arrange(mtcars, input$sort)
    }else{
      df <- mtcars
    }
  })

  output$heatmap <- renderD3heatmap({
    d3heatmap(df_sort(),
      colors = "Blues",
      if (input$cluster_row) RowV = TRUE else FALSE,
      if (input$cluster_col) ColV = TRUE else FALSE,
      yaxis_font_size = "7px"
    ) 
  })
}

shinyApp(ui = ui, server = server)

Solution

  • input$sort is being passed as a character string, so you need to use arrange_ (see the vignette on NSE).

    The following should do the trick:

    server <- function(input, output) {
      df_sort <- reactive({
        df <- if(input$sort=='none') mtcars else arrange_(mtcars, input$sort)
      })
      output$heatmap <- renderD3heatmap({
        d3heatmap(
          df_sort(),
          colors = "Blues",
          RowV <- if(input$cluster_row) TRUE else FALSE,
          ColV <- if(input$cluster_col) TRUE else FALSE,
          yaxis_font_size = "7px"
        )
      })
    }
    
    ui <- fluidPage(
      sidebarPanel(
        h5(strong("Dendrogram:")),
        checkboxInput("cluster_row", "Cluster Rows", value=FALSE),
        checkboxInput("cluster_col", "Cluster Columns", value=FALSE),
        selectInput("sort", "Sort By:", c(names(mtcars),"none"), selected="mpg")
      ),
      mainPanel(
        h4("Heatmap"),
        d3heatmapOutput("heatmap", width = "100%", height="600px") ##
      )
    )