I am working on a Shiny app where the user would have the ability to select all options in the dropdown, a subset of options, and/or a single option.
My reproducible example of data to use:
set.seed(42)
n <- 366
mydata <- data.frame(id=1:n,
date = seq.Date(as.Date("2020-01-01"), as.Date("2020-12-31"), "day"),
group = rep(LETTERS[1:26], n/2))
#write_csv(mydata, "repex.csv")
My R Shiny code:
library(shiny)
library(tidyverse)
library(plotly)
mydata <- read_csv("repex.csv")
choices <- c('Select All', 'apple' = 'A', 'beta' = 'B', 'croc' = 'C', 'delta' = 'D',
'echo chamber' = 'E', 'fudge nuggets' = 'F', 'good boy' = 'G', 'hot' = 'H',
'it-tree' = 'I', 'joker' = 'J', 'kale' = 'K', 'lambo' = 'L', 'merry' = 'M',
'not so easy' = 'N', 'open' = 'O', 'pickles' = 'P', 'quasi' = 'Q', 'rotary' = 'R',
'same' = 'S', 'token' = 'T', 'unix' = 'U', 'virtue' = 'V', 'whack-a-mole' = 'W',
'xylaphone?' = 'X', 'yeti' = 'Y', 'zebra' = 'Z')
#ui
ui <- fluidPage(
titlePanel("My Dashboard"),
sidebarLayout(
sidebarPanel(
dateRangeInput("dateRange", "Select date range:"),
selectizeInput('group_type', 'For no action cases, select reason:',
choices = choices, multiple = TRUE)
),
mainPanel(
tabsetPanel(
tabPanel('plot1',
plotlyOutput("plot1")),
tabPanel('plot2',
plotlyOutput('plot2')),
tabPanel('plot3',
plotlyOutput('plot_3'))
)
)
)
)
server <- function(input, output, clientData, session) {
mydata <- mydata %>%
mutate(
date = as.Date(date, format="%Y-%m-%d")) %>%
select(id, date, group)
thedata <- reactive({
my_data <- mydata
# And update the date range values to match those of the dataset
updateDateRangeInput(
inputId = "dateRange",
session = session,
start = min(my_data$date),
end = max(my_data$date)
)
my_data
})
observe({
if ("Select All" %in% input$group_type) {
selected_choices <- setdiff(choices, "Select All")
updateSelectizeInput(session, "group_type", selected = selected_choices,
server = TRUE)
}
})
output$plot_3 <- renderPlotly({
# I need to subset the data, using the user input (dateRangeInput)
data_subset3 <- dplyr::filter(thedata(),
date >= input$dateRange[[1]],
date <= input$dateRange[[2]])
# And plot the subset of data
data_subset3 %>%
filter(group == input$group_type) %>%
group_by(date, group) %>%
summarise(counts = n()) %>%
ungroup() %>%
ggplot(., aes(date, counts, color = group))
geom_point()
theme_bw()
})
}
shinyApp(ui = ui, server = server)
The current issue I'm having is when I go to plot 3, select the date range, and then select the 'Select All' option the graph stops working and I have to refresh the page. I want the user to be able to select to show all the groups at once (colored by group), a subset of groups to show up at once ('apple', 'beta', and 'yeti' for example), or just one group to show.
All the groups have the same distribution so for my repex data this may not seem useful but for my actual data this would be awesome thing to have!
Thank you!
CodePudding user response：
I think you'd want to use %in% not ==.
data_subset3 %>%
filter(group %in% input$group_type) %>%
group_by(date, group) %>%
summarise(counts = n()) %>%
ungroup() %>%
ggplot(., aes(date, counts, color = group))
geom_point()
theme_bw()
CodePudding user response：
I found a solution that works nicely. I also included an option to clear all choices:
library(shiny)
library(tidyverse)
library(plotly)
mydata <- read_csv("repex.csv")
choices <- c('Select All', 'apple' = 'A', 'beta' = 'B', 'croc' = 'C', 'delta' = 'D',
'echo chamber' = 'E', 'fudge nuggets' = 'F', 'good boy' = 'G', 'hot' = 'H',
'it-tree' = 'I', 'joker' = 'J', 'kale' = 'K', 'lambo' = 'L', 'merry' = 'M',
'not so easy' = 'N', 'open' = 'O', 'pickles' = 'P', 'quasi' = 'Q', 'rotary' = 'R',
'same' = 'S', 'token' = 'T', 'unix' = 'U', 'virtue' = 'V', 'whack-a-mole' = 'W',
'xylaphone?' = 'X', 'yeti' = 'Y', 'zebra' = 'Z')
#ui
ui <- fluidPage(
titlePanel("My Dashboard"),
sidebarLayout(
sidebarPanel(
dateRangeInput("dateRange", "Select date range:"),
selectInput('group_type', 'For no action cases, select reason:',
choices = choices, multiple = TRUE),
actionButton('reset_group', 'Clear selection(s)')
),
mainPanel(
tabsetPanel(
tabPanel('plot1',
plotlyOutput("plot1")),
tabPanel('plot2',
plotlyOutput('plot2')),
tabPanel('plot3',
plotlyOutput('plot_3'))
)
)
)
)
server <- function(input, output, clientData, session) {
mydata <- mydata %>%
mutate(
date = as.Date(date, format="%Y-%m-%d")) %>%
select(id, date, group)
thedata <- reactive({
my_data <- mydata
# And update the date range values to match those of the dataset
updateDateRangeInput(
inputId = "dateRange",
session = session,
start = min(my_data$date),
end = max(my_data$date)
)
my_data
})
observe({
if ("Select All" %in% input$group_type)
selected_choices <- choices[-1]
else
selected_choices <- input$group_type
updateSelectInput(session, "group_type", selected = selected_choices)
})
observeEvent(input$reset_group, {
updateSelectInput(session, "group_type", selected = "")
})
output$plot_3 <- renderPlotly({
# I need to subset the data, using the user input (dateRangeInput)
data_subset3 <- dplyr::filter(thedata(),
date >= input$dateRange[[1]],
date <= input$dateRange[[2]])
# And plot the subset of data
data_subset3 %>%
filter(group %in% input$group_type) %>%
group_by(date, group) %>%
summarise(counts = n()) %>%
ungroup() %>%
ggplot(., aes(date, counts, color = group, group = group))
geom_line()
theme_bw()
})
}
shinyApp(ui = ui, server = server)
I've changed from geom_point() to geom_line() to see if this still worked with other graph types.
CodePudding user response：
You need to subset properly, and there is no need of updateSelectizeInput. Try this
set.seed(42)
n <- 366
mydata <- data.frame(id=1:n,
date = seq.Date(as.Date("2020-01-01"), as.Date("2020-12-31"), "day"),
group = rep(LETTERS[1:26], n/2))
library(shiny)
library(tidyverse)
library(plotly)
#mydata <- read_csv("repex.csv")
choices <- c('Select All', 'apple' = 'A', 'beta' = 'B', 'croc' = 'C', 'delta' = 'D',
'echo chamber' = 'E', 'fudge nuggets' = 'F', 'good boy' = 'G', 'hot' = 'H',
'it-tree' = 'I', 'joker' = 'J', 'kale' = 'K', 'lambo' = 'L', 'merry' = 'M',
'not so easy' = 'N', 'open' = 'O', 'pickles' = 'P', 'quasi' = 'Q', 'rotary' = 'R',
'same' = 'S', 'token' = 'T', 'unix' = 'U', 'virtue' = 'V', 'whack-a-mole' = 'W',
'xylaphone?' = 'X', 'yeti' = 'Y', 'zebra' = 'Z')
#ui
ui <- fluidPage(
titlePanel("My Dashboard"),
sidebarLayout(
sidebarPanel(
dateRangeInput("dateRange", "Select date range:"),
selectizeInput('group_type', 'For no action cases, select reason:',
choices = choices, multiple = TRUE)
),
mainPanel(
tabsetPanel(
tabPanel('plot1',
plotOutput("plot1")),
tabPanel('plot2',
plotOutput('plot2')),
tabPanel('plot3', DTOutput("t1"),
plotlyOutput('plot_3'))
)
)
)
)
server <- function(input, output, clientData, session) {
mydata <- mydata %>%
mutate(date = as.Date(date, format="%Y-%m-%d")) %>%
dplyr::select(id, date, group)
### I need to subset the data, using the user input (dateRangeInput)
data_subset1 <- eventReactive(input$dateRange, {
dplyr::filter(mydata,
date >= input$dateRange[[1]],
date <= input$dateRange[[2]])
})
data_subset3 <- eventReactive(c(data_subset1(),input$group_type), {
req(data_subset1(),input$group_type)
if ("Select All" %in% input$group_type) dfa <- data_subset1()
else dfa <- data_subset1() %>% dplyr::filter(group %in% input$group_type)
df <- dfa %>%
group_by(date,group) %>%
dplyr::summarise(counts = n()) %>%
ungroup()
df
})
output$t1 <- renderDT({data_subset1()})
observe({
my_data <- mydata
# And update the date range values to match those of the dataset
updateDateRangeInput(
inputId = "dateRange",
session = session,
start = min(my_data$date),
end = max(my_data$date)
)
# if ("Select All" %in% input$group_type) {
# selected_choices <- setdiff(choices, "Select All")
#
# updateSelectizeInput(session, "group_type", selected = selected_choices,
# server = TRUE)
# }
})
output$plot1 <- renderPlot({plot(cars)})
output$plot2 <- renderPlot({plot(pressure)})
output$plot_3 <- renderPlotly({
req(data_subset3())
p <- ggplot(data_subset3(), aes(date, counts, color = group))
geom_point()
theme_bw()
ggplotly(p)
})
}
shinyApp(ui = ui, server = server)