在 R 闪亮中，如何将滚动合并到模式对话框中？

Posted 2023-03-24

【中文标题】在 R 闪亮中，如何将滚动合并到模式对话框中？

【英文标题】：In R shiny, how to incorporate scrolling into modal dialog box?

【发布时间】：2021-11-27 07:35:26

【问题描述】：

在运行下面的 MWE 代码时，如底部图像所示，用户输入到模态对话框中呈现的矩阵会导致矩阵压缩。用户输入到矩阵中的列越多，矩阵压缩得越多，直到留下一个难以阅读的矩阵。

有没有办法在添加列时不允许矩阵压缩，而是向右扩展，用户使用滚动条向左/向右导航？今天早上我一直在尝试插入滚动条，但还没有运气。

也许挑战在于shinyMatrix 包本身。我想知道是否可以使用 DT Table，因为它呈现得很好（带有滚动），shinyMatrix 作为其输入/输出的后端引擎？ rhandsontable 包虽然很漂亮，但在模态对话框中效果不佳。

MWE 代码：

library(shiny)
library(shinyMatrix)

ui <- fluidPage(

  sidebarLayout(
    sidebarPanel(
      uiOutput("panel"),
      actionButton("show2nd","Show 2nd input (in modal)")
    ),
    mainPanel(plotOutput("plot1"))
  )
)

server <- function(input, output, session)
 
  output$panel <- renderUI(
    tagList(
      matrixInput("input1", 
        value = matrix(c(10,5), 1, 2, dimnames = list(c("1st input"),c("X|Y",""))),
        rows =  list(extend = FALSE, names = TRUE),
        cols =  list(extend = FALSE, 
                     delta = 1,
                     delete = FALSE,
                     names = TRUE, 
                     editableNames = FALSE,
                     multiheader=TRUE),
        class = "numeric"),
      helpText("Generate curves (X|Y):"),
    )
  )

  observeEvent(input$show2nd,
    showModal(
      modalDialog(
        matrixInput("input2", 
          value = if(isTruthy(input$input2))input$input2 else
                  matrix(c(input$input1[1,1],input$input1[1,2]), 1, 2, 
                          dimnames = list(c("2nd input"),c("X|Y",""))),
          rows =  list(extend = FALSE, names = TRUE),
          cols =  list(extend = TRUE, 
                       delta = 2,
                       delete = TRUE,
                       names = TRUE, 
                       editableNames = FALSE,
                       multiheader=TRUE
                       ),
          class = "numeric"),
    footer = modalButton("Close")
    ))
  )
  
  observe(
    req(input$input2)
    mm <- input$input2
    colnames(mm) <- trunc(1:ncol(mm)/2)+1 
    isolate(updateMatrixInput(session, "input2", mm))
  )
  
  output$plot1 <-renderPlot(
    req(input$input1)
    plot(rep(if(isTruthy(input$input2))input$input2[1,2] else 
            input$input1[1,2], times=10),ylab = "y")
  )
  


shinyApp(ui, server)

添加图像以显示模式输入的滚动：

【问题讨论】：

modalDialog 在闪亮的 1.7 中获得了 size 参数。你试过size = "xl"吗？

【参考方案1】：

这是一种使用library(shinyjs)的方法：

我用style = "overflow-x: auto;" 将matrixInput 包裹在div 中。

当向矩阵添加列时，输入 2 的宽度会通过 runjs 反应性地重新设置样式：

library(shiny)
library(shinyMatrix)
library(shinyjs)

ui <- fluidPage(
  shinyjs::useShinyjs(),
  sidebarLayout(
    sidebarPanel(
      uiOutput("panel"),
      actionButton("show2nd","Show 2nd input (in modal)")
    ),
    mainPanel(plotOutput("plot1"))
  )
)

server <- function(input, output, session)
  
  output$panel <- renderUI(
    tagList(
      matrixInput("input1", 
                  value = matrix(c(10,5), 1, 2, dimnames = list(c("1st input"),c("X|Y",""))),
                  rows =  list(extend = FALSE, names = TRUE),
                  cols =  list(extend = FALSE, 
                               delta = 1,
                               delete = FALSE,
                               names = TRUE, 
                               editableNames = FALSE,
                               multiheader=TRUE),
                  class = "numeric"),
      helpText("Generate curves (X|Y):"),
    )
  )
  
  observeEvent(input$show2nd,
    showModal(
      modalDialog(
        div(matrixInput("input2", 
                        value = if(isTruthy(input$input2))input$input2 else
                        matrix(c(input$input1[1,1],input$input1[1,2]), 1, 2, 
                                dimnames = list(c("2nd input"),c("X|Y",""))),
                        rows =  list(extend = FALSE, names = TRUE),
                        cols =  list(extend = TRUE, 
                                     delta = 2,
                                     delete = TRUE,
                                     names = TRUE, 
                                     editableNames = FALSE,
                                     multiheader=TRUE
                        ),
                        class = "numeric"), style = "overflow-x: auto;", id = "container"),
        footer = modalButton("Close")
      ))
  )
  
  observeEvent(c(input$show2nd, input$input2), 
    print(paste0('$("#input2").css("width","calc(100% + ', (dim(input$input2)[2]-2 + dim(input$input2)[2]%%2)*115, 'px")'))
    runjs(paste0('$("#input2").css("width","calc(100% + ', (dim(input$input2)[2]-2 + dim(input$input2)[2]%%2)*115, 'px")'))
    runjs("document.getElementById('container').scrollLeft += 1000;")
    # runjs("$('#container').scrollLeft(1000)")
  )
  
  observe(
    req(input$input2)
    mm <- input$input2
    colnames(mm) <- trunc(1:ncol(mm)/2)+1 
    isolate(updateMatrixInput(session, "input2", mm))
  )
  
  output$plot1 <- renderPlot(
    req(input$input1)
    plot(rep(if(isTruthy(input$input2))input$input2[1,2] else 
    input$input1[1,2], times=10),ylab = "y")
  )
  


shinyApp(ui, server)

【讨论】：

我现在只能说嗯，哇....太漂亮了...我什至怀疑是否有解决方案

如果有帮助请记得接受答案 - 干杯！

啊，我明白了 - 我们需要在打开模式后检查列数。观察者现在也在收听input$show2nd 请检查我的编辑。

添加了另一个 runjs 调用以在更新输入后自动向右滚动 (scrollLeft)。

忘记删除了。使用 scrollLeft 的另一种方式。