r语言 - navlistPanel:使标签在闪亮的应用程序中顺序激活

Question

我正试图写一个闪亮的应用程序，其中标签是顺序活动的。例如,用户只有在完成第一个选项卡上的任务后才能移动到第二个选项卡。在这种情况下，第一个选项卡将添加一个绿色的复选标记(例如)，第二个选项卡将变为活动状态。(后面的选项卡也一样)

作为一个例子，下面是ui。R和服务器。R文件:

shinyUI(fluidPage(  
   titlePanel("New Project"), 
   navlistPanel(selected="Data Upload",
   tabPanel("Data Upload",           
         textInput("aInSummary", label = h5("Please type a"), 
                   value = "Enter value...")
         ),   
   tabPanel("Data Check",
         textInput("bInDataCheck", label = h5("Please type b"), 
                   value = "Enter value...")             
         ),   
   tabPanel("Dry Run",
         textInput("cInDryRun", label = h5("Please type c"), 
                   value = "Enter value...")            
        ),                 
   tabPanel("Output"),
   "-----",
   tabPanel("Help-FAQ")
   )
))

shinyServer(function(input, output,server) {
})

我知道我应该在"navlistPanel"one_answers"tabPanel"中添加"id"，但我不确定我应该在服务器中包含的逻辑。R文件，因为我不知道用户将如何修改这样的id。

我已经搜索了闪亮的谷歌组，线程在这里，并阅读条件面板..但那不是我真正想要的。任何帮助/教程或阅读建议是非常感谢!

Answer 1

下面是一个例子。当页面加载时，除第一个导航链接外的所有导航链接都被禁用。我在每个部分都添加了"完成"按钮。当您按下Done按钮时，下一个导航链接将被启用。

 ui <- fluidPage(  
   tags$head(tags$script("
        window.onload = function() {
            $('#mynavlist a:contains("Data Check")').parent().addClass('disabled');
            $('#mynavlist a:contains("Dry Run")').parent().addClass('disabled');
            $('#mynavlist a:contains("Output")').parent().addClass('disabled');
        };
        Shiny.addCustomMessageHandler('activeNavs', function(nav_label) {
            $('#mynavlist a:contains("' + nav_label + '")').parent().removeClass('disabled');
        });
   ")),
   titlePanel("New Project"), 
   navlistPanel(selected="Data Upload", id='mynavlist',
   tabPanel("Data Upload",           
         textInput("aInSummary", label = h5("Please type a"), 
                   value = "Enter value..."),
         br(),
         actionButton('data_upload_done', 'Done')
         ),   
   tabPanel("Data Check",
         textInput("bInDataCheck", label = h5("Please type b"), 
                   value = "Enter value..."),
         br(),
         actionButton('data_check_done', 'Done')
         ),   
   tabPanel("Dry Run",
         textInput("cInDryRun", label = h5("Please type c"), 
                   value = "Enter value..."),
         br(),
         actionButton('dry_run_done', 'Done')
        ),                 
   tabPanel("Output"),
   "-----",
   tabPanel("Help-FAQ")
   )
)

server <- function(input, output,session) {
    observe({
        if (input$data_upload_done > 0) {
            session$sendCustomMessage('activeNavs', 'Data Check')
        }
    })
    observe({
        if (input$data_check_done > 0) {
            session$sendCustomMessage('activeNavs', 'Dry Run')
        }
    })
    observe({
        if (input$dry_run_done > 0) {
            session$sendCustomMessage('activeNavs', 'Output')
        }
    })
}
runApp(list(ui=ui, server=server))