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 from shinyglide. This worked fine until I introduced a 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 you now change the option on the first screen, then the behaviour gets very strange altogether. I have no idea what causes this or where to start to fix it. Below is a (not so small) mockup example of my app which includes the observed behaviour (if you uncomment the next_condition, everything works fine). The important part to the problem is the server part in the end, the rest is just setup to make the app fully functional.
UPDATE:
I have tried to shorten the example by getting rid of the datatable and the modalDialog, but I could not replicate the behaviour this way. So it seems to me the interaction between modalDialog and glide is at fault. I was however able to shorten it a tiny bit by getting rid of the reactive variables without changing the result.
UPDATE 2:
Also posted it here, but the answer has not (yet) worked for me.
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)
