SlickR Shiny R 在通过用户输入过滤轮播对象时动态地将点转换为图像

Question

解决这个 slickR 问题已经有一段时间了。对于如何解决此问题或采用不同的解决方案的任何意见或新观点，我将不胜感激。

我一直在解决两个问题：

第一个我认为可以使用 CSS 解决，我不是很熟悉，当 'obj' 通过更新时，slickR 似乎正在创建多个 divs使用输入$系列。这是不可取的，因为它将最近的 div 重新定位在页面的下方。我尝试使用我也不是很熟悉的 javascript 来使用观察事件来破坏旧的浮油。为该问题提供简单解决方案的奖励积分。

我正在努力解决的主要问题是我想将点转换为图像并让它们在选择每个系列时动态更新。这里的目标是我希望在上方显示更大的图像并在下方显示一系列 'thumbnails' 以便用户可以了解每张照片的外观而无需滚动浏览轮播中的每张图像.

我的应用程序比这个例子复杂得多，但我正在使用 slickR，因为它有一种方便的方式来访问当前的、活动的和居中的幻灯片，我用它来过滤一个额外的数据框来呈现显示关于轮播中每张 active/centered 图片的信息。

这是一个演示这两个问题的示例：

library(shiny)
library(shinyjs)
library(shinydashboard)
library(shinydashboardPlus)
library(jsonlite)
library(htmltools)
library(htmlwidgets)
library(slickR)

fish <- c(
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banner.jpg",
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banggai-cardinalfish.jpg",
  "https://www.sonomamag.com/wp-content/uploads/2016/12/fish.jpg" )

butterfly <- c(
  "https://www.futurity.org/wp/wp-content/uploads/2019/02/viceroy-butterfly_1600.jpg",
  "https://harvardforest.fas.harvard.edu/sites/harvardforest.fas.harvard.edu/files/butterfly_giant_swallowtail_model.jpg",
  "https://www.butterflyidentification.com/wp-content/uploads/2019/02/Doris-Longwing-Butterfly-Images.jpg"
)

bird <- c(
  "http://www.cutepetname.com/wp-content/uploads/2018/11/funy-bird-names-feat-img.jpeg",
  "http://3.bp.blogspot.com/-mJ-Kw1mdLOo/UeLJx7vxsaI/AAAAAAAADkg/TfDHtuJnY7I/s1600/The-Cardinal-Bird.jpg",
  "https://images7.alphacoders.com/416/thumb-1920-416332.jpg"
)

df <- data.frame(fish=fish, butterfly=butterfly, bird=bird)
pics <- df[,"fish"]

ui <- dashboardPagePlus(
  useShinyjs(),
  
  header = dashboardHeaderPlus(disable = TRUE ),
  sidebar = dashboardSidebar(
    
    radioButtons('series', "Choose Series", 
                 choices = c("fish"="fish", "butterfly"="butterfly", "bird"="bird")
                 ) 
    ),
  
  body = dashboardBody(
    
    tags$script( sprintf("var dotObj = %s", jsonlite::toJSON( 'dots')) ),
    
    slickROutput('slickRCarousel'),
    
    uiOutput('dots')
    
  )
)



server <- function(input, output, session) {
  
  # unslick to counteract slick generating multiple divs?
   observeEvent(input$series, ignoreInit = TRUE, {
     runjs("$('.slickRCarousel').slick('unslick');")
    print(df[,input$series])
  })
  
 
  # observe({
  #   print(input$slickROutput_current$.clicked)
  # })
  
  output$dots <- renderPrint({
    c(df[,input$series])
  })
  
  
  # carousel setup
    cP2 <- JS("function(slick,index) {
          return '<a><img src= ' + dotObj[index] + '  width=30px height=30px></a>';
          }")
  
  opts <- 
    settings(
      initialSlide = 1,
      slidesToShow = 3,
      slidesToScroll = 1,
      centerMode = TRUE,
      focusOnSelect = TRUE,
      dots = TRUE,
      customPaging = cP2
    )
  
  output$slickRCarousel <- renderSlickR({
    
    slick_dots_logo <- slickR(
      obj = df[,input$series],
      height = 100,
      width = "95%"
    ) + opts
    
  })
  
  
}

shinyApp(ui, server)

提前感谢您抽出宝贵时间查看本文！

编辑 1：说明和当前方法

这是我目前的方法，尝试通过 session$sendCustomMessage 传递动态值并更新负责呈现 slickR 点（或缩略图）的变量。

