Re: InsertUI with Modules Issue

[Joe Cheng]

The server-side equivalent of ns() is session$ns(). So

    ui = graph_shinyUI(paste0("exhibit", btn), paste("Exhibit no.", btn))

and

    callModule(graph_shiny, paste0("exhibit", btn), data_use = data_source)

should probably be

    ui = graph_shinyUI(session$ns(paste0("exhibit", btn)), paste("Exhibit no.", btn))

and

    callModule(graph_shiny, session$ns(paste0("exhibit", btn)), data_use = data_source)

On Mon, May 22, 2017 at 1:46 PM Trevor Nederlof <tned...@rpimco.com> wrote:

Hi there, I was recently trying to use the insertUI function to dynamically add modules and I ran into an interesting problem. Since I am trying to dynamically add modules inside another module already I believe I need to wrap the UI id in a ns() call, however, I am not sure how to do that since its wrapped in a observeEvent function already. Hopefully, I have narrowed it down to the right problem. Any help making the code posted below work (created arbitrary amounts of the modules that work, showing scatter graphs) would be much appreciated.

I bolded and made the background around the part of the code I think is the issue not being wrapped in ns() like most elements in UI are.

library(tidyverse)

library(shiny)

library(shinydashboard)

source("module_file.R")

app.R file

#### UI CODE ####
ui <- dashboardPage(skin = "blue",
  # define header
  dashboardHeader(title = "Test Dashboard"),
 
  # define sidebar
  dashboardSidebar(
    sidebarMenu(id = "dashboard_menu",
                menuItem("Test Tools", icon = icon("area-chart"), tabName = "test_tools_main")
    )
  ),
 
  # define body
  dashboardBody(
    tabItems(
      test_tools_setUI(id = "test_tools_main")
    )
  )
)
#### END UI CODE ####


#### SERVER CODE ####
server <- function(input, output, session) {
  ### Module Calls ###
  callModule(test_tools_set, id = "test_tools_main")
}
#### END SERVER CODE ####




#### FINAL OUTPUT FUNCTION ####
shinyApp(ui = ui, server = server)
#### END FINAL OUTPUT FUNCTION ####

module_file.R

test_tools_setUI <- function(id) {
  ns <- NS(id)
 
  tabItem(tabName = id,
          fluidRow(
            column(12,
                   test_exhibit_launchUI(ns("test_exhibit_launch_main"))
            )
          ),
          fluidRow(
            column(12,
                   h2("")
            )
          )
  )
}


test_tools_set <- function(input, output, session) {
 
  test_exhibit_launch_results <- callModule(test_exhibit_launch, "test_exhibit_launch_main")
 
  data_source <- reactive({
    data.frame(cond = rep(c("A", "B"), each=10),
               xvar = 1:20 + rnorm(20,sd=3),
               yvar = 1:20 + rnorm(20,sd=3))
  })

  observeEvent(test_exhibit_launch_results[[1]](), {
    btn <- test_exhibit_launch_results[[1]]()
    insertUI(
      selector = "h2",
      where = "beforeEnd",
      ui = graph_shinyUI(paste0("exhibit", btn), paste("Exhibit no.", btn))
    )
    callModule(graph_shiny, paste0("exhibit", btn), data_use = data_source)
  })


}


graph_shinyUI <- function(id, tab_box_name, width = 12, height = NULL) {
  ns <- NS(id)
 
  box(
    width = width,
    height = height,
    title = tab_box_name,
    solidHeader = TRUE,
    plotOutput(ns("graph_panel"))
  )
}

graph_shiny <- function(input, output, session, data_use) {


  output$graph_panel <- renderPlot({
    ggplot(data_use(), aes(x = xvar, y = yvar)) + geom_point(shape = 1)
  })
 
}


test_exhibit_launchUI <- function(id, width = 12, height = NULL, title = "Exhibit Selection") {
  ns <- NS(id)
 
  box(title = title,
      width = width,
      solidHeader = TRUE,
      height = height,
      wellPanel(
        fluidRow(
          column(4,
                 uiOutput(ns("add_exhibit_button_menu"))
          )
        )
      )
  )
}


test_exhibit_launch <- function(input, output, session, collection_prefix) {


  output$add_exhibit_button_menu <- renderUI({
    ns <- session$ns
   
    actionButton(ns("add_exhibit_button"), "Add Exhibit")
  })
 
  return(list(reactive(input$add_exhibit_button)))
}

--
You received this message because you are subscribed to the Google Groups "Shiny - Web Framework for R" group.
To unsubscribe from this group and stop receiving emails from it, send an email to shiny-discus...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/c700c9aa-7003-40a0-93bf-cd03a175d499%40googlegroups.com.
For more options, visit https://groups.google.com/d/optout.