Giter Club home page Giter Club logo

Comments (16)

yonicd avatar yonicd commented on June 5, 2024

Thanks for trying the package.

slickR has shiny observers to track slider state. You can see an example here:

https://github.com/metrumresearchgroup/slickR/blob/master/Miscellaneous/shinyTest.R

from slickr.

yonicd avatar yonicd commented on June 5, 2024

here is a quick explanation of what is in the example

network <- shiny::reactiveValues() # <- a new reactive object like input
  
# when the slider changes this happens
  shiny::observeEvent(input$slick_current,{
    clicked_slide <- input$slick_current$.clicked # <- last index clicked
    relative_clicked <- input$slick_current$.relative_clicked # <- last relative index clicked
    center_slide <- input$slick_current$.center # <- index of center image
    total_slide <- input$slick_current$.total # <- total number of slides in slick
    active_slide <- input$slick_current$.slide # <- index of the active image
    
# if an image is clicked on then update objects in the network object
    if(!is.null(clicked_slide)){
      network$clicked_slide <- clicked_slide
      network$center_slide <- center_slide
      network$relative_clicked <- relative_clicked
      network$total_slide <- total_slide
      network$active_slide <- active_slide
      }
  })
  
# this prints out to a text UI that state of all the objects in network.
  output$current <- renderText({
    l <- shiny::reactiveValuesToList(network)
    paste(gsub('_',' ',names(l)), unlist(l),sep=' = ',collapse='\n')
  })

from slickr.

RossPitman avatar RossPitman commented on June 5, 2024

Thanks, Yoni. Appreciate your quick response. Unfortunately I still can't get this working. I've provided a reproducible example below.

suppressMessages({
  library(dplyr)
  library(htmlwidgets)
  library(slickR)
})

#NBA Team Logos
nbaTeams=c("ATL","BOS","BKN","CHA","CHI","CLE","DAL","DEN","DET","GSW",
       "HOU","IND","LAC","LAL","MEM","MIA","MIL","MIN","NOP","NYK",
       "OKC","ORL","PHI","PHX","POR","SAC","SAS","TOR","UTA","WAS")
teamImg=sprintf(paste0("https://i.cdn.turner.com/nba/nba/.element/",
                   "img/4.0/global/logos/512x512/bg.white/svg/%s.svg"),
            nbaTeams)
teamImg2=sprintf(paste0("https://i.cdn.turner.com/nba/nba/.element/",
                    "img/4.0/global/logos/512x512/bg.white/svg/%s.svg"),
             nbaTeams)

#Player Images
a1=read_html('http://www.espn.com/nba/depth') %>% 
  html_nodes(css = '#my-teams-table a')
a2=a1%>%html_attr('href')
a3=a1%>%html_text()
team_table=read_html('http://www.espn.com/nba/depth') %>% 
  html_table()
team_table=team_table[[1]][-c(1,2),]
playerTable=team_table%>%melt(,id='X1') %>% 
  arrange(X1,variable)
playerName=a2[grepl('[0-9]',a2)]
playerId=do.call('rbind',lapply(strsplit(playerName,'[/]'),
                            function(x) x[c(8,9)]))
playerId=playerId[playerId[,1]!='phi',]
playerTable$img=sprintf(paste0('http://a.espncdn.com/combiner/i?img=/",
                           "i/headshots/nba/players/full/%s.png&w=350&h=254'),
                    playerId[,1])


server <- function(input, output) {

  output$slick <- renderSlickR({
    slickR(obj = teamImg, slideId = 'ex1',height = 100,width='100%')
  })

  output$slick2 <- renderSlickR({
    slickR(obj = teamImg2, slideId = 'ex12',height = 100,width='100%')
  })

  network <- shiny::reactiveValues()
  network2 <- shiny::reactiveValues()

  shiny::observeEvent(input$slick_current,{
    clicked_slide <- input$slick_current$.clicked
    relative_clicked <- input$slick_current$.relative_clicked
    center_slide <- input$slick_current$.center
    total_slide <- input$slick_current$.total
    active_slide <- input$slick_current$.slide

    if(!is.null(clicked_slide)){
      network$clicked_slide <- clicked_slide
      network$center_slide <- center_slide
      network$relative_clicked <- relative_clicked
      network$total_slide <- total_slide
      network$active_slide <- active_slide
     }
   })

  output$current <- renderText({
    l <- shiny::reactiveValuesToList(network)
    paste(gsub('_',' ',names(l)), unlist(l),sep=' = ',collapse='\n')
  })

  output$current2 <- renderText({
    l <- shiny::reactiveValuesToList(network)
    paste(gsub('_',' ',names(l)), unlist(l),sep=' = ',collapse='\n')
   })

}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      shiny::verbatimTextOutput('current'),
      shiny::verbatimTextOutput('current2')
    ),
    mainPanel(slickROutput("slick",width='100%',height='100px'),
              slickROutput("slick2",width='100%',height='100px'))
  )
)

shinyApp(ui = ui, server = server)

At the moment, every time I flip through images within the upper slide, both text boxes update. Instead, I need just the top text box to update when I change the upper slide. Conversely, I need to the lower text box to update when the lower slide is changed. Is this possible using slickR?

Many thanks!

from slickr.

yonicd avatar yonicd commented on June 5, 2024

they naming convention is not that obvious in the example... it is [outputId]_current so this is how to write it

server <- function(input, output) {
  
  output$slick <- renderSlickR({
    slickR(obj = teamImg, slideId = 'ex1',height = 100,width='100%')
  })
  
  output$slick2 <- renderSlickR({
    slickR(obj = teamImg2, slideId = 'ex12',height = 100,width='100%')
  })
  
  network <- shiny::reactiveValues()
  network2 <- shiny::reactiveValues()
  
  shiny::observeEvent(input$slick_current,{
    clicked_slide <- input$slick_current$.clicked
    relative_clicked <- input$slick_current$.relative_clicked
    center_slide <- input$slick_current$.center
    total_slide <- input$slick_current$.total
    active_slide <- input$slick_current$.slide
    
    if(!is.null(clicked_slide)){
      network$clicked_slide <- clicked_slide
      network$center_slide <- center_slide
      network$relative_clicked <- relative_clicked
      network$total_slide <- total_slide
      network$active_slide <- active_slide
    }
  })
  
  shiny::observeEvent(input$slick2_current,{
    clicked_slide <- input$slick2_current$.clicked
    relative_clicked <- input$slick2_current$.relative_clicked
    center_slide <- input$slick2_current$.center
    total_slide <- input$slick2_current$.total
    active_slide <- input$slick2_current$.slide
    
    if(!is.null(clicked_slide)){
      network2$clicked_slide <- clicked_slide
      network2$center_slide <- center_slide
      network2$relative_clicked <- relative_clicked
      network2$total_slide <- total_slide
      network2$active_slide <- active_slide
    }
  })
  
  output$current <- renderText({
    l <- shiny::reactiveValuesToList(network)
    paste(gsub('_',' ',names(l)), unlist(l),sep=' = ',collapse='\n')
  })
  
  output$current2 <- renderText({
    l <- shiny::reactiveValuesToList(network2)
    paste(gsub('_',' ',names(l)), unlist(l),sep=' = ',collapse='\n')
  })
  
}

from slickr.

RossPitman avatar RossPitman commented on June 5, 2024

Thanks, Yoni! I totally missed that, but it's actually so simple. slickR is a great package, thank you so much for developing it. This approach is so much cleaner than my earlier javascript approach. I do, however, have one last question related to this approach: does the reactive nature of "outputId"_current rely on the user having to click the image, or could it simply work by using the keyboard arrow keys (i.e., so shiny basically tracks the centre image, and returns the index, whenever the user hits the left or right arrow key). This is essentially what my javascript approach was doing--albeit in a very messy manner. Having to rely on clicking each image would be cumbersome for the user of the shiny app (esp when inspecting hundreds of images), so it would be great if this approach would work without having to click, but simply work when using the arrow keys. Hopefully there's a way to do this?

