Choosing rows of data by a drop-down menu - r

Question

This code reads in the data, find unique values of a column (Location) and puts these values as options in the dropdown menu. My goal is to customize my data based on values that are chosen in the dropdown menu. My data looks like below:
I tried to view the data but I found it is not working properly. What should I do?
Update 1: The problem is in data()$Location == input$Locationscheck but I don't know how to fix it.
library(shiny)
dropdownButton <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {
status <- match.arg(status)
# dropdown button content
html_ul <- list(
class = "dropdown-menu",
style = if (!is.null(width))
paste0("width: ", validateCssUnit(width), ";"),
lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
)
# dropdown button apparence
html_button <- list(
class = paste0("btn btn-", status," dropdown-toggle"),
type = "button",
`data-toggle` = "dropdown"
)
html_button <- c(html_button, list(label))
html_button <- c(html_button, list(tags$span(class = "caret")))
# final result
tags$div(
class = "dropdown",
do.call(tags$button, html_button),
do.call(tags$ul, html_ul),
tags$script(
"$('.dropdown-menu').click(function(e) {
e.stopPropagation();
});")
)
}
ui <- fluidPage(
fileInput(inputId = "uploadedcsv","", accept = '.csv'),
dropdownButton(label = "Choose the locations",status = "default",
width = 250,actionButton(inputId = "allLocations", label = "(Un)select all"),
checkboxGroupInput(inputId = "Locationscheck",label = "Choose",choices = "")),
actionButton('Run', label = "Run!")
)
server <- function(input, output, session) {
data <- reactive({
infile <- input$uploadedcsv
if (is.null(infile))
return(NULL)
read.csv(infile$datapath, header = TRUE, sep = ",")
})
observe({
locationnames <- unique(data()$Location)
updateCheckboxGroupInput(session, "Locationscheck",
choices = locationnames,
selected = locationnames)
### selecting and de-selecting in step 2 ###
observeEvent(input$allLocations, {
if (is.null(input$Locationscheck)) {
updateCheckboxGroupInput(session = session,
inputId = "Locationscheck",
selected = locationnames)
} else {
updateCheckboxGroupInput(session = session,
inputId = "Locationscheck",
selected = "")
}
})
### End of selecting and de-selecting ###
observeEvent(input$Run, {
Newdata <- data()[data()$Location == input$Locationscheck,]
View(data())
View(Newdata)
})
})
}
shinyApp(ui = ui, server = server)

Answer 1

The problem in the code data()$Location == input$Locationscheck is that it only considers first element in the input$Locationscheck vector and gives you the result as the values that are matched(eg: Location1) . You should use which(data()[data()$Location %in% input$Locationscheck,]) instead. which gives the indexes and %in% compares data()$Locationwith all the values in the input$Locationscheck vector.
I have modified your code and further added a table to illustrate the working:
library(shiny)
dropdownButton <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {
status <- match.arg(status)
# dropdown button content
html_ul <- list(
class = "dropdown-menu",
style = if (!is.null(width))
paste0("width: ", validateCssUnit(width), ";"),
lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
)
# dropdown button apparence
html_button <- list(
class = paste0("btn btn-", status," dropdown-toggle"),
type = "button",
`data-toggle` = "dropdown"
)
html_button <- c(html_button, list(label))
html_button <- c(html_button, list(tags$span(class = "caret")))
# final result
tags$div(
class = "dropdown",
do.call(tags$button, html_button),
do.call(tags$ul, html_ul),
tags$script(
"$('.dropdown-menu').click(function(e) {
e.stopPropagation();
});")
)
}
ui <- fluidPage(
fileInput(inputId = "uploadedcsv","", accept = '.csv'),
dropdownButton(label = "Choose the locations",status = "default",
width = 250,actionButton(inputId = "allLocations", label = "(Un)select all"),
checkboxGroupInput(inputId = "Locationscheck",label = "Choose",choices = "")),
actionButton('Run', label = "Run!"),
tableOutput('table')
)
server <- function(input, output, session) {
data <- reactive({
infile <- input$uploadedcsv
if (is.null(infile))
return(NULL)
read.csv(infile$datapath, header = TRUE, sep = ",", stringsAsFactors = FALSE)
})
observe({
locationnames <- unique(data()$Location)
updateCheckboxGroupInput(session, "Locationscheck",
choices = locationnames,
selected = locationnames)
### selecting and de-selecting in step 2 ###
observeEvent(input$allLocations, {
if (is.null(input$Locationscheck)) {
updateCheckboxGroupInput(session = session,
inputId = "Locationscheck",
selected = locationnames)
} else {
updateCheckboxGroupInput(session = session,
inputId = "Locationscheck",
selected = "")
}
})
### End of selecting and de-selecting ###
observeEvent(input$Run, {
# Newdata <- data()[data()$Location == input$Locationscheck,]
Newdata <- data()[which(data()$Location %in% input$Locationscheck),]
# # View(data())
# View(Newdata)
output$table <- renderTable({
Newdata
})
})
})
}
shinyApp(ui = ui, server = server)
I suggest you useisolate when you access the value so that the reactive event is not triggered again and again, something like this Newdata <- isolate(data())[which(isolate(data())$Location %in% input$Locationscheck),]
Hope it helps!