持续存在的问题是：

当单选按钮改变时轮播跳转
更改单选按钮时缩略图未更新

代码：

library(shiny)
library(shinyjs)
library(shinydashboard)
library(shinydashboardPlus)
library(jsonlite)
library(htmltools)
library(htmlwidgets)
library(slickR)

fish <- c(
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banner.jpg",
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banggai-cardinalfish.jpg",
 "https://www.sonomamag.com/wp-content/uploads/2016/12/fish.jpg" )

butterfly <- c(
  "https://www.futurity.org/wp/wp-content/uploads/2019/02/viceroy-butterfly_1600.jpg",
  "https://harvardforest.fas.harvard.edu/sites/harvardforest.fas.harvard.edu/files/butterfly_giant_swallowtail_model.jpg",
  "https://www.butterflyidentification.com/wp-content/uploads/2019/02/Doris-Longwing-Butterfly-Images.jpg"
)

bird <- c(
  "http://www.cutepetname.com/wp-content/uploads/2018/11/funy-bird-names-feat-img.jpeg",
  "http://3.bp.blogspot.com/-mJ-Kw1mdLOo/UeLJx7vxsaI/AAAAAAAADkg/TfDHtuJnY7I/s1600/The-Cardinal-Bird.jpg",
  "https://images7.alphacoders.com/416/thumb-1920-416332.jpg"
)

df <- data.frame(fish=fish, butterfly=butterfly, bird=bird)


ui <- dashboardPagePlus(
  useShinyjs(),
  
  header = dashboardHeaderPlus(disable = TRUE ),
  sidebar = dashboardSidebar(
    
    radioButtons('series', "Choose Series", 
                 choices = c("fish"="fish", "butterfly"="butterfly", "bird"="bird")
    )
  ),
  
  body = dashboardBody(
    
    # this sets thumbnails to always be fish, replacing with
    # df[,input$series] seems to cause an issue.
    tags$script( HTML(sprintf("var dotObj = %s", jsonlite::toJSON( df[,'fish'])) ) ), 
    
    #attempting to add a custom message handler to update the dots, but it doesn't
    # update
    tags$script("
                  Shiny.addCustomMessageHandler(setDots, function(newDots) {
                    var dotObj = newDots; 
                  });
                "),
    
    slickROutput('slickRCarousel')
    
  )
)


server <- function(input, output, session) {
  
  #custom message handler to update the dots, but it doesn't update
  observe({
    session$sendCustomMessage('setDots', jsonlite::toJSON( df[,input$series]))
    #print(jsonlite::toJSON( df[,input$series]))
  })
  
  # unslick to counteract slick generating multiple divs
  # and pushing the carousel down? It's not working
   observeEvent(input$series, ignoreInit = TRUE, {
     runjs("$('.slickRCarousel').slick('unslick');")
  })
  
  # slickR carousel setup
  cP2 <- JS(
    "function(slick,index) {
            return '<a><img src= ' + dotObj[index] + '  width=30px height=30px></a>';
          }" )
  
  opts <- 
    settings(
      initialSlide = 1,
      slidesToShow = 1,
      slidesToScroll = 1,
      centerMode = TRUE,
      focusOnSelect = TRUE,
      dots = TRUE,
      customPaging = cP2
    )
  
  output$slickRCarousel <- renderSlickR({
  slick_dots_thumb <- slickR(
      obj = df[,input$series],
      height = 100,
      width = "95%"
    ) + opts
    
  })
  
}

shinyApp(ui, server)

编辑 2：基于@ismirsehregal 的显示和导航解决方案

最后一块拼图是将中心或活动幻灯片值返回到服务器。 slickR 文档说明您可以像这样访问它：

输入$mySlick_current$.center

可能是output$mySlick需要通过renderSlickR({})创建，而不是renderUI({})。

这是来自@ismirsehregal 的解决方案的一些更新代码：

library(shiny)
library(htmlwidgets)
library(slickR)

fish <- c(
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banner.jpg",
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banggai-cardinalfish.jpg",
  "https://www.sonomamag.com/wp-content/uploads/2016/12/fish.jpg"
)

butterfly <- c(
  "https://www.futurity.org/wp/wp-content/uploads/2019/02/viceroy-butterfly_1600.jpg",
  "https://harvardforest.fas.harvard.edu/sites/harvardforest.fas.harvard.edu/files/butterfly_giant_swallowtail_model.jpg",
  "https://www.butterflyidentification.com/wp-content/uploads/2019/02/Doris-Longwing-Butterfly-Images.jpg"
)

bird <- c(
  "http://www.cutepetname.com/wp-content/uploads/2018/11/funy-bird-names-feat-img.jpeg",
  "http://3.bp.blogspot.com/-mJ-Kw1mdLOo/UeLJx7vxsaI/AAAAAAAADkg/TfDHtuJnY7I/s1600/The-Cardinal-Bird.jpg",
  "https://images7.alphacoders.com/416/thumb-1920-416332.jpg"
)

df <- data.frame(fish = fish,
                 butterfly = butterfly,
                 bird = bird)

ui <- fluidPage(uiOutput("mySlick"),
                radioButtons(
                  'series',
                  "Choose Series",
                  choices = c(
                    "fish" = "fish",
                    "butterfly" = "butterfly",
                    "bird" = "bird"
                  )
                ),
                uiOutput('imageInfo')
                )

server <- function(input, output, session) {
  output$mySlick <- renderUI({
    cP2 <- JS(
      "function(slick,index) {
          return '<a><img src= ' + dotObj[index] + '  width=100% height=100%></a>';
          }"
    )
    
    opts_dot_logo <-
      settings(
        initialSlide = 1,
        slidesToShow = 1,
        slidesToScroll = 3,
        centerMode = TRUE,
        focusOnSelect = TRUE,
        dots = TRUE,
        customPaging = cP2
      )
    
    s2 <- htmltools::tags$script(sprintf("var dotObj = %s", jsonlite::toJSON(df[[input$series]])))
    
    slick_dots_logo <- slickR(obj = df[[input$series]],
                              height = 100,
                              width = "95%") + opts_dot_logo
    
    htmltools::tagList(s2, slick_dots_logo)
  })
  
  observeEvent(input$series, ignoreInit = TRUE, {
  
  output$imageInfo <- renderPrint({
    paste("The center image is: ", input$mySlick_current$.center)
    })
  
  #print(input$mySlick_current$.center)
  })
  
  
}

