javascript - r - 如何在 shinyapp 中自动滚动到 div 的底部？

Question

我想在添加新内容时将滚动条保持在底部。

printText <- function() {
  for(i in 1:20){
    Sys.sleep(0.1)
    shinyjs::html("text", paste("My text", i, "<br>"), add = TRUE)
    y = i + 1
  }
  return(y)
}
library(shiny)
library(shinyjs)
runApp(list(
  ui = shinyUI(fluidPage(
    shinyjs::useShinyjs(),
    titlePanel("Print consol output"),
    sidebarLayout(
      sidebarPanel(actionButton("go", "Go")),
      mainPanel(
        style = "overflow-y:scroll; max-height: 100px; position:relative;",
        div(id = "text")
      )
    )
  )),
  server = shinyServer(function(input, output, session){
    observeEvent(input$go, {
      shinyjs::html("text", "")
      y <- printText()
    })
  })
))

我找到了调用 javascript 的相关解决方案，但它在我的案例中不起作用。

这是js代码:

function scrollToBottom(){
  var elem = document.getElementById('text');
  elem.scrollTop = elem.scrollHeight;
};

我试过在div前面加上includeScript来调用函数，比如includeScript("myJSfile.js")，但是没有成功。

我做错了什么？

非常感谢。

Answer 1

这对我有用:

library(shiny)

ui <- fluidPage(
  tags$head(
    # Some css to style the div to make it more easily visible
    tags$style(
      '#outDiv{
        height:150px;
        overflow-y:scroll;
        border: 1px solid black;
        border-radius:15px;
        padding:15px;
      }
      '
    ),
    # Custom shiny to javascript binding
    # scrolls "outDiv" to bottom once called
    tags$script(
      '
      Shiny.addCustomMessageHandler("scrollCallback",
        function(color) {
          var objDiv = document.getElementById("outDiv");
          objDiv.scrollTop = objDiv.scrollHeight;
        }
      );'
    )
  ),
  sidebarLayout(
    sidebarPanel(
      actionButton('go','Start Printing')
    ),
    mainPanel(
      div(id='outDiv',
        htmlOutput('out')
      )
      # Text output

    )
  )
)

server <- function(input, output, session) {
  autoInvalidate <- reactiveTimer(250, session) # Timer function

  ptm      <- proc.time() # Start time
  startTxt <- ''          # Start string to show on screen

  # Function to print new line when reactiveTimer invalidates
  startPrint <- function(){
    output$out <- renderText({ 
      ctm <- proc.time() - ptm
      autoInvalidate() # Start invalidating function every n miliseconds

      # Format string to print
      curr.font <- sample(colours(distinct=T), 1) 
      curr.txt  <- sprintf('<font color="%s"> %4.2f</font> seconds from start <br>', curr.font, ctm[[3]]) 
      startTxt  <<- paste(startTxt, curr.txt, collapse = '')

      # Call custom javascript to scroll window
      session$sendCustomMessage(type = "scrollCallback", 1)

      return(startTxt)
    })
  }

  observeEvent(input$go,{
    startPrint()
  })
}

runApp(shinyApp(ui,server))

这里的诀窍是，每次更新文本输出时，我都会调用 Javascript 函数来滚动 div。让我知道这个答案是否令人费解。