juba / shinyglide

Glide.js component for Shiny apps
https://juba.github.io/shinyglide/
91 stars 8 forks source link

Find out which screen is currently active #22

Closed gueyenono closed 3 years ago

gueyenono commented 3 years ago

This is not an issue per se, but more of a question. Is there anyway to programmatically know which of the screens is currently active? I looked at the pkgdown website and I did not see anything to that effect. My apologies if I missed it.

In the example below, I give an id argument to the glide root element and try to check its content in the console; however, it returns NULL.

library(shiny)
library(bs4Dash)
library(shinyglide)

shinyApp(
  ui = dashboardPage(
    title = "Basic Dashboard",
    header = dashboardHeader(),
    sidebar = dashboardSidebar(),
    controlbar = dashboardControlbar(),
    footer = dashboardFooter(),
    body = dashboardBody(

      glide(
        id = "glider",
        screen(h1("First screen")),
        screen(h1("Second green"))
      ),

      actionButton("btn", "Click")

    )
  ),
  server = function(input, output) {

    observeEvent(input$btn, {

      print(input$glider)

    })

  }
)
juba commented 3 years ago

You didn't miss anything, there's currently no out-of-the-box way to do it with shinyglide. This should however be possible in JavaScript, by registering an event handler following Glide API :

https://glidejs.com/docs/events/

You could then use Shiny JavaScript to R features to set a corresponding value :

https://shiny.rstudio.com/articles/communicating-with-js.html

I've never tried to implement it directly, though.

gueyenono commented 3 years ago

Your prompt responses are always very appreciated. Thank you for pointing me to some resources. I'll take a look at them and post some more code if I can make it work for posterity.

gueyenono commented 3 years ago

@juba So after some investigation, I was able to reach my goal using pure HTML/CSS/Javascript. However, my implementation in R does not seem to work. The process is quite simple actually:

When I attempt it in Shiny, I keep getting the first index (i.e. 0) even though I scroll through all the screens. Here is a reproducible example with 4 screens. As you already know, you will be able to check the screen index in your browser's JavaScript console:

library(shiny)
library(shinyglide)

js <- "
document.addEventListener('DOMContentLoaded', () => {
  let prevBtns = document.querySelector('.prev-screen')
  let nextBtns = document.querySelector('.next-screen')
  let glide = new Glide('#glide')

  console.log(glide)

  prevBtns.addEventListener('click', (event) => {
    console.log(glide.index)
  })

  nextBtns.addEventListener('click', (event) => {
    console.log(glide.index)
  })
})
"

controls <- fluidRow(
  div(class="col-sm-1 text-right",
      div(class = "navBtn btn btn-warning prev-screen")
  ),
  div(class="col-sm-1 text-left",
      div(class = "navBtn btn btn-success next-screen")
  )
)

ui <- fluidPage(
  tags$head(tags$script(HTML(js))),

  glide(
    id = "glide",
    screen(h1("First screen")),
    screen(h1("Second screen")),
    screen(h1("Third screen")),
    screen(h1("Four screen"))
  )
)

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

}

shinyApp(ui = ui, server = server)
juba commented 3 years ago

Ah, you're right, this is more complicated than I thought. I think the reason your code doesn't work is because by using new Glide you are creating a new instance instead of accessing the existing one. But I don't see a way to do the latter in Glide API.

I think this must be implemented in the package directly, I'll take a look at it.

juba commented 3 years ago

It was in fact quite straightforward to add the current glide index as a Shiny input. So now with the development version you should be able to do something like this :

library(shiny)
library(shinyglide)

ui <- fluidPage(

  glide(
    id = "glide2",
    screen(h1("First screen")),
    screen(h1("Second screen")),
    screen(h1("Third screen")),
    screen(h1("Four screen"))
  ),

  textOutput("index")
)

server <- function(input, output, session){
  output$index <- renderText(input$shinyglide_index_glide2)
}

shinyApp(ui = ui, server = server)

If your glide has no id, just use input$shinyglide_index.

Can you confirm that it is working for you and that it is what you want to achieve ?

gueyenono commented 3 years ago

This was actually my suspicion... that I needed a way to access the original Glide instance in order to manipulate it.

I confirm that the update to the package works as intended. Thank you for adding this new feature to the package

gueyenono commented 3 years ago

I'd like to point out two things.

(i) You pass the index of the current screen to Shiny under a run.after event (shiny-glide.js). This, I believe, is the reason why index 0 does not appear on app launch in your example. I think it would be useful to have the index right at the beginning by also passing the index of the current screen to Shiny under a mount.after event. As it is now, the index can only be accessed after a click to the "Next" button.

(ii) I make extensive use of Shiny modules and I believe this is the case for many intermediate to advanced Shiny users. It turns out that the fix you implemented does not work right out of the bat with modules. The reproducible example below is a recreation of your example using Shiny modules (with just a few changes). I suspect this is namespace issue:

library(shiny)
library(shinyglide)

