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

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

解决这个 slickr 问题已经有一段时间了。我将不胜感激任何有关如何解决此问题的意见或新观点或解决方案的不同方法。

我一直在解决两个问题：

我认为第一个可以使用 CSS 解决，我不太熟悉，当通过使用 input$series 更新 'obj' 时，slickr 似乎正在创建多个 div。这是不可取的，因为它会将最新的 div 重新定位到页面下方。我尝试使用我也不太熟悉的 javascript 来使用观察事件销毁旧的浮华。为该问题提供简单解决方案的奖励积分。

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

我的应用程序比这个例子复杂得多，但我使用的是 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)
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",bird=bird)


ui <- dashboardPagePlus(
  useShinyjs(),"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,session) {
  
  #custom message handler to update the dots,but it doesn't update
  observe({
    session$sendCustomMessage('setDots',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,{
     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,customPaging = cP2
    )
  
  output$slickrCarousel <- renderslickr({
  slick_dots_thumb <- slickr(
      obj = df[,width = "95%"
    ) + opts
    
  })
  
}

shinyApp(ui,server)

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

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

input$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.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://images7.alphacoders.com/416/thumb-1920-416332.jpg"
)

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

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

server <- function(input,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,slidesToScroll = 3,customPaging = cP2
      )
    
    s2 <- htmltools::tags$script(sprintf("var dotObj = %s",jsonlite::toJSON(df[[input$series]])))
    
    slick_dots_logo <- slickr(obj = df[[input$series]],width = "95%") + opts_dot_logo
    
    htmltools::tagList(s2,slick_dots_logo)
  })
  
  observeEvent(input$series,{
  
  output$imageInfo <- renderPrint({
    paste("The center image is: ",input$mySlick_current$.center)
    })
  
  #print(input$mySlick_current$.center)
  })
  
  
}

shinyApp(ui,server)

编辑 3：最终解决方案

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

代码：

library(shiny)
library(htmlwidgets)
library(slickr)

fish <- c(
  "https://www.hakaimagazine.com/wp-content/uploads/aquarium-reef-fish-banner.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,bird = bird)

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),uIoUtput("mySlick"),df[[input$series]][input[['imageIndex']]])
    })
  print(input[['imageIndex']])
  print( df[[input$series]][input[['imageIndex']]] )
  })
  
  
}

shinyApp(ui,server)

解决方法

要在中间显示图像，您可以使用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(),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,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)

这是我认为您所追求的（我没有使用 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',choices = c(
                    "fish" = "fish","butterfly" = "butterfly","bird" = "bird"
                  )
                ),textOutput("center"))

server <- function(input,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,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.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://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","https://images7.alphacoders.com/416/thumb-1920-416332.jpg"
)

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

ui <- fluidPage(uiOutput("mySlick"),"bird" = "bird"
                  )
                ))

server <- function(input,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,customPaging = cP2
      )
    
    s2 <- htmltools::tags$script(sprintf("var dotObj = %s",jsonlite::toJSON(df[[input$series]])))
    
    slick_dots_logo <- slickR(obj = df[[input$series]],width = "95%") + opts_dot_logo
    
    htmltools::tagList(s2,slick_dots_logo)
  })
  
}

shinyApp(ui,server)

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

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

解决方法

相关推荐