Is there any chance to not only use html in the text but in the button of sendweetalert or confirmsweetalert in the shinyWidgets package?
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
tags$h1("Confirm sweet alert"),
actionButton(
inputId = "launch1",
label = "Confirmation"
),
verbatimTextOutput(outputId = "res1"),
tags$br(),
actionButton(
inputId = "launch2",
label = "Sweetalert"
),
verbatimTextOutput(outputId = "res2")
)
server <- function(input, output, session) {
observeEvent(input$launch1, {
confirmSweetAlert(
session,
inputId = "confirm",
btn_labels = HTML("<a href='https://google.de'>Link</a>"),
title = "confirmation",
html = T
)
})
output$res1 <- renderPrint(input$confirm)
observeEvent(input$launch2, {
sendSweetAlert(
session,
title = "sweetalert",
html = T,
btn_labels = HTML("<a href='https://google.de'>Link</a>")
)
})
}
shinyApp(ui = ui, server = server)
Related
Here I'm trying to create a actionlink between tabs, but I have many nested tabs within and since I'm calling the links from the nested tabs itself and not the main session, I'm not able to place the id's correctly.
I've looked into this question : Question , but this works for only the main session.
Here's a part of my reproducible code:
ui <- fluidPage(
navbarPage(id = "Navbar",
tabPanel("About",..
actionLink("link_to_overview", "Let's start with the Overview!"), <--- This works
),
tabPanel("Overview",
tabsetPanel(id = "Tab_ov",
tabPanel("Flights",..
actionLink("link_to_airlines", "Let's go to the Airlines!"),<--- This doesn't work
),
tabPanel("Airlines",..
actionLink("link_to_domestic_stats", "Let's go to the Domestic!") <--- This doesn't work
),
)),
tabPanel("Statistics",
tabsetPanel(id = "stats_tab",
tabPanel("Domestic",..
),
tabPanel("International",..),
))
))
server <- function(input, output, session) {
observeEvent(input$link_to_overview, {
newvalue <- "Overview"
updateTabItems(session, "Navbar", newvalue)
})
observeEvent(input$link_to_airlines, {
updateTabsetPanel(session, inputId = 'Flights', selected = 'Tab_ov')
updateTabsetPanel(session, inputId = 'Overview', selected = 'Airlines')
})
observeEvent(input$link_to_domestic_stats, {
updateTabsetPanel(session, inputId = 'Overview', selected = 'Statistics')
updateTabsetPanel(session, inputId = 'stats_tab', selected = 'Domestic')
})
}
Try this:
library(shiny)
library(tidyverse)
ui <- fluidPage(navbarPage(
id = "Navbar",
tabPanel(
"About",
actionLink("link_to_overview", "Let's start with the Overview!")
),
tabPanel("Overview",
tabsetPanel(
tabPanel(
"Flights",
value = 'flights',
actionLink("link_to_airlines", "Let's go to the Airlines!")
),
tabPanel(
"Airlines",
value = 'airlines',
actionLink("link_to_domestic_stats", "Let's go to the Domestic!")
), id = "Tab_ov"
),value = 'ovview'),
tabPanel(
"Statistics",
tabsetPanel(
tabPanel("Domestic", value = 'domestic'),
tabPanel("International", ''),
id = "stats_tab")
)
))
server <- function(input, output, session) {
observeEvent(input$link_to_overview, {
updateTabsetPanel(session, "Navbar", 'ovview')
})
observeEvent(input$link_to_airlines, {
updateTabsetPanel(session, inputId = 'Tab_ov', selected = 'airlines')
})
observeEvent(input$link_to_domestic_stats, {
updateTabsetPanel(session, inputId = 'Navbar', selected = 'Statistics')
updateTabsetPanel(session, inputId = 'stats_tab', selected = 'domestic')
})
}
shinyApp(ui, server)
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'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');")
}
})
}
)
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)
I am new in shiny, I wonder how to put the "=" close beside the selectInput box?
library(shiny)
ui = fluidPage(
mainPanel(
titlePanel("Calculation:"),#Voltage calculation
fluidRow(
column(3,
selectInput("selc11", h4("Cable"),#Resistivity
choices = list("Copper" = 0.0174, "Alum" = 0.0282), selected = 1)),
h4("=")
)
)
)
server = function(input, output) {
}
shinyApp(ui = ui, server = server)
If you want something like this:
You can achive it with:
library(shiny)
library(shinyjs)
ui = fluidPage(
useShinyjs(),
mainPanel(
titlePanel("Calculation:"),#Voltage calculation
fluidRow(
column(1, h4('Cable')),
column(3, selectInput(
"selc11",
label = '',
choices = list("Copper" = 0.0174, "Alum" = 0.0282), selected = 1)
),
column(3, h4("="))
)
)
)
server = function(input, output) {
runjs("$('label.control-label').remove()")
}
shinyApp(ui = ui, server = server)