时间戳

首页 > 解决方案 > r shiny - 更改 inputId 后将垂直滚动条重置为顶部

r - r shiny - 更改 inputId 后将垂直滚动条重置为顶部

问题描述

使用sidebarLayout()，我正在从选定的值生成图片库radioButtons()。但是，如果我向下滚动一点然后选择不同的值，我希望滚动条重置到顶部。

下面是一个可重现的（“复制粘贴”）示例。可视化问题：（1）一直向下滚动到左侧第一个选项的最后一张图片，（2）然后选择第二个选项，也一直向下滚动，（3）然后返回到第一个选项。

您应该看到（与我想要的不同）滚动条不会回到顶部。

library(shiny)

species <- c(rep("Archaeolacerta bedriagae",5),rep("Bombina variegata",5))
photo <- c("https://www.hylawerkgroep.be/jeroen/files/0048/IMG_9055.jpg",
          "https://www.hylawerkgroep.be/jeroen/files/0048/IMG_9941.jpg",
          "https://www.hylawerkgroep.be/jeroen/files/0048/IMG_8674.jpg",
          "https://www.hylawerkgroep.be/jeroen/files/0046/IMG_7534.jpg",
          "https://www.hylawerkgroep.be/jeroen/files/0048/IMG_9635.jpg",
          "https://www.hylawerkgroep.be/jeroen/files/0045/IMG_2704.jpg",
          "http://www.hylawerkgroep.be/jeroen/files/0051/IMG_4158.jpg",
          "https://www.hylawerkgroep.be/jeroen/files/ugent_16_tr/171_7174.jpg",
          "https://www.hylawerkgroep.be/jeroen/files/0039/288_8898.jpg",
          "https://www.hylawerkgroep.be/jeroen/files/ugent_16_tr/Greece2004_23.jpg")
data <- data.frame(species,photo, stringsAsFactors = FALSE)

ui = fluidPage(
  tabsetPanel(
    tabPanel("Species",
             sidebarLayout(
               sidebarPanel(width=2, radioButtons(inputId = "species1", selected = sort(unique(data$species))[1], label = NULL,
                                                     choices = c(sort(unique(data$species))))),
               mainPanel(width = 10,
                         fluidRow(
                           tags$head(tags$style(type = "text/css", "#tPanel4 {height:75vh !important;}")),
                           column(6,
                                  fluidRow(
                                    column(12, wellPanel(id = "tPanel4", style = "overflow-y: scroll; font-size: 14px", htmlOutput("gallery")))))))))))  


server = function(input, output, session) {  
  output$gallery <- renderText({
    galdat <- data[data$species==input$species1 & data$photo!= "NO", ]
    galdat$picstring <- paste0("<img src='",galdat$photo,"' width=600 /><br<br><hr>")
    string <- paste(galdat$picstring, collapse = " ")
    string
  })
}

shinyApp(ui = ui, server = server, options = list(launch.browser=TRUE))

每次更改 inputId 的值时（无论右侧内容的长度如何），我可以强制垂直滚动条重置到顶部吗？

标签： rshinyscrollbar

解决方案

您可以library(shinyjs)为此使用：

library(shiny)
library(shinyjs)
library(V8)

jsCode <- "shinyjs.scrolltop = function() {tPanel4.scrollTo(0, 0)};" 

species <- c(rep("Archaeolacerta bedriagae",5),rep("Bombina variegata",5))
photo <- c("https://www.hylawerkgroep.be/jeroen/files/0048/IMG_9055.jpg",
           "https://www.hylawerkgroep.be/jeroen/files/0048/IMG_9941.jpg",
           "https://www.hylawerkgroep.be/jeroen/files/0048/IMG_8674.jpg",
           "https://www.hylawerkgroep.be/jeroen/files/0046/IMG_7534.jpg",
           "https://www.hylawerkgroep.be/jeroen/files/0048/IMG_9635.jpg",
           "https://www.hylawerkgroep.be/jeroen/files/0045/IMG_2704.jpg",
           "http://www.hylawerkgroep.be/jeroen/files/0051/IMG_4158.jpg",
           "https://www.hylawerkgroep.be/jeroen/files/ugent_16_tr/171_7174.jpg",
           "https://www.hylawerkgroep.be/jeroen/files/0039/288_8898.jpg",
           "https://www.hylawerkgroep.be/jeroen/files/ugent_16_tr/Greece2004_23.jpg")
data <- data.frame(species,photo, stringsAsFactors = FALSE)

ui = fluidPage(
  useShinyjs(),
  extendShinyjs(text = jsCode),
  tabsetPanel(
    tabPanel("Species",
             sidebarLayout(
               sidebarPanel(width=2, radioButtons(inputId = "species1", selected = sort(unique(data$species))[1], label = NULL,
                                                  choices = c(sort(unique(data$species))))),
               mainPanel(width = 10,
                         fluidRow(
                           tags$head(tags$style(type = "text/css", "#tPanel4 {height:75vh !important;}")),
                           column(6,
                                  fluidRow(
                                    column(12, wellPanel(id = "tPanel4", style = "overflow-y: scroll; font-size: 14px", htmlOutput("gallery")))))))))))  


server = function(input, output, session) {  

  observeEvent(input$species1, {
    js$scrolltop()
  })

  output$gallery <- renderText({
    galdat <- data[data$species==input$species1 & data$photo!= "NO", ]
    galdat$picstring <- paste0("<img src='",galdat$photo,"' width=600 /><br<br><hr>")
    string <- paste(galdat$picstring, collapse = " ")
    string
  })
}

shinyApp(ui = ui, server = server, options = list(launch.browser=TRUE))

推荐阅读