shinyApp(ui, server)

编辑 3：最终解决方案

感谢@ismirsehregal 在评论中提供的link，我能够将中心幻灯片的索引传回服务器。

代码：

library(shiny)
library(htmlwidgets)
library(slickR)

fish <- c(
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banner.jpg",
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banggai-cardinalfish.jpg",
  "https://www.sonomamag.com/wp-content/uploads/2016/12/fish.jpg"
)

butterfly <- c(
  "https://www.futurity.org/wp/wp-content/uploads/2019/02/viceroy-butterfly_1600.jpg",
  "https://harvardforest.fas.harvard.edu/sites/harvardforest.fas.harvard.edu/files/butterfly_giant_swallowtail_model.jpg",
  "https://www.butterflyidentification.com/wp-content/uploads/2019/02/Doris-Longwing-Butterfly-Images.jpg"
)

bird <- c(
  "http://www.cutepetname.com/wp-content/uploads/2018/11/funy-bird-names-feat-img.jpeg",
  "http://3.bp.blogspot.com/-mJ-Kw1mdLOo/UeLJx7vxsaI/AAAAAAAADkg/TfDHtuJnY7I/s1600/The-Cardinal-Bird.jpg",
  "https://images7.alphacoders.com/416/thumb-1920-416332.jpg"
)

js <- "
$(document).ready(function(){
  $('#mySlick').on('setPosition', function(event, slick) {
    var index = slick.currentSlide + 1;
    Shiny.setInputValue('imageIndex', index);
  });
})"

df <- data.frame(fish = fish,
                 butterfly = butterfly,
                 bird = bird)

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),
  
  uiOutput("mySlick"),
                radioButtons(
                  'series',
                  "Choose Series",
                  choices = c(
                    "fish" = "fish",
                    "butterfly" = "butterfly",
                    "bird" = "bird"
                  )
                ),
                uiOutput('imageInfo')
                )

server <- function(input, output, session) {
  output$mySlick <- renderUI({
    cP2 <- JS(
      "function(slick,index) {
          return '<a><img src= ' + dotObj[index] + '  width=100% height=100%></a>';
          }"
    )
    
    opts_dot_logo <-
      settings(
        initialSlide = 1,
        slidesToShow = 1,
        slidesToScroll = 3,
        centerMode = TRUE,
        focusOnSelect = TRUE,
        dots = TRUE,
        customPaging = cP2
      )
    
    s2 <- htmltools::tags$script(sprintf("var dotObj = %s", jsonlite::toJSON(df[[input$series]])))
    
    slick_dots_logo <- slickR(obj = df[[input$series]],
                              height = 100,
                              width = "95%") + opts_dot_logo
    
    htmltools::tagList(s2, slick_dots_logo)
  })
  
  observeEvent(input$series, ignoreInit = TRUE, {
  
  output$imageInfo <- renderPrint({
    paste("The center image is: ", df[[input$series]][input[['imageIndex']]])
    })
  print(input[['imageIndex']])
  print( df[[input$series]][input[['imageIndex']]] )
  })
  
  
}

shinyApp(ui, server)

Answer 1

要在中间显示图像，可以使用carousel()函数，并列出carouselItem()中的项目，如下所示。

df <- data.frame(fish=fish, butterfly=butterfly, bird=bird)
pics <- df[,"fish"]

jscode <-"
$(document).ready(function(){
            $('#mycarousel').carousel( { interval:  false } );
});"

ui <- dashboardPagePlus(
  useShinyjs(),
  #tags$head(tags$script(HTML(jscode))),  ### to stop the autoplay; does not seem to work
  header = dashboardHeaderPlus(disable = TRUE ),
  sidebar = dashboardSidebar(
    
    radioButtons('series', "Choose Series", 
                 choices = c("fish"="fish", "butterfly"="butterfly", "bird"="bird")
    ) 
  ),
  
  body = dashboardBody(
    
    tags$script( sprintf("var dotObj = %s", jsonlite::toJSON( 'dots')) ),
    
    slickROutput('slickRCarousel'), br(), br(), br(), br(), br(),
    
    uiOutput("carousell")
    # uiOutput('dots')
    
  )
)

server <- function(input, output, session) {
  
  # unslick to counteract slick generating multiple divs?
  observeEvent(input$series, ignoreInit = TRUE, {
    runjs("$('.slickRCarousel').slick('unslick');")
    print(df[,input$series])
  })
  
  # observe({
  #   print(input$slickROutput_current$.clicked)
  # })
  
  output$dots <- renderPrint({
    c(df[,input$series])
  })
  
  output$carousell <- renderUI({
    carousel(
      id = "mycarousel",
      carouselItem(
        caption = "First image",
        tags$img(src = df[1,input$series])
      ),
      carouselItem(
        caption = "An image file",
        tags$img(src = df[2,input$series])
      ),
      carouselItem(
        caption = "Item 3",
        tags$img(src = df[3,input$series])
      )
    )
    
  })
  
  
  # carousel setup
  cP2 <- JS("function(slick,index) {
          return '<a><img src= ' + dotObj[index] + '  width=30px height=30px></a>';
          }")
  
  opts <- 
    settings(
      initialSlide = 1,
      slidesToShow = 3,
      slidesToScroll = 1,
      centerMode = TRUE,
      focusOnSelect = TRUE,
      dots = TRUE,
      customPaging = cP2
    )
  
  output$slickRCarousel <- renderSlickR({
    
    slick_dots_logo <- slickR(
      obj = df[,input$series],
      height = 100,
      width = "75%"
    ) + opts
    
  })
  
  
}

shinyApp(ui, server)

Answer 2

这就是我认为你想要的（我没有使用 shinydashboardPlus 因为它与给定的问题无关）

编辑： 经过一些 fixes 之后，您现在可以使用 renderSlickR 实现同样的效果。您需要安装一个包含最新提交的版本：

remotes::install_github("yonicd/slickR@417fd60e013b70540970c1b798897050c3580d2c")

现在也可以在分支中使用：

remotes::install_github("yonicd/slickR@fix_shinyvignette")

此外，我发现，您可以通过将高度参数作为字符传递来避免 jumping on re-rendering 问题（请参阅 ?slickR - 有效 css 单位，例如 "100px" 或"25vh").

library(shiny)
library(htmlwidgets)
library(slickR)

