Search code examples
rshinyslickr

Shiny slickR, don't advance slide if input is empty


I have a shiny app where I have a slick slideshow and inputs that are associated with each image. The user will put in their name and then guess the age of each person in the photo. Every time the user advances the slide with the arrow the inputs will also advance. The user must fill out the inputs for the rest of the app to work (rest of app not shown here). What I would like is that every time the arrow is clicked the app will check to see if the associated input is empty and if it is the slideshow will not advance and a little message will pop up. I have tried to work out solutions with shinyjs and shinyvalidate and shinyalert but I can't come up with a solution.

library(shiny)
library(shinyalert)
library(slickR)
library(tidyverse)
library(shinyvalidate)
library(shinyjs)

js <- "
$(document).ready(function(){
  var ss = document.getElementById('slickr');
  
  // create an observer instance
  var observer = new MutationObserver(function(mutations) {
    var index = $(ss).find('.slick-current').data('slick-index');
    Shiny.setInputValue('imageIndex', parseInt(index)+1);
  });
  // configuration of the observer
  var config = {subtree: true, attributes: true};
  // observe
  observer.observe(ss, config);
 
  var deleteThis = function(elem){
        elem.style.display = 'none';
        // elem.style.visibility = 'hidden';
};

})
"

slider <- "$('.slider').slick({
  autoplay: false,
  dots: true,
  customPaging : function(slider, i) {
    var thumb = $(slider.$slides[i]).data();
    
    return '<a>'+1:6[i]+'</a>';
  },
  responsive: [{ 
    breakpoint: 500,
    settings: {
      dots: false,
      arrows: false,
      infinite: false,
      slidesToShow: 2,
      slidesToScroll: 2
    } 
  }]
});"

cP1=htmlwidgets::JS("function(slick,index) {return '<a>'+(index+1)+'</a>';}")

imgs <- list.files("samplepictures/", pattern=".jpg|.jpeg|.png", full.names = TRUE)
imgs <- imgs[!grepl("photo_ages",imgs)]

photoages <- lapply(1:6,function(x){ numericInput(paste0("Photo",x),
                                                  paste0("Photo ",x," Age Guess:"),
                                                  min = 1,
                                                  max = 100,
                                                  value = NULL)})

texfn <- function(x= "Guesser"){
  textInput("Name",paste(x))
}
actionfn <- function(){
  actionButton("go", "Submit All Guesses")
}

photoages <- as.vector(photoages)

photoages <- c(list(texfn()),
               photoages,
               list(actionfn()))

ui <- fluidPage(
  useShinyjs(),
  
  titlePanel("Photo Guesses"),
  mainPanel(

    tags$head(
      tags$script(HTML(js))
    ),
    tags$head(
      tags$style(HTML("
    .arrows {
      height: 30px;
    }
    .slick-prev {
      left: 10px; # moves right
    }
    .slick-next {
      left: 30px;  # moves right
    }
    "))),
    
    fluidRow(
      column(12),
      column(4,align = "left",tags$body( div(id = "mydiv",uiOutput("photoinput"))) ) ,
      column(4, align = "left",div(id = "npht",h4("Advance:")), tags$br(), tags$div(id = "arr",class="arrows"))
    ),

    tags$hr(),
    slickROutput("slickr") ,
    tags$br()
    
  )
)

server <- function(input, output,session) {
 
  iv <- InputValidator$new()
  iv$add_rule("Name", sv_required())
  iv$add_rule("Photo1", sv_between(1,100, allow_na = T))
  iv$add_rule("Photo2", sv_between(1,100, allow_na = T))
  iv$add_rule("Photo3", sv_between(1,100, allow_na = T))
  iv$add_rule("Photo4", sv_between(1,100, allow_na = T))
  iv$add_rule("Photo5", sv_between(1,100, allow_na = T))
  iv$add_rule("Photo6", sv_between(1,100, allow_na = T))
  iv$enable()
  
  
  observeEvent(input[["imageIndex"]],{
    values <- reactiveValues()
    
    values$click <- input[["imageIndex"]]
    if(input[["imageIndex"]] >7){
      removeUI("#npht")
      removeUI("#arr")
    }
    
  })
  

  output$slickr <- renderSlickR({
    
    
    imgs <- list.files("samplepictures/", pattern=".jpg|.jpeg|.png", full.names = TRUE)
    imgs <- imgs[!grepl("photo_ages",imgs)]
    (slickR(imgs) +
        
        slickR::settings(dots = TRUE,
                         #customPaging = cP1,
                         appendArrows = '.arrows',
                         prevArrow = "null"
        )) 
  })
  
  output[["photoinput"]] <- renderUI({photoages[input[["imageIndex"]]]})
     
}

# Run the application
shinyApp(ui = ui, server = server)

Solution

  • You can replace the javascript code and slickR code with shinyglide as recommended by ismireshregal. I simplified it but you can prevent the slide from advancing if it doesn't meet a condition using the next_condition argument. See here for more information: https://juba.github.io/shinyglide/articles/b_conditionals.html.

    library(shiny)
    library(shinyglide)
    
    
    
    ui <- fluidPage(
    
      mainPanel(
        glide(
          id = "plot-glide",
          controls_position = "top",
          next_label = "Go to next screen",
          previous_label = "Go Back",
          screen(
            next_condition = "input.Name != ''",
            p("Please enter your name:"),
            textInput("Name","Guesser")
            ),
          screen(
            next_condition = "input.Name2 != ''",
            textInput("Name2","Guesser")
            ),
          screen(
            next_condition = "input.Name3 != ''",
            textInput("Name3","Guesser")
          )
        )
        
      )
    )
    
    server <- function(input, output,session) {
    
    
      
    }
    
    # Run the application
    shinyApp(ui = ui, server = server)