文档建议反馈控制台
首页
学习
活动
专区
圈层
工具
MCP广场
文章/答案/技术大牛
发布
首页
学习
活动
专区
圈层
工具
MCP广场
返回腾讯云官网
社区首页 >问答首页 >SlickR闪亮R在用户输入过滤旋转木马时动态地将点转换成图像

问SlickR闪亮R在用户输入过滤旋转木马时动态地将点转换成图像
EN

Stack Overflow用户
提问于 2021-02-07 15:47:39
回答 2查看 298关注 0票数 2

解决这个slickR问题已经有一段时间了。我非常希望就如何解决这一问题提出任何意见或提出新的看法，或以不同的方式寻求解决办法。

我一直在努力解决两个问题：

我认为第一个问题可以用CSS解决，我不太熟悉它，当通过使用input$series更新'obj‘时，slickR似乎正在创建多个div。这是不可取的，因为它将页面上最近的div重新定位到较低的位置。我试着使用javascript (我也不太熟悉)来使用一个观察事件来销毁旧的漏洞。这个问题的简单解决方案的奖金。

我正在努力解决的主要问题是，我想要将点转换成图像，并让它们在选择每个系列时动态更新。这里的目标是，我希望在上面显示一个更大的图像，并在下面显示一系列的“缩略图”，这样用户就可以知道每一张照片的样子，而不必浏览旋转木马中的每一张图片。

我的应用程序比这个例子要复杂得多，但我使用的是slickR，因为它有一种访问当前、活动和中心幻灯片的方便方法，我使用它来过滤额外的数据，以呈现旋转木马中每个活动/中心图像的信息显示。

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

代码语言：javascript
复制
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:澄清和当前方法

下面是我当前的方法，试图通过会话$sendCustomMessage传递一个动态值，并更新负责呈现slickR点(或缩略图)的变量。

持续存在的问题是：

  • 当单选按钮被更改时，旋转木马会跳跃。
  • 当单选按钮更改时，缩略图不会更新。

代码：

代码语言：javascript
复制
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文档声明您可以这样访问它：

input$mySlick_current$.center

可能需要由renderSlickR({})而不是renderUI({})创建输出$mySlick。

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

代码语言：javascript
复制
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在注释中提供的链接，我能够将中心幻灯片的索引传回服务器。

代码：

代码语言：javascript
复制
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)
javascript
css
r
shiny
slickr
EN

回答 2

Stack Overflow用户

回答已采纳

发布于 2021-02-09 14:20:18

这里是我认为您想要的(我没有使用shinydashboardPlus，因为它与给定的问题无关)

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

代码语言：javascript
复制
remotes::install_github("yonicd/slickR@417fd60e013b70540970c1b798897050c3580d2c")

现在也可以在一个分支中获得：

代码语言：javascript
复制
remotes::install_github("yonicd/slickR@fix_shinyvignette")

此外，我发现，您可以通过将高度参数作为字符传递来避免跳过重渲染问题(参见?slickR -有效的css单元，例如"100px"或"25vh")。

代码语言：javascript
复制
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解决方案：

代码语言：javascript
复制
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)

​

​

票数 0
EN

Stack Overflow用户

发布于 2021-02-07 17:19:14

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

代码语言：javascript
复制
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)

​

​

票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：

https://stackoverflow.com/questions/66089815

复制
相关文章

相似问题

领券

腾讯云开发者

扫码关注腾讯云开发者

扫码关注腾讯云开发者

领取腾讯云代金券

热门产品

热门推荐

更多推荐

Copyright © 2013 - 2025 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有 

深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 深公网安备号 44030502008569

腾讯云计算（北京）有限责任公司 京ICP证150476号 |  京ICP备11018762号 | 京公网安备号11010802020287

问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档