R Shiny - 在 modalDialog 中预选数据表的行和页

Question

下面的应用程序包含一个 selectInput 数据集 ID 和一个按钮 View details，单击该按钮会显示 modalDialog。模态对话框有一个数据表，其中包含有关 select 输入下拉列表中数据集的一些信息。

这是应用程序启动时的屏幕截图：

由于用户可以通过 select 下拉菜单中的选项或 select 数据表中的行来 select 数据集，因此我创建了一个反应值 rv$selectedRow 存储 selected 数据集的值。当模态被触发时，rv$selectedRow 取 input$data 的值。单击模态页脚中的 Select 按钮时，rv$selectedRow 将采用 input$dfs_rows_selected 的值，并更新 selectInput 以反映此新值。这是由下面代码中的两个 observeEvents 完成的。

当用户select一行，关闭模态再打开，我想要selected数据集的页和行 (input$data) 预 selected。我试图在 renderDT 调用中使用 selection = list(mode = 'single', selected = rv$selectedRow) 来实现这一点。正如您在屏幕截图中看到的那样，第 1 行应该是预先 select 编辑的，但事实并非如此。我觉得我在 renderDT 中的某处缺少 req()，但我不确定。 rv$selectedRow 的值在我将它打印到控制台时检查出来，所以我不知道为什么 renderDT 的 selected 参数不起作用。我也不确定如何存储 selected 行的页面。任何见解将不胜感激，因为我有点迷路。

应用程序如下：

library(shiny)
library(DT)

datasets = data.frame(cbind(id = seq_len(4), name = c('iris', 'mtcars', 'satellite', 'credit')))

# UI ----------------------------------------------------------------------
ui = fluidPage(

  selectInput('data', 'Select dataset:', choices = datasets$id),

  actionButton('view', 'View details')

)

# SERVER ------------------------------------------------------------------
server <- shinyServer(function(input, output, session) {

  rv = reactiveValues(selectedRow = NULL, selectedPage = NULL)

  # Opening the modal
  observeEvent(input$view, {

    rv$selectedRow = req(input$data)

    print(paste("selectedRow on 'View':", rv$selectedRow))

    showModal(modalDialog(
      title = 'Available datasets',

      tags$b('Click on a row to select a dataset.'),

      br(),

      br(), 

      DT::dataTableOutput('dfs'),

      easyClose = F,
      footer = tagList(
        modalButton('Cancel'), 
        bsButton('select', 'Select')
        )
      )
    )

  })


  # Rendering the DT - pre-selection of row not working
  output$dfs <- renderDT({

    print(paste("selectedRow on 'renderDT':", rv$selectedRow))

    datasets

  }, 

  options = list(
    # displayStart = selectedPage,
    pageLength = 2
    ),
  filter = 'top',
  selection = list(mode = 'single', selected = rv$selectedRow), 
  rownames = F

  )

  # Saving the selected row and updating the selectInput
  observeEvent(input$select, {

    rv$selectedRow = req(input$dfs_rows_selected)

    print(paste("selectedRow on 'Select':", rv$selectedRow))

    updateSelectInput(session = session, inputId = 'data', selected = datasets[rv$selectedRow, 1])

    removeModal(session)

  })
})

shinyApp(ui, server)

更新代码：

根据和下面 Wilmar 发布的那篇文章，在 renderDT 中使用 datatable() 似乎解决了问题 -

library(shiny)
library(DT)

datasets = data.frame(cbind(id = seq_len(4), name = c('iris', 'mtcars', 'satellite', 'credit')))

# UI ----------------------------------------------------------------------
ui = fluidPage(

  selectInput('data', 'Select dataset:', choices = datasets$id),

  actionButton('view', 'View details')

)

