Shinyglide设置next_condition后跳转回前一界面问题求助

问题现象 #

开发的Shiny应用中，点击DT表格行弹出嵌入shinyglide的模态框，原本功能正常。但为第二个glide screen添加next_condition后出现以下异常：

• 选择第一个选项（或取消选择后重新选择）时，glide会自动跳回第一个界面；
• 修改第一个界面的选项后，整个glide组件的交互行为变得混乱。

移除DT表格和模态框后无法复现该问题，推测问题根源在于模态框与shinyglide的交互逻辑冲突。

复现代码 #

依赖库 #

library(shiny)
library(shinydashboard)
library(shinyBS)
library(shinyglide)
library(shinyWidgets)
library(shinyjs)
library(DT)

UI 部分 #

ui <- dashboardPage(skin = 'purple',
                    dashboardHeader(title = "Shinyglide 示例"),
                    dashboardSidebar(disable = TRUE),
                    dashboardBody(
                        useShinyjs(),
                        tags$head(tags$style("#modal1 .modal-body {min-height:750px; padding: 10px}
                       #modal1 .modal-dialog { width: 1280px; height: 1280px;}"
                        )),
                        
                        fixedRow(
                            column(width = 12,
                                   box(title = "这是表格！",width = NULL,status = 'info',solidHeader = TRUE,
                                       DT::dataTableOutput("table")))
                        )
                    )
)

辅助初始化函数 #

render_my_table <- function(){
    col_a <- c("A","B","C","D","E")
    col_b <- c("人类","猫","人类","狗","狗")
    col_c <- c(35,7,42,5,11)
    col_d <- c("地球","地球","地球","地球","火星")
    
    my_data <- data.frame(编号 = col_a,物种 = col_b,年龄 = col_c,母星 = col_d)
    my_data <- datatable(my_data,colnames = c("ID","物种","年龄","母星"),rownames = FALSE,filter = 'top',selection = 'single',
                         callback = JS("table.on('click.dt','tr',function() {
                                        Shiny.onInputChange('rows',table.rows(this).data().toArray(),{priority:'event'});});"))
    return(my_data)
}

pickerinput_choices <- function(my_species){
    if(my_species == "人类"){
        return(c("工作","家庭","房贷"))
    }else{
        return(c("品种","主人","家庭"))
    }
}

advanced_inputs <- function(my_species,my_choiceA){
    
    if(is.null(my_choiceA)){return(0)}
    
    if(my_choiceA == "工作"){
        return(checkboxGroupInput("my_checkbox",label = "工作类型",choices = c("受雇","自主创业","学徒")))
    }else if(my_choiceA == "房贷"){
        return(checkboxGroupInput("my_checkbox",label = "住房类型",choices = c("公寓","别墅")))
    }else if(my_choiceA == "品种"){
        return(checkboxGroupInput("my_checkbox",label = "详细信息",choices = c("身高","毛发","体重")))
    }else if(my_choiceA == "主人"){
        return(checkboxGroupInput("my_checkbox",label = "详细信息",choices = c("年龄","是否就业","子女数量")))
    }else{
        if(my_species == "人类"){
            return(checkboxGroupInput("my_checkbox",label = "详细信息",choices = c("伴侣","父母","子女","兄弟姐妹")))
        }else{
            return(checkboxGroupInput("my_checkbox",label = "详细信息",choices = c("主人","子女","子女的主人")))
        }
    }
}

Server 部分 #

server <- function(input, output,session) {
    
    glide_modal <- modalDialog(
        renderUI({title = tags$span(paste("你选择了第",input$rows[1],"行"),style = "font-size: 20px; font-weight: bold")}),
        footer = NULL,
        easyClose = TRUE,
        glide(
            id = "my_glide",
            controls_position = 'bottom',
            height = "800px",
            screen(
                renderUI({
                    pickerInput(inputId = "my_pickerinput",h3("选择选项A"),choices = pickerinput_choices(input$rows[2]),
                                options = pickerOptions(container = 'body'))
                })
            ),
            screen(
                renderUI({
                    tagList(
                        h3("选择选项B"),
                        advanced_inputs(input$rows[2],input$my_pickerinput)
                    )
                }),
                next_condition = "(typeof input['my_checkbox'] !== 'undefined' && input['my_checkbox'].length > 0)"
            ),
            screen(
                renderText({
                    paste("你选择了第",input$rows[1],"行，这是一只/一位",input$rows[2],"，你查看的是",
                          input$my_pickerinput,"相关信息，具体包括：",paste(input$my_checkbox,collapse = " 和 "))
                })
            )
        )
    )
    
    output$table <- DT::renderDataTable({
        render_my_table()
    })
    
    observeEvent(input$rows,{
        showModal(tags$div(id="modal1",glide_modal))
    })
}

启动应用 #

shinyApp(ui = ui, server = server)

内容的提问来源于stack exchange，提问作者king_of_limes