Question

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

以下是启动时该应用的屏幕截图：

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

当用户选择一行，关闭模式并再次打开它时，我希望预先选择所选数据集（input$data）的页面和行。我尝试在selection = list(mode = 'single', selected = rv$selectedRow)调用中使用renderDT来实现这一点。正如您在屏幕快照中看到的那样，应该预先选择第1行，但不是。我觉得我在req()中某处缺少了renderDT，但不确定。当我将rv$selectedRow的值打印到控制台时，它的值会检出，因此我不知道为什么renderDT的选定参数不起作用。我也不确定如何存储所选行的页面。由于我有点迷茫，因此任何见解将不胜感激。

该应用程序如下：

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)

更新的代码：

根据this solution和下面由威尔玛（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。其次，您每次按下“查看”按钮时都将重新呈现数据表。第三，您对selectInput（“数据”）没有做任何事情。

我将rv$selectedRow转换为numeric，将您的showModal移至ui，并为您的selectInput创建了一个观察者。另外，我将您的数据仓库包装在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

1 个答案: