I have create one app that allows to subset a dataframe based on a checkboxGroupInput and radioButtons.
The function ofradioButtons basically is remove the samples categorized as "excluded" or not.
Here is my code.
#data
#data
df <- structure(list(Val1 = c(71L, 19L, 13L, 73L, 30L, 6L, 89L, 39L,
64L, 33L, 47L, 54L, 9L, 11L, 12L, 94L, 77L, 34L, 25L, 52L, 37L,
87L, 32L, 14L, 62L, 20L, 38L, 27L, 85L, 90L, 28L, 29L, 40L, 41L,
83L, 4L, 57L, 61L, 72L, 95L, 21L, 65L, 98L, 97L, 2L, 100L, 50L,
59L, 46L, 45L), Val2 = c(27L, 31L, 2L, 29L, 46L, 12L, 6L, 26L,
28L, 35L, 1L, 24L, 20L, 18L, 11L, 39L, 17L, 36L, 40L, 5L, 14L,
43L, 10L, 15L, 34L, 48L, 3L, 22L, 44L, 45L, 30L, 33L, 32L, 49L,
47L, 23L, 7L, 19L, 13L, 41L, 16L, 4L, 37L, 38L, 50L, 42L, 21L,
8L, 9L, 25L), AfterExclusion = structure(c(1L, 2L, 2L, 4L, 3L,
4L, 2L, 1L, 4L, 4L, 2L, 3L, 2L, 3L, 4L, 3L, 1L, 4L, 2L, 3L, 1L,
2L, 3L, 3L, 1L, 2L, 4L, 2L, 1L, 1L, 3L, 3L, 2L, 2L, 1L, 1L, 4L,
2L, 1L, 1L, 3L, 3L, 3L, 4L, 3L, 1L, 3L, 4L, 3L, 4L), levels = c("b",
"c", "d", "excluded_sample"), class = "factor"), BeforeExclusion = structure(c(2L,
3L, 3L, 1L, 4L, 1L, 3L, 2L, 1L, 1L, 3L, 4L, 3L, 4L, 1L, 4L, 2L,
1L, 3L, 4L, 2L, 3L, 4L, 4L, 2L, 3L, 1L, 3L, 2L, 2L, 4L, 4L, 3L,
3L, 2L, 2L, 1L, 3L, 2L, 2L, 4L, 4L, 4L, 1L, 4L, 2L, 4L, 1L, 4L,
1L), levels = c("a", "b", "c", "d"), class = "factor")), row.names = c(NA,
-50L), class = "data.frame")
library(shiny)
library(DT)
library(dplyr)
ui <- fluidPage(
sidebarPanel(
checkboxInput("choose_variables", "Variables to select:", value=TRUE),
conditionalPanel(
condition = "input.choose_variables",
style = "margin-left: 20px;",
checkboxGroupInput("selection", "",
c("Excluded" = "excluded_sample",
"b" = "b",
"c" = "c",
"d" = "d"),
selected = c("excluded_sample", "b", "c", "d"))),
hr(),
checkboxInput(inputId = "criteria", label = "Choose criteria"),
conditionalPanel(
condition = "input.criteria == '1'",
style = "margin-left: 20px;",
radioButtons(inputId = "exclusion_criteria_samples", label="",
c("Remove excluded samples" = "remove_excluded_samples",
"Without any exclusion criteria" = "all_samples"))),
actionButton("Submit", "Submit")
),
mainPanel(
dataTableOutput("table")
)
)
server <- function(input, output, session) {
mydata <- reactive({
data <- df
if(input$choose_variables){
data <- data %>%
filter(AfterExclusion %in% c(input$selection)) %>%
droplevels() # we update the current levels
}
if(input$criteria){
if(input$exclusion_criteria_samples == "all_samples"){
data$AfterExclusion <- NULL
names(data)[names(data) == "BeforeExclusion"] <- "Col" # change name of the column
}else{
data <- subset(data, data$AfterExclusion != "excluded_sample")
data <- data %>% droplevels()
data$BeforeExclusion <- NULL
names(data)[names(data) == "AfterExclusion"] <- "Col" # change name of the column
}
}else{
data <- data
}
return(data)
}) %>% bindEvent(input$Submit)
observeEvent(input$Submit, {
if(input$criteria){
list_variables <- levels(mydata()$Col)
if(input$exclusion_criteria_samples == "all_samples"){
updateCheckboxGroupInput(session, "selection",
label = "",
choices = list_variables,
selected = list_variables)
print(list_variables)
}
else if(input$exclusion_criteria_samples == "remove_excluded_samples"){
print(list_variables)
updateCheckboxGroupInput(session, "selection",
label = "",
choices = list_variables,
selected = list_variables)
}
}
})
output$table <- renderDataTable({
req(input$choose_variables)
mydata()
})
}
shinyApp(ui=ui, server=server)
The idea is that if the user clicks "Choose criteria" and "Remove excluded samples", I would like to update the checkboxGroupInput with the new levels of the dataframe. However, if after doing that, the user wants to select "Without any exclusion criteria" I would like the original checkboxGroupInput (with all the original levels).
I managed to get something close based on an actionButton but once I have selected "Remove excluded samples" and I get the updated checkboxGroupInput, I cannot go back to the original one if I select the other option.
(see the code that I have added just before renderDataTable in order to do this)
observeEvent(input$Submit, {
if(input$criteria){
list_variables <- levels(mydata()$Col)
if(input$exclusion_criteria_samples == "all_samples"){
updateCheckboxGroupInput(session, "selection",
label = "",
choices = list_variables,
selected = list_variables)
print(list_variables)
}
else if(input$exclusion_criteria_samples == "remove_excluded_samples"){
print(list_variables)
updateCheckboxGroupInput(session, "selection",
label = "",
choices = list_variables,
selected = list_variables)
}
}
})
Does anybody know how to fix it?
Thanks in advance
Aucun commentaire:
Enregistrer un commentaire