I am developing a shiny application which has a selectInput filter whose choices are coming from a dataframe of NAMES. This selectinput allows to filter rows in rhandsontable on the basis of names.
At present the selectinput doesn't show "" choice where NAME is empty i.e "" and only show available NAMES.
I want to filter rows in table which don't have any names (i.e NAMES=="") via selectinput.
Could you please help on how to do it?
May I suggest you go with shinyWidgets package, I know that selectInput will not allow you to do a null show:
library(shiny)
library(shinyWidgets)
data <- head(mtcars)
data$NAMES <- data$mpg
data$NAMES[c(1,3)] <- ""
ui <- fluidPage(
pickerInput(
inputId = "NAMES",
label = "NAMES",
choices = unique(data$NAMES),
selected = "",
multiple = TRUE,
options = pickerOptions(maxOptions = 1)
),
tableOutput("table")
)
server <- function(input, output,session) {
mydata <- eventReactive(input$NAMES,{
data[data$NAMES %in% input$NAMES,]
})
output$table <- renderTable({
mydata()
})
}
shinyApp(ui = ui, server = server)
Related
I have data table output that I want users to be able to create their own custom table by using checkboxes to select which row/element they want. In the example below is a mtcars output. For example I want users to be able to pick say A Mazda, Fiat, Toyota, and a Dodge model using a check box. As far as trying any code, I haven't found any examples that come close.
library(shiny)
if (interactive()) {
# basic example
shinyApp(
ui = fluidPage(
selectInput("variable", "Variable:",
c("Cylinders" = "cyl",
"Transmission" = "am",
"Gears" = "gear"), multiple = T),
tableOutput("data")
),
server = function(input, output) {
output$data <- renderTable({
mtcars[, c("mpg", input$variable), drop = FALSE]
}, rownames = TRUE)
}
)
}
The general approach below is 1) create a checkbox group input listing the car names (i.e. rownames) as the names, having the corresponding values be the row numbers and 2) using those row numbers to filter your data.frame on the server.
Using the reactive rowsToUse will update every time the selection changes. It also allows the handling of the case when no rows are selecting (default to all rows in the example below).
shinyApp(
ui = fluidPage(
checkboxGroupInput(
inputId = "variable",
label = "Cars:",
choiceNames = rownames(mtcars),
choiceValues = seq(NROW(mtcars))
),
tableOutput("data")
),
server = function(input, output) {
rowsToUse <- reactive(
if(is.null(input$variable)) {
seq(NROW(mtcars))
} else{
as.numeric(input$variable)
}
)
output$data <- renderTable({
mtcars[rowsToUse(), , drop = FALSE]
}, rownames = TRUE)
}
)
I am trying to create my first shiny app but I am facing a difficulty: in the reproducible example below I am creating a reactive pickerInput (i.e. only show brands proposing a cylindre equal to the input visitors select).
I then want that based on the combination input_cyl and picker_cny (remember that picker_cny depends on input_cyl) to display a table which shows the relevant data for the observation matching the combination input_cyl and picker_cny.
Thank you for your help!
df <- mtcars
df$brand <- rownames(mtcars)
df$brand <- gsub("([A-Za-z]+).*", "\\1", df$brand)
if (interactive()) {
library(shiny)
library(shinyWidgets)
library(shinythemes)
library(shinycssloaders)
# Define UI -----------------------------------------------
ui <- fluidPage(
# Application title
titlePanel("Reproducible Example"),
# Parameters
sidebarLayout(
sidebarPanel(
selectInput(inputId = "input_cyl", label = "Cyl",
choices = c("6", "4", "8")),
pickerInput(
inputId = "picker_cny",
label = "Select Company",
choices = paste0(unique(df$brand)),
options = list(`actions-box` = TRUE),
multiple = TRUE),
width = 2),
# Show Text
mainPanel(
tableOutput("table"),
width = 10)
))
# Define Server ------------------------------------------
server <- function(input, output, session) {
# Reactive pickerInput ---------------------------------
observeEvent(input$input_cyl, {
df_mod <- df[df$cyl == paste0(input$input_cyl), ]
# Method 1
disabled_choices <- !df$cyl %in% df_mod$cyl
updatePickerInput(session = session,
inputId = "picker_cny",
choices = paste0(unique(df$brand)),
choicesOpt = list(
disabled = disabled_choices,
style = ifelse(disabled_choices,
yes = "color: rgba(119, 119, 119, 0.5);",
no = "")
))
}, ignoreInit = TRUE)
output$table <- renderTable(df)
}
}
# Run the application
shinyApp(ui = ui, server = server)
You need a reactive that will handle the change in the input and subset the dataframe before giving it to the output table. For that, you just need to add this block to your server:
data <- reactive({
if (length(input$picker_cny) > 0)
df[df$brand %in% input$picker_cny,]
else
df
})
and update the output$table like this:
output$table <- renderTable(data())
Note: feel free to remove the if else in the reactive to get that:
data <- reactive({
df[df$brand %in% input$picker_cny,]
})
The only difference in that case is: would you show all or nothing when no input has been entered yet. That's a matter of taste.
I have two datasets, one with a list of two hundred cities and their corresponding state and another much larger dataset that I'd like to make an app to sort through. I need help making two drop down boxes in my shiny app where the first is the state variable and the second is the list of cities within that chosen state. I then want those selections to filter the much larger, second dataset in the output. I've tried solutions from several similar but slightly different examples online, but I'm having trouble translating it to what I'm doing.
So far I have this:
ui <- fluidPage(
headerPanel(''),
sidebarPanel(
#add selectinput boxs
htmlOutput("state_selector"),
htmlOutput("city_selector"),
),
mainPanel(
fluidRow(
# Create a new row for the table.
DT::dataTableOutput("table")
)
server <- function(session, input, output) {
output$state_selector = renderUI({
selectInput("state", label = h4("State"),
choices = as.character(unique(citystatedata$state)), selected = NULL)
})
output$city_selector = renderUI({
data_available = citystatedata[citystatedata$State == input$state, "state"]
selectInput(inputId = "city", #name of input
label = "City", #label displayed in ui
choices = unique(data_available), #calls list of available cities
selected = unique(data_available)[1])
})
shinyApp(ui = ui, server = server)
I tried to take out the portions of the code that weren't specifically related to the drop down boxes, since that's what I was more specifically asking about. So I'm sorry if I've left anything out! Let me know if I need to include anything else
Using available gapminder data, you can try this.
df <- gapminder
df$state <- gapminder$continent
df$city <- gapminder$country
citystatedata <- df
ui <- fluidPage(
headerPanel('Test'),
sidebarPanel(
#add selectinput boxs
uiOutput("state_selector"),
uiOutput("city_selector"),
),
mainPanel(
fluidRow(
# Create a new row for the table.
DTOutput("table")
)
)
)
server <- function(session, input, output) {
output$state_selector = renderUI({
selectInput("state", label = h4("State"),
choices = as.character(unique(citystatedata$state)), selected = NULL)
})
output$city_selector = renderUI({
data_available = citystatedata[citystatedata$state == req(input$state),]
selectInput(inputId = "city", #name of input
label = "City", #label displayed in ui
choices = unique(data_available$city), #calls list of available cities
selected = 1)
})
mydt <- reactive({
citystatedata %>% filter(citystatedata$state == req(input$state) & citystatedata$city %in% req(input$city))
})
output$table <- renderDT(mydt())
}
shinyApp(ui = ui, server = server)
I am trying to create a shiny code that is able to filter a table non pre-determined number of times. When the user uploads a different (new) table, unfortunately the code breaks as I need to restart a lapply loop somehow, throwing out the previously stored column names.
I would like to create an non pre-defined filtering options for a table within Shiny. The user can select a column and filter a table choosing different categorical variables within that column. It is possible to add additional selection fields by pressing the 'Add' button.
the UI:
library(shiny)
library(shinydashboard)
library(dplyr)
ui <- shinyUI(
pageWithSidebar(
headerPanel("testing of dynamic number of selection"),
sidebarPanel(
uiOutput("buttons")),
mainPanel(
uiOutput("drops")
,tableOutput("table")
)
))
The server:
A table (test.csv) is automatically stored in a reactive values and a first searching field appears with 3 buttons (Add = to add a new searching field by reading in the colnames and a multiselect that stores the unique variables from that columns. The filtering function is activated by the Calculate button)
server<-function(input, output, session) {
###### read in test file
values<-reactiveValues(number = 1,
upload = NULL,
input = NULL)
values$upload<-read.csv("test.csv")
#just the "add" button, in this instance it shouldn't be a uiOutput
output$buttons <- renderUI({
div(
actionButton(inputId = "add", label = "Add"), actionButton(inputId = "calc", label = "Calculate"),
actionButton(inputId = "new", label = "new table")
)
})
#pressing the add button
observeEvent(input$add, {
cat("i adding a new record\n")
values$number <- values$number + 1L })
daStuff <- function(i){
inputName<-paste0("drop", i)
inputName2<-paste0("select", i)
inputText<-if(values$number>0){input[[paste0("drop",i)]]}else{F} # previously selected value for dropdown
inputSelect <- if(values$number>1){input[[paste0("select",i)]]}else{F} # previously selected value for dropdown
fluidRow(
column(6,selectInput(inputName, inputName, c(colnames(values$upload)), selected = inputText)),
column(6,selectInput(inputName2, inputName2,
na.omit(unique(as.vector(values$upload[,input[[paste0("drop",i)]]]))),
multiple=TRUE, selectize=TRUE, selected=inputSelect)) )}
output$drops<- renderUI({
lapply(seq_len(values$number), daStuff)})
By pressing the Calculate button, the uploaded table is subjected to filtering, depending on the selected unique values and shown in the output$table
observeEvent(input$calc, {
values$input<-NULL
for (i in 1:values$number){
if(!is.null(input[[paste0("select",i)]])){
if(is.null(values$input)){
values$input<- filter(values$upload,values$upload[,input[[paste0("drop",i)]]] %in% input[[paste0("select",i)]])}
else{
values$input<- filter(values$input,values$input[,input[[paste0("drop",i)]]] %in% input[[paste0("select",i)]])}
} }
if (is.null(values$input)){values$input<-values$upload}
output$table <- renderTable({values$input})
})
My problem is when I upload a new table (test2.csv), I don't know how to erase the previously stored selections (drop* and select* values) and gives back an error message.
observeEvent(input$new,{
values$upload<-read.csv("test2.csv")
})
}
shinyApp(ui=ui, server = server)
I suppose I should stop somehow the lapply loop and restart it over, so the previously stored values are replaced depending on the new selection, but I am a bit stuck on how I could achieve that.
Just in case you might still be looking for solutions, I wanted to share something that was similar and could potentially be adapted for your needs.
This uses observeEvent for all select inputs. If it detects any changes, it will update all inputs, including the possibilities for select based on drop.
In addition, when a new file is read, the selectInput for drop and select are reset to first value.
Edit: I forgot to keep selected = input[[paste0("drop",i)]] in place for the dropdown (see revised code). It seems to keep the values now when new filters are added - let me know if this is what you had in mind.
library(shiny)
library(shinydashboard)
library(dplyr)
myDataFrame <- read.csv("test.csv")
ui <- shinyUI(
pageWithSidebar(
headerPanel("Testing of dynamic number of selection"),
sidebarPanel(
fileInput("file1", "Choose file to upload", accept = ".csv"),
uiOutput("buttons")
),
mainPanel(
uiOutput("inputs"),
tableOutput("table")
)
)
)
server <- function(input, output, session) {
myInputs <- reactiveValues(rendered = c(1))
myData <- reactive({
inFile <- input$file1
if (is.null(inFile)) {
d <- myDataFrame
} else {
d <- read.csv(inFile$datapath)
}
d
})
observeEvent(lapply(paste0("drop", myInputs$rendered), function(x) input[[x]]), {
for (i in myInputs$rendered) {
updateSelectInput(session,
paste0('select', i),
choices = myData()[input[[paste0('drop', i)]]],
selected = input[[paste0("select",i)]])
}
})
output$buttons <- renderUI({
div(
actionButton(inputId = "add", label = "Add"),
actionButton(inputId = "calc", label = "Calculate")
)
})
observeEvent(input$add, {
myInputs$rendered <- c(myInputs$rendered, max(myInputs$rendered)+1)
})
observeEvent(input$calc, {
showData <- NULL
for (i in 1:length(myInputs$rendered)) {
if(!is.null(input[[paste0("select",i)]])) {
if(is.null(showData)) {
showData <- filter(myData(), myData()[,input[[paste0("drop",i)]]] %in% input[[paste0("select",i)]])
}
else {
showData <- filter(showData, showData[,input[[paste0("drop",i)]]] %in% input[[paste0("select",i)]])
}
}
}
if (is.null(showData)) { showData <- myData() }
output$table <- renderTable({showData})
})
observe({
output$inputs <- renderUI({
rows <- lapply(myInputs$rendered, function(i){
fluidRow(
column(6, selectInput(paste0('drop',i),
label = "",
choices = colnames(myData()),
selected = input[[paste0("drop",i)]])),
column(6, selectInput(paste0('select',i),
label = "",
choices = myData()[1],
multiple = TRUE,
selectize = TRUE))
)
})
do.call(shiny::tagList, rows)
})
})
}
shinyApp(ui, server)
I have a shiny app where I want to allow the user to select a dataset based on a set of uploaded files and then specify the columns to display from the selected dataset. If I leave some columns selected and then switch datasets, an error flashes and is output to the console stating that the selected columns are unknown before the app switches datasets and displays it correctly. In my full app however, the app crashes, though I wasn't able to figure out how to reproduce the crash. I thought it might be related to some preprocessing that is done to add additional columns which are the same across datasets and which remain selected, but the error is the same without that feature.
library(shiny)
library(tidyverse)
library(DT)
ui <- fluidPage(
checkboxGroupInput("select_var", label = "Select Variables"),
selectInput("dataset", label = NULL, choices = c("mtcars", "rock")),
DT::dataTableOutput("table")
)
server <- function(session, input, output) {
# define the dataset
data <- reactive({switch(input$dataset,"rock" = rock,"mtcars" = mtcars)})
# add a common column name that is always selected
dataprocessed <- reactive({data <- data()
data$num <- seq(1:nrow(data))
return(data)})
# dynamically generate the variable names
observe({
vchoices <- names(dataprocessed())
updateCheckboxGroupInput(session, "select_var", choices = vchoices, selected = c("num"))
})
# select the variables based on checkbox
data_sel <- reactive({
req(input$select_var)
df_sel <- dataprocessed() %>% select(input$select_var)
})
output$table <- DT::renderDataTable(data_sel())
}
# Run the application
shinyApp(ui = ui, server = server)
We can add a conditional requirement using req() to test for column existence before rendering:
library(shiny)
library(tidyverse)
library(DT)
ui <- fluidPage(
checkboxGroupInput("select_var", label = "Select Variables"),
selectInput("dataset", label = NULL, choices = c("mtcars", "rock")),
DT::dataTableOutput("table")
)
server <- function(session, input, output) {
# define the dataset
data <- reactive({
switch(input$dataset,"rock" = rock,"mtcars" = mtcars)
})
# add a common column name that is always selected
dataprocessed <- reactive({
data <- data()
data$num <- seq(1:nrow(data))
return(data)
})
# dynamically generate the variable names
observe({
vchoices <- names(dataprocessed())
updateCheckboxGroupInput(session, "select_var", choices = vchoices, selected = c("num"))
})
# select the variables based on checkbox
data_sel <- reactive({
req(input$select_var)
req(names(dataprocessed()) %in% input$select_var)
a <- names(dataprocessed())[names(dataprocessed()) %in% input$select_var]
df_sel <- dataprocessed() %>% select(a)
})
output$table <- DT::renderDataTable(data_sel())
}
# Run the application
shinyApp(ui = ui, server = server)