In the following bit of MWE code using the selectizeInput() function, the user selects which variable to filter the mtcars data by. When running the code you'll see where you can select the filtering variable in the user input box labeled "Variable".
However, how can this be changed so the user can deselect a variable after it has been entered into the "Variable" user input box, and thus update the table? By clicking on a little "x" next to the items appearing in the box would be ideal. For example, I have used selectizeGroupUI() before and those selected items can be easily deselected, and the related table updated, by clicking on a little "x" that appears next to each item.
library(shiny)
shinyApp(
ui = fluidPage(
uiOutput("filter"),
tableOutput("data")
),
server = function(input, output) {
output$filter <-
renderUI({
selectizeInput("variable", "Variable:",
c("Cylinders" = "cyl","Trans" = "am","Gears" = "gear"),
multiple = TRUE
)
})
output$data <- renderTable({
req(input$variable)
mtcars[, c("mpg", input$variable), drop = FALSE]
}, rownames = TRUE)
}
)
Is pickerInput from {shinyWidgets} an option?.
Doc: https://dreamrs.github.io/shinyWidgets/reference/pickerInput.html
pickerInput("variable",
"Variable:",
choices = c("Cylinders" = "cyl","Trans" = "am","Gears" = "gear"),
multiple = TRUE,
selected = NULL,
options = list(
title = "Select variables",
`actions-box` = TRUE,
`deselect-all-text` = "Remove"
))
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 reset selectizeInput selections upon actionButton input.
Please see the following code, in which I cannot get the eventReactive to function:
library(shiny)
ui <- fluidPage(
column(width = 4,algin = "center", uiOutput("choose_Number")) ,
br(),
column(width = 4, algin = "center",div(
align = "center", actionButton('delete','Delete Number(s)',style="color: #fff; background-color: #53C1BE")))
)
server <- function(input, output, session) {
output$choose_Number <- renderUI({
selectizeInput("choose_Number", "Select Number", as.list(c(1,2,3,4)),selected = c(''), options=list(create=TRUE,'plugins' = list('remove_button'),
persist = FALSE), multiple = TRUE)
})
##### I am trying to reset the selectizeInput upon input from the Delete button
eventReactive(input$delete, {updateSelectizeInput("choose_Number", "Select Number", as.list(c(1,2,3,4)), selected = c(''),options=list(create=TRUE,'plugins' = list('remove_button'),
persist = FALSE), multiple = TRUE)} )
}
shinyApp(ui, server)
Thank you.
The biggest issue was that the session was missing. You can omit the session argument if you want to but then you need to name all other arguments because session is the first in line. Second issue was that you can set multiple in selectizeInput but not later when using updateSelectizeInput() to change it.
Minor improvements: the manual recommends using character() to deselect the current choice. As mentioned by #YBS you do not provide a reactive value so that observeEvent is the better choice here.
PS: are you sure you want to centre align the columns? It looks strange.
library(shiny)
ui <- fluidPage(
column(width = 4, align = "center", uiOutput("choose_Number")),
br(),
column(width = 4, align = "center", div(
align = "center",
actionButton('delete', 'Delete Number(s)', style="color: #fff; background-color: #53C1BE"))
)
)
server <- function(input, output, session) {
output$choose_Number <- renderUI({
selectizeInput("choose_Number", "Select Number", as.list(c(1,2,3,4)), selected = character(),
options = list(create=TRUE,'plugins' = list('remove_button'), persist = FALSE),
multiple = TRUE)
})
##### I am trying to reset the selectizeInput upon input from the Delete button
observeEvent(input$delete, {
updateSelectizeInput(session, "choose_Number", choices = as.list(1:4),
selected = character(0),
options = list(create=TRUE, 'plugins' = list('remove_button'), persist = FALSE))
})
}
shinyApp(ui, server)
I am trying to use a basin, and then update the possible choices of sub-basins within that basin.
However, my code is not working. I cannot make it work neither with observe, nor with reactive, nor with observeEvent nor without all of them.
My ui side is as:
selectInput(inputId = 'countyType_id',
label = '1. Select a basin',
choices = all_basins
),
selectizeInput(inputId = 'subbasins_id',
label = '2. Select subbasins',
choices = subbasins,
selected = head(subbasins, 1),
multiple = TRUE)
and the server side looks like :
observe({
#
# from
# https://shiny.rstudio.com/reference/shiny/latest/updateSelectInput.html
#
subbasins <- sort(unique(curr_spatial$subbasin))
# Can also set the label and select items
updateSelectizeInput(session,
server = FALSE,
"subbasins_id",
label = "2. Select subbasins",
choices = subbasins,
selected = head(subbasins, 1)
)
# It seems the followin has no effect:
# and when it is outside observe, it produces errors!
curr_spatial <- curr_spatial %>%
filter(subbasin %in% input$subbasins_id) %>%
data.table()
})
Any input? please.
I did put the data and the whole code in google drive:
https://drive.google.com/file/d/1qaZG6-VmBhIgMsxs5dffX9PmagkMhuB8/view?usp=sharing
The second selectInput should render from the server and not from the UI to be interactive.
ui.R
selectInput(inputId = 'countyType_id',
label = '1. Select a basin',
choices = all_basins
),
uiOutput('subbasins_id')
server.R
output$subbasins_id <- renderUI({
## add some code to filter subbasin based on the selected basin, i.e. input$countyType_id
curr_spatial <- curr_spatial %>%
filter(subbasin %in% input$subbasins_id) %>%
data.table()
subbasins <- sort(unique(curr_spatial$subbasin))
selectizeInput(inputId = 'subbasins_id',
label = '2. Select subbasins',
choices = subbasins,
selected = head(subbasins, 1),
multiple = TRUE)
})
The app below contains a selectInput of dataset IDs and a button View details which displays a modalDialog when clicked. The modal dialog has a datatable that contains some information about the datasets in the selectInput dropdown.
Here is a screenshot of the app on startup:
Since the user can select a dataset either by selecting an option from the dropdown menu or by selecting a row in the datatable, I created a reactive value rv$selectedRow which stores the value of the selected dataset. When the modal is triggered, rv$selectedRow takes the value of input$data. When the Select button in the modal footer is clicked, rv$selectedRow takes the value of input$dfs_rows_selected and the selectInput is updated to reflect this new value. This is done by the two observeEvents in the code below.
When the user selects a row, closes the modal and opens it again, I would like the page and row of the selected dataset (input$data) to be pre-selected. I tried to achieve this using selection = list(mode = 'single', selected = rv$selectedRow) in the renderDT call. As you can see in the screenshot, row 1 should be pre-selected but it isn't. I feel like I'm missing a req() somewhere in the renderDT but I'm not sure. The value of rv$selectedRow checks out when I print it to the console, so I don't know why the selected argument of renderDT isn't working. I am also not sure how to store the page of the selected row. Any insight would be much much appreciated as I'm a little lost.
The app is as follows:
library(shiny)
library(DT)
datasets = data.frame(cbind(id = seq_len(4), name = c('iris', 'mtcars', 'satellite', 'credit')))
# UI ----------------------------------------------------------------------
ui = fluidPage(
selectInput('data', 'Select dataset:', choices = datasets$id),
actionButton('view', 'View details')
)
# SERVER ------------------------------------------------------------------
server <- shinyServer(function(input, output, session) {
rv = reactiveValues(selectedRow = NULL, selectedPage = NULL)
# Opening the modal
observeEvent(input$view, {
rv$selectedRow = req(input$data)
print(paste("selectedRow on 'View':", rv$selectedRow))
showModal(modalDialog(
title = 'Available datasets',
tags$b('Click on a row to select a dataset.'),
br(),
br(),
DT::dataTableOutput('dfs'),
easyClose = F,
footer = tagList(
modalButton('Cancel'),
bsButton('select', 'Select')
)
)
)
})
# Rendering the DT - pre-selection of row not working
output$dfs <- renderDT({
print(paste("selectedRow on 'renderDT':", rv$selectedRow))
datasets
},
options = list(
# displayStart = selectedPage,
pageLength = 2
),
filter = 'top',
selection = list(mode = 'single', selected = rv$selectedRow),
rownames = F
)
# Saving the selected row and updating the selectInput
observeEvent(input$select, {
rv$selectedRow = req(input$dfs_rows_selected)
print(paste("selectedRow on 'Select':", rv$selectedRow))
updateSelectInput(session = session, inputId = 'data', selected = datasets[rv$selectedRow, 1])
removeModal(session)
})
})
shinyApp(ui, server)
Updated code:
As per this solution and the one posted by Wilmar below, using datatable() in the renderDT seemed to fix the problem -
library(shiny)
library(DT)
datasets = data.frame(cbind(id = seq_len(4), name = c('iris', 'mtcars', 'satellite', 'credit')))
# UI ----------------------------------------------------------------------
ui = fluidPage(
selectInput('data', 'Select dataset:', choices = datasets$id),
actionButton('view', 'View details')
)
# SERVER ------------------------------------------------------------------
server <- shinyServer(function(input, output, session) {
rv = reactiveValues(selectedRow = NULL, selectedPage = NULL)
# Opening the modal
observeEvent(input$view, {
print(paste("selectedRow on 'View':", rv$selectedRow))
showModal(modalDialog(
title = 'Available datasets',
tags$b('Click on a row to select a dataset.'),
br(),
br(),
DT::dataTableOutput('dfs'),
easyClose = F,
footer = tagList(
modalButton('Cancel'),
bsButton('select', 'Select')
)
)
)
})
# Rendering the DT - pre-selection of row not working
output$dfs <- renderDataTable({
r = rv$selectedRow
print(paste("selectedRow on 'renderDT':", r))
datatable(
datasets,
options = list(
displayStart = as.numeric(r)-1,
pageLength = 2
),
filter = 'top',
selection = list(mode = 'single', selected = r),
rownames = F
)
}, server = F)
# Saving the selected row and updating the selectInput
observeEvent(input$select, {
rv$selectedRow = req(input$dfs_rows_selected)
print(paste("selectedRow on 'Select':", rv$selectedRow))
updateSelectInput(session = session, inputId = 'data', selected = datasets[rv$selectedRow, 1])
removeModal(session)
})
observe({
rv$selectedRow = input$data
})
})
shinyApp(ui, server)
I guess this is what you're looking for. Your first problem was that you had to convert rv$selectedRow to numeric. Secondly it you were re-rendering your datatable everytime you pressed the "view" button. And thirdly you didn't do anything with your selectInput ("data").
I transformed rv$selectedRow to a numeric, moved your showModal to the ui and created an observer for your selectInput. In addition, I wrapped your datafarme in the datatable function, which I think is a bit more convenient.
Working example:
library(shiny)
library(DT)
library(shinyBS)
datasets = data.frame(cbind(id = seq_len(4), name = c('iris', 'mtcars', 'satellite', 'credit')))
# UI ----------------------------------------------------------------------
ui = fluidPage(
selectInput('data', 'Select dataset:', choices = datasets$id),
actionButton('view', 'View details'),
tags$head(tags$style("#df_popup .modal-footer{ display:none}
#df_popup .modal-header .close{display:none}")),
bsModal("df_popup", title='Available datasets', trigger='view',
tags$b('Click on a row to select a dataset.'),
br(),
br(),
DT::dataTableOutput('dfs'),
column(12, align='right',
modalButton('Cancel'),
bsButton('select', 'Select')
)
)
)
# SERVER ------------------------------------------------------------------
server <- shinyServer(function(input, output, session) {
rv = reactiveValues(selectedRow = NULL, selectedPage = NULL)
# Rendering the DT - pre-selection of row not working
output$dfs <- renderDT({
print(paste("selectedRow on 'renderDT':", rv$selectedRow))
datatable(datasets, options = list(
# displayStart = selectedPage,
pageLength = 2
),
filter = 'top',
selection = list(mode = 'single', selected=c(as.numeric(rv$selectedRow))),
rownames = F)
},
)
# Saving the selected row and updating the selectInput
observeEvent(input$select, {
rv$selectedRow = req(input$dfs_rows_selected)
print(paste("selectedRow on 'Select':", rv$selectedRow))
updateSelectInput(session = session, inputId = 'data', selected = datasets[rv$selectedRow, 1])
toggleModal(session, 'df_popup')
})
observeEvent(input$data, {
rv$selectedRow = input$data
print(paste("selectedRow on 'data':", rv$selectedRow))
})
})
shinyApp(ui, server)
I'm a Shiny newbie and was trying to get something simple working, but unable to :(
Here is a part of my ui.R
sidebarLayout(
sidebarPanel(
radioButtons("market",
"Choose a Region to build the Sales file:",
c("North America & ANZ" = "NA", "Europe" = "EU"), inline = TRUE),
conditionalPanel(
condition = "input.market == 'NA'",
radioButtons("Locale",
"Choose a locale to see the sales Calendar:",
c("US and Canada" = "US_CA", "ANZ" = "ANZ"), inline = TRUE),
numericInput("sale_num", "Choose a Sale Number from the Table below",1,width = '100px' )
),
conditionalPanel(
condition = "input.market == 'EU'",
radioButtons("Locale",
"Choose a locale to see the sales Calendar:",
c("UK" = "UK", "FR and RoE" = "FR_ROE","DE,AT & CH" = "DACH"), inline = TRUE),
numericInput("sale_num", "Choose a Sale Number from the Table below",1,width = '100px' )),
dataTableOutput("sales"))
),
Here is my server.R
server <- shinyServer(function(input, output) {
output$sales <- renderDataTable({
saleTable(input$Locale)
},options = list(autoWidth = FALSE,searching = FALSE,pageLength=10))
})
When a change in the market radio button is triggered, the Locale radio does not update and hence the sales output table still has stale values and is not reflected by any change in Locale values.
I know I'm supposed to use something like UpdateRadiobuttons, but I'm not sure how. :(
saleTable is just a function in my Rscript that produces a data table.
Please help!
Thanks in advance!
Please post a minimal example, i.e. your function saleTable. Don't use the same input ID twice in your app, it's bad style and will not work in most cases. Here are two solutions: First one is bad style, second one better style.
1) Rename the second Locale to Locale2 and put this in your output$sales:
output$sales <- renderDataTable({
if(input$market == 'NA') data <- input$Locale
else if(input$market=="EU") data <- input$Locale2
saleTable(data)
}, options = list(autoWidth = FALSE,searching = FALSE,pageLength=10))
)
2) Create the second output as UIOutput and make it dependent on the first one:
ui <- shinyUI(
sidebarLayout(
sidebarPanel(
radioButtons("market",
"Choose a Region to build the Sales file:",
c("North America & ANZ" = "NA", "Europe" = "EU"), inline = TRUE),
uiOutput("Locale")),
mainPanel(dataTableOutput("sales"))))
server <- function(input, output, session) {
output$Locale <- renderUI({
if(input$market == "NA") myChoices <- c("US and Canada" = "US_CA", "ANZ" = "ANZ")
else myChoices <- c("UK" = "UK", "FR and RoE" = "FR_ROE","DE,AT & CH" = "DACH")
radioButtons("Locale","Choose a locale to see the sales Calendar:",
choices <- myChoices,
inline = TRUE)
})
output$sales <- renderDataTable({
saleTable(input$Locale)
},options = list(autoWidth = FALSE,searching = FALSE,pageLength=10))
}
shinyApp(ui = ui, server = server)
Based on the expressed interest in using updateRadioButtons, I put together a simple example with two radio buttons and a table output.
The first radio button input does not change. The second radio button input depends on the value of the first input. The table displayed is the mtcars data frame filtered by the values of the two radio button groups.
Using observeEvent ensures the value of the carb radio input updates each time the cyl radio input is changed. This will also trigger when the application is first launched and is why we do not see the default, dummy, choice "will be replaced" for the carb radio input.
Make sure to include session as one of the Shiny server function arguments. All of Shiny's update*Input functions require you pass a session object to them.
I hope this proves useful.
library(shiny)
shinyApp(
ui = fluidPage(
fluidRow(
column(
width = 4,
radioButtons(
inputId = "cyl",
label = "Choose number of cylinders:",
choices = unique(mtcars$cyl),
selected = unique(mtcars$cyl)[1]
),
radioButtons(
inputId = "carb",
label = "Choose number of carburetors:",
choices = "will be replaced"
)
),
column(
width = 8,
tableOutput(
outputId = "mtcars"
)
)
)
),
server = function(input, output, session) {
observeEvent(input$cyl, {
newChoices <- sort(unique(mtcars[mtcars$cyl == input$cyl, ]$carb))
updateRadioButtons(
session = session,
inputId = "carb",
choices = newChoices,
selected = newChoices[1]
)
})
output$mtcars <- renderTable({
req(input$cyl, input$carb)
mtcars[mtcars$cyl == input$cyl & mtcars$carb == input$carb, ]
})
}
)