'updateCheckboxGroupInput behaves differently depending on previous added/deleted updateRadioButtons
In short, the issue I have is the following: Depending on whether I update or leave empty Radio buttons "previously" shown to users of my Shiny App, the CheckboxGroup will update correctly or not. I added a reproducible example below.
My goal is to allow our research assistants to enter data for specific parties. We have the data set stored in the background, and it might be that RAs have already started working on some of the parties. So they can, at first, choose the country, the party and indicate whether they have already worked on the party previously. In the latter case, their previous codings shall be updated and shown on the "next pages". What is shown on the "next pages" (hiding and showing parts of the shiny app) in our online version is shown below the vertical line.
However, the following issue puzzles me to great extent: When ignoring the lines 69-71 as it is now done, the CheckboxGroupInput behaves as expected; once all relevant meta data is selected, it shows a list of ethnic groups to choose from for the respective country chosen. If RAs have already started coding these parties, the previously selected choices are again selected. But, of course, the previously added data for religious claims are not shown, because they are not (yet) updated.
When I run all lines, including lines 69-71, the Shiny App updates the information on the religious claims correctly, but only shows all possible choices for ethnic groups per country if and only if the party data is sub-setted to the ones previously coded. If RAs choose "No" and then any combination of party ids and countries, they only see the choice selections "Other..." and "Don't know". However, if they choose "Yes" and any combination of party ids and countries, they do get the full list of ethnic groups plus their previous entered data.
Obviously, I would like my app to update both the religious claims and the ethnic groups selection, irrespective of any of the selections made regarding previously coded data, party id and country.
library(shiny)
library(dplyr)
library(stringr)
party_data <- data.frame(country_name=c("Austria","Austria","Belgium","Belgium","Austria","Austria","Belgium","Belgium"),
party_id=c(100,101,100,101,100,101,100,101),
rel_claim_flag=c(rep(NA,4), rep("Yes",4)),
eth_base_group=c(rep(NA,4), rep("Germans|Czech",2), rep("French|Flemings",2)),
coded=c(rep("No",4),rep("Yes",4)),
stringsAsFactors = F)
party_data$eth_base_group <- str_split(string=party_data$eth_base_group, pattern="\\|")
ethnicgroups <- data.frame(country_name=c(rep("Austria",3), rep("Belgium",3)),
groupname=c("Germans","Czech","French","French","Flemings","Dutch"),
stringsAsFactors = F)
ui <- fluidPage(
############## Country /party selection #####
div(id="choose_country_and_party",
div(id="preselect",
selectInput("coded", "Has the data already been coded?",
choices=c("Yes","No",""),
selected=""),
selectInput("country_name", "Select country",
choices=c(party_data$country_name,""),
selected=""),
selectInput("party_id", "Select party ID",
choices=c(party_data$party_id,0),
selected=0)),
),
hr(),
############## Ethnic page #####
div(id="data_entry_ethnic",
h3("Religious claims and base"),
radioButtons("rel_claim_flag", "Religious claim and base:", choices=c("Yes","No","Don't know"),
selected=character(0)),
h3("Ethnic base group"),
checkboxGroupInput("eth_base_group", "Please select:",
choices=c(unique(ethnicgroups$groupname),"Other (please specify below)","Don't know"),
selected=character(0))
)
)
server <- function(input, output, session) {
selectedData <- reactive({
if (input$coded=="Yes") {
selected <- party_data %>%
filter(coded=="Yes" &
country_name==input$country_name &
party_id==input$party_id)
} else {
selected <- party_data %>%
filter(coded=="No" &
country_name==input$country_name &
party_id==input$party_id)
}
})
# 3.4 Religion, language and ethnicity ####
observe({
selected <- selectedData()
# updateRadioButtons(session,
# inputId="rel_claim_flag",
# selected=selected$rel_claim_flag)
updateCheckboxGroupInput(session,
inputId="eth_base_group",
choices=c(ethnicgroups$groupname[ethnicgroups$country_name%in%selected$country_name],
"Other (please specify below)","Don't know"),
selected = unlist(selected$eth_base_group))
})
}
shinyApp(ui=ui, server=server)
I am especially confused here because from my understanding, updating the radio buttons should neither affect the data in the background, nor is it in any way linked to the checkboxGroupInput element. Any suggestions on how to move forward here so that I can update both input elements would be highly appreciated.
Thank you!
P.S. I do not care for the following issues with this minimal reproducible example, because in the final version, they will not be problematic / solved: Sometimes, the input objects only get updated, once.
Solution 1:[1]
Try this
server <- function(input, output, session) {
selectedData <- reactive({
req(input$coded,input$country_name,input$party_id)
party_data %>% dplyr::filter(coded %in% input$coded &
country_name==input$country_name &
party_id==input$party_id)
})
# 3.4 Religion, language and ethnicity ####
observeEvent(c(input$coded,input$country_name,input$party_id), {
selected <- selectedData()
updateRadioButtons(session,
inputId="rel_claim_flag",
selected=selected$rel_claim_flag)
})
observeEvent(input$country_name, {
updateCheckboxGroupInput(session,
inputId="eth_base_group",
choices=c( ethnicgroups$groupname[ethnicgroups$country_name %in% input$country_name],
"Other (please specify below)","Don't know"),
selected = selectedData()$eth_base_group)
})
}
Solution 2:[2]
This is what now seems to work, at least in this minimal reproducible example, although I am not sure why:
library(shiny)
library(dplyr)
library(stringr)
party_data <- data.frame(country_name=c("Austria","Austria","Belgium","Belgium","Austria","Austria","Belgium","Belgium"),
party_id=c(100,101,100,101,100,101,100,101),
rel_claim_flag=c(rep(NA,4), rep("Yes",4)),
eth_base_group=c(rep(NA,4),
"Germans|Czech","Germans|French", "French|Flemings","French|Dutch"),
coded=c(rep("No",4),rep("Yes",4)),
stringsAsFactors = F)
party_data$eth_base_group <- str_split(string=party_data$eth_base_group, pattern="\\|")
ethnicgroups <- data.frame(country_name=c(rep("Austria",3), rep("Belgium",3)),
groupname=c("Germans","Czech","French","French","Flemings","Dutch"),
stringsAsFactors = F)
ui <- fluidPage(
############## Country /party selection #####
div(id="choose_country_and_party",
div(id="preselect",
selectInput("coded", "Has the data already been coded?",
choices=c("Yes","No",""),
selected=""),
selectInput("country_name", "Select country",
choices=c(party_data$country_name),
selected=NULL),
selectInput("party_id", "Select party ID",
choices=c(party_data$party_id),
selected=NULL)
)),
hr(),
############## Ethnic page #####
div(id="data_entry_ethnic",
h3("Religious claims and base"),
radioButtons("rel_claim_flag", "Religious claim and base:",
choices=c("Yes","No","Don't know", ""),
selected=""),
h3("Ethnic base group"),
checkboxGroupInput("eth_base_group", "Please select:",
choices=c(unique(ethnicgroups$groupname),"Other (please specify below)","Don't know",""),
selected="")
)
)
server <- function(input, output, session) {
selectedData <- reactive({
if (input$coded=="Yes") {
selected <- party_data %>%
filter(coded=="Yes" &
country_name==input$country_name &
party_id==input$party_id)
} else {
selected <- party_data %>%
filter(coded=="No" &
country_name==input$country_name &
party_id==input$party_id)
}
})
# 3.4 Religion, language and ethnicity ####
observe({
selected <- selectedData()
updateRadioButtons(session,
inputId="rel_claim_flag",
choices=c("Yes","No","Don't know"),
selected=ifelse(is.na(selected$rel_claim_flag), "", selected$rel_claim_flag))
updateCheckboxGroupInput(session,
inputId="eth_base_group",
choices=c(ethnicgroups$groupname[ethnicgroups$country_name%in%selected$country_name],
"Other (please specify below)","Don't know"),
selected = ifelse(is.na(unlist(selected$eth_base_group)), "", unlist(selected$eth_base_group)))
})
}
shinyApp(ui=ui, server=server)
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|---|
| Solution 1 | YBS |
| Solution 2 | LeaK |
