I'm trying to disable the confirm button in confirmSweetAlert unless selectizeInput has some input within it. There seem to be solutions by using Javascript, such as swal.disableConfirmButton() and document.getElementsByClassName().disabled = true, but when I run them under shinyjs::runjs, these don't seem to work. Are there any solutions out there to resolve this issue? Here's my sample code:
shinyApp(
ui <- fluidPage(
actionButton("button", "Show Sweet Alert!")
),
server <- function(input, output, session) {
observeEvent(input$button, {
confirmSweetAlert(
session = session,
inputId = "letterSelect",
title = "Select a Letter!",
type = "info",
text = tags$div(
h4("Please select from the options below then press 'Confirm'.", align = "center"),
selectizeInput(
inputId = "letters",
label = NULL,
choices = c("A", "B", "C"),
options = list(placeholder = "None selected."),
multiple = TRUE,
width = '100%')
),
closeOnClickOutside = FALSE
)
})
}
)
This seems to work:
library(shiny)
library(shinyWidgets)
library(shinyjs)
shinyApp(
ui <- fluidPage(
useShinyjs(),
actionButton("button", "Show Sweet Alert!")
),
server <- function(input, output, session) {
observeEvent(input$button, {
confirmSweetAlert(
session = session,
inputId = "letterSelect",
title = "Select a Letter!",
type = "info",
text = tags$div(
h4("Please select from the options below then press 'Confirm'.", align = "center"),
selectizeInput(
inputId = "letters",
label = NULL,
choices = c("A", "B", "C"),
options = list(placeholder = "None selected."),
multiple = TRUE,
width = '100%')
),
closeOnClickOutside = FALSE
)
runjs("Swal.getConfirmButton().setAttribute('disabled', '');")
})
observe({
if(is.null(input$letters)){
runjs("Swal.getConfirmButton().setAttribute('disabled', '');")
}else{
runjs("Swal.getConfirmButton().removeAttribute('disabled');")
}
})
}
)
Related
The documentation of selectizeInput describes the argument selected as follows.
selected The initially selected value (or multiple values if multiple
= TRUE). If not specified then defaults to the first value for single-select lists and no values for multiple select lists.
I interpreted this sentence as the selected argument would be the first element of the choices argument if nothing is specified for the selected. However, in the following example, after the selection of any numbers for the first selectizeInput, the second selectizeInput does not select the first choice. It still displays the default message as a placeholder.
Notice that if I set server = TRUE, the second selectizeInput would be able to display the first choice as the selected.
I am wondering why server = TRUE or server = FALSE affects if the selected can be the first element in choices. I also want to know how I can make the behavior of server = FALSE as the same as when server = TRUE.
library(shiny)
ui <- fluidPage(
headerPanel("shinyStore Example"),
sidebarLayout(
sidebarPanel = sidebarPanel(
selectizeInput(inputId = "Select1", label = "Select A Number",
choices = as.character(1:3),
options = list(
placeholder = 'Please select a number',
onInitialize = I('function() { this.setValue(""); }'),
create = TRUE
))
),
mainPanel = mainPanel(
fluidRow(
selectizeInput(inputId = "Select2",
label = "Select A Letter",
choices = character(0),
options = list(
placeholder = 'Please select a number in the sidebar first',
onInitialize = I('function() { this.setValue(""); }'),
create = TRUE
))
)
)
)
)
server <- function(input, output, session) {
dat <- data.frame(
Number = as.character(rep(1:3, each = 3)),
Letter = letters[1:9]
)
observeEvent(input$Select1, {
updateSelectizeInput(session, inputId = "Select2",
choices = dat$Letter[dat$Number %in% input$Select1],
server = FALSE)
})
}
shinyApp(ui, server)
Why not create the second selectizeInput completely on the server side?
library(shiny)
ui <- fluidPage(
headerPanel("shinyStore Example"),
sidebarLayout(
sidebarPanel = sidebarPanel(
selectizeInput(inputId = "Select1", label = "Select A Number",
choices = as.character(1:3),
options = list(
placeholder = 'Please select a number',
onInitialize = I('function() { this.setValue(""); }'),
create = TRUE
))
),
mainPanel = mainPanel(
fluidRow(
uiOutput('select2')
)
)
)
)
server <- function(input, output, session) {
dat <- data.frame(
Number = as.character(rep(1:3, each = 3)),
Letter = letters[1:9]
)
output$select2 <- renderUI({
req(input$Select1)
selectizeInput(inputId = "Select2",
label = "Select A Letter",
choices = dat$Letter[dat$Number %in% input$Select1])
})
}
shinyApp(ui, server)
I am trying to create a dynamic left menu (header), but the items are listed downward instead of to the right. I guess it has to do with the tagList wrapper when defining the UI.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
library(stringr)
ui = dashboardPage(
dashboardHeader(
leftUi = tagList(uiOutput("filter"))
),
dashboardSidebar(
pickerInput(
"inputParameters",
"Parameters:",
choices = c("a", "b", "c"),
multiple = TRUE,
options = list(
`actions-box` = TRUE,
size = 10,
`selected-text-format` = "count > 1"
)
)
),
dashboardBody(),
title = "DashboardPage"
)
server = function(input, output) {
params <- reactive(input$inputParameters)
output$filter = renderUI(
lapply(seq_along(params()), function(i) {
dropdownButton(
inputId = paste0("mydropdown", i),
label = params()[i],
icon = icon("sliders"),
status = "primary",
circle = FALSE,
selectizeInput(
paste0("input", paste0(str_to_title(params()[i]))),
paste0(paste0(str_to_title(params()[i]), ":")),
choices = 1:3,
multiple = TRUE,
selected = 1:3
)
)
})
)
}
shinyApp(ui, server)
Not tested, I would try:
output$filter = renderUI({
ddbuttons <- lapply(seq_along(params()), function(i) {
dropdownButton(
inputId = paste0("mydropdown", i),
label = params()[i],
icon = icon("sliders"),
status = "primary",
circle = FALSE,
selectizeInput(
paste0("input", paste0(str_to_title(params()[i]))),
paste0(paste0(str_to_title(params()[i]), ":")),
choices = 1:3,
multiple = TRUE,
selected = 1:3
)
)
})
do.call(splitLayout, ddbuttons)
})
And don't use tagList, just uiOutput("filter").
I'm trying to get the pickerInput dropdown placed in front of the confirmSweetAlert buttons, but using z-index within CSS doesn't appear to work. Any other suggestions?
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
actionButton(
inputId = "launch",
label = "Launch Confirm!"
)
)
server <- function(input, output, session) {
# Launch sweet alert confirmation
observeEvent(input$launch, {
confirmSweetAlert(
session = session,
inputId = "test",
title = "This is a Test!",
type = "info",
text = tags$div(
div(style="position: relative; z-index: 1;", pickerInput(
inputId = "numbers",
multiple = TRUE,
choices = 1:5,
width = "100%"
)),
closeOnClickOutside = FALSE,
html = TRUE
))
})
}
if (interactive())
shinyApp(ui, server)
You can use options = pickerOptions(container = "body") in pickerInput to append the select to a specific element, in that case "body" help positioning the menu.
Full example:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
actionButton(
inputId = "launch",
label = "Launch Confirm!"
)
)
server <- function(input, output, session) {
# Launch sweet alert confirmation
observeEvent(input$launch, {
confirmSweetAlert(
session = session,
inputId = "test",
title = "This is a Test!",
type = "info",
text = tags$div(
pickerInput(
inputId = "numbers",
multiple = TRUE,
choices = 1:5,
width = "100%",
options = pickerOptions(container = "body")
),
closeOnClickOutside = FALSE,
html = TRUE
))
})
}
if (interactive())
shinyApp(ui, server)
I need to show\hide input and will be great get NULL or empty string if the input not exists, here reproducible example:
ui <-
dashboardPage(
dashboardHeader(
title = 'Test'),
dashboardSidebar(),
dashboardBody(
selectInput(
inputId = 'mainInput',
label = 'Main input',
selected = 'Show',
choices = c('Show', 'Hide')
),
uiOutput(
outputId = 'secondInputUI'
),
actionButton(
inputId = 'thirdInput',
label = 'Check value'
)
)
)
server <- function(input, output, session){
observeEvent(input$mainInput, ignoreNULL = TRUE, {
if (input$mainInput == 'Show')
output$secondInputUI <-
renderUI(
selectInput(
inputId = 'secondInput',
label = 'Second input',
selected = 0,
multiple = FALSE,
choices = c(1, 0)
)
)
else {
output$secondInputUI <-
renderUI(
selectInput(
inputId = 'secondInput',
label = 'Second input',
selected = '',
multiple = TRUE,
choices = c(1, 0)
)
)
# If uncommit - input value don't update and will return latest available before delete input
# output$secondInputUI <-
# NULL
}
})
observeEvent(input$thirdInput, {
showNotification(
session = session,
ui = paste(input$secondInput, collapse = ', '))
})
}
shinyApp(
ui = ui,
server = server)
You can see commented part with setting NULL to uioutput, if it active - shiny return latest available value before clear that ui, so how to deal with that?
I think I understand. You could create a reactive variable that is independent of the UI, because inputs are not updated when the UI element is removed.
library(shiny)
library(shinydashboard)
ui <-
dashboardPage(
dashboardHeader(
title = 'Test'),
dashboardSidebar(),
dashboardBody(
selectInput(
inputId = 'mainInput',
label = 'Main input',
selected = 'Show',
choices = c('Show', 'Hide')
),
uiOutput(
outputId = 'secondInputUI'
),
actionButton(
inputId = 'thirdInput',
label = 'Check value'
)
)
)
server <- function(input, output, session){
secondInputVar <- reactive({
if(input$mainInput == 'Show'){
input$secondInput
} else {
}
})
observeEvent(input$mainInput, ignoreNULL = TRUE, {
if (input$mainInput == 'Show')
output$secondInputUI <-
renderUI(
selectInput(
inputId = 'secondInput',
label = 'Second input',
selected = 0,
multiple = FALSE,
choices = c(1, 0)
)
)
else {
output$secondInputUI <- renderUI({
NULL
})
}
})
observeEvent(input$thirdInput, {
showNotification(
session = session,
ui = paste(secondInputVar(), collapse = ', '))
})
}
shinyApp(
ui = ui,
server = server)
So, I found another solution, the main idea is: update input value in observer for first input, hide second input from observer for the second input. Will be better if I show:
ui <-
dashboardPage(
dashboardHeader(
title = 'Test'),
dashboardSidebar(),
dashboardBody(
selectInput(
inputId = 'mainInput',
label = 'Main input',
selected = 'Show',
choices = c('Show', 'Hide')
),
uiOutput(
outputId = 'secondInputUI'
),
actionButton(
inputId = 'thirdInput',
label = 'Check value'
)
)
)
server <- function(input, output, session){
observeEvent(input$mainInput, {
if (input$mainInput == 'Show')
output$secondInputUI <-
renderUI(
selectInput(
inputId = 'secondInput',
label = 'Second input',
selected = 0,
multiple = FALSE,
choices = c(1, 0)
)
)
else {
output$secondInputUI <-
renderUI(
selectInput(
inputId = 'secondInput',
label = 'Second input',
selected = '',
multiple = TRUE,
choices = c(1, 0)
)
)
}
})
# THE TRICK HERE ####
observeEvent(input$secondInput, ignoreNULL = FALSE, {
if (input$mainInput != 'Show'){
output$secondInputUI <-
renderUI(NULL)
}
})
observeEvent(input$thirdInput, {
showNotification(
session = session,
ui = paste(input$secondInput, collapse = ', '))
})
}
shinyApp(
ui = ui,
server = server)
Below is some code for a very simple shiny dashboard. On tab 1 "Select" I have a radio button selector and on tab 2 "Food" I have a selectizeInput.
When the dashboard initially loads the first tab is loaded and "Fruits" is selected by default. When I move to tab 2 however, nothing displays in the selectizeInput drop down menu dispite having an observe event linked to the radio buttons.
If I then go back to the Select tab and click on Meats, the selectizeInput populates. If I then select Fruits again on the Select tab, the selectizeInput populates with a list of fruits.
How do I make the selectizeInput populate on first load with the list of fruits?
Thanks
library(shinydashboard)
library(data.table)
menu <- data.table(numb = c(rep(1,4), rep(2,4)),
item = c("Apple", "Orange", "Grape", "Lemon", "Steak", "Chicken", "Pork", "Venison"))
ui <- dashboardPage(skin = "blue",
dashboardHeader(),
dashboardSidebar(
sidebarMenu(id = "initalTab",
sidebarMenuOutput("menuSidebar"))
),
dashboardBody(
tabItems(
tabItem("select",
uiOutput("selectType")),
tabItem("food",
uiOutput("selectFood"))
)
)
)
server <- (function(input, output, session) {
output$menuSidebar <- renderMenu({
sidebarMenu(
menuItem("Select", tabName = "select", icon = icon("home")),
menuItem("Food", tabName = "food", icon = icon("sort"))
)
})
isolate({updateTabItems(session, "initalTab", "select")})
output$selectType <- renderUI({
fluidRow(
box(width = 3, status = "primary", solidHeader = TRUE,
radioButtons("foodFilter", label = h4("Filter by Food Type"),
choices = c("Fruits" = 1, "Meats" = 2),
selected = 1,
inline = TRUE)
)
)
})
output$selectFood <- renderUI({
fluidRow(
box(width = 6, status = "primary", solidHeader = TRUE,
h4("Select Your Food"),
selectizeInput("group",
choices = NULL,
width ="100%",
NULL,
NULL,
multiple = TRUE,
options = list(plugins = list("drag_drop", "remove_button"),
placeholder = "Please select you food"))
)
)
})
observeEvent(input$foodFilter, {
updateSelectizeInput(session,
"group",
choices = menu[numb == input$foodFilter,`item`],
selected = menu[numb == input$foodFilter,`item`][1],
server = TRUE)
})
})
shinyApp(ui, server)
Building up on my comment try adding this line outputOptions(output, "selectFood", suspendWhenHidden = FALSE)
library(shinydashboard)
library(data.table)
library(shiny)
menu <- data.table(numb = c(rep(1,4), rep(2,4)),
item = c("Apple", "Orange", "Grape", "Lemon", "Steak", "Chicken", "Pork", "Venison"))
ui <- dashboardPage(skin = "blue",
dashboardHeader(),
dashboardSidebar(
sidebarMenu(id = "initalTab",
sidebarMenuOutput("menuSidebar"))
),
dashboardBody(
tabItems(
tabItem("select",
uiOutput("selectType")),
tabItem("food",
uiOutput("selectFood"))
)
)
)
server <- (function(input, output, session) {
output$menuSidebar <- renderMenu({
sidebarMenu(
menuItem("Select", tabName = "select", icon = icon("home")),
menuItem("Food", tabName = "food", icon = icon("sort"))
)
})
isolate({updateTabItems(session, "initalTab", "select")})
output$selectType <- renderUI({
fluidRow(
box(width = 3, status = "primary", solidHeader = TRUE,
radioButtons("foodFilter", label = h4("Filter by Food Type"),
choices = c("Fruits" = 1, "Meats" = 2),
selected = 1,
inline = TRUE)
)
)
})
output$selectFood <- renderUI({
fluidRow(
box(width = 6, status = "primary", solidHeader = TRUE,
h4("Select Your Food"),
selectizeInput("group",
choices = NULL,
width ="100%",
NULL,
NULL,
multiple = TRUE,
options = list(plugins = list("drag_drop", "remove_button"),
placeholder = "Please select you food"))
)
)
})
outputOptions(output, "selectFood", suspendWhenHidden = FALSE)
observeEvent(input$foodFilter,{
updateSelectizeInput(session,
"group",
choices = menu[numb == input$foodFilter,`item`],
selected = menu[numb == input$foodFilter,`item`][1],
server = TRUE)
})
})
shinyApp(ui, server)