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

Question

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

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

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

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)

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

Answer 1

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

我把它包裹matrixInput在一个divwith中style = "overflow-x: auto;"。

当将列添加到矩阵时，输入 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)