This is the script I am trying to run, randomApp function is a wrapper for a simple shiny app. However, when I call randomApp() it throws me an error: Error: 'server' must be a function. It looks to me that the server is already a function so I have no idea why it gives me an error. Any ideas?
library(shiny)
randomUI <- function(id) {
tagList(
textOutput(NS(id, "val")),
actionButton(NS(id, "go"), "Go!")
)
}
randomServer <- function(id) {
moduleServer(id, function(input, output, session) {
rand <- eventReactive(input$go, sample(100, 1))
output$val <- renderText(rand())
})
}
randomApp <- function(){
ui <- fluidPage(
randomUI("random1"),
randomUI("random2"),
randomUI("random3")
)
server <- function(input, output, session) {
randomServer("random1")
randomServer("random2")
randomServer("random3")
}
runApp(ui, server)
}
randomApp()
You are using the wrong function to launch your app. You should use shinyApp rather than runApp when specifying a UI and server function. Check the help pages to see the difference.
Related
I have a function which I'd like to handle multiple outputs but base it off of the input to the function. For example, in the following code side could refer to any number of maps on the page, e.g. 10:
library(shiny)
ui <- fluidPage(
textOutput("m1"),
textOutput("m2")
)
f <- function(output, side) {
m = output[[paste0('m', side)]]
print(m)
}
server <- function(input, output, session) {
f(output, 1)
f(output, 2)
}
shinyApp(ui, server)
However, running this code results in the following error:
Warning: Error in [[.shinyoutput: Reading from shinyoutput object is not allowed.
You have to create a reactive context for each output. This would be the first solution of doing it. This way you write a function that creates a renderText output in each call.
library(shiny)
ui <- fluidPage(
textInput("in1", "Value"),
textOutput("m1"),
textOutput("m2")
)
server <- function(input, output, session) {
f <- function(outputId, side) {
output[[outputId]] <<- renderText({
paste0('m', side, " - ", input$in1)
})
}
f("m1", 1)
f("m2", 2)
}
shinyApp(ui, server)
The solution above duplicates code. For most apps that shouldn't be a problem. But if you need to avoid that:
library(shiny)
ui <- fluidPage(
textInput("in1", "Value"),
textOutput("m1"),
textOutput("m2")
)
server <- function(input, output, session) {
f <- function(outputId, side) {
paste0('m', side, " - ", input$in1)
}
output$m1 <- renderText({
f("m1", 1)
})
output$m2 <- renderText({
f("m2", 2)
})
}
Getting started with shiny, I try to learn how to use the Shiny Module design pattern. As the most simple example, I want to display a dataset without any further interaction.
I wish to organise the UI in tabPanels of a navbarPage. Each panel is independent from each other, (except that all panels use a global database connection objects, but this does not bother me now).
Here is the code for the DT GUI element:
library(shiny)
library(DT)
tabTable <- function(id) {
ns <- shiny::NS(id)
tabPanel(
"Table",
shiny::dataTableOutput(ns("table"))
)
}
This is the server logic. I want it to draw the data table.
srvTable <- function(id, dat) shiny::moduleServer(id,
function(input, output, session) {
output$table <- shiny::renderDataTable({DT::datatable(dat)})
}
)
Now here is the definition of the ui and the server:
ui <- shiny::navbarPage(title="Test",
tabTable(id="iris"),
shiny::tabPanel(title="Scatter")
)
server <- function(input, output, session) {
srvTable(id="iris", dat=iris)
session$onSessionEnded(stopApp)
}
shiny::shinyApp(ui, server)
This app starts, it displays the navigation bar, but it does not show the dataset. Any hint where I put the command for that? The problem for me is that there is no obvious condition that the server module needs to react to. What is to do in this case?
Try this
library(shiny)
library(DT)
tabTable <- function(id) {
ns <- shiny::NS(id)
tabPanel(
"Table",
DTOutput(ns("table"))
)
}
srvTable <- function(id, dat) { shiny::moduleServer(id,
function(input, output, session) {
output$table <- renderDT({DT::datatable(dat)})
}
)}
ui <- shiny::navbarPage(title="Test",
tabTable(id="iris"),
shiny::tabPanel(title="Scatter")
)
server <- function(input, output, session) {
srvTable(id="iris", dat=iris)
session$onSessionEnded(stopApp)
}
shiny::shinyApp(ui, server)
How to display a blank UI (alternatively destroy module UI), if the module server-function fails, without moving all the UI-code to the server function?
Simple reproducible example:
library(shiny)
my_module_ui <- function(id) {
ns <- NS(id)
tags$div(
tags$h1("Don't show me if my_module_server fails!"),
plotOutput(ns("my_plot"))
)
}
my_module_server <- function(input, output, session) {
tryCatch({
my_data <- cars * "A" # fail for demo
# my_data <- cars
output$my_plot <- renderPlot({
cars2 <- my_data + rnorm(nrow(my_data))
plot(cars2)
})
}, error=function(cond) {
message("Destroy UI here!")
})
}
ui <- fluidPage(
my_module_ui("my_id")
)
server <- function(input, output, session) {
callModule(my_module_server, "my_id")
}
shinyApp(ui, server)
My current solution is to have nothing but a uiOutput() in my_module_ui and render the entire ui in the server function. I want to prevent this, since large modules get very messy if all UI-components are placed within the module server-function.
In addition I would preferably also like to avoid returning values from callModule() that destroy the UI and do this from within the server-function instead.
Thanks!
How about you assign a value to the session object and evaluate this value before you create the UI (from server side via renderUI().
1) Move rendering of UI to server side
Use renderUI(my_module_ui("my_id")) on server side and uiOutput("module") on ui side.
2) To detect whether your server module was successful assign a value to the session object
my_module_server <- function(input, output, session) {
tryCatch({
...
session$userData$mod_server <- TRUE
}, error = function(cond) {
session$userData$mod_server <- NULL
})
}
3) Use this value to make the call of your module ui conditional
output$module <- renderUI({
callModule(my_module_server, "my_id")
if(!is.null(session$userData$mod_server)) my_module_ui("my_id")
})
Reproducible example:
library(shiny)
my_module_ui <- function(id) {
ns <- NS(id)
tags$div(
tags$h1("Don't show me if my_module_server fails!"),
plotOutput(ns("my_plot"))
)
}
my_module_server <- function(input, output, session) {
tryCatch({
my_data <- cars * "A" # fail for demo
# my_data <- cars
output$my_plot <- renderPlot({
cars2 <- my_data + rnorm(nrow(my_data))
plot(cars2)
})
session$userData$mod_server <- TRUE
}, error = function(cond) {
session$userData$mod_server <- NULL
})
}
ui <- fluidPage(
uiOutput("module")
)
server <- function(input, output, session) {
output$module <- renderUI({
callModule(my_module_server, "my_id")
if(!is.null(session$userData$mod_server)) my_module_ui("my_id")
})
}
shinyApp(ui, server)
With a little code reordering, and the use of the amazing shinyjs package this can be done.
Note that I added an input to simulate errors and not errors, to see how the UI dissapears. Also all is done in the server part of the module. I hope this will help you. The code has inline comments explaining the steps.
library(shiny)
library(shinyjs)
my_module_ui <- function(id) {
ns <- NS(id)
tagList(
# input added to be able to throw errors and see the ui dissapear
selectInput(
ns('trigger'), 'Error trigger',
choices = list('no error' = c(2,1), 'error' = c('A', 'B')),
selected = 2
),
tags$div(
# div with id, to select it with shinyjs and hide it if necessary
id = ns('hideable_div'),
tags$h1("Don't show me if my_module_server fails!"),
plotOutput(ns("my_plot"))
)
)
}
my_module_server <- function(input, output, session) {
# get all the things prone to error in a reactive call, that way you capture the final
# result or a NULL reactive when an error occurs
foo <- reactive({
tryCatch({
if (input$trigger %in% c(2,1)) {
trigger <- as.numeric(input$trigger)
} else {
trigger <- input$trigger
}
cars * trigger
}, error=function(cond) {
message("Destroy UI here!")
})
})
# obseveEvent based on the error reactive, to check if hide or not the UI
observeEvent(foo(), {
# hide checking if foo is null, using shinyjs
if (is.null(foo())) {
shinyjs::hide('hideable_div')
} else {
shinyjs::show('hideable_div')
}
}, ignoreNULL = FALSE, ignoreInit = FALSE)
# outputs, with validation of the error reactive. That way code after validate is not
# executed but the app does not get blocked (gray)
output$my_plot <- renderPlot({
shiny::validate(
shiny::need(foo(), 'no data')
)
cars2 <- foo() + rnorm(nrow(foo()))
plot(cars2)
})
}
ui <- fluidPage(
# really important for shinyjs tu work!!!!!!!
shinyjs::useShinyjs(),
my_module_ui("my_id")
)
server <- function(input, output, session) {
callModule(my_module_server, "my_id")
}
shinyApp(ui, server)
I am having a shiny app that is heavily relying on modules. Basically it's a big navbarPage with different menus and tabs where every tab is wrapped as a module. Below I provided a minimal example with 2 tabs, but in reality there are more than 20.
# module 1 ------------------------------------------------
moduleOneUI <- function(id) {
ns = NS(id)
tagList(
h2("module1"),
textOutput(ns("text"))
)
}
moduleOne <- function(input, output, session) {
output$text <- renderText({"one yo"})
}
# module 2 ------------------------------------------------
moduleTwoUI <- function(id) {
ns = NS(id)
tagList(
h2("module2"),
textOutput(ns("text"))
)
}
moduleTwo <- function(input, output, session) {
output$text <- renderText({"two yo"})
}
# main app ------------------------------------------------
ui <- navbarPage(
"dashboard",
navbarMenu(
"#1",
tabPanel(
"mod1",
uiOutput("module_one")
)
),
navbarMenu(
"#2",
tabPanel(
"mod2",
uiOutput("module_two")
)
)
)
server <- function(input, output, session) {
output$module_one <- renderUI({
moduleOneUI("module_one")
})
callModule(moduleOne, "module_one")
output$module_two <- renderUI({
moduleTwoUI("module_two")
})
callModule(moduleTwo, "module_two")
}
shinyApp(ui, server)
As you might see the server function gets very large with this hard coded server function. So I tried to create it in a more dynamic way using a loop:
modules <- list(
module_one = c(ui = moduleOneUI, server = moduleOne),
module_two = c(ui = moduleTwoUI, server = moduleTwo)
)
server <- function(input, output, session) {
for (mod_id in names(modules)) {
module <- modules[[mod_id]]
ui_func <- module$ui
server_func <- module$server
output[[mod_name]] <- renderUI({
ui_func(mod_id)
})
callModule(server_func, mod_id)
}
}
However, this approach fails to work as expected. Now I see the moduleTwo code rendered in my module_one tab:
Does any1 know why this is happening and how I can fix it? I really need a dynamic approach to render all those modules.
The two renderUI expressions aren't evaluated until after the loop completes and mod_id = "module_two".
To get around this, you can create a local scope for each loop iteration:
for (mod_id in names(modules)) {
local({
mod_id <- mod_id
module <- modules[[mod_id]]
ui_func <- module$ui
server_func <- module$server
output[[mod_id]] <- renderUI({
ui_func(mod_id)
})
callModule(server_func, mod_id)
})
}
I seem to have found a solution for that problem. If I define a function that calls the module everything works as expected.
create_tab <- function(mod_id, output) {
module <- modules[[mod_id]]
ui_func <- module$ui
server_func <- module$server
output[[mod_id]] <- renderUI({
ui_func(mod_id)
})
callModule(server_func, mod_id)
}
server <- function(input, output, session) {
lapply(names(modules), create_tab, output = output)
}
However, I have no idea why this is working and the other approach isn't. I assume it has something to do with scoping in R.
I am trying to convert a section of code into a Shiny Module, but my renderPlot() functions generated within an lapply() don't seem to be working. I have created a simple example below to demonstrate the issue.
(Note: Here I'm using renderText() calls, but the same behavior applies.)
app_normal.R:
library(shiny)
ui <- fixedPage(
h2("Normal example"),
uiOutput("test")
)
server <- function(input, output, session) {
output$test <- renderUI({
lapply(1:3, function(val) {
fluidRow(column(12,renderText(paste("Line", val))))
})
})
}
shinyApp(ui, server)
app_module.R:
library(shiny)
myModuleUI <- function(id) {
ns <- NS(id)
uiOutput(ns("test"))
}
myModule <- function(input, output, session) {
output$test <- renderUI({
lapply(1:3, function(val) {
fluidRow(column(12,renderText(paste("Line", val))))
})
})
}
ui <- fixedPage(
h2("Module example"),
myModuleUI("test_module")
)
server <- function(input, output, session) {
callModule(myModule, "test_module")
}
shinyApp(ui, server)
All of the div elements are being created, but they just fail to contain the plots/text. How do I properly use the Shiny renderText() or renderPlot() functions within renderUI()/lapply() calls within a module?
It appears that the approach I was taking using the renderText() and renderPlot() functions directly in a renderUI() works fine in the normal case, i.e. when not operating within a Shiny Module. Shiny automatically calls the necessary textOutput() or plotOutput() to generate the HTML. Some how this automatic link is broken when you are performing the same operations within a Shiny Module. I suspect this is due to the mismatch between assigning and referencing items in the output list due to the introduction of the ns() call when assigning outputIds as is done manually in a call to outputPlot() or outputText().
To successfully use renderUI within a Shiny Module, you need to separately call textOutput() and renderText(): textOutput in the lapply() in the renderUI(), and renderText() in an lapply() in an observe(). This allows us to introduce an ns() into the generation of the outputId for the textOutput() call.
Below I've included a refactoring of both app_normal.R and app_module.R that demonstrates the disentanglement of these two calls.
app_normal_observe.R:
library(shiny)
ui <- fixedPage(
h2("Normal example"),
uiOutput("test")
)
server <- function(input, output, session) {
output$test <- renderUI({
lapply(1:3, function(val) {
fluidRow(column(12,textOutput(paste0("line_", val))))
})
})
observe({
lapply(1:3, function(val) {
output[[paste0("line_", val)]] <- renderText(paste("Line", val))
})
})
}
shinyApp(ui, server)
app_module_observe.R:
library(shiny)
myModuleUI <- function(id) {
ns <- NS(id)
uiOutput(ns("test"))
}
myModule <- function(input, output, session) {
output$test <- renderUI({
lapply(1:3, function(val) {
fluidRow(column(12,textOutput(session$ns(paste0("line_", val)))))
})
})
observe({
lapply(1:3, function(val) {
output[[paste0("line_", val)]] <- renderText(paste("Line", val))
})
})
}
ui <- fixedPage(
h2("Module example"),
myModuleUI("test_module")
)
server <- function(input, output, session) {
callModule(myModule, "test_module")
}
shinyApp(ui, server)