R中的D3表格篩選器Shiny update SQL服務器

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轉換輸出效果更好。但是由於格式化等簡單的優點，很難渲染圖像，如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") 
})