I've made a Shiny app where you can edit the rows of the members table by clicking on the edit button. However, if there's any relational tables (such as program001) that was connected to the members table (and the Programs column of the members table depends on the program001 table), when clicking edit, the members table retained everything that was in the members table except for the Programs column selection. Is there a way for the edit to retain information from columns that are connected to other tables?
Here's my code:
members<- data.frame(Id=c(1,2,4,5,6),Member_Names = c("Sam","Daniel","Megan","Yeti", "Kate"), Member_Type = c("FULL","AFFILIATE","FULL","NONMEMBER","FULL"),Status = c("ACTIVE","ACTIVE","ACTIVE","INACTIVE","INACTIVE"), Programs = c("1","2","2;3","1;3","3"))
program001<- data.frame(Id=c(1,2,4),Title =c("Action Building Company","Hat Brimming Company","Lyric Breaking Company"),Label=c("ABC","HBC","LBC"))
t3 <- data.frame(program001$Id, program001$Title)
colnames(t3) <- c("Id","Name")
programchoices <- t3$Id
names(programchoices) <- t3$Name
t3a <- data.frame(program001$Id, program001$Label)
colnames(t3a) <- c("Id","Name")
modal_dialog_mem <- function(Member_Name,
selected_mt, Member_Type,
selected_Status, Status, selected_Programs,
Programs, programchoices, edit) {
if(edit) {
x <- "Submit Edits"
} else {
x <- "Add New Member"
}
shiny::modalDialog(
title = "Edit Member",
div(
class = "text-center",
div(
#style = "display: inline-block;",
shiny::textInput(inputId = "Member_Name",
label = "Member Name",
value = Member_Name,
placeholder = "Input Name"
)
),
div(
#style = "display: inline-block;",
shiny::selectInput(inputId = "Member_Type",
label = "Member Type",
selected = selected_mt,
choices = unique(Member_Type)
)
),
div(
#style = "display: inline-block;",
shiny::selectInput(inputId = "Status",
label = "Status",
selected = selected_Status,
choices = unique(Status)
)
),
div(
#style = "display: inline-block;",
shinyWidgets::virtualSelectInput(inputId = "Programs",
label = "Programs",
selected = selected_Programs,
choices = programchoices,
multiple = TRUE,
search = TRUE
)
)
),
size = 'm',
easyClose = TRUE,
footer = div(
class = "pull-right container",
shiny::actionButton(inputId = "final_edit_mem",
label = x,
icon = shiny::icon("edit"),
class = "btn-info"),
shiny::actionButton(inputId = "dismiss_modal_mem",
label = "Close",
class = "btn-danger")
)
) %>% shiny::showModal()
}
create_btns_mem <- function(x) {
x %>%
purrr::map_chr(~
paste0(
'<div class = "btn-group">
<button class="btn btn-sm action-button btn-info action_button" id="editmem_',
.x, '" type="button" onclick=get_id_mem(this.id)><i class="fas fa-edit"></i></button>
<button class="btn btn-sm action-button btn-danger action_button" id="deletemem_',
.x, '" type="button" onclick=get_id_mem(this.id)><i class="fa fa-trash-alt"></i></button></div>'
))
}
library(shinyWidgets)
library(shinydashboard)
library(shinyjs)
library(shinyFeedback)
library(shiny)
library(data.table)
library(dplyr)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "MEM"),
dashboardSidebar(menuItem("Data", tabName= "mem01", icon = icon("dashboard"), startExpanded= TRUE)),
dashboardBody(
useShinyjs(),
shinyFeedback::useShinyFeedback(),
tabItem(tabName = "mem01",fluidRow(box(
div(
class = "container",
style = "margin-top: 50px; overflow-y: scroll;overflow-x: scroll;",
DT::DTOutput(outputId = "dt_table_mem", width = "50%")
),
tags$style(type = "text/css", ".container-fluid {padding-left:16px;
padding-right:16px; margin-right:100px; margin-left:100px;}"),
width=12,
shiny::includeScript("script.js"))))))
server<- function(input, output) {
x <- create_btns_mem(members$Id)
members <- members %>%
dplyr::bind_cols(tibble("Buttons" = x))
output$dt_table_mem <- DT::renderDT(
{
shiny::isolate(rv_mem$df)
},
escape = F,
rownames = FALSE,
colnames = c("Member Name",
"Member Type", "Status", "Programs", "Buttons"),
options = list(initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#041E42', 'color': 'white', 'text-align': 'center'});",
"}"),
processing = FALSE)
)
proxy_mem <- DT::dataTableProxy("dt_table_mem")
shiny::observe({
DT::replaceData(proxy_mem, rv_mem$df, resetPaging = FALSE, rownames = FALSE)
})
Progresult0 <- character(length(members$Programs))
for (i in seq_along(members$Programs)) {
inds <- as.numeric(strsplit(members$Programs[i],";")[[1]])
Progresult0[i] <- paste(t3a$Name[na.omit(match(inds,t3a$Id))], collapse = ";")
}
members$Programs <- gsub(";", "\t \n",Progresult0)
rv_mem <- shiny::reactiveValues(
df = members %>%
dplyr::select(-Id),
dt_row = NULL,
add_or_edit = NULL,
editmem_button = NULL,
keep_track_id = max(members$Id) + 1
)
# when edit button is clicked, modal dialog shows current editable row filled out
shiny::observeEvent(input$current_id_mem, {
shiny::req(!is.null(input$current_id_mem) &
stringr::str_detect(input$current_id_mem,
pattern = "editmem"
))
rv_mem$dt_row <- which(stringr::str_detect(rv_mem$df$Buttons,
pattern = paste0("\\b", input$current_id_mem, "\\b")
))
df <- rv_mem$df[rv_mem$dt_row, ]
modal_dialog_mem(
Member_Name = df$Member_Name,
Member_Type = members$Member_Type, selected_mt = df$Member_Type,
Status = members$Status,
selected_Status = df$Status, Programs = members$Programs,
selected_Programs = df$Programs,
programchoices = programchoices,
edit = TRUE
)
rv_mem$add_or_edit <- NULL
})
# when final edit button is clicked, table will be changed
shiny::observeEvent(input$final_edit_mem, {
shiny::req(!is.null(input$current_id_mem) &
stringr::str_detect(input$current_id_mem, pattern = "editmem") &
is.null(rv_mem$add_or_edit))
rv_mem$edited_row <- dplyr::tibble(
Member_Name = input$Member_Name,
Member_Type = input$Member_Type,
Status = input$Status,
Programs = paste(input$Programs, collapse = ';'),
Buttons = rv_mem$df$Buttons[rv_mem$dt_row]
)
sql_row <- rv_mem$edited_row %>%
dplyr::select(-Buttons)
id <- rv_mem$df[rv_mem$dt_row, ][["Buttons"]] %>%
stringr::str_extract_all(pattern = "deletemem_[0-9]+") %>%
unlist() %>%
readr::parse_number()
query <- paste0(
"UPDATE Members SET ",
paste0(names(sql_row), "=", "'", unlist(c(gsub("'", "''",sql_row))), "'", collapse = ", "),
stringr::str_glue("WHERE id = {id}")
)
#DBI::dbSendQuery(
# con,
# query
#)
dbExecute(con,query)
#####END SQL PORTION
new_edit_row <- rv_mem$edited_row
Progresult0 <- character(length(new_edit_row$Programs))
for (i in seq_along(new_edit_row$Programs)) {
inds <- as.numeric(strsplit(new_edit_row$Programs[i],";")[[1]])
Progresult0[i] <- paste(t3a$Name[na.omit(match(inds,t3a$Id))], collapse = ";")
}
Progresult0 <- gsub(";", "\t \n",Progresult0)
new_edit_row$Programs <- Progresult0
####FRONT END END
rv_mem$df[rv_mem$dt_row, ] <- new_edit_row#rv_mem$edited_row
})
}
onStop(function() {
dbDisconnect(con)
})
shinyApp(ui, server)