I would like to understand why I get different behaviors than I expect when using eventReactive instead of reactive together with an actionButton to refresh the page.
For example, this simple Shiny dashboard behaves as I expect: upon loading the plot is displayed and I can modify the filter and refresh the plot when clicking on the refresh button.
# app1.R
library(shiny)
library(dplyr)
library(ggplot2)
species <- levels(iris$Species)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("species", "Select Iris Species",
choices = species, selected=species, multiple = TRUE),
actionButton("refresh", "Refresh")
),
mainPanel(plotOutput("scatterplot"))
)
)
server <- function(input, output) {
selected_data <- reactive({
input$refresh
isolate({
iris %>% filter(Species %in% input$species)
})
})
output$scatterplot <- renderPlot({
plot(selected_data())
})
}
shinyApp(ui = ui, server = server)
Based on my understanding of actionButton and eventReactive I though I could replace the code for selected_data with
selected_data <- eventReactive( input$refresh, {
iris %>% filter(Species %in% input$species)
})
this way I make explicit that selected_data only depends on input$refresh.
However the app doesn't behave as I expect: upon loading no plot is shown and I have to explicitely click on "Refresh" to get the plot displayed. After that everything works as intended.
Here is the full code for the second version of the app:
# app2.R
library(shiny)
library(dplyr)
library(ggplot2)
species <- levels(iris$Species)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("species", "Select Iris Species",
choices = species, selected=species, multiple = TRUE),
actionButton("refresh", "Refresh")
),
mainPanel(plotOutput("scatterplot"))
)
)
server <- function(input, output) {
selected_data <- eventReactive( input$refresh, {
iris %>% filter(Species %in% input$species)
})
output$scatterplot <- renderPlot({
plot(selected_data())
})
}
shinyApp(ui = ui, server = server)
According to the documentation, when the Shiny app is executed input$refresh should have changed value from NULL to 0, which in turns triggers the evaluation of selected_data and showing the plot.
Can you explain me why in app1.R the plot is shown when the app is loaded and in app2.R you have to force the refresh manually?
Is there any (clean) way I can make app2.R show the plot when the app is loaded?
There is an argument within eventReactive which is ignoreNULL and it is set to TRUE by default, if you change that to FALSE it will trigger. For more info please refer to ?eventReactive
library(shiny)
library(dplyr)
library(ggplot2)
species <- levels(iris$Species)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("species", "Select Iris Species",
choices = species, selected=species, multiple = TRUE),
actionButton("refresh", "Refresh")
),
mainPanel(plotOutput("scatterplot"))
)
)
server <- function(input, output) {
selected_data <- eventReactive( input$refresh, {
iris %>% filter(Species %in% input$species)
},ignoreNULL = F)
output$scatterplot <- renderPlot({
plot(selected_data())
})
}
shinyApp(ui = ui, server = server)
Related
I am using the mtcars dataset and have created another column that is a random number(x) * 2. I have then used the renderDataTable in r shiny to print it. I now want to use renderPlot({}) on the new_col column and any other column. How would I go about calling that new column?
library(shiny)
library(ggplot2)
df<- mtcars
ui<- fluidPage(
titlePanel("Mtcars"),
sidebarLayout(
sidebarPanel(
selectInput(inputID = 'test', label = "TEST", choices = c(1,2,3,4), selected = 3)
mainPanel(
DT::dataTableOutput('table1')
plotOutput('basicplot')
))
server <- function(input, output) {
func<-function(x){
df%>%
mutate(new_col = x*2)
output$table1 <- renderTable({
func(2)
})
output$basicplot <-renderPlot({
plot(* $new_col, *$mpg) #what do i call the new dataframe with the new_col
})
)
shinyApp(ui = ui, server = server)
You had numerous syntax errors. Please check it before posting a question in the future. Try this
library(shiny)
library(ggplot2)
df<- mtcars
ui<- fluidPage(
titlePanel("Mtcars"),
sidebarLayout(
sidebarPanel(
selectInput('test', label = "TEST", choices = names(df)[-1] )
),
mainPanel(
DTOutput('table1'),
plotOutput('basicplot')
)
)
)
server <- function(input, output) {
mydata <- reactive({
df %>%
mutate(new_col = as.numeric(df[[input$test]])*2)
})
output$table1 <- renderDT({
mydata()
})
output$basicplot <-renderPlot({
req(mydata())
df <- data.frame(mydata()$new_col,mydata()$mpg)
plot(df)
})
}
shinyApp(ui = ui, server = server)
In my app I want user to choose between two dataset (mtcars and iris), then to choose one variable from previously chosen dataset. The app will show the summary of that variable.
I can choose the dataset, however a problem arises when I'm trying to choose the variable - everytime I choose something, it returns to the first column available (eg. while choosing Iris as a db I can see only Sepal.Length). For a brief moment summary can be seen for that chosen variable
library(shiny)
library(dplyr)
db_cars <- mtcars
db_iris <- iris
# Define server logic required to summarize and view the selected dataset
server <- shinyServer(function(input, output, session) {
datasetInput <- reactive({
simple_name <- eval(as.symbol(paste(input$dataset)))
observe({
updateSelectInput(
session,
"variable",
choices = colnames(simple_name[1:ncol(simple_name)])
)
})
simple_name %>% pull (input$variable)
})
output$summary <- renderPrint({
dataset <- datasetInput()
summary(dataset)
})
})
# Define UI for dataset viewer application
ui <- shinyUI(pageWithSidebar(
headerPanel("Shiny Text"),
sidebarPanel(
selectInput("dataset", "Choose dataset",
choices = c("db_cars", "db_iris")),
selectInput("variable", "Choose variable",
choices = ""),
),
mainPanel(
verbatimTextOutput("summary"),
)
))
shinyApp(ui = ui, server = server)
You should separate the reactive element into two parts. One for the data selection, and one for variable selection.
server <- shinyServer(function(input, output, session) {
currentdata <- reactive({
simple_name <- eval(as.symbol(paste(input$dataset)))
updateSelectInput(
session,
"variable",
choices = colnames(simple_name[1:ncol(simple_name)])
)
simple_name
})
datasetInput <- reactive({
currentdata() %>% pull(input$variable)
})
output$summary <- renderPrint({
dataset <- datasetInput()
summary(dataset)
})
})
They way each is only dependent on one input value so you don't run into trouble trying to change the dataset when you are trying to change just the varible.
I'm trying to show a table with Shiny, but I have a problem showing dates in the right format. Here is an example of what I'm dealing with:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textInput("myfirstinput", "text1"),
textInput("mysecondinput", "text2"),
actionButton("button", "An action button")
),
mainPanel(
tableOutput("table1")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
selected <- as.Date('2000-01-01', "%Y-%m-%d")
selected <- as.list(selected)
output$table1 <- renderTable(selected)
}
# Run the application
shinyApp(ui = ui, server = server)
This works as well :)
selected <- as.character(as.Date('2000-01-01', "%Y-%m-%d"))
Enjoy and Keep Posting!
It seems to work if you change the line:
selected <- as.Date('2000-01-01', "%Y-%m-%d")
to:
selected <- format(as.Date('2000-01-01'), "%Y-%m-%d")
I found that you need to format the date at the last step when the output is computed. Mutating to date earlier on did not solve the issue.
library(shiny)
library(dplyr)
ui <- fluidPage(
fileInput("upload", "Upload CSV", accept = c(".csv", ".tsv")),
numericInput("n", "Rows", value = 5, min = 1, step = 1),
tableOutput("head")
)
server <- function(input, output, session) {
data <- reactive({
req(input$upload)
readr::read_csv(input$upload$datapath)
})
output$head <- renderTable({
data() %>%
group_by(condition, metric) %>%
filter(agg_date == min(agg_date)) %>%
arrange(condition) %>%
mutate(agg_date = format(agg_date, "%Y-%m-%d"))
})
}
shinyApp(ui, server)
If I add a debounce to a get_data() reactive expression, the first time the data is retrieved the plot does not render. However, changing the data (by selecting a new mpg) causes the plot to then render. Why is this? Is there a workaround?
Here is a simple minimal example demonstrating the problem. Try removing %>% debounce(500) to see that it works as expected without it:
if (interactive()) {
options(device.ask.default = FALSE)
library(shiny)
library(magrittr)
ui <- fluidPage(
selectInput("select", label = "select mpg", choices = c(mtcars$mpg, ""), selected = ""),
plotOutput("plot")
)
server <- function(input, output, session) {
get_data <- reactive({
req(input$select)
mtcars[mtcars$mpg == input$select,]
}) %>% debounce(500)
get_plot <- reactive({
data <- get_data()
print(data)
plot(get_data())
})
output$plot <- renderPlot({
get_plot()
})
}
shinyApp(ui, server)
}
Couple of things going on here. I don't think we are allowed to have duplicates in a select input. mtcars$mpg has duplicate values inside it. Setting the initial value to "" is also causing strange behaviors. If you really want the initial plot to be empty along with debounce we could set it to " ". Here is what that would look like.
if (interactive()) {
options(device.ask.default = FALSE)
library(shiny)
library(magrittr)
ui <- fluidPage(
selectInput("select", label = "select mpg", choices = c(" ",unique(mtcars$mpg)),selected = " "),
plotOutput("plot")
)
server <- function(input, output, session) {
get_data <- reactive({
req(input$select)
if(!is.na(as.numeric(input$select))) mtcars[mtcars$mpg == input$select,] else NULL
}) %>% debounce(500)
get_plot <- reactive({
req(get_data())
data <- get_data()
print(data)
plot(get_data())
})
output$plot <- renderPlot({
get_plot()
})
}
shinyApp(ui, server)
}
Else if you're okay with having an initial plot the following works. Note its important to use unique()
if (interactive()) {
options(device.ask.default = FALSE)
library(shiny)
library(magrittr)
ui <- fluidPage(
selectInput("select", label = "select mpg", unique(mtcars$mpg)),
plotOutput("plot")
)
server <- function(input, output, session) {
get_data <- reactive({
req(input$select)
mtcars[mtcars$mpg == input$select,]
}) %>% debounce(500)
get_plot <- reactive({
req(get_data())
data <- get_data()
print(data)
plot(get_data())
})
output$plot <- renderPlot({
get_plot()
})
}
shinyApp(ui, server)
}
I even tried replacing the select input with selectizeInput("select", label = "select mpg", choices = unique(mtcars$mpg),multiple = TRUE,options = list(maxItems = 1)) This still caused issues.
I am not sure if Im doing this the right way (I am open for suggestions!). However what I try to do if to create a Shiny app where i can pick a bar and then the bar should be highlighted in the graph.
For this example I use the titanic_train dataset.
I do:
library(shiny)
library(ggplot2)
library(titanic)
library(dplyr)
UI <- fluidPage(
# Application title
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
selectInput("specific_bar", "Pick bar to highlight:",
choices = unique(titanic_train$Embarked))
),
mainPanel(
plotOutput("plot_nice")
)
)
)
Server <- function(input, output) {
filtered <- reactive({
titanic_train$Specific <- ifelse((titanic_train$Embarked == input$specific_bar), 1,0)
})
output$plot_nice <- renderPlot({
ggplot(filtered(), aes_string(x="Embarked", y="Survived", fill = "Specific")) +
geom_bar(stat = "identity")
})
}
shinyApp(ui = UI, server = Server)
Running this however gives me the following error:
ggplot2 doesn't know how to deal with data of class numeric
And the problem really seems to have to do with the filtered() reactive function. Any thoughts on what is going wrong here?
you have to ask for the data.frame object back in the reactive part,
what you were doing is getting a vector back instead of getting another column added to titanic_train.
this should fix it:
library(shiny)
library(ggplot2)
library(titanic)
library(dplyr)
UI <- fluidPage(
# Application title
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
selectInput("specific_bar", "Pick bar to highlight:",
choices = unique(titanic_train$Embarked))
),
mainPanel(
plotOutput("plot_nice")
)
)
)
Server <- function(input, output) {
filtered <- reactive({
titanic_train$Specific <- ifelse((titanic_train$Embarked == input$specific_bar), 1,0)
return(titanic_train)
})
output$plot_nice <- renderPlot({
ggplot(filtered(), aes_string(x="Embarked", y="Survived", fill = "Specific")) +
geom_bar(stat = "identity")
})
}
shinyApp(ui = UI, server = Server)