Many thanks!

from slickr.

yonicd avatar yonicd commented on June 5, 2024

right now it works on a click, but i am always open to changes if it makes it easier to use. you can PR a change if you find a more user friendly solution

from slickr.

RossPitman avatar RossPitman commented on June 5, 2024

Thanks, Yoni. I'll submit a push request soon. Just before that though, I've noticed that your [outputId]_current suggestion doesn't quite work for input$slick2_current$.center, input$slick2_current$.total, and slick2_current$.slide. All three outputs return values from the previous slide, rather than the current slide. It seems shiny, or slick, still doesn't know which carousel is actually current. Example code below:

suppressMessages({
  library(shiny)
  library(dplyr)
  library(htmlwidgets)
  library(slickR)
  library(xml2)
})

#NBA Team Logos
nbaTeams=c("ATL","BOS","BKN","CHA","CHI","CLE","DAL","DEN","DET","GSW",
       "HOU","IND","LAC","LAL","MEM","MIA","MIL","MIN","NOP","NYK",
       "OKC","ORL","PHI","PHX","POR","SAC","SAS","TOR","UTA","WAS")
teamImg=sprintf(paste0("https://i.cdn.turner.com/nba/nba/.element/",
                   "img/4.0/global/logos/512x512/bg.white/svg/%s.svg"),
            nbaTeams[1:10])
teamImg2=sprintf(paste0("https://i.cdn.turner.com/nba/nba/.element/",
                    "img/4.0/global/logos/512x512/bg.white/svg/%s.svg"),
             nbaTeams[1:15])

server <- function(input, output) {

  output$slick <- renderSlickR({
    slickR(obj = teamImg, slideId = 'ex1',height = 100,width='100%')
  })

  output$slick2 <- renderSlickR({
    slickR(obj = teamImg2, slideId = 'ex9',height = 100,width='100%')
  })

  network <- shiny::reactiveValues()
  network2 <- shiny::reactiveValues()

  shiny::observeEvent(input$slick_current,{
    network_clicked_slide <- input$slick_current$.clicked
    network_relative_clicked <- input$slick_current$.relative_clicked
    network_center_slide <- input$slick_current$.center
    network_total_slide <- input$slick_current$.total
    network_active_slide <- input$slick_current$.slide

    if(!is.null(network_clicked_slide)){
      network$network_clicked_slide <- network_clicked_slide
      network$network_center_slide <- network_center_slide
      network$network_relative_clicked <- network_relative_clicked
      network$network_total_slide <- network_total_slide
      network$network_active_slide <- network_active_slide
    }
  })

  shiny::observeEvent(input$slick2_current,{
    network2_clicked_slide <- input$slick2_current$.clicked
    network2_relative_clicked <- input$slick2_current$.relative_clicked
    network2_center_slide <- input$slick2_current$.center
    network2_total_slide <- input$slick2_current$.total
    network2_active_slide <- input$slick2_current$.slide

    if(!is.null(network2_clicked_slide)){
      network2$network2_clicked_slide <- network2_clicked_slide
      network2$network2_center_slide <- network2_center_slide
      network2$network2_relative_clicked <- network2_relative_clicked
      network2$network2_total_slide <- network2_total_slide
      network2$network2_active_slide <- network2_active_slide
    }
  })

  output$current <- renderText({
    l <- shiny::reactiveValuesToList(network)
    paste(gsub('_',' ',names(l)), unlist(l),sep=' = ',collapse='\n')
  })

  output$current2 <- renderText({
    l <- shiny::reactiveValuesToList(network2)
    paste(gsub('_',' ',names(l)), unlist(l),sep=' = ',collapse='\n')
  })

}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      shiny::verbatimTextOutput('current'),
      shiny::verbatimTextOutput('current2')
    ),
    mainPanel(slickROutput("slick",width='100%',height='100px'),
          slickROutput("slick2",width='100%',height='100px'))
  )
)

