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)
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") ##
)
)
Related
I have a very simple shiny app that is makes a gt table using some inputs.
One of my goals is to pass a user input which is numeric into the cols_width() argument so I can add padding to my first column. Although when doing something like the following I get an error that the input is not found.
output$table <- render_gt(
reactive_tab() %>%
gt() %>%
cols_width(
1 ~ px(input$colpad)
)
)
I've also tried doing {input$colpad} and .(input$colpad) with no success either.
Desired Output:
Here is the code:
library(data.table)
library(shiny)
library(gt)
library(shinyscreenshot)
data <- gtcars %>% head(10) %>%
select(mfr, model, msrp)
ui <- navbarPage("Y u no pad??",
tabPanel("Table", icon = icon("table"),
sidebarLayout(
sidebarPanel(
selectInput("input",
label = "Choose mfr",
choices = c("All", data$mfr)),
numericInput("colpad", label = "First Column Padding", min = 1, max = 10000, value = 150),
screenshotButton(selector="#table", label = 'Download Png', filename = 'screenshot'),
),
mainPanel(
gt_output("table")
)
)
)
)
server <- function(input, output, session) {
reactive_tab <- reactive({
d <- data
if(input$input != "All")
d <- subset(d, cyl == input$input)
d
})
output$table <- render_gt(
reactive_tab() %>%
gt() %>%
cols_width(
1 ~ px(input$colpad)
)
)
}
shinyApp(ui, server)
Reason
The reason this is not working is because of the way gt::cols_width() evaluates is arguments. It does not know which environment to look in to find the input object.
One way to circumvent the issue is to first evaluate input$colpad and then pass the value in a way gt::cols_width() will understand.
Code
Here is one such approach where I paste together a formula and cast it as such on line 46:
library(data.table)
library(shiny)
library(gt)
library(shinyscreenshot)
select <- dplyr::select
data <- gtcars %>%
head(10) %>%
select(mfr, model, msrp)
ui <- navbarPage(
"Y u no pad??",
tabPanel("Table",
icon = icon("table"),
sidebarLayout(
sidebarPanel(
selectInput("input",
label = "Choose mfr",
choices = c("All", data$mfr)
),
numericInput("colpad", label = "First Column Padding", min = 1, max = 10000, value = 150),
screenshotButton(selector = "#table", label = "Download Png", filename = "screenshot"),
),
mainPanel(
gt_output("table")
)
)
)
)
server <- function(input, output, session) {
reactive_tab <- reactive({
d <- data
if (input$input != "All") {
d <- subset(d, cyl == input$input)
}
d
})
output$table <- render_gt(
reactive_tab() %>%
gt() %>%
cols_width(
as.formula(paste0("1 ~ ", input$colpad)) # EDIT HERE
)
)
}
shinyApp(ui, server)
Result
I want to let the user be able to select "NA" or enter empty values in the sliderInput. Maybe add a "NA" button near the slider input? Is there any way to do that?
example
Thanks
You can add a checkboxInput and pair it with an if condition inside the server. Here's an example using iris dataset.
library(shiny)
library(shinyWidgets)
library(tidyverse)
iris_df <- iris
#populate with some NA's
set.seed(123)
sample(1:nrow(iris), 10) %>%
walk(~ {
iris_df[.x, "Sepal.Width"] <<- NA
})
ui <- fluidPage(
checkboxInput("na", "Select NA Values", value = FALSE),
conditionalPanel(
condition = "input.na == false",
sliderInput("sepalw", "Sepal Width Range",
value = c(median(iris$Sepal.Width), max(iris$Sepal.Width)),
min = min(iris$Sepal.Width),
max = max(iris$Sepal.Width)
)
),
dataTableOutput("table")
)
server <- function(input, output, session) {
df <- reactive({
if (!input$na) {
iris_df %>%
filter(between(Sepal.Width, input$sepalw[[1]], input$sepalw[[2]]))
} else {
iris_df %>% filter(is.na(Sepal.Width))
}
})
output$table <- renderDataTable(
{
df()
},
options = list(pageLength = 10)
)
}
shinyApp(ui, server)
I'm trying to build a simple application that draws a histogram of a selected variable based on a subset filtered by the other input. I get the error in the line hist(dataX()$datasetInput()) which should return dataX$mpg. How can I fix it?
Full code:
library(shiny)
u <- shinyUI(pageWithSidebar(
headerPanel("Staz w bezrobociu"),
sidebarPanel(
selectInput("variable", "Variable:",
list("Milles/gallon",
"Horse power")
),
textInput("nc","Number of cylinders",value = 6)
),
mainPanel(
plotOutput("Plot")
)
))
s <- shinyServer(function(input, output)
{
dataX <- reactive({mtcars[mtcars$cyl==input$nc,,drop = FALSE]})
datasetInput <- reactive({
switch(input$variable,
"Milles/gallon" = mpg,
"Horse power" = hp)
})
output$Plot <- renderPlot({
hist(dataX()$datasetInput())
})
})
shinyApp(u,s)
You complicated the simple app.
You do not need to list all the columns in selectInput. You can just render it from the server side.
Same applies to the cylinders
Shortcuts like u and sare acceptable, but just stick to the naming conventions. It makes your life easy.
Below is a complete working app
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("Staz w bezrobociu"),
sidebarPanel(uiOutput("SelectColname"),
uiOutput("Cylinders")),
mainPanel(plotOutput("Plot"))
))
server <- shinyServer(function(input, output){
# Create a reactive dataset
dataX <- reactive({
mtcars
})
# Output number cylinders as select box
output$Cylinders <- renderUI({
selectInput("cylinders", "cylinders:", unique(dataX()$cyl))
})
# Output column names as selectbox
output$SelectColname <- renderUI({
selectInput("variable", "Variable:", colnames(dataX()[,c(1,4)]))
})
# Based on the selection by user, create an eventreactive plotdata object
plotdata <- eventReactive(input$cylinders, {
plotdata = dataX()[dataX()$cyl == input$cylinders, , drop = FALSE]
})
# Render the plot, the plot changes when new cylinder is selected
output$Plot <- renderPlot({
if (is.null(plotdata()))
return(NULL)
hist(
plotdata()[, input$variable],
xlab = input$variable,
main = paste(
"Histogram of" ,
input$variable
)
)
})
})
shinyApp(ui, server)
I have created a shinyapp, with tabs, that takes a dataframe and allows the user to filter it - then create a histogram based on the filters. This app works great when I run it on my local machine. However, When I publish it to shinyapps.io I get the following error:
ERROR: object of type 'closure' is not subsettable
I understand from other posts that the dataframe needs to be reactive or may need to be reactive? However when I enclose the data frame in reactive like so:
dat <- reactive(df)
I get the same error.
The files are located at github
or here:
library(shiny)
library(DT)
#server.R
shinyServer(function(input, output) {
df <- read.csv('orioles.csv')
output$table <- DT::renderDataTable(DT::datatable({
dat <- df
if (input$opp != "All") {
dat <- dat[dat$Opponent == input$opp,]
}
if (input$prk != "All") {
dat <- dat[dat$parkId == input$prk,]
}
if (input$strt != "All") {
dat <- dat[dat$Day.or.Night == input$strt,]
}
dat
}))
output$plot1 <- renderPlot({
dat <- df
if (input$opp != "All") {
dat <- dat[dat$Opponent == input$opp,]
}
if (input$prk != "All") {
dat <- dat[dat$parkId == input$prk,]
}
if (input$strt != "All") {
dat <- dat[dat$Day.or.Night == input$strt,]
}
hist(dat$BAL_SCORE, main = "Based on Filters", xlab = "Runs", ylab = "Frequency of runs scored", breaks = 20, col = "orange" )
})
})
UI:
library(shiny)
library(DT)
navbarPage(
title = 'Navigation',
tabPanel('Data Table', fluidPage(
titlePanel("Baltimore Orioles Game Results from 2010-2015"),
# Create a new Row in the UI for selectInputs
fluidRow(
column(4,
selectInput("opp",
"Opponent:",
c("All",
unique(as.character(df$Opponent))))
),
column(4,
selectInput("prk",
"Ball Park:",
c("All",
unique(as.character(df$parkId))))
),
column(4,
selectInput("strt",
"Day or Night Game:",
c("All",
unique(as.character(df$Day.or.Night))))
)
),
# Create a new row for the table.
fluidRow(
DT::dataTableOutput("table")
)
)),
tabPanel('Runs', fluidPage(
titlePanel("Runs Scored in filtered games"),
fluidRow(
column(6,
plotOutput("plot1", width = 800, height = 600)
)
)
))
)
I was able to get my App Working. The error was occuring because the data frame was not loading the way I had it set up. Solution is posted on github link shown above.
You'll get a more concise code using reactive and combining your subsetting conditions:
shinyServer(function(input, output) {
df <- read.csv('orioles.csv')
dat <- reactive(
df[(input$opp == "All" | df$Opponent == input$opp) &
(input$prk != "All" | df$parkId == input$prk) &
(input$strt != "All"| df$Day.or.Night == input$strt),])
output$table <- DT::renderDataTable(DT::datatable(dat()))
output$plot1 <- renderPlot({
hist(dat()$BAL_SCORE, main = "Based on Filters", xlab = "Runs",
ylab = "Frequency of runs scored", breaks = 20, col = "orange" )
})
})
I'm building a Shiny app and want to reactivity control which columns get displayed in a heatmap. I'd like for all of the columns to be displayed at first and then be able to subset it by deselecting columns from a checkboxGroupInput.
When I run the code, the heatmap doesn't appear. I tried troubleshooting by looking at the df_select dataframe but it only has the "mpg" column when it should have all of them (mpg:carb) initially. Including View(df_select) throws an error so it is commented out below.
Any help 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),
checkboxGroupInput("col_list", "Select col to include:", names(mtcars), selected=names(mtcars)),
h5(strong("Sort:")),
checkboxInput("check_sort", "Sort (Yes/No)", value=FALSE),
selectInput("sort", "Sort:", names(mtcars), selected="mpg")
),
mainPanel(
h4("Heatmap"),
d3heatmapOutput("heatmap", width = "100%", height="600px")
)
)
## server.R
server <- function(input, output) {
df_select <- reactive({
all <- names(mtcars)
print(all) #debug
selection <- input$col_list
print(selection) #debug
if("All" %in% input$col_list || length(input$col_list) == 0){
selection <- all
}else{
selection <- input$col_list
}
df_select <- select_(mtcars, selection)
#View(df_select) #debug
})
df_sort <- reactive({
df_sort <- if(input$check_sort==FALSE) df_select() else arrange_(df_select(), input$sort)
})
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)
It is a standard evaluation issue. Use select_(mtcars, .dots=selection) (line number 38).