Блог

При выполнении приведенного ниже кода MWE и, как показано на рисунке внизу, вводимые пользователем данные в матрицу, отображаемую в модальном диалоговом окне, приводят к сжатию матрицы. Чем больше столбцов пользователь вводит в матрицу, тем больше матрица сжимается, пока вы не останетесь с трудночитаемой матрицей.

Есть ли способ не позволять матрице сжиматься при добавлении столбцов, а вместо этого расширять вправо, когда пользователь использует полосу прокрутки для навигации влево/вправо? Этим утром я пытался вставить полосы прокрутки, но пока безуспешно.

Возможно, проблема заключается в shinyMatrix самой упаковке. Интересно, можно ли использовать таблицу DT, так как она хорошо представлена (с прокруткой) и 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)
 

Добавление изображений для отображения прокрутки модальных входов:

Вот подход, использующий library(shinyjs) :

Я завернул matrixInput его в div салфетку 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)