Here is my code in R Shiny using modules.
I created a module named MyModule and want to generate two UI elements: selectInput and textInput. This code is just an example - in my real application second element require the result from the first element, so I want to generate them separately.
I don't understand why the second uiOutput doesn't generate the UI element it indended to:
library(shiny)
# Define UI
ui <- shinyUI(fluidPage(MyModuleUI("one")))
# Define server logic
server <- shinyServer(function(input, output, session) {callModule(MyModule, 'one')})
#Here is my UI Module
MyModuleUI <- function(id) {
ns <- NS(id)
fluidRow(
uiOutput(ns('ChooseNumber')),
uiOutput(ns('EnterText'))
)
}
#Here is my server Module
MyModule <- function(input, output, session) {
output$ChooseNumber <- renderUI({
# In my bigger program I need this UI to be generated with some database values,
# thats why it is in the Server part of the Module
ns <- session$ns
selectInput(ns("TheNumber"), label = 'Select a number', c(1,2,3))
})
# Same here
output$EnterText <- renderUI({
ns <- session$ns
textInput(ns('TheText'),label = 'Enter a text:',value = 'ABC')
})
}
# Run the application
shinyApp(ui = ui, server = server)
Thank you!
Related
I have a Shiny app that I am trying to "modularize". I have an issue that my subtab tabPanel tab_Summary is not recognized when I separate it in another R file.
If I place the creation of the tab_Summary inside the ui.R it works, but if I want to be able to have this subtab in another file like showed in the following scripts, then I get error that object 'tab_Summary' not found :
The 0_tab_Summary_ui.R placed in the folder 'C:/Users/ROG/Downloads/example_shiny/Shiny_Modules':
tab_Summary <- tabPanel('Summary',
fluidRow(
column(width = 3,
htmlOutput("Summary_Number_ui")
)
)
)
The ui.R script:
setwd(paste0(main_working_dir, "Shiny_Modules"))
source("0_tab_Summary_ui.R")
ui <- navbarPage(
title=div("SHINY DASHBOARD"),
tab_Summary
)
The server.R script:
server <- function(input, output, session) {
output$Summary_Number_ui <- renderUI({
HTML(paste0("<div id='mydiv'><font size='5'><font color=\"#0d0a36\"> Total Number of Accounts: <b>", 726431 , "</b></div>"))
})
}
The app.R script:
library(shiny)
local_working_dir <- "C:/Users/ROG/Downloads/example_shiny/"
main_working_dir <- local_working_dir
setwd(main_working_dir)
shinyApp(ui, server)
And below the ui.R script that does not show any error but is not modularized:
setwd(paste0(main_working_dir, "Shiny_Modules"))
source("0_tab_Summary_ui.R")
ui <- navbarPage(
title=div("SHINY DASHBOARD"),
# tab_Summary
tab_Summary <- tabPanel('Summary',
fluidRow(
column(width = 3,
htmlOutput("Summary_Number_ui")
)
)
)
)
Try to learn how to use modules in Shiny, roughly global.R "includes" all your modules and those files have a module specific UI and a Server part that belong together. In the ui.R you define your layout and call the specific module UI part, same for the server.R. This way you keep all code for one module together, which makes it nicely scalable. Also note that whatever settings you may want to use and define, global.R is excecuted once upon the start of your app, while all code within your server.R server function is run upon every browser refresh.
global.R
# Global.R is loaded once at App start (not at browser refresh!)
# load all libraries
library("shiny")
# source all your modules here
source("modules/MyTabModule.R")
ui.R
ui <- navbarPage(
title=div("SHINY DASHBOARD"),
MyTabModuleUI("Summary_Number_ui")
)
server.R
server <- function(input, output, session) {
MyTabModuleServer("Summary_Number_ui")
}
modules/MyTabModule.R
MyTabModuleUI <- function(id) {
ns <- NS(id)
tabPanel('Summary',
fluidRow(
column(
width = 3,
htmlOutput(ns("Summary_Number_ui"))
)
)
)
}
MyTabModuleServer <- function(id) {
moduleServer(id, function(input, output, session) {
output$Summary_Number_ui <- renderUI({
HTML(paste0("<div id='mydiv'><font size='5'><font color=\"#0d0a36\"> Total Number of Accounts: <b>", 726431 , "</b></div>"))
})
})
}
I want to create a shiny app that uses navbarMenu() and tabPanel() to display data tables. Instead of writing all of the codes in one app.R file, I plan to use the concept of shiny modules creating R/tabUI.R and R/tabServer.R to generate these tables.
However, I run into an error and cannot figure it out. Any suggestions and help are appreciated!
My code:
### R/tabUI.R
tabUI <- function(id) {
tagList(
navbarMenu("display table",
tabPanel(NS(id, "mtcars table"),
DT::dataTableOutput("table")
)
)
)
}
### R/tabServer.R
tabServer <- function(id) {
moduleServer(id, function(input, output, session){
output$table <- DT::renderDataTable(mtcars)
})
}
### app.R
library(shiny)
ui <- navbarPage("dashboard",
tabUI("table1")
)
server <- function(input, output, session){
tabServer("table1")
}
shinyApp(ui=ui, server=server)
Error:
> runApp()
Error: Navigation containers expect a collection of `bslib::nav()`/`shiny::tabPanel()`s and/or `bslib::nav_menu()`/`shiny::navbarMenu()`s. Consider using `header` or `footer` if you wish to place content above (or below) every panel's contents.
You can't use tagList() inside navbarPage() so you need to remove it from the module.
As a sidenote, you should define ns <- NS(id) at the beginning of the module and then wrap all ids in ns(). In your code, the table id was not wrapped in ns() so it wasn't displayed.
Fixed code:
### R/tabUI.R
tabUI <- function(id) {
ns <- NS(id)
navbarMenu("display table",
tabPanel(ns("mtcars table"),
DT::dataTableOutput(ns("table"))
)
)
}
### R/tabServer.R
tabServer <- function(id) {
moduleServer(id, function(input, output, session){
output$table <- DT::renderDataTable(mtcars)
})
}
### app.R
library(shiny)
ui <- navbarPage("dashboard",
tabUI("table1")
)
server <- function(input, output, session){
tabServer("table1")
}
shinyApp(ui=ui, server=server)
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)
I'm trying to updateSelectInput on a selectInput from the parent namespace inside a sub-module. In the module function, I'm inside the namespace as far as I understand, and therefore I can't access and update the selectInput from the parent namespace. How can I solve this?
library(shiny)
library(shinydashboard)
moduleUI <- function(id) {
ns <- NS(id)
box(
title=actionLink(ns("link"),"This is a link"),
plotOutput(ns("plot"))
)
}
module <- function(input, output,session,number) {
output$plot <- renderPlot({
plot(number)
})
observeEvent(input$link,{
print(paste0("Number is: ",number))
updateSelectInput(session,"selectInput",selected=number) #Doesn't work
})
}
ui <-
dashboardPage(
dashboardHeader(title="Title"),
dashboardSidebar(
selectInput("selectInput","Choose one option",choices=seq(1,10),selected=1)
),
dashboardBody(
moduleUI("5"),
moduleUI("10")
)
)
server <- function(session,input, output) {
callModule(module=module,id="5",5)
callModule(module=module,id="10",10)
}
shinyApp(ui = ui, server = server)
Took me a while, but I found a way to get the sub-module to update the super-module.
Shiny is designed so that access to other modules must be done via module arguments or returned values. We can not pass the widget ID between modules, but we can pass the session information of the parent.
library(shiny)
moduleUI <- function(id) {
ns <- NS(id)
uiOutput(ns("my_link"))
}
module <- function(input, output, session, number, parent) {
output$my_link <- renderUI({
actionLink(session$ns("link"), paste0("This is a link to ", number))
})
observeEvent(input$link,{
updateSelectInput(session = parent,"selectInput",selected = number) ### use parent session
})
}
ui <- fluidPage(
selectInput("selectInput","Choose one option",choices=seq(1,10),selected=1),
moduleUI("5"),
moduleUI("10")
)
server <- function(session,input, output) {
callModule(module = module, id = "5", 5, parent = session) ### pass session information
callModule(module = module, id = "10", 10, parent = session) ### pass session information
}
shinyApp(ui = ui, server = server)
In particular note that:
we pass the current session information when the sub-module is called
we use the parent session when updating the input selector
I think the ideal would be to get the sub-module to observe and update the super-module. However, I can only offer a solution in line with my comment above: having one observer per sub-module in the super-module. This will rapidly get cumbersome if you have many sub-modules.
library(shiny)
library(shinydashboard)
moduleUI <- function(id) {
ns <- NS(id)
box(
title=actionLink(ns("link"),"This is a link"),
plotOutput(ns("plot"))
)
}
module <- function(input, output,session,number) {
current = reactiveValues()
current$return_value = 0
returnvalue <- reactive(current$return_value)
output$plot <- renderPlot({
plot(number)
})
observeEvent(input$link,{
print(paste0("Number is: ",number))
current$return_value = current$return_value + 1
})
return(list(rv = returnvalue, num = number))
}
ui <-
dashboardPage(
dashboardHeader(title="Title"),
dashboardSidebar(
selectInput("inputID","Choose one option",choices=seq(1,10),selected=1),
actionButton("button","Knap")
),
dashboardBody(
moduleUI("5"),
moduleUI("10")
)
)
server <- function(session,input, output) {
val1 <- callModule(module=module,id="5",5)
val2 <- callModule(module=module,id="10",10)
observeEvent(val1$rv(),{
updateSelectInput(session,inputId="inputID",selected=val1$num)
})
observeEvent(val2$rv(),{
updateSelectInput(session,inputId="inputID",selected=val2$num)
})
}
shinyApp(ui = ui, server = server)
Key changes from Tobias's question:
sub-modules have different names
separate observer for each sub-module
sub-module contains a return_value that gets updated every time the link is clicked. This ensures the observer in the super-module has a change to observe.
sub-module returns a list with two values: return_value as described above, and the value to update the UI with.
I'm trying to make a dynamically generated navbar based on the session user id.
I have a data table that maps the session user to a list of that user's clients. I want the app to produce a navbar where each tabPanel is for each client that user has. I'm not sure how I can easily do that since navbarPage() doesn't take a list argument.
Below is my example
library(shiny)
data <- data.frame(user=c("emily", "emily"), clients=c("client1", "client2"))
CreateCustomNavbarContent <- function(data) {
l <- lapply(data$clients, function(client) {
tabPanel(client,
h2(client))
})
renderUI({
l
})
}
shinyApp(
ui <- fluidPage(
uiOutput("custom_navbar")
),
server <- function(input, output) {
output$custom_navbar <- renderUI({
## commented below doesn't work
# navbarPage(
# CreateCustomNavbarContent(data)
# )
navbarPage("",
tabPanel("client1",
h2("client1")
),
tabPanel("client2",
h2("client2")
)
)
})
}
)
You could achieve what you want with do.call, so we can pass a list of arguments as separate arguments. Below is a working example, I gave emily a companion called John so you can validate that the code does what you want ;)
Hope this helps!
library(shiny)
data <- data.frame(user=c("Emily", "Emily","John","John"), clients=c("client1", "client2","client3","client4"))
ui = fluidPage(
selectInput('select_user','Select user:',unique(data$user)),
uiOutput('mytabsetpanel')
)
server = function(input, output, session){
output$mytabsetpanel = renderUI({
myTabs = lapply(data$clients[data$user==input$select_user], tabPanel)
do.call(tabsetPanel, myTabs)
})
}
shinyApp(ui,server)