从闪亮的 DTedit uiOutput 对象中获取选定的行

Question

我需要从 DTedit 表中捕获用户选择以构建其他表。

我已经从一个新的 DT 对象中使用了 input$

_rows_selected，但从 DTedit 对象中没有成功。

我怀疑我需要构建一些中间对象来捕获选择，但无法弄清楚。

我在下面的 DTedit 演示代码中添加了几行来说明我的问题。

感谢您的帮助

library(shiny)
library(RSQLite)
library(DTedit); # devtools::install_github('jbryer/DTedit')

# Code modified from: https://github.com/jbryer/DTedit/blob/master/inst/shiny_demo/app.R

##### Load books data.frame as a SQLite database
conn <- dbConnect(RSQLite::SQLite(), "books.sqlite")

if(!'books' %in% dbListTables(conn)) {
    books <- read.csv('books.csv', stringsAsFactors = FALSE)
    books$Authors <- strsplit(books$Authors, ';')
    books$Authors <- lapply(books$Authors, trimws) # Strip white space
    books$Authors <- unlist(lapply(books$Authors, paste0, collapse = ';'))
    books$id <- 1:nrow(books)
    books$Date <- paste0(books$Date, '-01-01')
    dbWriteTable(conn, "books", books, overwrite = TRUE)
}

getBooks <- function() {
    res <- dbSendQuery(conn, "SELECT * FROM books")
    books <- dbFetch(res)
    dbClearResult(res)
    books$Authors <- strsplit(books$Authors, ';')
    books$Date <- as.Date(books$Date)
    books$Publisher <- as.factor(books$Publisher)
    return(books)
}

##### Callback functions.
books.insert.callback <- function(data, row) {
    query <- paste0("INSERT INTO books (id, Authors, Date, Title, Publisher) VALUES (",
                    "", max(getBooks()$id) + 1, ", ",
                    "'", paste0(data[row,]$Authors[[1]], collapse = ';'), "', ",
                    "'", as.character(data[row,]$Date), "', ",
                    "'", data[row,]$Title, "', ",
                    "'", as.character(data[row,]$Publisher), "' ",
                    ")")
    print(query) # For debugging
    dbSendQuery(conn, query)
    return(getBooks())
}

books.update.callback <- function(data, olddata, row) {
    query <- paste0("UPDATE books SET ",
                    "Authors = '", paste0(data[row,]$Authors[[1]], collapse = ';'), "', ",
                    "Date = '", as.character(data[row,]$Date), "', ",
                    "Title = '", data[row,]$Title, "', ",
                    "Publisher = '", as.character(data[row,]$Publisher), "' ",
                    "WHERE id = ", data[row,]$id)
    print(query) # For debugging
    dbSendQuery(conn, query)
    return(getBooks())
}

books.delete.callback <- function(data, row) {
    query <- paste0('DELETE FROM books WHERE id = ', data[row,]$id)
    dbSendQuery(conn, query)
    return(getBooks())
}

##### Create the Shiny server
server <- function(input, output) {
    books <- getBooks()
    dtedit(input, output,
           name = 'books',
           thedata = books,
           edit.cols = c('Title', 'Authors', 'Date', 'Publisher'),
           edit.label.cols = c('Book Title', 'Authors', 'Publication Date', 'Publisher'),
           input.types = c(Title='textAreaInput'),
           input.choices = list(Authors = unique(unlist(books$Authors))),
           view.cols = names(books)[c(5,1,3)],
           callback.update = books.update.callback,
           callback.insert = books.insert.callback,
           callback.delete = books.delete.callback)
    
    # removed the second example
    
    # added for this post using 'input$books_rows_selected' to capture the required info
    output$selectedrow <- renderPrint({
      s <- input$books_rows_selected
      cat(paste0("selected ID:", s))
      if (length(s)) {
        cat(getBooks()[s,1])
      }
    })
}

##### Create the shiny UI
ui <- fluidPage(
    h3('Books'),
    uiOutput('books'),
    verbatimTextOutput('selectedrow') # added for this post
)