shinyApp(ui = ui, server = server)

Is this error happening on your side too? Or is it just user error on my end?

Thanks, Ross.

from slickr.

yonicd avatar yonicd commented on June 5, 2024

good catch. i'll see where the problem is in the js.

from slickr.

RossPitman avatar RossPitman commented on June 5, 2024

Hi Yoni, is there any update on this?

from slickr.

yonicd avatar yonicd commented on June 5, 2024

sorry. haven't gotten to this yet.

from slickr.

yonicd avatar yonicd commented on June 5, 2024

this commit 010aafe should fix it. shiny observes now

# the value given to the outputId in  slickROutput(outputId = 'slick1')
active_slide <- input$slick_current$.slide 

active_slide
> "slick1"

from slickr.

RossPitman avatar RossPitman commented on June 5, 2024

Thanks, Yoni. That update seems to get closer to the issue, but it's still not fixed. Note that if you run the reproducible example above, and observe the 'network2 center slide', it still tracks the first slider and only updates when you click the first slider. Instead, it should update whenever you click the second slider. Also, 'network2 total slide' should reflect 15, but it still reflects 10.

from slickr.

yonicd avatar yonicd commented on June 5, 2024

this should work now. i made the shiny observer a callback function, now it responds per slick. 6bd8399

from slickr.

yonicd avatar yonicd commented on June 5, 2024

final commit 0167109 for this ... now there is an event observer for afterChange so now the arrow and keyboard are tracked by shiny.

here is the new example, the NULL that you will see for clicked is just to make it more obvious what is happening (arrow or click event).

suppressMessages({
  library(shiny)
  library(dplyr)
  library(htmlwidgets)
  library(slickR)
})

#NBA Team Logos
nbaTeams=c("ATL","BOS","BKN","CHA","CHI","CLE","DAL","DEN","DET","GSW",
           "HOU","IND","LAC","LAL","MEM","MIA","MIL","MIN","NOP","NYK",
           "OKC","ORL","PHI","PHX","POR","SAC","SAS","TOR","UTA","WAS")
teamImg=sprintf(paste0("https://i.cdn.turner.com/nba/nba/.element/",
                       "img/4.0/global/logos/512x512/bg.white/svg/%s.svg"),
                nbaTeams)
teamImg2=sprintf(paste0("https://i.cdn.turner.com/nba/nba/.element/",
                        "img/4.0/global/logos/512x512/bg.white/svg/%s.svg"),
                 nbaTeams)

#Player Images
a1=read_html('http://www.espn.com/nba/depth') %>% 
  html_nodes(css = '#my-teams-table a')
a2=a1%>%html_attr('href')
a3=a1%>%html_text()
team_table=read_html('http://www.espn.com/nba/depth') %>% 
  html_table()
team_table=team_table[[1]][-c(1,2),]
playerTable=team_table%>%melt(,id='X1') %>% 
  arrange(X1,variable)
playerName=a2[grepl('[0-9]',a2)]
playerId=do.call('rbind',lapply(strsplit(playerName,'[/]'),
                                function(x) x[c(8,9)]))
