堆棧內存溢出
  簡體   English   中英

SlickR Shiny R 在通過用戶輸入過濾輪播 obj 時動態將點轉換為圖像

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

 原文  2021-02-07 15:47:39  0   2    javascript/ css/ r/ shiny/ slickr

問題描述

一段時間以來一直在解決這個 slickR 問題。 我將不勝感激有關如何解決此問題或解決方案的不同方法的任何意見或新觀點。

我一直在解決兩個問題：

第一個我認為可以使用 CSS 解決，我不太熟悉，當通過使用 input$series 更新“obj”時，slickR 似乎正在創建多個 div。 這是不可取的，因為它會將最近的 div 重新定位在頁面的下方。 我嘗試使用我也不太熟悉的 javascript 使用觀察事件來破壞舊的浮油。 該問題的簡單解決方案的獎勵積分。

我正在努力解決的主要問題是我想將點轉換為圖像，並在選擇每個系列時讓它們動態更新。 這里的目標是我希望在上方顯示更大的圖像，並在下方顯示一系列“縮略圖”，以便用戶可以了解每張照片的外觀，而無需滾動瀏覽輪播中的每張圖像。

我的應用程序比這個示例復雜得多，但我使用的是 slickR，因為它可以方便地訪問當前、活動和中心幻燈片，我使用它來過濾額外的 dataframe 以呈現有關每個活動的信息的顯示/在輪播中居中圖像。

這是一個演示這兩個問題的示例：

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

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

以下是來自@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 在評論中提供的鏈接，我能夠將中心幻燈片的索引傳遞回服務器。

代碼：

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)

2 個解決方案

解決方案1
 0  2021-02-07 17:19:14

要在中間顯示圖像，您可以使用carousel() function，並列出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)

輸出

解決方案2
 0 已采納  2021-02-09 14:20:18

這就是我認為你所追求的（我沒有使用shinydashboardPlus ，因為它與給定的問題無關）

編輯：經過一些修復后，您現在可以使用renderSlickR實現相同的效果。 您需要安裝包含最新提交的版本：

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

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

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

此外，我發現，您可以通過將高度參數作為字符傳遞來避免重新渲染問題的跳躍（請參閱?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)

結果

暫無
暫無

聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

相關問題 R用戶輸入的閃亮鍵碼 KnockoutJS-過濾用戶輸入 如何動態地將文本附加到輪播中的圖像？ 嘗試將圖片動態添加到輪播中無法正常工作 當所有div /幻燈片可見時隱藏點 - 貓頭鷹旋轉木馬2 在Rails 4應用中將圖像動態添加到Bootstrap Carousel 根據點擊事件動態更改輪播圖像 如何動態添加圖像和到輪播的鏈接？ 如何將圖像動態渲染到 React Carousel？ 為什么在鍵入用戶輸入時過濾不起作用？
相關標簽
 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM