ggplot not working in eventReactive() correctly in shiny - r

I wasted hours to find out why my plot is automatically updating itself when I change inputs while it was supposed to wait for the Run button but it simply ignored that step and I ended up finally finding ggplot as the trouble maker!!! This is my minimal code:
library(ggplot2)
library(tidyverse)
varnames <- names(cars)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fluidRow(
column(
width = 12,
# Variables Inputs:
varSelectInput("variables", "Select Input Variables", cars, multiple = TRUE),
selectizeInput("outvar", "Select Output Variable", choices = varnames, "speed", multiple = F),
# Run Button
actionButton(inputId = "run", label = "Run")
)
)
),
# Main panel for displaying outputs ----
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
df <- reactive({
cars %>% dplyr::select(!!!input$variables, input$outvar)
})
plt <- eventReactive(input$run, {
#Just creating lm formula
current_formula <- paste0(input$outvar, " ~ ", paste0(input$variables, collapse = " + "))
current_formula <- as.formula(current_formula)
#Fitting lm
fit <- lm(current_formula, data = df())
pred <- predict(fit, newdata = df())
#Plotting
ggplot(df(), aes(df()[, input$outvar], pred)) +
labs(x = "Observed", y = "Predicted") +
geom_point() +
theme_bw()
#plot(df()[, input$outvar], pred) #This one works fine!!!!
})
output$plot <- renderPlot({
plt()
})
}
# Run the application
shinyApp(ui = ui, server = server)
If you run this, you'll notice that ggplot doesn't care anymore about the Run button after the 1st run and it keeps updating as you change the inputs!! However, if you use the simple base plot function (which I put in a comment in the code) there wouldn't be any problems and that works just fine! Sadly I need ggplot in my app because base plot is ugly. I am seeing suggestions for using isolate() to solve this issue but I have no clue where isolate() should be put to fix my problem also it doesn't make sense to use isolate() when base plot function works fine without it and it's the ggplot that makes the problem. Any explanation would be appreciated.

It seems to work fine if you follow the ggplot's preferred method of passing column names i.e using .data.
library(ggplot2)
library(shiny)
server <- function(input, output, session) {
df <- reactive({
cars %>% dplyr::select(!!!input$variables, input$outvar)
})
plt <- eventReactive(input$run, {
#Just creating lm formula
current_formula <- paste0(input$outvar, " ~ ", paste0(input$variables, collapse = " + "))
current_formula <- as.formula(current_formula)
#Fitting lm
fit <- lm(current_formula, data = df())
pred <- predict(fit, newdata = df())
#Plotting
ggplot(df(), aes(.data[[input$outvar]], pred)) +
labs(x = "Observed", y = "Predicted") +
geom_point() +
theme_bw()
})
output$plot <- renderPlot({
plt()
})
}
# Run the application
shinyApp(ui = ui, server = server)

I think the issue is that ggplot is processing things lazily. If you make one change to your code to pre-pull df() and input$outvar, the over-reactivity is fixed:
plt <- eventReactive(input$run, {
#Just creating lm formula
current_formula <- paste0(input$outvar, " ~ ", paste0(input$variables, collapse = " + "))
current_formula <- as.formula(current_formula)
#Fitting lm
fit <- lm(current_formula, data = df())
pred <- predict(fit, newdata = df())
#Plotting
dat <- df()
outv <- input$outvar
ggplot(dat, aes(dat[, outv], pred)) +
labs(x = "Observed", y = "Predicted") +
geom_point() +
theme_bw()
#plot(df()[, input$outvar], pred) #This one works fine!!!!
})
The issue is that ggplot is somehow internally preserving some of the reactivity.
(I placed the assignment to dat and outv immediately before ggplot, just for demonstration. It might be more sensible to assign them first-thing in the eventReactive block and use dat for everything, just for consistency in code (none of the other code is operating on lazy principles).

Related

ggplot not working properly inside eventReactive() in shiny

I wasted hours to find out why my plot is automatically updating itself when I change inputs while it was supposed to wait for the Run button but it simply ignored that step and I ended up finally finding ggplot as the trouble maker!!! This is my minimal code:
library(ggplot2)
library(tidyverse)
varnames <- names(cars)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fluidRow(
column(
width = 12,
# Variables Inputs:
varSelectInput("variables", "Select Input Variables", cars, multiple = TRUE),
selectizeInput("outvar", "Select Output Variable", choices = varnames, "speed", multiple = F),
# Run Button
actionButton(inputId = "run", label = "Run")
)
)
),
# Main panel for displaying outputs ----
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
df <- reactive({
cars %>% dplyr::select(!!!input$variables, input$outvar)
})
plt <- eventReactive(input$run, {
#Just creating lm formula
current_formula <- paste0(input$outvar, " ~ ", paste0(input$variables, collapse = " + "))
current_formula <- as.formula(current_formula)
#Fitting lm
fit <- lm(current_formula, data = df())
pred <- predict(fit, newdata = df())
#Plotting
ggplot(df(), aes(df()[, input$outvar], pred)) +
labs(x = "Observed", y = "Predicted") +
geom_point() +
theme_bw()
#plot(df()[, input$outvar], pred) #This one works fine!!!!
})
output$plot <- renderPlot({
plt()
})
}
# Run the application
shinyApp(ui = ui, server = server)
If you run this, you'll notice that ggplot doesn't care anymore about the Run button after the 1st run and it keeps updating as you change the inputs!! However, if you use the simple base plot function (which I put in a comment in the code) there wouldn't be any problems and that works just fine! Sadly I need ggplot in my app because base plot is ugly. I am seeing suggestion for using isolate() to solve this issue but I have no clue where isolate() should be put to fix my problem also it doesn't make sense to use isolate() when base plot function works fine without it and it's the ggplot that makes the problem. Any explanation would be appreciated.
The issue is that ggplot aesthetics are lazy evaluated. You really want to put symbols into the aes() rather that reactive data values. Change your plotting code to
ggplot(df(), aes(.data[[input$outvar]], pred)) +
labs(x = "Observed", y = "Predicted") +
geom_point() +
theme_bw()
With ggplot you use the .data pronoun to access the current data source rather than trigger the reactive df() object again.

Using switch to transform a variable from within a ggplot2 function

I have an R Shiny app which plots horsepower from the mtcars data set against a user selected x variable. I would like the user to be able to select a transformation to perform on the x-variable ahead of plotting. In the simplified example below, these transformations are the ability to square it or obtain its reciprocal. I am doing this using a switch function.
While this switching function works in non-shiny contexts, I can't get it to execute inside a working shiny app. I know that I could perform the transformation on a reactive copy of the data frame and plot from that, but if possible, I would like to perform the transformation in the ggplot call itself. Does anyone have any suggestions on how to do so?
library(shiny)
library(tidyverse)
tran_func <- function(pred, trans) {
switch(trans,
"None" = pred,
"Reciprocal" = 1/pred,
"Squared" = pred^2,
)
}
ui <- fluidPage(
selectInput("xvar",
"Select X Variable",
choices = names(mtcars),
selected = "disp"),
selectInput("transform",
"Select Transformation",
choices = c("None", "Reciprocal", "Squared"),
selected = "None"),
plotOutput("scatter_good"),
plotOutput("scatter_bad")
)
server <- function(input, output, session) {
output$scatter_good <- renderPlot({
mtcars %>%
ggplot(aes_string(x = "hp", y = input$xvar)) +
geom_point()
})
output$scatter_bad <- renderPlot({
mtcars %>%
ggplot(aes_string(x = "hp", y = tran_func(input$xvar, "Squared"))) +
geom_point()
})
}
shinyApp(ui, server)
The issue would be the evaluation of the string passed from input$xvar to modify the column. An option is to pass the 'data' also as argument in the function, and use [[ to subset the column without converting to symbol or evaluate
library(shiny)
library(ggplot2)
library(dplyr)
tran_func <- function(data, pred, trans) {
switch(trans,
"None" = data[[pred]],
"Reciprocal" = 1/data[[pred]],
"Squared" = data[[pred]]^2,
)
}
ui <- fluidPage(
selectInput("xvar",
"Select X Variable",
choices = names(mtcars),
selected = "disp"),
selectInput("transform",
"Select Transformation",
choices = c("None", "Reciprocal", "Squared"),
selected = "None"),
plotOutput("scatter_good"),
plotOutput("scatter_bad")
)
server <- function(input, output, session) {
output$scatter_good <- renderPlot({
mtcars %>%
mutate(y_col = tran_func(cur_data(), input$xvar, input$transform)) %>%
ggplot(aes(x = hp, y = y_col)) +
geom_point()
})
output$scatter_bad <- renderPlot({
mtcars %>%
mutate(y_col = tran_func(cur_data(), input$xvar, input$transform)) %>%
ggplot(aes(x = hp, y =y_col)) +
geom_point()
})
}
shinyApp(ui, server)
-output

Interactive Bar Chart Using Shiny - Graph changes based on selected columns

I am teaching myself r and shiny and trying to make an interactive bar chart where the user can change the chart based on columns. I keep getting errors with this code. Any help would be appreciated! My data has four columns: v, one, two, three. The first column is characters and the last three are numbers. I want to change the bar chart based on the y axis (columns: one, two and three). Right now, the error I am getting is: missing value where TRUE/FALSE needed.
library(shiny)
library(readr)
library(ggplot2)
data <- read.csv('scoring.csv')
data$v <- as.character(data$v)
ui <- fluidPage(
titlePanel("Scoring"),
sidebarPanel(
selectInput(inputId = "scoring", label = "Select a score:", c("Scoring Method 1", "Scoring Method 2", "Scoring Method 3"))),
mainPanel(
plotOutput(outputId = "bar")
)
)
#browser()
server <- function(input, output) {
new_data <- reactive({
selected_score = as.numeric(input$"scoring")
if (selected_score == "Scoring Method 1"){(data[data$one])}
if (selected_score == "Scoring Method 2"){(data[data$two])}
if (selected_score == "Scoring Method 3"){(data[data$three])}
})
#browser()
output$bar <- renderPlot({
newdata <- new_data()
p <- ggplot(newdata, aes(x=reorder(v, -selected_score), selected_score, y = selected_score, fill=v)) +
geom_bar(stat = 'identity', fill="darkblue") +
theme_minimal() +
ggtitle("Sports")
barplot(p, height = 400, width = 200)
})
}
Run the application
shinyApp(ui = ui, server = server)
You have a few errors in your code. In the server part, please use input$scoring, instead of input$"scoring".
First, in ui selectInput could be defined as
selectInput(inputId = "scoring", label = "Select a score:", c("Scoring Method 1"="one",
"Scoring Method 2"="two",
"Scoring Method 3"="three")))
Second, your reactive dataframe new_data() could be defined as shown below:
new_data <- reactive({
d <- data %>% mutate(selected_score = input$scoring)
d
})
Third, ggplot could be defined as
output$bar <- renderPlot({
newdata <- new_data()
p <- ggplot(newdata, aes(x=v, y = newdata[[as.name(selected_score)]], fill=v)) +
geom_bar(stat = 'identity', position = "dodge", fill="blue") +
theme_bw() +
#scale_fill_manual(values=c("blue", "green", "red")) +
scale_y_continuous(limits=c(0,10)) +
ggtitle("Sports")
p
})
Please note that you had an extra selected_score variable within aes. My suggestion would be to play with it to reorder x, and review some online or youtube videos on R Shiny.

R/Shiny: Change plot ONLY after action button has been clicked

I am setting up a small shiny app where I do not want the plot to change unless the action button is clicked. In the example below, when I first run the app, there is no plot until I click the action button. However, if I then change my menu option in the drop-down from Histogram to Scatter, the scatter plot is automatically displayed even though the value for input$show_plot has not changed because the action button has not been clicked.
Is there a way that I can change my menu selection from Histogram to Scatter, but NOT have the plot change until I click the action button? I've read through several different posts and articles and can't seem to get this worked out.
Thanks for any input!
ui.R
library(shiny)
fluidPage(
tabsetPanel(
tabPanel("Main",
headerPanel(""),
sidebarPanel(
selectInput('plot_type', 'Select plot type', c('Histogram','Scatter'), width = "250px"),
actionButton('show_plot',"Plot", width = "125px"),
width = 2
),
mainPanel(
conditionalPanel(
"input.plot_type == 'Histogram'",
plotOutput('plot_histogram')
),
conditionalPanel(
"input.plot_type == 'Scatter'",
plotOutput('plot_scatter')
)
))
)
)
server.R
library(shiny)
library(ggplot2)
set.seed(10)
function(input, output, session) {
### GENERATE SOME DATA ###
source_data <- reactive({
mydata1 = as.data.frame(rnorm(n = 100))
mydata2 = as.data.frame(rnorm(n = 100))
mydata = cbind(mydata1, mydata2)
colnames(mydata) <- c("value1","value2")
return(mydata)
})
# get a subset of the data for the histogram
hist_data <- reactive({
data_sub = as.data.frame(source_data()[sample(1:nrow(source_data()), 75), "value1"])
colnames(data_sub) <- "value1"
return(data_sub)
})
# get a subset of the data for the scatter plot
scatter_data <- reactive({
data_sub = as.data.frame(source_data()[sample(1:nrow(source_data()), 75),])
return(data_sub)
})
### MAKE SOME PLOTS ###
observeEvent(input$show_plot,{
output$plot_histogram <- renderPlot({
isolate({
plot_data = hist_data()
print(head(plot_data))
p = ggplot(plot_data, aes(x = value1, y = ..count..)) + geom_histogram()
return(p)
})
})
})
observeEvent(input$show_plot,{
output$plot_scatter <- renderPlot({
isolate({
plot_data = scatter_data()
print(head(plot_data))
p = ggplot(plot_data, aes(x = value1, y = value2)) + geom_point()
return(p)
})
})
})
}
Based on your desired behavior I don't see a need for actionButton() at all. If you want to change plots based on user input then the combo of selectinput() and conditionPanel() already does that for you.
On another note, it is not good practice to have output bindings inside any reactives. Here's an improved version of your server code. I think you are good enough to see notice the changes but comment if you have any questions. -
function(input, output, session) {
### GENERATE SOME DATA ###
source_data <- data.frame(value1 = rnorm(n = 100), value2 = rnorm(n = 100))
# get a subset of the data for the histogram
hist_data <- reactive({
# reactive is not needed if no user input is used for creating this data
source_data[sample(1:nrow(source_data), 75), "value1", drop = F]
})
# get a subset of the data for the histogram
scatter_data <- reactive({
# reactive is not needed if no user input is used for creating this data
source_data[sample(1:nrow(source_data), 75), , drop = F]
})
### MAKE SOME PLOTS ###
output$plot_histogram <- renderPlot({
req(hist_data())
print(head(hist_data()))
p = ggplot(hist_data(), aes(x = value1, y = ..count..)) + geom_histogram()
return(p)
})
output$plot_scatter <- renderPlot({
req(scatter_data())
print(head(scatter_data()))
p = ggplot(scatter_data(), aes(x = value1, y = value2)) + geom_point()
return(p)
})
}

Ways to make shiny faster when using rhandsontable and reactiveValues

My shiny code has an rhandstontable that the user can edit. This leads to an update of the rightmost columns, based on a custom function. the code also plots values from the table on two ggplots, which also get updated when the table values change. All of this works except that there is a funny double refresh that makes Shiny slow; my table isn't big, about 50rows by 23 columns where only 4 columns are used in the plots but about 12 columns go into my custom function.
Is there a way to make shiny faster using observe(), reactiveValues, or other related functions?
I'm new at reactive expressions and I've been reading that it might be possible to make the app faster by caching data properly.
library(shiny)
library(rhandsontable)
library(tidyverse)
library(ggthemes)
library(ggrepel)
## Create the dataset
DF <- readRDS("data/DF2.Rds")
numberofrows <- nrow(DF)
# weighting variables
w1 = (c(4,3,1))
w2 = (c(1,1,1,1))
w3 = (c(2,2,1,2,1,1,2))
# Function to calculate scores
ScoresTbl <- function(data, w1, w2, w3){
Description <- data[,1:9]
Potential <- crossprod(t(data[,10:12]), w1)/sum(w1)
Setting <- crossprod(t(data[,13:16]), w2)/sum(w2)
Risk <- crossprod(t(data[,17:23]),w3)/sum(w3)
data.frame(data[1:23],Potential,Setting,Risk) %>%
mutate(
SOP = rowMeans(data.frame(Potential,Setting,Risk)))
}
ui = fluidPage(
fluidRow(column(12,
rHandsontableOutput('hotable1', width = "100%", height = "25%")#,
# actionButton("go", "Plot Update")
)),
fluidRow(column(6, plotOutput("plot1")),
column(6, plotOutput("plot2")))
)
server <- shinyServer(function(input, output) {
indat <- reactiveValues(data=ScoresTbl(DF,w1, w2, w3))
observe({
if(!is.null(input$hotable1))
indat$data <- hot_to_r(input$hotable1)
})
output$hotable1 <- renderRHandsontable({
rhandsontable(ScoresTbl(indat$data,w1, w2, w3))
})
output$plot1 <- renderPlot({
ggplot(data = indat$data,
aes(x=Potential,
y=Setting, label = Project)) +
geom_point(alpha = 0.5) +
scale_size(range = c(2,15)) +
geom_text_repel(colour = "black",size = 2.5) +
theme_minimal()
})
output$plot2 <- renderPlot({
ggplot(data = indat$data,
aes(x=Potential,
y=Setting, label = Project)) +
geom_point(alpha = 0.5) +
scale_size(range = c(2,15)) +
geom_text_repel(colour = "black",size = 2.5) +
theme_minimal()
})
})
shinyApp(ui, server)

Resources