Comments (16)
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.
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.
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.
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.
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.
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.
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.
good catch. i'll see where the problem is in the js.
from slickr.
Hi Yoni, is there any update on this?
from slickr.
sorry. haven't gotten to this yet.
from slickr.
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.
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.
this should work now. i made the shiny observer a callback function, now it responds per slick. 6bd8399
from slickr.
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.
Thanks, Yoni. This seems to do the trick! Thank you very much for your work on this. Really appreciate it.
from slickr.
you're welcome
from slickr.
Related Issues (20)
- using slickR for mobile HOT 2
- slickR shiny vignette broken HOT 12
- shiny: Carousel "jumps" when re-rendered with numeric height HOT 3
- slickr_output_current$.center isn't providing data on shiny app startup HOT 3
- Synch 3 Carousels and Change Color of Text HOT 3
- Move previous next buttons HOT 4
- target = "_self" HOT 1
- Browser side linking to other chart HOT 4
- Replace a slide? HOT 1
- Shiny: carousel collapses / folds after clicking on different tab and returning to carousel page HOT 1
- SlickR always insert image into html
- Problem with slickR + shiny, when the xmlSVG-file becomes to large. HOT 2
- Change figure size according to browser window size
- SlickR and Shiny, duplicated carousels HOT 7
- how to continue the carousel after click the arrow? HOT 3
- Error in file.info(x, extra_cols = FALSE) : file name conversion problem -- name too long?
- How change style settings in multiple slider ?
- How does Slide Synchronization work with asNavFor
- Duplicated carousels in shiny HOT 1
- How to add line breaks to a caption?
Recommend Projects
-
React
A declarative, efficient, and flexible JavaScript library for building user interfaces.
-
Vue.js
🖖 Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.
-
Typescript
TypeScript is a superset of JavaScript that compiles to clean JavaScript output.
-
TensorFlow
An Open Source Machine Learning Framework for Everyone
-
Django
The Web framework for perfectionists with deadlines.
-
Laravel
A PHP framework for web artisans
-
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.
-
Visualization
Some thing interesting about visualization, use data art
-
Game
Some thing interesting about game, make everyone happy.
Recommend Org
-
Facebook
We are working to build community through open source technology. NB: members must have two-factor auth.
-
Microsoft
Open source projects and samples from Microsoft.
-
Google
Google ❤️ Open Source for everyone.
-
Alibaba
Alibaba Open Source for everyone
-
D3
Data-Driven Documents codes.
-
Tencent
China tencent open source team.
from slickr.