R Shiny更新SQL服务器中的D3表过滤器

Question

我正在开发一个项目，使用 D3 表过滤器使用 Shiny 应用程序更新 SQL 数据库。

我能够使用不同的文本输入查询服务器，并且表格将仅使用这些行呈现。下一步是在闪亮的应用程序中编辑表，然后将查询发送回服务器以更新它。

我已在特定列中启用编辑。如何进行编辑并让它发送查询？

非常感谢您。

到目前为止，这是我的代码：

#install.packages("devtools")
#devtools::install_github("ThomasSiegmund/D3TableFilter")

library(shiny)
library(htmlwidgets)
library(D3TableFilter)
library(RSQLite)
library(RODBCext)
library(sqldf)

dbhandle = odbcDriverConnect(connection = "driver={SQL Server};server= ... ;database= ... ;trusted_connection=true")
fulldata = sqlExecute(dbhandle, "SELECT * FROM ...", fetch = TRUE, stringsAsFactors = FALSE)



ui <- fluidPage(

  # Application title
  titlePanel("Patient Search"),

  sidebarLayout(

    sidebarPanel(
      textInput(inputId = "Id", label = "Search by Account Number, Date of Birth (YYYY-MM-DD) or Last Name"),               
      textInput(inputId = "NextAppt", label = "Search by Next Appointment (YYYY-MM-DD)"),
      submitButton(text = "Go!")
    ),

    mainPanel(
      title = 'Patient Search with D3 Table Filter in Shiny',
      fluidRow(
        column(width = 12, d3tfOutput('data'))
      )
    )
  )
)




# server.R
# --------------------------------------------------------
server <- shinyServer(function(input, output, session) {
  #this reactive will return the row numbers that will need to be returned in our table.
  #this could depend on any of our inputs: last name, DoB, account number, or next appointment
  search.criteria <- reactive({
    out <- c()
    outAppt <- c()
    if(grepl("\\d{4}\\-\\d{2}\\-\\d{2}", input$Id)==TRUE){
      out <- which(fulldata$PatientDOB==input$Id)
      print(out)
    } else if(grepl("\\d{5}", input$Id)==TRUE){
      out <- which(fulldata$AccountNo==input$Id)
    } else{
      out <- which(fulldata$PatientLastName==toupper(input$Id))
    }
    # filter for appointment
    if(grepl("\\d{4}\\-\\d{2}\\-\\d{2}", input$NextAppt)==TRUE){
      outAppt <- which(fulldata$NextAppt==input$NextAppt)
      if(length(out)){
        out <- intersect(out, outAppt)
      }else{
        out <- outAppt
      }
    }
    out
  })

  #make the output table
  output$data <- renderD3tf({
    # Define table properties
    tableProps <- list(
      btn_reset = TRUE,
      # alphabetic sorting for the row names column, numeric for all other columns
      col_types = c("string", rep("number", ncol(fulldata)))
    );

    d3tf(fulldata[search.criteria(),],
         tableProps = tableProps,
         extensions = list(
           list(name = "sort")
         ),
         showRowNames = TRUE,
     tableStyle = "table table-bordered",
     #this optional argument enables editing on these specific columns
     edit = c("col_49", "col_50", "col_51", "col_52", "col_53"));
})

  #NEED TO ADD SOMETHING HERE TO SEND QUERY TO SERVER WHEN USER EDITS

})


runApp(list(ui=ui,server=server))

Answer 1

我使用了 rhandsontable。它工作得更好，因为您可以使用 hot_to_r 转换输出。但是因为是简单的excel格式，所以很难像DT那样渲染图片

如果只有数据，请继续使用 rhandsontable。 例如。

rhandsontable(df) %>%
           hot_cols(colWidths = c(80,150,80,80,80,80,200,200,80,80,300,80,80), manualColumnResize = TRUE) %>%
           hot_col(2:13, renderer = "html") %>%
           hot_col(2:13, renderer = htmlwidgets::JS("safeHtmlRenderer")) %>%
           hot_col(1, renderer = "
                   function(instance, td, row, col, prop, value, cellProperties) {
                   var escaped = Handsontable.helper.stringify(value),
                   img;

                   if (escaped.indexOf('http') === 0) {
                   img = document.createElement('IMG');
                   img.src = value;

                   Handsontable.dom.addEvent(img, 'mousedown', function (e){
                   e.preventDefault(); // prevent selection quirk
                   });

                   Handsontable.dom.empty(td);
                   td.appendChild(img);
                   }
                   else {
                   // render as text
                   Handsontable.renderers.TextRenderer.apply(this, arguments);
                   }

                   return td;
                   }")
 })

 observeEvent(input$submitComments, {
     a = hot_to_r(input$upcomingAuctionsTable)
     # sqlSave(myConnUpcom, a, tablename = "test", rownames = FALSE, varTypes = c(date = "varchar(255)"))
     sqlUpdate(myConnUpcom, a, tablename = "temp", index = "item_id")
 })