I have to call a module within another module to display a dataset filter. So the construction of the filter is dynamic and is done within a renderUI.
The problem is that it doesn't show me the filter.
I have created a code that exemplifies my problem.
I have two modules:
inner and outer.
From outer and I call inner.
If the call is made from a renderUI of outer (filter3), the button is not displayed.
It must be a namespace (ns) problem but I can't figure out why.
innerUI <- function(id) {
ns <- NS(id)
hidden(
actionButton(
NS(id, "filter"),
label = NULL,
icon = icon("filter"),
style = "margin-left: 0px;"
)
)
}
outerUI <- function(id) {
ns <- NS(id)
wellPanel(
innerUI(ns("inner1")),
uiOutput(ns("list_dtf"))
)
}
innerServer <- function(id,
data = reactive(NULL),
hide = FALSE,
hover_text = NULL) {
# SERVER
moduleServer(id, function(input, output, session) {
# NAMESPACE
ns <- session$ns
print("!hide")
if (!hide) {
print(hide)
shinyjs::show("filter")
print('show("filter")')
print(id)
if(!is.null(hover_text)) {
addTooltip(session = session,
id = ns("filter"),
title = hover_text)
}
} else {
print("escondo el filter")
}
}
)
}
outerServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
ns <- session$ns
innerResult1 <- innerServer("inner1", hover_text="prueba tooltip 1")
innerResult3 <- innerServer( "inner3", hover_text="prueba tooltip 3")
output$list_dtf <- renderUI({
div(
h2("1 OTRO FILTRO:"),
innerUI(session$ns("inner3")),
h2("2 OTRO FILTRO:")
)
})
}
)
}
ui <- fluidPage(
wellPanel(
titlePanel("Select of Data File"),
useShinyjs(),
outerUI ("select_data_file"),
innerUI("inner2")
)
)
# server
server <- function(input, output, session){
outerServer ("select_data_file")
innerServer("inner2",hide = FALSE,hover_text="prueba tooltip2")
}
shinyApp(ui, server)
Try this
innerUI <- function(id) {
ns <- NS(id)
#hidden(
actionButton(
ns("filter"),
label = NULL,
icon = icon("filter"),
style = "margin-left: 0px;"
)
#)
}
innerServer <- function(id,
data = reactive(NULL),
hide = FALSE,
hover_text = NULL) {
# SERVER
moduleServer(id, function(input, output, session) {
# NAMESPACE
ns <- session$ns
print("!hide")
if (!hide) {
print(hide)
shinyjs::show("filter")
print('show("filter")')
print(id)
if(!is.null(hover_text)) {
addTooltip(session = session,
id = ns("filter"),
title = hover_text)
}
} else {
shinyjs::hide("filter")
print("escondo el filter")
}
}
)
}
Related
I've got two shiny modules, with updateTextInput() in the first one. I want to update textInput() in the second module, when button from the first is clicked. I know it's because those modules are in different namespaces but I can't figure out how to communicate modules.
Reprex below :)
library(shiny)
firstUI <- function(id) {
ns <- NS(id)
tagList(
actionButton(ns("update"), "Update 1st and 2nd module"),
textInput(ns("first"), "Update me pls1", value = "Clear me!")
)
}
firstServer <- function(id) {
moduleServer(id, function(input, output, session) {
observeEvent(input$update, {
updateTextInput(session = session, "first", value = "")
updateTextInput(session = session,"second", value = "")
})
})
}
secondUI <- function(id) {
ns <- NS(id)
tagList(
textInput(ns("second"), "Update me pls", value = "Clear me!")
)
}
secondServer <- function(id) {
moduleServer(id, function(input, output, session) {
observeEvent(input$update, {
updateTextInput(session = session, "first", value = "")
updateTextInput(session = session,"second", value = "")
})
})
}
ui <- fluidPage(
firstUI("module_one"),
secondUI("module_two")
)
server <- function(input, output, session) {
firstServer("module_one")
secondServer("module_two")
}
shinyApp(ui, server)
You can do it by making the first input$update reactive, then returning that value and making it reactive to the second server module. This way the second server module is "listening" to the change in the first one.
library(shiny)
firstUI <- function(id) {
ns <- NS(id)
tagList(
actionButton(ns("update"), "Update 1st and 2nd module"),
textInput(ns("first"), "Update me pls1", value = "Clear me!")
)
}
firstServer <- function(id) {
moduleServer(id, function(input, output, session) {
observeEvent(input$update, {
updateTextInput(session = session, "first", value = "")
updateTextInput(session = session,"second", value = "")
})
reactive(input$update)
})
}
secondUI <- function(id) {
ns <- NS(id)
tagList(
textInput(ns("second"), "Update me pls", value = "Clear me!")
)
}
secondServer <- function(id, clear) {
moduleServer(id, function(input, output, session) {
observeEvent(clear(), {
updateTextInput(session = session, "first", value = "")
updateTextInput(session = session,"second", value = "")
})
})
}
ui <- fluidPage(
firstUI("module_one"),
secondUI("module_two")
)
server <- function(input, output, session) {
clear <- reactive(firstServer("module_one"))
secondServer("module_two", clear())
}
shinyApp(ui, server)
A roundabout way would be to use shinyjs to trigger the updating manually.
library(shiny)
library(shinyjs)
firstUI <- function(id) {
ns <- NS(id)
tagList(
actionButton(ns("update"), "Update 1st and 2nd module"),
textInput(ns("first"), "Update me pls1", value = "Clear me!")
)
}
firstServer <- function(id) {
moduleServer(id, function(input, output, session) {
observeEvent(input$update, {
updateTextInput(session = session, "first", value = "")
runjs('document.getElementById("module_two-second").value = ""')
})
})
}
secondUI <- function(id) {
ns <- NS(id)
tagList(
textInput(ns("second"), "Update me pls", value = "Clear me!")
)
}
secondServer <- function(id) {
moduleServer(id, function(input, output, session) {
# Code not needed in here for now
})
}
ui <- fluidPage(
useShinyjs(),
firstUI("module_one"),
secondUI("module_two")
)
server <- function(input, output, session) {
firstServer("module_one")
secondServer("module_two")
}
shinyApp(ui, server)
Shiny modules work by giving each element a unique id by pasting [module_name]-[element_id] together in the html frontend, so each module server can correctly identify which it should be talking to. The first server can find and talk to module_two-second when passed that id directly. Ideally there might be a way of doing this within the Shiny code itself though.
Edit: fix within Shiny by passing parent_session (without shinyjs)
The updateTextInput call can indeed find module_two-second itself if it can look outside of its own session environment. To achieve this, you can pass the parent_session as the argument to updateTextInput (defined in firstServer function definition and passed as parent_session = session in the server body):
library(shiny)
firstUI <- function(id) {
ns <- NS(id)
tagList(
actionButton(ns("update"), "Update 1st and 2nd module"),
textInput(ns("first"), "Update me pls1", value = "Clear me!")
)
}
firstServer <- function(id, parent_session) {
moduleServer(id, function(input, output, session) {
observeEvent(input$update, {
updateTextInput(session = session, "first", value = "")
updateTextInput(session = parent_session, "module_two-second", value = "")
})
})
}
secondUI <- function(id) {
ns <- NS(id)
tagList(
textInput(ns("second"), "Update me pls", value = "Clear me!")
)
}
secondServer <- function(id) {
moduleServer(id, function(input, output, session) {
# Code not needed in here for now
})
}
ui <- fluidPage(
firstUI("module_one"),
secondUI("module_two")
)
server <- function(input, output, session) {
firstServer("module_one", parent_session = session)
secondServer("module_two")
}
shinyApp(ui, server)
I have a shiny app, each module is it's own file. Each module get's an ns <- NS(id). When I adress an Element, say a button from one of those modules with observeEvent it works if I just hardcode an ID in the module, but not if I use ns(). What am I doing wrong?
Module:
mod_add_element_ui <- function(id){
ns <- NS(id)
tagList(
shiny::actionButton(ns("add_element"), "add new element", icon = icon("plus-square"))
)
}
mod_add_element_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
})
}
app_ui:
app_ui <- function(request) {
tagList(
fluidPage(
mod_add_element_ui("add_element_ui_1"),
div(id="add_here")
)
)
}
app_server:
app_server <- function( input, output, session ) {
mod_add_element_server("add_element_ui_1")
observeEvent(input$add_element,
{
mod_add_element_server(id="mod")
insertUI(selector = "#add_here", ui = mod_add_element_ui("mod"))
}
)
}
Try this
mod_add_element_ui <- function(id){
ns <- NS(id)
tagList(
shiny::actionButton(ns("add_element"), "add new element", icon = icon("plus-square"))
)
}
mod_add_element_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
return(reactive(input$add_element))
})
}
app_ui <- function(request) {
tagList(
fluidPage(
mod_add_element_ui("add_element_ui_1"),
div(id="add_here")
)
)
}
app_server <- function( input, output, session ) {
added_element <- mod_add_element_server("add_element_ui_1")
observeEvent(added_element(),
{
mod_add_element_server(id="mod")
insertUI(selector = "#add_here", ui = mod_add_element_ui("mod"))
}
)
}
shinyApp(app_ui, app_server)
Background
I am using {brochure} and {golem} to build a shiny app. I have one outer module grid that consists of inner modules subGrid2 which displays the same module UI on two tabs.
GOAL
have a module subGrid2 that can be used for repeating graph
visualizations on multiple tabs.
in the REPREX --> fake graph generated from {shinipsum} to
be displayed on the "Home" tab + "Portfolio" tab
use observeEvent to look at the slected tab and generate server response respectivley
Problem
The observeEvent reactive expr. fails to recognize when the corresponding tab is selected to generate the correct server response.
-using the reprex below replicates my issue-
TL/DR
Why wont the observeEvent reactive generate the correct server response per the selected tab?
REPREX
uncomment observeEvent to see error
#22.2.22
library(brochure)
library(shiny)
library(shinipsum)
library(shinydashboard)
library(shinydashboardPlus)
mod_subGrid2_ui <- function(id) {
ns <- NS(id)
tagList(
plotOutput(ns("plot"))
)
}
mod_subGrid2_server <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$plot <- renderPlot({
shinipsum::random_ggplot()
})
})
}
#Setup dashboard
mod_Grid_ui <- function(id) {
ns <- NS(id)
shinydashboardPlus::dashboardPage(
skin = "midnight",
header = dashboardHeader(title = "test"),
sidebar = dashboardSidebar(
shinydashboard::sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs",
menuItem("Home", tabName = "home", icon = icon("tachometer-alt")),
menuItem("Portfolio", tabName = "portfolio", icon = icon("chart-line"), badgeLabel = "new",
badgeColor = "green")
)
),
body = shinydashboard::dashboardBody(
# Enable shinyjs
shinyjs::useShinyjs(),
shinydashboard::tabItems(
shinydashboard::tabItem("home",
shiny::tagList(
div(p("Content for 1st tab goes here -- GRID MODULE")),
mod_subGrid2_ui(ns("subGrid2_ui_1"))
)
),
shinydashboard::tabItem("portfolio",
shiny::tagList(
div(p("Content for 2nd goes here -- GRID MODULE (2x)")),
titlePanel(title = "The same module UI goes here"),
mod_subGrid2_ui(ns("subGrid2_ui_2"))
)
)
)
)
)
}
mod_Grid_server <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
mod_subGrid2_server("subGrid2_ui_1")
mod_subGrid2_server("subGrid2_ui_2")
## uncomment to try
# observeEvent(input$tabs,{
# if(input$tabs == "home"){
# # <subGrid> server fragment
# mod_subGrid2_server("subGrid2_ui_1")
# } else if(input$tabs == "portfolio"){
# mod_subGrid2_server("subGrid2_ui_1")
# }
# }, ignoreNULL = TRUE, ignoreInit = TRUE)
})
}
brochureApp(
page(
href = "/",
ui = tagList(
mod_Grid_ui("grid_1")
),
server = function(input, output, session) {
mod_Grid_server("grid_1")
}
),
wrapped = shiny::tagList
)
When using a module nested inside another module, you need to ns() the id of the nested UI function.
So here, mod_subGrid2_ui(ns("subGrid2_ui_1")).
Here is a minimal reprex:
mod_subGrid2_ui <- function(id) {
ns <- NS(id)
tagList(
plotOutput(ns("plot"))
)
}
mod_subGrid2_server <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$plot <- renderPlot({
shinipsum::random_ggplot()
})
})
}
mod_Grid_ui <- function(id) {
ns <- NS(id)
tagList(
mod_subGrid2_ui(ns("subGrid2_ui_1"))
)
}
mod_Grid_server <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
mod_subGrid2_server("subGrid2_ui_1")
})
}
brochureApp(
page(
href = "/",
ui = tagList(
mod_Grid_ui("grid_1")
),
server = function(input, output, session) {
mod_Grid_server("grid_1")
}
)
)
The app below contains a module that inserts a UI object each time the Add button is clicked. The UI object consists of two inputs:
Input 1 is a selectInput with choices A and B.
Input 2 is a textInput if the user chooses A and a
numericInput if they choose B.
However, when I click Add, the inserted UI only contains Input 1 (the selectInput) - Input 2 is not rendered, as shown below:
Whereas the desired output looks like this:
I'm not sure if this is a namespacing issue or if there is a problem in the scoping of the module. Printing the IDs to the console checks out:
The app is as follows:
library(shiny)
# module UI function
modUI <- function(id){
ns <- NS(id)
tagList(
actionButton(ns('add'), 'Add'),
div(id = ns('placeholder'))
)
}
# module server function
modServer <- function(input, output, session) {
ns = session$ns
ctn <- reactiveVal(0)
Id <- reactive({
function(id){
ns(paste0(id, ctn()))
}
})
observeEvent(input$add, {
ctn(ctn() + 1)
insertUI(
selector = paste0('#', ns('placeholder')),
ui = div(
id = Id()('div'),
selectInput(Id()('letter'), 'Letter:', LETTERS[1:2]),
uiOutput(Id()('input'))
)
)
})
observeEvent(ctn(), {
id <- Id()('input')
selection <- Id()('letter')
print(list(id = id, selection = selection))
req(input[[selection]])
output[[id]] <- renderUI({
req(input[[selection]])
switch(
input[[selection]],
'A' = textInput(Id()('text'), 'ENTER TEXT', ''),
'B' = numericInput(Id()('numeric'), 'ENTER NUMBER', '')
)
})
}, ignoreInit = TRUE)
}
# main ui
ui <- fluidPage(
modUI('mod1')
)
# main server
server <- function(input, output, session) {
callModule(modServer, "mod1")
}
# run app
shinyApp(ui, server)
I tried splitting the module up into an inner and outer module. The inner mod creates Input 1 and Input 2 and the outer mod inserts them into the main app using insertUI. This gives me the same outcome as before though. The code for this can be viewed below:
library(shiny)
# INNER MOD ---------------------------------------------------------------
innermodUI <- function(id) {
ns = NS(id)
tagList(
selectInput(ns('letter'), 'Letter:', LETTERS[1:2]),
uiOutput(ns('names'))
)
}
innermodServer <- function(input, output, session) {
ns = session$ns
output$names <- renderUI({
selection = req(input$letter)
switch(
selection,
'A' = textInput(ns('text'), 'ENTER TEXT', ''),
'B' = numericInput(ns('numeric'), 'ENTER NUMBER', '')
)
})
}
# OUTER MOD ---------------------------------------------------------------
modUI <- function(id){
ns <- NS(id)
tagList(
actionButton(ns('add'), 'Add'),
div(id = ns('placeholder'))
)
}
modServer <- function(input, output, session) {
ns = session$ns
ctn <- reactiveVal(0)
Id <- reactive({
function(id){
ns(paste0(id, ctn()))
}
})
observeEvent(input$add, {
ctn(ctn() + 1)
filterId = Id()('filter')
insertUI(
selector = paste0('#', ns('placeholder')),
ui = innermodUI(filterId)
)
callModule(innermodServer, filterId)
})
}
# MAIN --------------------------------------------------------------------
ui <- fluidPage(
modUI('mod1')
)
server <- function(input, output, session) {
callModule(modServer, "mod1")
}
shinyApp(ui, server)
I also tried wrapping the renderUI in a shinyjs::delay() to no avail. I would really appreciate any help on this since I'm not well-versed in Shiny modules and don't know what to try next.
I've managed to make it work by multiple trials-errors. As I understand (I'm still new in Shiny modules), you have to use session$ns only for the inputs created in the server.
library(shiny)
# module UI function
modUI <- function(id){
ns <- NS(id)
tagList(
actionButton(ns('add'), 'Add'),
div(id = ns('placeholder'))
)
}
# module server function
modServer <- function(input, output, session) {
ns = session$ns
ctn <- reactiveVal(0)
Id <- reactive({
function(id){
paste0(id, ctn())
}
})
IdNS <- reactive({
function(id){
ns(paste0(id, ctn()))
}
})
observeEvent(input$add, {
ctn(ctn() + 1)
insertUI(
selector = paste0('#', ns('placeholder')),
ui = div(
id = Id()('div'),
selectInput(IdNS()('letter'), 'Letter:', LETTERS[1:2]),
uiOutput(IdNS()('input'))
)
)
})
observeEvent(ctn(), {
id <- Id()('input')
selection <- Id()('letter')
output[[id]] <- renderUI({
switch(
input[[selection]],
'A' = textInput(IdNS()('text'), 'ENTER TEXT', ''),
'B' = numericInput(IdNS()('numeric'), 'ENTER NUMBER', '')
)
})
}, ignoreInit = TRUE)
}
# main ui
ui <- fluidPage(
modUI('mod1')
)
# main server
server <- function(input, output, session) {
callModule(modServer, "mod1")
}
# run app
shinyApp(ui, server)
I am trying to decompose an unwieldy app that I have created, and in doing so I realize that I really need to modularize add/remove buttons. I want to be able to create a shiny module that has an add and remove button, and by clicking those buttons, we can add and remove an instance of another module. To make it simple, I have a toy example that has a simple module that just has a selectInput() IU with 3 choices. I want to be able to add as many of these selectInput() UI elements as desired and be able to access the results of these selections for use in the main server logic. So I created "firstUI()" and firstServer()" modules, as well as "addRmBtnUI()" and "addRmBtnServer()" modules. The addRmBtn modules accept parameters serverModToCall and uiModToCall, which are the names of the ui and server modules that we want to call with the addRmBtn modules. I seem to be getting tripped up on the passing of these modules as parameters to the addRmBtn modules. Code is below. How can I get this to work as intended? Thanks!
suppressWarnings(library(shiny))
firstUI <- function(id) {
ns <- NS(id)
tags$div(
fluidRow(
column(12,
uiOutput(ns("first"))
)
)
)
}
firstServer <- function(input, output, session) {
ns = session$ns
output$first <- renderUI({
selectInput(ns("select"), label = h4("Select"),
choices = list("Selection1" = 1, "Selection2" = 2,
"Selection3" = 3), selected = 1)
})
}
addRmBtnUI <- function(id) {
ns <- NS(id)
tags$div(
fluidRow(
column(2,
uiOutput(ns("insertParamBtn"))
),
column(2,
uiOutput(ns("removeParamBtn"))
)
),
hr(),
tags$div(id = 'placeholder')
)
}
addRmBtnServer <- function(input, output, session, serverModToCall, uiModToCall) {
ns = session$ns
params <- reactiveValues(btn = 0)
output$insertParamBtn <- renderUI({
actionButton(inputId = ns('insertParamBtn'),
label = "Add", offset = 3)
})
output$removeParamBtn <- renderUI({
actionButton(inputId = ns('removeParamBtn'),
label = "Remove", offset = 3)
})
params <- reactiveValues(btn = 0)
observeEvent(input$insertParamBtn, {
params$btn <- params$btn + 1
callModule(do.call(serverModToCall, args = list(id = params$btn)))
insertUI(
selector = '#placeholder',
ui = do.call(uiModToCall, args = list(id = params$btn)) #********# This line is issue
)
})
observeEvent(input$removeParamBtn, {
removeUI(
## pass in appropriate div id
selector = paste0('#param', params$btn)
)
params$btn <- params$btn - 1
})
}
ui <- function(request) {
fluidPage(
fluidRow(
addRmBtnUI(1)
),
fluidRow(
uiOutput("result")
)
)
}
server <- function(input, output, session) {
callModule(addRmBtnServer, id = 1,
serverModToCall = 'firstServer',
uiModToCall = 'firstUI')
res <- reactive({ })
output$result <- renderUI({
verbatimTextOutput(paste0(input[[NS(1, "select")]]), placeholder = T)
})
}
shinyApp(ui = ui, server = server)
It seems there were somme errors in the code
First, the call to firstServer was
callModule(do.call(firstServer, args = list(id = params$btn)))
which translates to
callModule(firstServer(params$btn))
callModule should however be invoked like this:
callModule(firstServer, params$btn)
The version below passes functions rather than function names, so the differences might be hard to spot at first glance.
Second, you need to namespace the ids for insertUI/removeUI. You can read more about this in the "nesting modules" section of this article.
## in addRmBtnServer/observe add button
insertUI(
selector = paste('#', ns('placeholder')),
ui = uiModToCall(ns(params$btn))
)
## in addRmBtnServer/observe remove button
removeFirstUI(ns(params$btn))
## in global scope
removeFirstUI <- function(id){
removeUI(selector = paste0('#', NS(id, "first") ))
}
Third, i am not sure what output$result was supposed to show, so I omitted it in the version below.
library(shiny)
firstUI <- function(id){uiOutput(NS(id, "first"))}
firstServer <- function(input, output, session){
output$first <- renderUI({
selectInput(session$ns("select"), h4("Select"), letters[1:4])
})
}
removeFirstUI <- function(id){
removeUI(selector = paste0('#', NS(id, "first")))
}
addRmBtnUI <- function(id) {
ns <- NS(id)
tags$div(
actionButton(inputId = ns('insertParamBtn'), label = "Add"),
actionButton(ns('removeParamBtn'), label = "Remove"),
hr(),
tags$div(id = ns('placeholder'))
)
}
addRmBtnServer <- function(input, output, session, moduleToReplicate) {
ns = session$ns
params <- reactiveValues(btn = 0)
observeEvent(input$insertParamBtn, {
params$btn <- params$btn + 1
callModule(moduleToReplicate$server, id = params$btn)
insertUI(
selector = paste0('#', ns('placeholder')),
ui = moduleToReplicate$ui(ns(params$btn))
)
})
observeEvent(input$removeParamBtn, {
moduleToReplicate$remover(ns(params$btn))
params$btn <- params$btn - 1
})
}
ui <- fluidPage(addRmBtnUI("addRm"))
server <- function(input, output, session) {
callModule(
addRmBtnServer, id = "addRm",
moduleToReplicate = list(
ui = firstUI,
server = firstServer,
remover = removeFirstUI
)
)
}
shinyApp(ui = ui, server = server)