Alexia
Reputation: 3
Display options in selectInput based on user's previous selection after table processing in RShiny
I have a shiny application that displays a table based on calculations of sum (line one) and rates of the line one (line two) of the filtered values of a database. In the current situation, the filtering and processing of the table are working exactly as they should, showing the results only of what has been selected, and always aggregating the data if not all the filters have been chosen.
However, I would like the selectInput drop-downs to display only the possible options based on whatever selection the user has already made, so that the user does not need to guess which combinations are available as the original data is larger and with more combinations.
Example:
When Campaign F is selected in the Campaign filter, only the options 'Objective 1' in Objective filter and codes 608, 609 in the Code filter appear, while the table displays the sum and rates of all the lines that have 'Campaign F'.
Or if 'Objective 1' is selected, 'Campaign A', 'Campaign C' and 'Campaign F' appears as options to the filter Campaign but the table is showing the sum of values for all the lines that are 'Objective 1'.
If I select 'Objective 1' and 'Campaign F', only the Code filter is left to show more options, while the table displays the results of the sum of the corresponding lines. And so on.
Date Objective Campaign Code Metric_One Metric_Two Metric_Three Metric_Four
2018-09-04 Objective 1 Campaign A 601 8273 7417 415 129
2018-09-04 Objective 2 Campaign B 602 2390 818 30 4
2018-09-04 Objective 2 Campaign B 603 2485 1354 34 7
2018-09-05 Objective 1 Campaign C 604 537513 532170 18693 2136
2018-09-05 Objective 2 Campaign D 605 13 13 3 1
2018-09-08 Objective 3 Campaign E 606 14855 12505 676 162
2018-09-08 Objective 3 Campaign E 607 24363 20270 790 180
2018-09-10 Objective 1 Campaign F 608 155 148 11 1
2018-09-10 Objective 1 Campaign F 609 1320 974 79 11
My only clue is that it has to do with UI reactivity and perhaps observeEvent. But I only found examples with those in which the database itself or plain numbers were displayed and I was not able to adapt them to also calculating values for a table.
This is the code:
library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)
# Sample data
campaigns <- structure(list(Date = structure(c(1536019200, 1536019200, 1536019200, 1536105600, 1536105600, 1536364800, 1536364800, 1536537600, 1536537600),
class = c("POSIXct", "POSIXt"), tzone = "UTC"),
Objective = c("Objective 1","Objective 2", "Objective 2", "Objective 1", "Objective 2", "Objective 3", "Objective 3", "Objective 1", "Objective 1"),
Campaign = c("Campaign A", "Campaign B", "Campaign B", "Campaign C", "Campaign D", "Campaign E", "Campaign E", "Campaign F", "Campaign F"),
Code = c(601, 602, 603, 604, 605, 606, 607, 608, 609),
Metric_One = c(8273, 2390, 2485, 537513, 13, 14855, 24363, 155, 1320),
Metric_Two = c(7417, 818, 1354, 532170, 13, 12505, 20270, 148, 974),
Metric_Three = c(415, 30, 34, 18693, 3, 676, 790, 11, 79),
Metric_Four = c(129, 4, 7, 2136, 1, 162, 180, 1, 11)), row.names = c(NA, -9L), class = c("tbl_df", "tbl", "data.frame"))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
selectInput("objective",
"Objective:",
choices = c("Nothing Selected" , sort(unique(campaigns$Objective))),
width = "200px",
selectize = F,
selected = "Nothing Selected"),
selectInput("name_campaign",
"Campaign Name:",
choices = c("Nothing Selected" , sort(unique(campaigns$Campaign))),
width = "200px",
selectize = F,
selected = "Nothing Selected"),
selectInput("code",
"Code:",
choices = c("Nothing Selected" , sort(unique((campaigns$Code)))),
width = "200px",
selectize = F,
selected = "Nothing Selected")
), # End () dashboard Sidebar
dashboardBody(
DT::dataTableOutput("BigNumberTable")
) # End () dashboardBody
) # End () dashboardPage
server <- function(input, output) { # Server
line_one <- reactive({
total_campaign <- campaigns
if(input$objective != "Nothing Selected"){
total_campaign <- subset(total_campaign, Objective == input$objective)
}
if(input$name_campaign != "Nothing Selected"){
total_campaign <- subset(total_campaign, Campaign == input$name_campaign)
}
if(input$code != "Nothing Selected"){
total_campaign <- subset(total_campaign, Code == input$code)
}
total_campaign <- total_campaign %>%
select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
summarise(Metric_One = sum(Metric_One),
Metric_Two = sum(Metric_Two),
Metric_Three = sum(Metric_Three),
Metric_Four = sum(Metric_Four)) %>%
mutate(Description = "") %>%
mutate(Date = "") %>%
select(Description, Date, Metric_One, Metric_Two, Metric_Three, Metric_Four)
total_campaign
}) ## End () line_one
line_two <- reactive({
campaign_tx <- line_one()
campaign_tx <- campaign_tx %>%
select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
mutate(TxMetric_One = "",
TxMetric_Two = (Metric_Two/Metric_One)*100,
TxMetric_Three = (Metric_Three/Metric_Two)*100,
TxMetric_Four = (Metric_Four/Metric_Three)*100) %>%
mutate(Date = "") %>%
mutate(Description = "") %>%
select(Description, Date, TxMetric_One, TxMetric_Two, TxMetric_Three, TxMetric_Four) %>%
dplyr::rename(Metric_One = TxMetric_One,
Metric_Two = TxMetric_Two,
Metric_Three = TxMetric_Three,
Metric_Four = TxMetric_Four)
campaign_tx
}) ## End () line_two
# Table
output$BigNumberTable <- DT::renderDataTable({
## Bind the lines in one table
all_table <- rbind(line_one(), line_two())
datatable(all_table,
rownames = NULL,
colnames = c("Description", "Date", "Metric 1", "Metric 2", "Metric 3", "Metric 4"),
filter = "none",
options = list(dom = 't',
scrollX = TRUE,
ordering=F,
columnDefs = list(list(className = 'dt-center', targets = 0:5))))
} # End {} renderDataTable
) # End () renderTable
} # End {} server function
# Run the application
shinyApp(ui = ui, server = server)
Thank you for any help and input.
Upvotes: 0
Views: 717
Answers (1)
Pork Chop
Reputation: 29387
Something like this will do the trick, note that I mostly used observeEvent
library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)
# Sample data
campaigns <- structure(list(Date = structure(c(1536019200, 1536019200, 1536019200, 1536105600, 1536105600, 1536364800, 1536364800, 1536537600, 1536537600),
class = c("POSIXct", "POSIXt"), tzone = "UTC"),
Objective = c("Objective 1","Objective 2", "Objective 2", "Objective 1", "Objective 2", "Objective 3", "Objective 3", "Objective 1", "Objective 1"),
Campaign = c("Campaign A", "Campaign B", "Campaign B", "Campaign C", "Campaign D", "Campaign E", "Campaign E", "Campaign F", "Campaign F"),
Code = c(601, 602, 603, 604, 605, 606, 607, 608, 609),
Metric_One = c(8273, 2390, 2485, 537513, 13, 14855, 24363, 155, 1320),
Metric_Two = c(7417, 818, 1354, 532170, 13, 12505, 20270, 148, 974),
Metric_Three = c(415, 30, 34, 18693, 3, 676, 790, 11, 79),
Metric_Four = c(129, 4, 7, 2136, 1, 162, 180, 1, 11)), row.names = c(NA, -9L), class = c("tbl_df", "tbl", "data.frame"))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
selectInput("objective",
"Objective:",
choices = c("Nothing Selected" , sort(unique(campaigns$Objective))),
width = "200px",
selectize = F,
selected = "Nothing Selected"),
selectInput("name_campaign",
"Campaign Name:",
choices = c("Nothing Selected" , sort(unique(campaigns$Campaign))),
width = "200px",
selectize = F,
selected = "Nothing Selected"),
selectInput("code",
"Code:",
choices = c("Nothing Selected" , sort(unique((campaigns$Code)))),
width = "200px",
selectize = F,
selected = "Nothing Selected")
), # End () dashboard Sidebar
dashboardBody(
DT::dataTableOutput("BigNumberTable")
) # End () dashboardBody
) # End () dashboardPage
server <- function(input, output,session) { # Server
observeEvent(input$objective,{
req(input$objective)
if(input$objective == "Nothing Selected"){
return()
}
updateSelectInput(session,"name_campaign", choices = c("Nothing Selected",campaigns$Campaign[campaigns$Objective %in% input$objective]),selected = "Nothing Selected")
})
observeEvent(c(input$objective,input$name_campaign),{
req(input$objective)
req(input$name_campaign)
if(input$objective == "Nothing Selected" || input$name_campaign == "Nothing Selected"){
return()
}
updateSelectInput(session,"code", choices = c("Nothing Selected",campaigns$Code[campaigns$Objective %in% input$objective & campaigns$Campaign %in% input$name_campaign]),selected = "Nothing Selected")
})
line_one <- reactive({
req(input$name_campaign)
req(input$code)
total_campaign <- campaigns
if(input$objective != "Nothing Selected"){
total_campaign <- subset(total_campaign, Objective == input$objective)
}
if(input$name_campaign != "Nothing Selected"){
total_campaign <- subset(total_campaign, Campaign == input$name_campaign)
}
if(input$code != "Nothing Selected"){
total_campaign <- subset(total_campaign, Code == input$code)
}
total_campaign <- total_campaign %>%
select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
summarise(Metric_One = sum(Metric_One),
Metric_Two = sum(Metric_Two),
Metric_Three = sum(Metric_Three),
Metric_Four = sum(Metric_Four)) %>%
mutate(Description = "") %>%
mutate(Date = "") %>%
select(Description, Date, Metric_One, Metric_Two, Metric_Three, Metric_Four)
total_campaign
}) ## End () line_one
line_two <- reactive({
campaign_tx <- line_one()
campaign_tx <- campaign_tx %>%
select(Metric_One, Metric_Two, Metric_Three, Metric_Four) %>%
mutate(TxMetric_One = "",
TxMetric_Two = (Metric_Two/Metric_One)*100,
TxMetric_Three = (Metric_Three/Metric_Two)*100,
TxMetric_Four = (Metric_Four/Metric_Three)*100) %>%
mutate(Date = "") %>%
mutate(Description = "") %>%
select(Description, Date, TxMetric_One, TxMetric_Two, TxMetric_Three, TxMetric_Four) %>%
dplyr::rename(Metric_One = TxMetric_One,
Metric_Two = TxMetric_Two,
Metric_Three = TxMetric_Three,
Metric_Four = TxMetric_Four)
campaign_tx
}) ## End () line_two
# Table
output$BigNumberTable <- DT::renderDataTable({
## Bind the lines in one table
all_table <- rbind(line_one(), line_two())
datatable(all_table,
rownames = NULL,
colnames = c("Description", "Date", "Metric 1", "Metric 2", "Metric 3", "Metric 4"),
filter = "none",
options = list(dom = 't',
scrollX = TRUE,
ordering=F,
columnDefs = list(list(className = 'dt-center', targets = 0:5))))
} # End {} renderDataTable
) # End () renderTable
} # End {} server function
# Run the application
shinyApp(ui = ui, server = server)
Upvotes: 2
Related Questions
- SelectInput Value update based on previous SelectInput in R shiny
- selectInput choices dependent on another selectInput for R Shiny Flexdashboard
- Interactively display values in one selectInput() based on the value chosen in another selectInput()
- Update selectInput on the double click of table in Shiny App
- How to make selectInput choices reactive?
- How to display an rhandsontable in Shiny that is dependent on selectInput choices
- R shiny passing reactive to selectInput choices
- Update selectInput() choices after editing rhandsontable in shiny app
- Dynamic selectInput in R shiny
- dynamically list 'choices' for selectInput from a user selected column