Updating PostgreSQL database from R shiny app - r

Question

Please suggest how to update PostgreSQL database from R shiny app. I would like to be able to update values in table "testUpdate" in a PostgreSQL database:
Update "YN" after a checkbox is checked in 'x1' Data-table.
Update "Note" after "save_changes" button is pressed.
I've created fake data so you could see how the app works. Alternatively, I've included the data source. I haven't found one method that works well with R. Please suggest an implementation.
library(dplyr)
library(dbplyr)
library(DBI)
library(DT)
library(data.table)
library(shinyjs)
library(shinydashboard)
library(shinycssloaders)
library(tidyr)
library(tableHTML)
library(shiny)
library(RPostgreSQL)
pool <- pool::dbPool(drv = dbDriver("PostgreSQL"),
dbname = "postgreDatabase",
host = "11.111.11.1",
port = '12342',
user = "fdc",
password = "password")
shinyApp(
ui = fluidPage(
tabPanel("Test",
sidebarLayout(position = "right",
sidebarPanel(id="sidebar",
(DT::dataTableOutput("y1"))),
mainPanel(
(DT::dataTableOutput("x1")))
))),
server = function(input, output, session) {
buttonInput <- function(FUN, len, id, ...) {
inputs <- character(len)
for (i in seq_len(len)) {
inputs[i] <- as.character(FUN(paste0(id, i), ...))
}
inputs
}
# create a character vector of shiny inputs
shinyInput = function(FUN, len, id, value, width) {
if (length(value) == 1) value <- rep(value, len)
inputs = character(len)
for (i in seq_len(len)) {
inputs[i] =
as.character(FUN(paste0(id, i), label = NULL, value = value[i], width = width))
}
inputs
}
# obtain the values of inputs
shinyValue = function(id, len, initial) {
vapply(seq_len(len), function(i) {
value = input[[paste0(id, i)]]
if (is.null(value)) initial[i] else value
}, FUN.VALUE = logical(1))
}
#created fake data so you can run the app without the db.
n = 10
YN = rep(c(FALSE, TRUE), times = c(5,5))
df1 = data.frame(
cb = shinyInput(checkboxInput, n, 'cb_',
value = YN, width='30px'),
month = month.abb[1:n],
YN = YN,
ID = seq_len(n),
stringsAsFactors = FALSE
)
#####alternatively data comes from table called "testUpdate"
testUpdate <- tbl(db_pool,"testUpdate") %>% collect()
testUpdate_cols <- testUpdate %>%
select(ID, month, YN, Note)
vals <- reactiveValues()
vals$Data <- data.table(
ID = seq_len(n),
Note = c("test notes", "testing", "changed", "serial number", "", "", "", "", "testing", ""),
'Update Note' = buttonInput(
FUN = actionButton,
len = n,
id = 'button_',
label = "?",
onclick = 'Shiny.onInputChange(\"GoToNoteClick\", this.id)'
)
)
observeEvent(input$GoToNoteClick, {
showModal(modal_modify)
})
modal_modify<-modalDialog(
fluidPage(
textAreaInput(
"run_notes",
label = "Notes:",
width = "100%",
height = "100px"
),
actionButton("save_changes", "Save changes")
),
size="l"
)
get_sel <- reactive({
w <- input$x1_rows_selected
df1[w,] -> out
print(out)
out
})
filterMain <- reactive({
req(input$x1_rows_selected)
w <- input$x1_rows_selected
id_sel <- df1[w,'ID']
print(id_sel)
vals$Data %>% filter(ID %in% id_sel) -> out
out
})
output$y1 <- DT::renderDataTable(
datatable(
{
filterMain()
}
,escape = FALSE,
#class = "display compact",
rownames=F,
selection='none',
options = list(
dom = 't', paging = FALSE, ordering = FALSE)
))
loopData = reactive({
values = shinyValue('cb_', n, initial = YN)
dat = df1
dat$cb = shinyInput(checkboxInput, n, 'cb_',
value = values,
width = '30px')
dat$YN = values
dat
})
observeEvent(input$save_changes, {
req(vals$Data)
selected_row=as.numeric(gsub("button_","",input$GoToNoteClick))
print(selected_row)
curid <- vals$Data[selected_row,1]
print(curid)
print(input$run_notes)
vals$Data$Note[vals$Data$ID %in% curid] <- input$run_notes
##write changes
#write data back to postgreSQL
qry = paste0("UPDATE SET Note = '';")
print(qry)
dbSendQuery(conn = db_pool, statement = qry)
removeModal()
#dbDisconnect(db_pool)
})
output$x1 = renderDT(
df1, class = "display compact",
escape = FALSE, selection = 'single', rownames=F,
options = list(
dom = 't', paging = FALSE, ordering = FALSE,
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
))
proxy = dataTableProxy('x1')
observe({
replaceData(proxy, loopData(), resetPaging = FALSE, rownames=F)
})
}
)

Answer 1

The database was updated using the following function from here:database bulk update
updateDB <- function(editedValue, id, field, pool, tbl){
conn <- poolCheckout(pool)
id = id
col = field
value = editedValue
query <- glue::glue_sql("UPDATE {`tbl`} SET
{`col`} = {value}
WHERE runid = {id}
", .con = conn)
dbExecute(conn, sqlInterpolate(ANSI(), query))
poolReturn(conn)
return(invisible())
}
onStop(function() {
poolClose(db_pool)
})
The functionally works great in Rstudio Server Pro, however doesn't work in a published app via Rstudio Connect. Any suggestion on how to make this work in Rstudio connect would be extremely helpful.
Thanks