Question

使用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))

每次输入id的值更改时，我是否可以强制垂直滚动条重置到顶部（而与右侧内容的长度无关）？

Answer 1

您可以使用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))

r闪亮-更改inputId

1 个答案: