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

Question

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

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

也许挑战在于 shinyMatrix 包本身。我想知道 DT Table 是否可以使用，因为它呈现得很好（滚动），shinyMatrix 作为 input/output 的后端引擎？包 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)

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

Answer 1

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

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

当列添加到矩阵时，input2 的宽度通过 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)

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

In R shiny, how to incorporate scrolling into modal dialog box?

r

modal-dialog

shiny

dt