Jumping back to previous screen when next_condition is set

[kingoflimes230]

I posted this on stackoverflow, but have not received any answers, I don't know if it's my coding mistake or an issue with shinyglide (which is a great package, thank you for that!).

I have a shiny app in which a datatable is displayed and upon a click on a row, a modalDialog opens in which I embedded a glide. This worked fine until I introduced the next_condition to the second screen. Now whenever the first box is selected (or after deselecting everything and selecting again), the glide jumps back to the first screen. If I now change the option on the first screen, then the behaviour gets very strange altogether. My example (with Version 0.1.3.9000):

Code:

Library Calls:

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

UI:

ui <- dashboardPage(skin = 'purple',
                    dashboardHeader(title = "Shinyglide Example"),
                    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 = "I am the table!",width = NULL,status = 'info',solidHeader = TRUE,
                                       DT::dataTableOutput("table")))
                        )
                    )
)

Setup Functions:

render_my_table <- function(){
    col_a <- c("A","B","C","D","E")
    col_b <- c("Human","Cat","Human","Dog","Dog")
    col_c <- c(35,7,42,5,11)
    col_d <- c("Earth","Earth","Earth","Earth","Mars")

    my_data <- data.frame(letter = col_a,species = col_b,age = col_c,planet = col_d)
    my_data <- datatable(my_data,colnames = c("ID","Species","Age","Home Planet"),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 == "Human"){
        return(c("Job","Family","Mortgage"))
    }else{
        return(c("Breed","Owner","Family"))
    }
}

advanced_inputs <- function(my_species,my_choiceA){

    if(is.null(my_choiceA)){return(0)}

    if(my_choiceA == "Job"){
        return(checkboxGroupInput("my_checkbox",label = "Type of Jobs",choices = c("Employed","Self-Employed","Apprenticeship")))
    }else if(my_choiceA == "Mortgage"){
        return(checkboxGroupInput("my_checkbox",label = "Type of Housing",choices = c("Apartment","House")))
    }else if(my_choiceA == "Breed"){
        return(checkboxGroupInput("my_checkbox",label = "Details",choices = c("Height","Fur","Weight")))
    }else if(my_choiceA == "Owner"){
        return(checkboxGroupInput("my_checkbox",label = "Details",choices = c("Age","Employed","Children")))
    }else{
        if(my_species == "Human"){
            return(checkboxGroupInput("my_checkbox",label = "Details",choices = c("Partner","Parents","Children","Siblings")))
        }else{
            return(checkboxGroupInput("my_checkbox",label = "Details",choices = c("Owner","Children","Owners of Children")))
        }
    }
}

Server:

server <- function(input, output,session) {

    glide_modal <- modalDialog(
        renderUI({title = tags$span(paste("You have chosen Row",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("Make Choice A"),choices = pickerinput_choices(input$rows[2]),
                                options = pickerOptions(container = 'body'))
                })
            ),
            screen(
                renderUI({
                    tagList(
                        h3("Make Choice B"),
                        advanced_inputs(input$rows[2],input$my_pickerinput)
                    )
                }),
                next_condition = "(typeof input['my_checkbox'] !== 'undefined' && input['my_checkbox'].length > 0)"
            ),
            screen(
                renderText({
                    paste("You have selected row",input$rows[1],"which is a",input$rows[2],"and have requested information about",
                          input$my_pickerinput,", especially about",paste(input$my_checkbox,collapse = " and "))
                })
            )
        )
    )

    output$table <- DT::renderDataTable({
        render_my_table()
    })

    observeEvent(input$rows,{
        showModal(tags$div(id="modal1",glide_modal))
    })
}

and function call:

shinyApp(ui = ui, server = server)

[juba]

Hi,

Indeed I can reproduce the issue, but for the moment I didn't find a workaround. There seems to be a strange JavaScript interaction that triggers a modal.bs.show event when using an input associated to a condition, thus reloading the glide. I'll try to take a look into it again.

[juba]

Ok, so I think the problem comes from the fact that your my_checkbox input is not directly in the glide definition. If you do something like this I think it's working :

advanced_inputs <- function(my_species, my_choiceA) {
    if (is.null(my_choiceA)) {
        return(0)
    }

    if (my_choiceA == "Job") {
        return(c("Employed", "Self-Employed", "Apprenticeship"))
    } else if (my_choiceA == "Mortgage") {
        return(c("Apartment", "House"))
    } else if (my_choiceA == "Breed") {
        return(c("Height", "Fur", "Weight"))
    } else if (my_choiceA == "Owner") {
        return(c("Age", "Employed", "Children"))
    } else {
        if (my_species == "Human") {
            return(c("Partner", "Parents", "Children", "Siblings"))
        } else {
            return(c("Owner", "Children", "Owners of Children"))
        }
    }
}

advanced_inputs_label <- function(my_species, my_choiceA) {
    if (is.null(my_choiceA)) {
        return(0)
    }

    if (my_choiceA == "Job") {
        return("Type of Jobs")
    } else if (my_choiceA == "Mortgage") {
        return("Type of Housing")
    } else if (my_choiceA == "Breed") {
        return("Details")
    } else if (my_choiceA == "Owner") {
        return("Details")
    } else {
        return("Details")
    }
}

screen(
      renderUI({
            tagList(
                  h3("Make Choice B"),
                  checkboxGroupInput("my_checkbox",
                        label = advanced_inputs_label(input$rows[2], input$my_pickerinput),
                        choices = advanced_inputs(input$rows[2], input$my_pickerinput)
                   )
             )
      }),
      next_condition = "(input['my_checkbox'].length > 0)"
)

[kingoflimes230]

Hi,

thanks for looking into it. I finally had time to test it myself, but unfortunately the problem persists for me doing it this way (both in the example as well as my actual app and both in RStudio Browser, Firefox and Google Chrome). If you need further information, please tell me.

[juba]

I'm sorry for the very late answer, but I think your problem should now be solved with shinyglide development version. If it is not too late and it can still be useful, your original code should work without modification.

Closing the issue, don't hesitate to reopen it if needed.