r - 如何在 DT 数据表行中选择 html 选择输入小部件？ R

Question

我有以下 Shiny 的应用程序。

# GLOBAL ----
library(shiny)
library(DT)
library(readr)
library(dplyr)

SELECT = '<select year="" id="year-select">
    <option value="">--Please choose an option--</option>
    <option value="2014">2014</option>
    <option value="2015">2015</option>
    <option value="2016">2016</option>
</select>'



test_cars <- data.frame("Num" = c(1:5),
                        "Make" = c("Toyota","","","",""),
                        "Model" = c("Camry","","","",""))

test_cars$Year <- SELECT

# UI ----
ui <- navbarPage(
  title = 'Cars Editor',
  tabPanel("Cars Entry",DTOutput("table1")),
  tabPanel("About")
)

# SERVER ----
server <- function(input, output) {
  output$table1 <- renderDT({
    datatable(test_cars %>% select(!Num), editable = "all", escape = FALSE, extensions = 'Buttons',
              options = list(
                dom = 'Bfrtip',
                buttons =
                  list('copy', 'print', list(
                    extend = 'collection',
                    buttons = c('csv', 'excel', 'pdf'),
                    text = 'Download'
                  ))

              )
    )
  })

}
# Run app ----
shinyApp(ui = ui, server = server)

这给了我以下信息:我的目标是让用户从“年份”列中选择一个输入并将其保存到数据中。

但是当我点击下载时，我得到了 html 选择输入中的所有选项，而不是用户的选择。关于我应该如何处理这个问题有什么想法吗？

Answer 1

这可以通过一些自定义导出选项来完成。

library(shiny)
library(DT)
library(readr)
library(dplyr)

SELECT = '<select year="" id="year-select">
    <option value="">--Please choose an option--</option>
    <option value="2014">2014</option>
    <option value="2015">2015</option>
    <option value="2016">2016</option>
</select>'



test_cars <- data.frame("Num" = c(1:5),
                        "Make" = c("Toyota","","","",""),
                        "Model" = c("Camry","","","",""))

test_cars$Year <- SELECT

# UI ----
ui <- navbarPage(
    title = 'Cars Editor',
    tabPanel("Cars Entry",DTOutput("table1")),
    tabPanel("About")
)

# SERVER ----
server <- function(input, output) {
    output$table1 <- renderDT({
        datatable(test_cars %>% select(!Num), editable = "all", escape = FALSE, extensions = 'Buttons',
                  options = list(
                      dom = 'Bfrtip',
                      buttons =
                          list('copy', 'print', list(
                              extend = 'collection',
                              text = 'Download',
                              buttons = list('csv', 'excel', list(
                                  extend = "pdf",
                                  exportOptions = list(
                                      format = list(
                                          body = JS(
                                            "
                                              function(data, row, col, node) {
                                                  return $(node).has('select').length ?
                                                    $(node).find(':selected').text(): data
                                              }
                                            "
                                          )
                                      )
                                  )
                              ))
                          ))
                      
                  )
        )
    })
    
}

# Run app ----
shinyApp(ui = ui, server = server)

1. 本文以 pdf 导出选项为例，您可以对其他导出选项执行相同的操作。
2. 在导出数据时，我们添加了一个自定义 JS 函数来告诉 datatable 如何呈现 body。
3. 它检查单元格内是否有 select 标签，如果是，则从下拉列表中获取所选值，否则返回原始值。

阅读buttons.exportData了解详情。