I have a shiny app with a button which calls a modal dialog where a UI should be inserted. I'm using insertUI because I want to add UI elements dynamically. The problem is, whenever I press the action button, the app crashes with the following error message:
Warning: Error in as.character: cannot coerce type 'closure' to vector of type 'character'
[No stack trace available]
If I set immediate = T in the insertUI() then there is no error, but also no UI inserted. Can someone explain what's going on here? Here's a reprex.
library(shiny)
ui <- fluidPage(
actionButton("add", "addConstraints")
)
server <- function(input, output, session) {
observeEvent(input$add, {
showModal(modalDialog(
selectizeInput(session$ns("constraintType"), label = "Select constraint type", choices = c("Comparison", "Numeric", "Interval")),
tags$div(id = session$ns("constraintPlaceholder")),
insertUI(
selector = paste0("#", session$ns("constraintPlaceholder")),
where = "afterEnd",
ui = HTML("test")
),
title = "Set Constraints",
footer = tagList(
modalButton("Cancel"),
actionButton(session$ns("confirmConstraint"), "Add")
)
))
})
}
shinyApp(ui, server)
insertUI needs to be called outside modalDialog. What inside modalDialog is UI components, they should be shinyTags, or HTML elements. insertUI is a server call, it can't be added to modalDialog
library(shiny)
ui <- fluidPage(
actionButton("add", "addConstraints")
)
server <- function(input, output, session) {
observeEvent(input$add, {
showModal(modalDialog(
selectizeInput(session$ns("constraintType"), label = "Select constraint type", choices = c("Comparison", "Numeric", "Interval")),
tags$div(id = session$ns("constraintPlaceholder")),
title = "Set Constraints",
footer = tagList(
modalButton("Cancel"),
actionButton(session$ns("confirmConstraint"), "Add")
)
))
insertUI(
selector = paste0("#", session$ns("constraintPlaceholder")),
where = "afterEnd",
ui = HTML("test")
)
})
}
shinyApp(ui, server)
Related
I created a module to help me accept 1)an excel file 2)a text input for the sheet name and 3) a text input for the range.
I want to be able to use this module in an App such that each time I click on the action button (AddExcelDataButton in the code below), it allows me to input a different file. I also need to be able to extract the contents of the file later.
I tried the below code in the main App, but it is throwing me the following errors
error1: The UI is linking all the inputs "inside the button"
error2: I am unable to figure out how to "access" or retrieve the filenames later in the code.
Any help in doing this the right way is highly appreciated please!
CODE FOR THE MODULE:
importExceldataUI <- function(importExceldata){
tagList(
tags$div(
HTML(paste0("<b>", "Enter Your Data Here"))
),
tags$div(
fileInput(inputId = "ImportExcelFile",
label = "Excel File",
multiple=FALSE),
style = "display:inline-block; vertical-align:top"
),# end of tags$div for fileInput ImportExcelFile
tags$div(
textInput(inputId = "ExcelSheetName",
label = "Sheet",
value="Data",),
style = "display:inline-block; vertical-align:top"
),#end of tags$Div for texinput-ExcelSheetName
tags$div(
textInput(inputId = "ExcelSheetRange",
label = "Range",
value = "C5:BN1000"),
style = "display:inline-block"
)#end of tags$div for textInput - sheetrange
)
}
importExceldataServer <- function(importExceldata){
moduleServer(importExceldata, function(input, output, session){
})
}
CODE FOR MAIN APP
importExceldataApp <- function(){
ui <- fluidPage(
mainPanel(
actionButton(inputId = "AddExcelDataButton", label = "Click here to add Excel Data"),
)#emd pf mainpanel
)
server <- function(input, output, session){
observeEvent(input$AddExcelDataButton, {
insertUI(selector = "#AddExcelDataButton",
ui = importExceldataUI(paste0("file",input$AddExcelDataButton)))
})#end of observeEvent
}
shinyApp(ui, server)
}
importExceldataApp()
There are some errors you need to fix:
to use modules, you must have IDs for both UI and server. For each pair, they must have the same ID.
For ids in module UI, you must use namespace NS.
For insertUI, default is insert into the selector, apparently, you don't want to insert inside a button, you need to add after the button, so you need have where argument, please read the help file of this function.
You should read more about shiny modules standards
Here is the working code:
library(shiny)
importExceldataUI <- function(id){
ns <- NS(id)
tagList(
tags$div(
HTML(paste0("<b>", "Enter Your Data Here"))
),
tags$div(
fileInput(inputId = ns("ImportExcelFile"),
label = "Excel File",
multiple=FALSE),
style = "display:inline-block; vertical-align:top"
),# end of tags$div for fileInput ImportExcelFile
tags$div(
textInput(inputId = ns("ExcelSheetName"),
label = "Sheet",
value="Data"),
style = "display:inline-block; vertical-align:top"
),#end of tags$Div for texinput-ExcelSheetName
tags$div(
textInput(inputId = ns("ExcelSheetRange"),
label = "Range",
value = "C5:BN1000"),
style = "display:inline-block"
)#end of tags$div for textInput - sheetrange
)
}
importExceldataServer <- function(id){
moduleServer(id, function(input, output, session){
observeEvent(input$ImportExcelFile, {
req(input$ImportExcelFile)
print(input$ImportExcelFile$datapath)
})
})
}
importExceldataApp <- function(){
ui <- fluidPage(
mainPanel(
actionButton(inputId = "AddExcelDataButton", label = "Click here to add Excel Data"),
)#emd pf mainpanel
)
server <- function(input, output, session){
observeEvent(input$AddExcelDataButton, {
insertUI(selector = "#AddExcelDataButton", where = "afterEnd",
ui = importExceldataUI(paste0("file",input$AddExcelDataButton)))
importExceldataServer(paste0("file",input$AddExcelDataButton))
})#end of observeEvent
}
shinyApp(ui, server)
}
importExceldataApp()
So to read the path of uploaded file, just use input$ImportExcelFile$datapath, datapath is the file location. Here in my code, I just print it out, you can do other things.
If you run this app 'a' the default selected value does not appear until the UI tab is selected
and the UI element which populates 'input$select' is generated. How can I force this element to be created when the app is loaded without the need to click on the panel to initialize it in order to get access to its default value.
library(shiny)
library(shinydashboard)
ui <- fluidPage(
tabsetPanel(
tabPanel(
title = "landing",
"Stuff"
),
tabPanel(
title = "UI",
uiOutput("select")
)
),
textOutput("out")
)
server <- function(input, output, session) {
output$select <- renderUI(
selectInput(
"select", "Selector:", choices = c("a", "b"), selected = "a"
)
)
output$out <- renderText(input$select)
}
shinyApp(ui, server)
You can use the argument suspendWhenHidden = FALSE from outputOptions. I had to play a bit where to place outputOptions (it doesn't work at the beginning of the server function). However, it still needs a little bit of time to load, so maybe one could optimise it further.
library(shiny)
library(shinydashboard)
ui <- fluidPage(
tabsetPanel(
tabPanel(
title = "landing",
"Stuff"
),
tabPanel(
title = "UI",
uiOutput("select")
)
),
textOutput("out")
)
server <- function(input, output, session) {
output$select <- renderUI({
selectInput(
"select", "Selector:", choices = c("a", "b"), selected = "a"
)
})
output$out <- renderText(input$select)
outputOptions(output, "select", suspendWhenHidden = FALSE)
}
shinyApp(ui, server)
I am trying to implement something similar to this within the app and not at the browser level as described here.
After capturing the value of the new tab (tabPanel value) selected, could not display the confirmation message before switching to the newly selected tab to display its content.
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(useShinyalert(),
tabsetPanel(id = "tabselected",
tabPanel("Tab1"),
tabPanel("Tab2",plotOutput("plot"))
)
)
server <- function(input, output) {
observeEvent(input$tabselected, {
if(input$tabselected == "Tab2")
{
shinyalert(title = "Save your work before changing tab", type = "warning", showConfirmButton = TRUE)
output$plot <- renderPlot({ ggplot(mtcars)+geom_abline() })
}
})
}
shinyApp(ui = ui, server = server)
You can simply redirect to Tab1 via updateTabsetPanel as long as your desired condition is met.
Here is an example requiring the user to type something in the textInput before it's allowed to switch the tab.
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(useShinyalert(),
tabsetPanel(
id = "tabselected",
tabPanel("Tab1", p(), textInput("requiredText", "Required Text")),
tabPanel("Tab2", p(), plotOutput("plot"))
))
server <- function(input, output, session) {
observeEvent(input$tabselected, {
if (input$tabselected == "Tab2" && !isTruthy(input$requiredText)) {
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
shinyalert(title = "Save your work before changing tab",
type = "warning",
showConfirmButton = TRUE)
output$plot <- renderPlot({
ggplot(mtcars) + geom_abline() + ggtitle(req(input$requiredText))
})
}
})
}
shinyApp(ui = ui, server = server)
By the way an alternative approach wpuld be using showTab and hideTab to display the tabs only if all conditions are fulfilled.
I need my Shiny module to hide/show a div outside of the namespace. I tried passing the div id to the module server function and using shinyjs to show/hide it but that is not working. I'm not getting an error, it just doesn't show/hide the div.
I know the Shiny module documentation says modules cannot access outputs outside the namespace. The docs do, though, give a way for the module to access inputs outside the namespace using reactives.
Does anyone know if there is a way for a Shiny module to access an output outside the namespace?
Here is what I'm trying to do:
### ui.R ###
header <- dashboardHeader(
title = a(href = 'http://google.com')
)
dashboardPage(
skin = 'black',
header,
dashboardSidebar(
sidebarMenu( id='tabs',
menuItem('Edit Existing Client', tabName = 'client-info')
)),
dashboardBody(
useShinyjs(),
fluidRow(
tabItems(
tabItem(tabName = "client-info",
div(selectClientModuleUI("clientinfons")),
div(id='editclientinfo', uiOutput('editclientstuff'))
)
)
)
)
)
### server.R ###
shinyServer(function(session,input, output) {
output$editclientstuff <- renderUI({
div(
fluidRow(
column(6,
textInput('editname', "Display name", value ='Testing name')
),
column(6,
numericInput('editastart','Start', value ='3')
)
)
)
})
callModule(selectClientModule, 'clientinfons', 'editclientinfo')
shinyjs::hide(id='editclientstuff')
})
### in global.R ###
selectClientModuleUI <- function(id){
ns <- NS(id)
clientlist = c(0, 1, 2)
names(clientlist) = c('Choose client', 'Fred', 'Kim')
div(
selectInput(ns('selectclient'), 'Select client to edit', choices = clientlist, selected = NULL, multiple = FALSE)
)
}
selectClientModule <- function(input, output, session, divtoshow = ''){
observeEvent(input$selectclient, {
if (!is.null(input$selectclient) && input$selectclient > 0){
print(paste0("showing ", divtoshow))
shinyjs::show(divtoshow)
}
})
}
That is possible by giving the value as a reactive (not as the value of the reactive) to the module. You can change the reactive Value in the module and return the reactive from the Module to the app (note, return the reactive itself, not its value). The following app switches the 'divtoshow' in the main app from inside the module. If nothing is selected, it's hidden, otherwise it's shown (note, I adjusted you code a little so it's working as a stand-alone app):
library(shinydashboard)
library(shinyjs)
# Module
selectClientModuleUI <- function(id){
ns <- NS(id)
clientlist = c(0, 1, 2)
names(clientlist) = c('Choose client', 'Fred', 'Kim')
div(
selectInput(ns('selectclient'), 'Select client to edit', choices = clientlist, selected = NULL, multiple = FALSE)
)
}
selectClientModule <- function(input, output, session, divtoshow){
observeEvent(input$selectclient, {
if (input$selectclient > 0){
print(paste0("showing editclientinfo"))
divtoshow("editclientinfo") # set the div to show to "editclientinfo", this will be visible outside the module
}else{
divtoshow("") # set the div to show to "", if nothing was chosen
}
})
# return the div to show as reactive to the main app
return(divtoshow)
}
# Main App
ui <- shinyUI(
dashboardPage(
skin = 'black',
dashboardHeader(
title = a(href = 'http://google.com')
),
dashboardSidebar(
sidebarMenu( id='tabs',
menuItem('Edit Existing Client', tabName = 'client-info')
)),
dashboardBody(
useShinyjs(),
fluidRow(
tabItems(
tabItem(tabName = "client-info",
div(selectClientModuleUI("clientinfons")),
div(id='editclientinfo', uiOutput('editclientstuff'))
)
)
)
)
))
server <- shinyServer(function(session,input, output) {
output$editclientstuff <- renderUI({
div(
fluidRow(
column(6,
textInput('editname', "Display name", value ='Testing name')
),
column(6,
numericInput('editastart','Start', value ='3')
)
)
)
})
# store the div to show in a reactive
divtoshow <- reactiveVal('')
# divtoshow can be changed in side this module, so it's a return value
divtoshow <- callModule(selectClientModule, 'clientinfons', divtoshow)
# observe the value of divtoshow and toggle the corresponding div
observeEvent(divtoshow(), {
if(divtoshow() == "editclientinfo"){
shinyjs::show("editclientinfo")
}else{
shinyjs::hide("editclientinfo")
}
})
})
shinyApp(ui, server)
I have two inputs to be removed from the ui.R
fileInput(inputId = "FileInput",label = "Choose a csv file",accept = '.csv'),
uiOutput("SKU")
Inside server i am using an observeEvent to remove these 2 inputs and insert one. Though the insertUi is working I am not able to remove the other 2.
PFB the code:
observeEvent(input$Save,{
removeUI(
selector = "div:has(> #FileInput)"
)
insertUI(
selector = "#Save",
where = "afterEnd",
ui =fluidPage(
tags$hr(),
fluidRow(column(offset=0,1,actionButton("clean","Start cleaning the Data")))
)
)
})
It seems you have to treat it the same way in which the shiny blog example treats text by wrapping it in a div with id.
tags$div(
fileInput(inputId = "FileInput",label = "Choose a csv file",accept = '.csv'),
id='FileInput'
)
Example
ui <- fluidPage(
mainPanel(
tags$div(fileInput('element1','Input file...'),id='element1'),
actionButton('remove','Remove File Input')
)
)
server <- function(input, output) {
observeEvent(input$remove,{
removeUI(selector = '#element1')
})
}
shinyApp(ui = ui, server = server)