r-闪亮的模块:从具有不同名称空间的模块中切换选项卡

Question

我有一个有多个选项卡的闪亮应用程序，我希望在选项卡中有允许用户切换选项卡的操作按钮。我之前问过这个问题：R Shiny：从模块中更改选项卡得到了一个有帮助的答案，但并没有完全解决我的问题。

当我使用相同的id(tab.1(调用modtab1和modtab2时，它允许我切换选项卡，但它不区分这两个input$userid；当我使用不同的id时，它会区分两个input$userid，但不允许我切换选项卡。

library(shiny)
modtab1_ui <- function(id) {
ns <- NS(id)
tabPanel(title = 'Tab 1',
value = NS(id, 'tab.1'),
h4('This is the first tab'),
actionButton(NS(id, 'nexttab'), 'Next Tab'),
textInput(NS(id, 'userid'), 'User ID'),
textOutput(outputId = NS(id, 'id'))
) # tabPanel
}
modtab1_server <- function(id) {
moduleServer(id,
function(input, output, session) {
observeEvent(input$nexttab, {
print(paste('switching to tab 2', input$userid))
updateTabsetPanel(session = session, inputId =  'tabs', 
# selected = NS('tab2', 'tab.2')
# selected = 'tab.2'
selected = ns('tab.2')
)
})

output$id <- renderText(input$userid)
})
}
modtab2_ui <- function(id) {
ns <- NS(id)
tabPanel(title = 'Tab 2',
value = NS(id, 'tab.2'),
h4('This is the second tab'),
actionButton(NS(id, 'firsttab'), 'First Tab'),
textInput(NS(id, 'userid'), 'User ID'),
textOutput(outputId = NS(id, 'useridout'))
) # tabPanel
}
modtab2_server <- function(id) {
moduleServer(id,
function(input, output, session) {
observeEvent(input$firsttab, {
print(paste('switching to tab 1', input$userid))
updateTabsetPanel(session = session, inputId =  'tabs', 
# selected = NS('tab1', 'tab.1')
# selected = 'tab.1'
selected = ns('tab.1')
)
})

output$id <- renderText(input$userid)
})
}

ui <- fluidPage(
tabsetPanel(
'tabs',
modtab1_ui('tab1'),
modtab2_ui('tab2')
)
)
server <- function(input, output, session) {
modtab1_server('tab1')
modtab2_server('tab2')
}
shinyApp(ui = ui, server = server)

Answer 1

这是一个MWE，我认为它可以满足您的需求。

library(shiny)
modtab1_ui <- function(id) {
ns <- NS(id)
tabPanel(
title = 'Tab 1',
value = ns('tab'),
h4('This is the first tab'),
actionButton(ns('nexttab'), 'Next Tab')
) # tabPanel
}
modtab1_server <- function(id) {
moduleServer(id,
function(input, output, session) {
retVal <- reactiveValues(count=0)

observeEvent(input$nexttab, retVal$count <- retVal$count + 1)
return(reactive(retVal$count))
})
}
modtab2_ui <- function(id) {
ns <- NS(id)
tabPanel(
title = 'Tab 2',
value = ns('tab'),
h4('This is the second tab'),
actionButton(ns('firsttab'), 'First Tab')
) # tabPanel
}
modtab2_server <- function(id) {
moduleServer(id,
function(input, output, session) {
retVal <- reactiveValues(count=0)

observeEvent(input$firsttab, retVal$count <- retVal$count + 1)
return(reactive(retVal$count))
})
}
ui <- fluidPage(
tabsetPanel(
id='tabs',
modtab1_ui('tab1'),
modtab2_ui('tab2')
)
)
server <- function(input, output, session) {

tab1val <- modtab1_server('tab1')
tab2val <- modtab2_server('tab2')

observeEvent(tab1val(), {
updateTabsetPanel(session, 'tabs', selected = 'tab2-tab')
})  

observeEvent(tab2val(), {
updateTabsetPanel(session, 'tabs', selected = 'tab1-tab')
})
}
shinyApp(ui = ui, server = server)

请注意语法的更改，特别是关于ns和NS的使用以及传递给函数的参数。

此外，请注意模块服务器函数返回值的使用，以及如何在主服务器函数中访问这些值。

Answer 2

基于Limey的响应。您可以通过对UI模块进行附加形式化来简化为一个模块。

library(shiny)
modTabUi <- function(id, panelTitle = 'Tab 1', headding = 'This is the first tab', buttonLabel = 'Next Tab') {
ns <- NS(id)
tabPanel(
title = panelTitle,
value = ns('tab'),
h4(headding),
actionButton(ns('nexttab'), buttonLabel)
)
}
modTabServer <- function(id) {
moduleServer(id,
function(input, output, session) {
retVal <- reactiveValues(count = 0)

observeEvent(input$nexttab, retVal$count <- retVal$count + 1)
return(reactive(retVal$count))
})
}

ui <- fluidPage(
tabsetPanel(
id='tabs',
modTabUi('tab1', panelTitle = 'Tab 1', headding = 'This is the first tab', buttonLabel = 'Next Tab'),
modTabUi('tab2', panelTitle = 'Tab 2', headding = 'This is the second tab', buttonLabel = 'Back to First Tab')
)
)
server <- function(input, output, session) {

tab1val <- modTabServer('tab1')
tab2val <- modTabServer('tab2')

observeEvent(tab1val(), {
updateTabsetPanel(session, 'tabs', selected = 'tab2-tab')
})  

observeEvent(tab2val(), {
updateTabsetPanel(session, 'tabs', selected = 'tab1-tab')
})
}
shinyApp(ui = ui, server = server)