DF <- data.frame(fish = c(
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banner.jpg",
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banggai-cardinalfish.jpg",
  "https://www.sonomamag.com/wp-content/uploads/2016/12/fish.jpg"
),
butterfly = c(
  "https://www.futurity.org/wp/wp-content/uploads/2019/02/viceroy-butterfly_1600.jpg",
  "https://harvardforest.fas.harvard.edu/sites/harvardforest.fas.harvard.edu/files/butterfly_giant_swallowtail_model.jpg",
  "https://www.butterflyidentification.com/wp-content/uploads/2019/02/Doris-Longwing-Butterfly-Images.jpg"
),
bird = c(
  "http://www.cutepetname.com/wp-content/uploads/2018/11/funy-bird-names-feat-img.jpeg",
  "http://3.bp.blogspot.com/-mJ-Kw1mdLOo/UeLJx7vxsaI/AAAAAAAADkg/TfDHtuJnY7I/s1600/The-Cardinal-Bird.jpg",
  "https://images7.alphacoders.com/416/thumb-1920-416332.jpg"
))

ui <- fluidPage(slickROutput("mySlick", width = "50%"),
                radioButtons(
                  'series',
                  "Choose Series",
                  choices = c(
                    "fish" = "fish",
                    "butterfly" = "butterfly",
                    "bird" = "bird"
                  )
                ),
                textOutput("center"))

server <- function(input, output, session) {
  output$mySlick <- renderSlickR({

    cP2 <- JS(
      paste0("function(slick,index) {
      var dotObj = ", jsonlite::toJSON(DF[[input$series]]),";
          return '<a><img src= ' + dotObj[index] + '  width=100% height=100%></a>';
          }"))
    
    opts_dot_logo <-
      settings(
        initialSlide = 1,
        slidesToShow = 1,
        slidesToScroll = 3,
        centerMode = TRUE,
        focusOnSelect = TRUE,
        dots = TRUE,
        customPaging = cP2
      )
    
    slick_dots_logo <- slickR(obj = DF[[input$series]],
                              height = "100px") + opts_dot_logo
    
    
    slick_dots_logo
  })
  
  output$center <- renderText({
    paste("Center:", input$mySlick_current$.center)
  })
  
}

shinyApp(ui, server)

renderUI解决方案：

library(shiny)
library(htmlwidgets)
library(slickR)

fish <- c(
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banner.jpg",
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banggai-cardinalfish.jpg",
  "https://www.sonomamag.com/wp-content/uploads/2016/12/fish.jpg"
)

butterfly <- c(
  "https://www.futurity.org/wp/wp-content/uploads/2019/02/viceroy-butterfly_1600.jpg",
  "https://harvardforest.fas.harvard.edu/sites/harvardforest.fas.harvard.edu/files/butterfly_giant_swallowtail_model.jpg",
  "https://www.butterflyidentification.com/wp-content/uploads/2019/02/Doris-Longwing-Butterfly-Images.jpg"
)

bird <- c(
  "http://www.cutepetname.com/wp-content/uploads/2018/11/funy-bird-names-feat-img.jpeg",
  "http://3.bp.blogspot.com/-mJ-Kw1mdLOo/UeLJx7vxsaI/AAAAAAAADkg/TfDHtuJnY7I/s1600/The-Cardinal-Bird.jpg",
  "https://images7.alphacoders.com/416/thumb-1920-416332.jpg"
)

df <- data.frame(fish = fish,
                 butterfly = butterfly,
                 bird = bird)

ui <- fluidPage(uiOutput("mySlick"),
                radioButtons(
                  'series',
                  "Choose Series",
                  choices = c(
                    "fish" = "fish",
                    "butterfly" = "butterfly",
                    "bird" = "bird"
                  )
                ))

server <- function(input, output, session) {
  output$mySlick <- renderUI({
    cP2 <- JS(
      "function(slick,index) {
          return '<a><img src= ' + dotObj[index] + '  width=100% height=100%></a>';
          }"
    )
    
    opts_dot_logo <-
      settings(
        initialSlide = 1,
        slidesToShow = 1,
        slidesToScroll = 3,
        centerMode = TRUE,
        focusOnSelect = TRUE,
        dots = TRUE,
        customPaging = cP2
      )
    
    s2 <- htmltools::tags$script(sprintf("var dotObj = %s", jsonlite::toJSON(df[[input$series]])))
    
    slick_dots_logo <- slickR(obj = df[[input$series]],
                              height = 100,
                              width = "95%") + opts_dot_logo
    
    htmltools::tagList(s2, slick_dots_logo)
  })
  
}

shinyApp(ui, server)

SlickR Shiny R 在通过用户输入过滤轮播对象时动态地将点转换为图像

SlickR Shiny R dynamically convert dots to images when filtering the carousel obj by user input

javascript

css

r

shiny

slickr