# Modules --------------------------------------------------------------------------------

mod_shinyglide_ui <- function(id){

  ns <- NS(id)

  tagList(

    glide(
      id = ns("glide2"),
      screen(h1("First screen")),
      screen(h1("Second screen")),
      screen(h1("Third screen")),
      screen(h1("Fourth screen"))
    ),

    hr(),

    actionButton(ns("btn"), "OK")
  )

}

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

  ns <- session$ns

  observeEvent(input$btn, {
    print("Hi")
    print(input$shinyglide_index_glide2)
  })

}

# Main app ---------------------------------------------------------------------------------

ui <- fluidPage(
  mod_shinyglide_ui("slider")
)

server <- function(input, output, session){
  callModule(mod_shinyglide_server, id = "slider")
}

shinyApp(ui = ui, server = server)
juba commented 3 years ago

Absolutely, you were quite right on both points, thanks for reporting them.

I think they should both be fixed, but let me know if it is not the case (especially the one concerning modules).

gueyenono commented 3 years ago

Hi Julien, this is me again.

I just took a look at your fix and while it works for the example that I provided above, it does make two important assumptions! It assumes that (i) the user does not use any dash ("-") in their module ID and that (ii) they do not use nested modules (modules inside modules). If any of the two occurs, there will be unintended consequences. Not only will the index not be reported, but also the "Next" and "Back" buttons will not longer work. This is because your JS code assumes that the full ID contains only one dash. I provide a reproducible example for each case as well as a possible solution:

The user uses a dash in the module ID

In this example, the module ID is now: "my-slider" instead of "slider".

library(shiny)
library(shinyglide)

# Modules --------------------------------------------------------------------------------

mod_shinyglide_ui <- function(id){

  ns <- NS(id)

  tagList(

    glide(
      id = ns("glide2"),
      screen(h1("First screen")),
      screen(h1("Second screen")),
      screen(h1("Third screen")),
      screen(h1("Fourth screen"))
    ),

    hr(),

    actionButton(ns("btn"), "OK")
  )

}

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

  ns <- session$ns

  observeEvent(input$btn, {
    print("Hi")
    print(input$shinyglide_index_glide2)
  })

}

# Main app ---------------------------------------------------------------------------------

ui <- fluidPage(
  mod_shinyglide_ui("my-slider")
)

server <- function(input, output, session){
  callModule(mod_shinyglide_server, id = "my-slider")
}

shinyApp(ui = ui, server = server)

The user uses nested modules

In this example, the entire app is packaged inside a module: mod_app and the glide component is inside another module: mod_shinyglide.

library(shiny)
library(shinyglide)

# Modules --------------------------------------------------------------------------------

## Module 1 ~~~~~~~~~~~~~~~~~~~~~~~~

mod_app_ui <- function(id){
  ns <- NS(id)
  mod_shinyglide_ui(ns("glide"))
}

mod_app_server <- function(input, output, session){
  callModule(mod_shinyglide_server, "glide")
}

## Module 2 ~~~~~~~~~~~~~~~~~~~~

mod_shinyglide_ui <- function(id){

  ns <- NS(id)

  tagList(

    glide(
      id = ns("glide2"),
      screen(h1("First screen")),
      screen(h1("Second screen")),
      screen(h1("Third screen")),
      screen(h1("Fourth screen"))
    ),

    hr(),

    actionButton(ns("btn"), "OK")
  )

}

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

  ns <- session$ns

  observeEvent(input$btn, {
    print(input$shinyglide_index_glide2)
  })

}

# Main app ---------------------------------------------------------------------------------

ui <- fluidPage(
  mod_app_ui("app")
)

server <- function(input, output, session){
  callModule(mod_app_server, id = "app")
}

shinyApp(ui = ui, server = server)

Possible solution

You are definitely more versed in Javascript than I am; however, it seems to me that the following approach could work:

Here is a JavaScript code that showcases the approach I suggest here:

let string = "mod1-mod2-mod3-mod4-glide"

let id_split = string.split("-")
let id_split_pre = []

for(let i = 0; i < id_split.length-1; i++){
  id_split_pre.push(id_split[i])
}

let id = id_split_pre.join("-")
.concat("-shinyglide_index_")
.concat(id_split[id_split.length-1])

console.log(id)
juba commented 3 years ago

Thanks ! You are right, I overlooked the nested modules cased. I implemented a solution not far from yours : It will still fail when there's an hyphen in the glide id though, but in this case I don't think I have a way to differenciate a module prefix from an id-with-dash.

gueyenono commented 3 years ago

Indeed, if the glide ID is hyphenated, it will create some problems. I suggest you add this warning in the documentation. I will look into it as well and let you know if I find a solution.

The solution you implemented is very elegant. This is the true solution of an R user (aka one who avoids loops at all costs! lol)

juba commented 3 years ago

I've already added a small warning in the introduction vignette about hyphens in ids. Closing this issue for now, feel free to reopen it if needed !

See you on Slack 😉