shinyApp(ui = ui, server = server)

【问题讨论】：

Answer 1

这是一个使用 my modified version (v2.2.3+) 或 jbryer's DTedit 的工作示例：

我修改后的DTedit 会返回反应值，包括$rows_selected（不过只能选择一行！）。

library(shiny)
library(RSQLite)
library(DTedit); # devtools::install_github('DavidPatShuiFong/DTedit')

# Code modified from: https://github.com/jbryer/DTedit/blob/master/inst/shiny_demo/app.R

##### Load books data.frame as a SQLite database
conn <- dbConnect(RSQLite::SQLite(), "books.sqlite")

if(!'books' %in% dbListTables(conn)) {
    books <- read.csv('books.csv', stringsAsFactors = FALSE)
    books$Authors <- strsplit(books$Authors, ';')
    books$Authors <- lapply(books$Authors, trimws) # Strip white space
    books$Authors <- unlist(lapply(books$Authors, paste0, collapse = ';'))
    books$id <- 1:nrow(books)
    books$Date <- paste0(books$Date, '-01-01')
    dbWriteTable(conn, "books", books, overwrite = TRUE)
}

getBooks <- function() {
    res <- dbSendQuery(conn, "SELECT * FROM books")
    books <- dbFetch(res)
    dbClearResult(res)
    books$Authors <- strsplit(books$Authors, ';')
    books$Date <- as.Date(books$Date)
    books$Publisher <- as.factor(books$Publisher)
    return(books)
}

##### Callback functions.
books.insert.callback <- function(data, row) {
    query <- paste0("INSERT INTO books (id, Authors, Date, Title, Publisher) VALUES (",
                    "", max(getBooks()$id) + 1, ", ",
                    "'", paste0(data[row,]$Authors[[1]], collapse = ';'), "', ",
                    "'", as.character(data[row,]$Date), "', ",
                    "'", data[row,]$Title, "', ",
                    "'", as.character(data[row,]$Publisher), "' ",
                    ")")
    print(query) # For debugging
    dbSendQuery(conn, query)
    return(getBooks())
}

books.update.callback <- function(data, olddata, row) {
    query <- paste0("UPDATE books SET ",
                    "Authors = '", paste0(data[row,]$Authors[[1]], collapse = ';'), "', ",
                    "Date = '", as.character(data[row,]$Date), "', ",
                    "Title = '", data[row,]$Title, "', ",
                    "Publisher = '", as.character(data[row,]$Publisher), "' ",
                    "WHERE id = ", data[row,]$id)
    print(query) # For debugging
    dbSendQuery(conn, query)
    return(getBooks())
}

books.delete.callback <- function(data, row) {
    query <- paste0('DELETE FROM books WHERE id = ', data[row,]$id)
    dbSendQuery(conn, query)
    return(getBooks())
}

##### Create the Shiny server
server <- function(input, output) {
    books <- getBooks()
    my_results <- dtedit(input, output,
           name = 'books',
           thedata = books,
           edit.cols = c('Title', 'Authors', 'Date', 'Publisher'),
           edit.label.cols = c('Book Title', 'Authors', 'Publication Date', 'Publisher'),
           input.types = c(Title='textAreaInput'),
           input.choices = list(Authors = unique(unlist(books$Authors))),
           view.cols = names(books)[c(5,1,3)],
           callback.update = books.update.callback,
           callback.insert = books.insert.callback,
           callback.delete = books.delete.callback)
    
    
    output$selectedrow <- shiny::eventReactive(
        my_results$rows_selected, ignoreInit = TRUE, {
            paste0("selected ID: ", my_results$rows_selected)
    })
    
}

##### Create the shiny UI
ui <- fluidPage(
    h3('Books'),
    uiOutput('books'),
    verbatimTextOutput('selectedrow') # added for this post
)

shinyApp(ui = ui, server = server)

运行此示例的任何人实际上都需要 .csv/.sqlite 文件，该文件在 jbryer DTedit 和我的修改版本中都可用。