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)
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)