rshinyshinymodules

Namespacing issue in nested modules with for loop

I have coded a large Shiny app and I am modularising it with nested modules.

At the lower level, each module is taking care of coding for and returning a figure ('Figure' module). This module is called inside another module which structures the 'SubPanel' where the figure is displayed along with titles, text, and legends. The 'SubPanel' modules are called in the main app.

It all works fine except for one case where I use the same 'Figure' module twice. Instead of repeating the same code, I made the 'Figure' module call for another module using a for loop, thus adding yet another level of nesting.

Problem:

When I run the app, there is no error and all the aesthetics, navbars, panels, titles, texts, legends and all work fine. Yet the plots themselves do not show. I suspect that I do not handle the namespacing right.

I have read several posts on SO about this but I can't seem to catch what I am doing wrong. I could surely use some another set of eyes on this. Any feedback is appreciated!

Code:

Main app (simplified)

deployed <- data.frame(x = rep(c(1:10), 2),
                       y = rep(c(1:10), 2),
                       d = rep(c("A_site", "D_site"), each = 10))


# Main UI
ui <- fluidPage(
  
  theme = shinytheme("flatly"),
  div(style = "padding: 1px 0px; width: '100%'", titlePanel(title = "")),
  
  navbarPage(
    title = div(strong("MY PROJECT"),
    tabPanel(title = "Data management",
      tabsetPanel(type = "tabs",
        Panel2_SubPanel3_UI("MyData")
      )
    )
  )

)


# Main server
server <- function(input, output, session) {
  
  deplo <- reactive({deployed})
  Panel2_SubPanel3_Server("MyData", deplo)
  
}


# Run the application 
shinyApp(ui = ui, server = server)

SubPanel module: organises the page into sections corresponding to the figures.

Panel2_SubPanel3_UI <- function(id) {
  
  ns <- NS(id)
  tabPanel(
     title = "Proximity data",
     sidebarPanel(width = 3, strong("The panel focuses on...")),
     mainPanel(width = 9, uiOutput(ns("both_deployed")))
  )
  
}

Panel2_SubPanel3_Server <- function(id, deployed) {
  moduleServer(id, function(input, output, session) {
    
    output$both_deployed <- renderUI({
      Panel2_SubPanel3_Figure2C_UI(session$ns("both_deployed"))
    })
    Panel2_SubPanel3_Figure2C_Server("both_deployed", deployed())
    
  })
}

Combined Figure module: Creates all elements around a figure (title, text, placeholder, legend, etc.)

Panel2_SubPanel3_Figure2C_UI <- function(id) {
  
  ns <- NS(id)
  tagList(
    fluidRow(width = 12,
             box(width = 12,
                 title = strong("..."),
                 p("Some text"),
                 h4("Figure 2:..."))),
    fluidRow(width = 12,
      lapply(c("a","d"), function(i) {
        uiOutput(ns(paste0('loggers_deployed_', i)))
      })
    ),
    h6("Some text")
  )
  
}

Panel2_SubPanel3_Figure2C_Server <- function(id, deployed) {
  moduleServer(id, function(input, output, session) {
    
    lapply(c("Arugot","David"), function(iii) {
      ccc <- paste0("loggers_deployed_", stringr::str_to_lower(stringr::str_extract(iii, "[A-Z]{1}")))     
      output[[as.character(ccc)]] <- renderUI({
        Panel2_SubPanel3_Figure2_UI(session$ns(ccc))
      })
      Panel2_SubPanel3_Figure2_Server(session$ns(ccc), deployed(), iii)    
    })
    
  })
}

Last Figure module: Generates the actual ggplot

Panel2_SubPanel3_Figure2_UI <- function(id) {
  
  ns <- NS(id)
  box(width = 6, 
    div(
      plotOutput(ns("loggers_deployed"), height = 400)
    )
  )
  
}

Panel2_SubPanel3_Figure2_Server <- function(id, deployed, canyon) {
  moduleServer(id, function(input, output, session) {
    
    output$loggers_deployed <- renderPlot({
      fake_data <- deployed() %>% dplyr::filter(d == canyon)
      ggplot(fake_data, aes(x = x, y = y)) + gem_point()
    })
    
  })
}
Solution

  • You had some typos (gem_point) and issue in subsetting the data. Try this

    Panel2_SubPanel3_UI <- function(id) {
  
  ns <- NS(id)
  tabPanel(
    title = "Proximity data",
    sidebarPanel(width = 3, strong("The panel focuses on...")),
    mainPanel(width = 9, uiOutput(ns("both_deployed"))
              
              )
  )
  
}

Panel2_SubPanel3_Server <- function(id, deployed) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    output$both_deployed <- renderUI({ # print("Hello1")
      Panel2_SubPanel3_Figure2C_UI(ns("both_deployed"))
    })
    Panel2_SubPanel3_Figure2C_Server("both_deployed", deployed)
    
  })
}

Panel2_SubPanel3_Figure2C_UI <- function(id) {
  
  ns <- NS(id)
  tagList(
    fluidRow(width = 12,
             shinydashboard::box(width = 12,
                 title = strong("..."),
                 p("Some text"),
                 h4("Figure 2:..."))),
    fluidRow(width = 12,
             lapply(c("a","d"), function(i) {
               shinydashboard::box(width = 6, 
                   div(uiOutput(ns(paste0('loggers_deployed_', i)), height = 400)))
             })
    ),
    h6("Some text")
  )
  
}

Panel2_SubPanel3_Figure2C_Server <- function(id, deployed) {
  moduleServer(id, function(input, output, session) {
    
    lapply(c("Arugot","David"), function(iii) {
      ccc <- paste0("loggers_deployed_", stringr::str_to_lower(stringr::str_extract(iii, "[A-Z]{1}")))   
      
      output[[as.character(ccc)]] <- renderUI({ 
        Panel2_SubPanel3_Figure2_UI(session$ns(ccc))
      })
      Panel2_SubPanel3_Figure2_Server(ccc, deployed, iii)    
    })
    
  })
}

Panel2_SubPanel3_Figure2_UI <- function(id) {
  
  ns <- NS(id)
  plotOutput(ns("loggers_deployed"), height = 400)
  
}

Panel2_SubPanel3_Figure2_Server <- function(id, deployed, canyon) {
  moduleServer(id, function(input, output, session) {
    observe({print(deployed())})
    output$loggers_deployed <- renderPlot({
      fake_data <- deployed() %>% dplyr::filter(d == canyon)
      ggplot(fake_data, aes(x = x, y = y)) + geom_point() + labs(title = canyon)
    })
    
  })
}

deployed <- data.frame(x = rep(c(1:10), 2),
                       y = rep(c(1:10), 2),
                       # d = rep(c("A_site", "D_site"), each = 10)
                       d = rep(c("Arugot", "David"), each = 10)
                       )


# Main UI
ui <- fluidPage(
  # theme = shinytheme("flatly"),
  div(style = "padding: 1px 0px; width: '100%'", titlePanel(title = "")),

  navbarPage(
    title = div(strong("MY PROJECT"),
                tabPanel(title = "Data management",
                         tabsetPanel(type = "tabs",
                                     Panel2_SubPanel3_UI("MyData")
                         )
                )
    )

  )
)

# Main server
server <- function(input, output, session) {
    
    deplo <- reactive({deployed})
    Panel2_SubPanel3_Server("MyData", deplo)
    
}
  
# Run the application 
shinyApp(ui = ui, server = server)

    output