D3 Table Filter in R Shiny update SQL server - sql

Question

I am working on a project to update a SQL database with a Shiny app using D3 Table Filter.
I am able to query the server with different text inputs and the table will render with only those rows. The next step is to edit the table in the shiny app, and have that send a query back to the server to update it.
I have enabled editing in specific columns. How could I make an edit and have it send a query?
Thank you very much in advance.
Here is my code so far:
#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

I used rhandsontable. It works better as you can convert the output using hot_to_r. But because of it's simple excel like formatting, it's difficult to render images like DT
If only data, go ahead and use rhandsontable.
Eg.
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")
})