# SERVER ------------------------------------------------------------------
server <- shinyServer(function(input, output, session) {

  rv = reactiveValues(selectedRow = NULL, selectedPage = NULL)

  # Opening the modal
  observeEvent(input$view, {

    print(paste("selectedRow on 'View':", rv$selectedRow))

    showModal(modalDialog(
      title = 'Available datasets',

      tags$b('Click on a row to select a dataset.'),

      br(),

      br(), 

      DT::dataTableOutput('dfs'),

      easyClose = F,
      footer = tagList(
        modalButton('Cancel'), 
        bsButton('select', 'Select')
        )
      )
    )

  })

  # Rendering the DT - pre-selection of row not working
  output$dfs <- renderDataTable({

    r = rv$selectedRow

    print(paste("selectedRow on 'renderDT':", r))

    datatable(
      datasets, 
      options = list(
        displayStart = as.numeric(r)-1,
        pageLength = 2
      ),
      filter = 'top',
      selection = list(mode = 'single', selected = r), 
      rownames = F

    )

  }, server = F)


  # Saving the selected row and updating the selectInput
  observeEvent(input$select, {

    rv$selectedRow = req(input$dfs_rows_selected)

    print(paste("selectedRow on 'Select':", rv$selectedRow))

    updateSelectInput(session = session, inputId = 'data', selected = datasets[rv$selectedRow, 1])

    removeModal(session)

  })

  observe({

    rv$selectedRow = input$data

  })

})

shinyApp(ui, server)

Answer 1

我想这就是您要找的。您的第一个问题是您必须将 rv$selectedRow 转换为 numeric。其次，每次按下 "view" 按钮时都会重新呈现数据表。第三，你没有对你的 selectInput ("data") 做任何事情。

我将 rv$selectedRow 转换为 numeric，将您的 showModal 移至 ui 并为您的 selectInput 创建了一个观察者。另外，我把你的datafarme包裹在了datatable函数里，我觉得这样更方便一些。

工作示例：

library(shiny)
library(DT)
library(shinyBS)

datasets = data.frame(cbind(id = seq_len(4), name = c('iris', 'mtcars', 'satellite', 'credit')))

# UI ----------------------------------------------------------------------
ui = fluidPage(

  selectInput('data', 'Select dataset:', choices = datasets$id),

  actionButton('view', 'View details'),
  tags$head(tags$style("#df_popup .modal-footer{ display:none}
                       #df_popup .modal-header .close{display:none}")),
  bsModal("df_popup", title='Available datasets', trigger='view', 
    tags$b('Click on a row to select a dataset.'),

    br(),

    br(), 

    DT::dataTableOutput('dfs'),

    column(12, align='right',
      modalButton('Cancel'), 
      bsButton('select', 'Select')
    )
  )
)

# SERVER ------------------------------------------------------------------
server <- shinyServer(function(input, output, session) {

  rv = reactiveValues(selectedRow = NULL, selectedPage = NULL)

  # Rendering the DT - pre-selection of row not working
  output$dfs <- renderDT({
    print(paste("selectedRow on 'renderDT':", rv$selectedRow))
    datatable(datasets, options = list(
      # displayStart = selectedPage,
      pageLength = 2
    ),
    filter = 'top',
    selection = list(mode = 'single', selected=c(as.numeric(rv$selectedRow))), 
    rownames = F)
  }, 
  )


  # Saving the selected row and updating the selectInput
  observeEvent(input$select, {
    rv$selectedRow = req(input$dfs_rows_selected)
    print(paste("selectedRow on 'Select':", rv$selectedRow))
    updateSelectInput(session = session, inputId = 'data', selected = datasets[rv$selectedRow, 1])
    toggleModal(session, 'df_popup')
  })


  observeEvent(input$data, {
    rv$selectedRow = input$data
    print(paste("selectedRow on 'data':", rv$selectedRow))
  })


})

shinyApp(ui, server)

R Shiny - 在 modalDialog 中预选数据表的行和页

R Shiny - Pre-selecting the row and page of a datatable inside a modalDialog

r

shiny

dt

shiny-reactivity