playerId=playerId[playerId[,1]!='phi',]
playerTable$img=sprintf(paste0('http://a.espncdn.com/combiner/i?img=/",
                               "i/headshots/nba/players/full/%s.png&w=350&h=254'),
                        playerId[,1])


server <- function(input, output) {
  
  output$slick <- renderSlickR({
    slickR(obj = teamImg, slideId = 'ex1',
           slickOpts = list(slidesToShow=3,centerMode=TRUE),
           height = 100,width='100%')
  })
  
  output$slick2 <- renderSlickR({
    slickR(obj = teamImg2, slideId = 'ex12',height = 100,width='100%')
  })
  
  network <- shiny::reactiveValues()
  network2 <- shiny::reactiveValues()
  
  shiny::observeEvent(input$slick_current,{

    clicked_slide <- input$slick_current$.clicked
    relative_clicked <- input$slick_current$.relative_clicked
    
    center_slide <- input$slick_current$.center
    total_slide <- input$slick_current$.total
    active_slide <- input$slick_current$.slider
    
    if(!is.null(center_slide)){
      
      network$center_slide <- center_slide
      network$total_slide  <- total_slide
      network$active_slide <- active_slide
    }
    
    if(!is.null(clicked_slide)){
      
      network$clicked_slide    <- clicked_slide
      network$relative_clicked <- relative_clicked
      network$center_slide     <- center_slide
      
      network$total_slide      <- total_slide
      
      network$active_slide     <- active_slide
      
    
      }else{
      
      network$clicked_slide <- NULL
      network$relative_clicked <- NULL
      
    }
  })
  
  shiny::observeEvent(input$slick2_current,{
    clicked_slide <- input$slick2_current$.clicked
    relative_clicked <- input$slick2_current$.relative_clicked
    center_slide <- input$slick2_current$.center
    total_slide <- input$slick2_current$.total
    active_slide <- input$slick2_current$.slider
    
    if(!is.null(center_slide)){
      
      network2$center_slide <- center_slide
      network2$total_slide  <- total_slide
      network2$active_slide <- active_slide
    }
    
    if(!is.null(clicked_slide)){
      
      network2$clicked_slide    <- clicked_slide
      network2$relative_clicked <- relative_clicked
      network2$center_slide     <- center_slide
      
      network2$total_slide      <- total_slide
      
      network2$active_slide     <- active_slide
      
      
    }else{
      
      network2$clicked_slide <- NULL
      network2$relative_clicked <- NULL
      
    }
  })
  
  output$current <- renderText({
    l <- shiny::reactiveValuesToList(network)
    l <- l[!sapply(l,is.null)]
    paste(gsub('_',' ',names(l)), unlist(l),sep=' = ',collapse='\n')
  })
  
  output$current2 <- renderText({
    l <- shiny::reactiveValuesToList(network2)
    l <- l[!sapply(l,is.null)]
    paste(gsub('_',' ',names(l)), unlist(l),sep=' = ',collapse='\n')
  })
  
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      shiny::verbatimTextOutput('current'),
      shiny::verbatimTextOutput('current2')
    ),
    mainPanel(slickROutput("slick",width='100%',height='100px'),
              slickROutput(outputId = "slick2",width='100%',height='100px'))
  )
)

shinyApp(ui = ui, server = server)

from slickr.

RossPitman avatar RossPitman commented on June 5, 2024

Thanks, Yoni. This seems to do the trick! Thank you very much for your work on this. Really appreciate it.

from slickr.

yonicd avatar yonicd commented on June 5, 2024

you're welcome

from slickr.

Related Issues (20)

Recommend Projects

  • React photo React

    A declarative, efficient, and flexible JavaScript library for building user interfaces.

  • Vue.js photo Vue.js

    🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.

  • Typescript photo Typescript

    TypeScript is a superset of JavaScript that compiles to clean JavaScript output.

  • TensorFlow photo TensorFlow

    An Open Source Machine Learning Framework for Everyone

  • Django photo Django

    The Web framework for perfectionists with deadlines.

  • D3 photo D3

    Bring data to life with SVG, Canvas and HTML. 📊📈🎉

Recommend Topics

  • javascript

    JavaScript (JS) is a lightweight interpreted programming language with first-class functions.

  • web

    Some thing interesting about web. New door for the world.

  • server

    A server is a program made to process requests and deliver data to clients.

  • Machine learning

    Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.

  • Game

    Some thing interesting about game, make everyone happy.

Recommend Org

  • Facebook photo Facebook

    We are working to build community through open source technology. NB: members must have two-factor auth.

  • Microsoft photo Microsoft

    Open source projects and samples from Microsoft.

  • Google photo Google

    Google ❤️ Open Source for everyone.

  • D3 photo D3

    Data-Driven Documents codes.