rshinyargon

Dynamically generate argonSidebarItem in shiny


My expected output looks like this -

library(argonDash)
library(argonR)
library(shiny)

ui <- argonDashPage(
  header = argonDashHeader(
    color = "header_custom",
    gradient = TRUE,
    top_padding = 3,
    bottom_padding = 3
  ),
  sidebar = argonDashSidebar(
    id = "app_sidebar",
    vertical = TRUE,
    side = "left",
    size = "md",
    background = "sidebar_custom",
    wellPanel(id = "well_panel", argonDash::argonSidebarMenu(
      shiny::br(),
      argonDash::argonSidebarItem(tabName = "home", "Home", icon = htmltools::tags$i(class = paste0("fa fa-home"))),
      shiny::br(),
      argonDash::argonSidebarItem(tabName = "study_metrics", "Study Metrics",icon = argonR::argonIcon(name = "sound-wave")),
      shiny::br(),
      argonDash::argonSidebarItem(tabName = "demo_app", "Demo App"),
      shiny::br()
    )
    )
  ),
  body = argonDashBody(
    id = "app_body",
    argonTabItems(
      argonTabItem(tabName = "home", p("Test")),
      argonTabItem(tabName = "study_metrics",
        br(),textInput('id_study_metrics', 'text', placeholder = 'study_metrics')
      ),
      argonTabItem(tabName = "demo_app",
        br(),textInput('id_demo_app', 'text', placeholder = 'demo_app')
      )
    )
  ),
  footer = NULL
)

server <- function(input, output, session) {
  
}
shinyApp(ui, server)

enter image description here

The part that I want to change is -

 argonTabItem(tabName = "study_metrics",
        br(),textInput('id_study_metrics', 'text', placeholder = 'study_metrics')
      ),
      argonTabItem(tabName = "demo_app",
        br(),textInput('id_demo_app', 'text', placeholder = 'demo_app')
      )

I want to generate this tab items dynamically because this list going to expand in future.

My attempt -

library(argonDash)
library(argonR)
library(shiny)

ui <- argonDashPage(
  header = argonDashHeader(
    color = "header_custom",
    gradient = TRUE,
    top_padding = 3,
    bottom_padding = 3
  ),
  sidebar = argonDashSidebar(
    id = "app_sidebar",
    vertical = TRUE,
    side = "left",
    size = "md",
    background = "sidebar_custom",
    wellPanel(id = "well_panel", argonDash::argonSidebarMenu(
      shiny::br(),
      argonDash::argonSidebarItem(tabName = "home", "Home", icon = htmltools::tags$i(class = paste0("fa fa-home"))),
      shiny::br(),
      argonDash::argonSidebarItem(tabName = "study_metrics", "Study Metrics",icon = argonR::argonIcon(name = "sound-wave")),
      shiny::br(),
      argonDash::argonSidebarItem(tabName = "demo_app", "Demo App"),
      shiny::br()
    )
    )
  ),
  body = argonDashBody(
    id = "app_body",
    argonTabItems(
      argonTabItem(tabName = "home", p("Test")),
      uiOutput("apps_ui")
    )
  ),
  footer = NULL
)


server <- function(input, output, session) {
  apps_fns <- c("id_study_metrics", "id_demo_app")
  prefix_removed <- sub("id_", "", apps_fns)
  
  output$apps_ui <- renderUI({
    lapply(seq_along(apps_fns), function(i) {
      argonTabItem(
        tabName = prefix_removed[i],
        br(),
        textInput(apps_fns[i], "text", placeholder = prefix_removed[i])
      )
    })
  })
}

shinyApp(ui, server)

but that does not respect the tabs and all the inputs are consolidated into the same screen.

enter image description here

I did a lot of attempts using tagList etc but none of them are working for me the way I want it to. Sorry for the very long code but I wanted to make sure that I give a complete reproducible code similar to my case.


Solution

  • I would render the whole tab set in your server and not only some tabs:

    UI

    # ...
      body = argonDashBody(
        id = "app_body",
        uiOutput("apps_ui")
      )
    # ....
    

    Server

    output$apps_ui <- renderUI({
        tabs <- lapply(seq_along(apps_fns), function(i) {
          argonTabItem(
            tabName = prefix_removed[i],
            br(),
            textInput(apps_fns[i], "text", placeholder = prefix_removed[i])
          )
        })
        tabs <- c(
           list(argonTabItem(tabName = "home", p("Test"))),
           tabs)
        do.call(argonTabItems, tabs)  
      })
    

    Explanation

    In your original approach you have one div holding the dynamic input. This corresponds to one tab. Eventually you want something like:

    argonTabs(tab1, tab2, tab3)
    

    but in the end you are passing

    argonTabs(tab1, list(tab2, tab3))
    

    which is conceptually different (basically you are telling R to put two "tabs" in a list on the second tab). Thus, you have to let the server do the rendering of the whole thing to get finer control of how to fill the tabs.