├── app.R ├── db.sqlite └── rsconnect └── shinyapps.io └── niels-van-der-velden ├── Editable_SQL_table.dcf └── sql_table.dcf /app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(DT) 3 | library(RSQLite) 4 | library(pool) 5 | library(shinyjs) 6 | library(uuid) 7 | library(dplyr) 8 | 9 | #Create sql lite database 10 | pool <- dbPool(RSQLite::SQLite(), dbname = "db.sqlite") 11 | 12 | #Create sql lite df 13 | responses_df <- data.frame(row_id = character(), 14 | name = character(), 15 | sex = character(), 16 | age = character(), 17 | comment = character(), 18 | date = as.Date(character()), 19 | stringsAsFactors = FALSE) 20 | 21 | #Create responses table in sql database 22 | dbWriteTable(pool, "responses_df", responses_df, overwrite = FALSE, append = TRUE) 23 | 24 | #Label mandatory fields 25 | labelMandatory <- function(label) { 26 | tagList( 27 | label, 28 | span("*", class = "mandatory_star") 29 | ) 30 | } 31 | 32 | appCSS <- ".mandatory_star { color: red; }" 33 | 34 | # ui 35 | ui <- fluidPage( 36 | shinyjs::useShinyjs(), 37 | shinyjs::inlineCSS(appCSS), 38 | fluidRow( 39 | actionButton("add_button", "Add", icon("plus")), 40 | actionButton("edit_button", "Edit", icon("edit")), 41 | actionButton("copy_button", "Copy", icon("copy")), 42 | actionButton("delete_button", "Delete", icon("trash-alt")) 43 | ), 44 | br(), 45 | fluidRow(width="100%", 46 | dataTableOutput("responses_table", width = "100%") 47 | ) 48 | ) 49 | 50 | # Server 51 | server <- function(input, output, session) { 52 | 53 | #load responses_df and make reactive to inputs 54 | responses_df <- reactive({ 55 | 56 | #make reactive to 57 | input$submit 58 | input$submit_edit 59 | input$copy_button 60 | input$delete_button 61 | 62 | dbReadTable(pool, "responses_df") 63 | 64 | }) 65 | 66 | #List of mandatory fields for submission 67 | fieldsMandatory <- c("name", "sex") 68 | 69 | #define which input fields are mandatory 70 | observe({ 71 | 72 | mandatoryFilled <- 73 | vapply(fieldsMandatory, 74 | function(x) { 75 | !is.null(input[[x]]) && input[[x]] != "" 76 | }, 77 | logical(1)) 78 | mandatoryFilled <- all(mandatoryFilled) 79 | 80 | shinyjs::toggleState(id = "submit", condition = mandatoryFilled) 81 | }) 82 | 83 | #Form for data entry 84 | entry_form <- function(button_id){ 85 | 86 | showModal( 87 | modalDialog( 88 | div(id=("entry_form"), 89 | tags$head(tags$style(".modal-dialog{ width:400px}")), 90 | tags$head(tags$style(HTML(".shiny-split-layout > div {overflow: visible}"))), 91 | fluidPage( 92 | fluidRow( 93 | splitLayout( 94 | cellWidths = c("250px", "100px"), 95 | cellArgs = list(style = "vertical-align: top"), 96 | textInput("name", labelMandatory("Name"), placeholder = ""), 97 | selectInput("sex", labelMandatory("Sex"), multiple = FALSE, choices = c("", "M", "F")) 98 | ), 99 | sliderInput("age", "Age", 0, 100, 1, ticks = TRUE, width = "354px"), 100 | textAreaInput("comment", "Comment", placeholder = "", height = 100, width = "354px"), 101 | helpText(labelMandatory(""), paste("Mandatory field.")), 102 | actionButton(button_id, "Submit") 103 | ), 104 | easyClose = TRUE 105 | ) 106 | ) 107 | ) 108 | ) 109 | } 110 | 111 | # 112 | fieldsAll <- c("name", "sex", "age", "comment") 113 | 114 | #save form data into data_frame format 115 | formData <- reactive({ 116 | 117 | formData <- data.frame(row_id = UUIDgenerate(), 118 | name = input$name, 119 | sex = input$sex, 120 | age = input$age, 121 | comment = input$comment, 122 | date = as.character(format(Sys.Date(), format="%d-%m-%Y")), 123 | stringsAsFactors = FALSE) 124 | return(formData) 125 | 126 | }) 127 | 128 | #Add data 129 | appendData <- function(data){ 130 | quary <- sqlAppendTable(pool, "responses_df", data, row.names = FALSE) 131 | dbExecute(pool, quary) 132 | } 133 | 134 | observeEvent(input$add_button, priority = 20,{ 135 | 136 | entry_form("submit") 137 | 138 | }) 139 | 140 | observeEvent(input$submit, priority = 20,{ 141 | 142 | appendData(formData()) 143 | shinyjs::reset("entry_form") 144 | removeModal() 145 | 146 | }) 147 | 148 | #delete data 149 | deleteData <- reactive({ 150 | 151 | SQL_df <- dbReadTable(pool, "responses_df") 152 | row_selection <- SQL_df[input$responses_table_rows_selected, "row_id"] 153 | 154 | quary <- lapply(row_selection, function(nr){ 155 | 156 | dbExecute(pool, sprintf('DELETE FROM "responses_df" WHERE "row_id" == ("%s")', nr)) 157 | }) 158 | }) 159 | 160 | observeEvent(input$delete_button, priority = 20,{ 161 | 162 | if(length(input$responses_table_rows_selected)>=1 ){ 163 | deleteData() 164 | } 165 | 166 | showModal( 167 | 168 | if(length(input$responses_table_rows_selected) < 1 ){ 169 | modalDialog( 170 | title = "Warning", 171 | paste("Please select row(s)." ),easyClose = TRUE 172 | ) 173 | }) 174 | }) 175 | 176 | #copy data 177 | unique_id <- function(data){ 178 | replicate(nrow(data), UUIDgenerate()) 179 | } 180 | 181 | copyData <- reactive({ 182 | 183 | SQL_df <- dbReadTable(pool, "responses_df") 184 | row_selection <- SQL_df[input$responses_table_rows_selected, "row_id"] 185 | SQL_df <- SQL_df %>% filter(row_id %in% row_selection) 186 | SQL_df$row_id <- unique_id(SQL_df) 187 | 188 | quary <- sqlAppendTable(pool, "responses_df", SQL_df, row.names = FALSE) 189 | dbExecute(pool, quary) 190 | 191 | }) 192 | 193 | observeEvent(input$copy_button, priority = 20,{ 194 | 195 | if(length(input$responses_table_rows_selected)>=1 ){ 196 | copyData() 197 | } 198 | 199 | showModal( 200 | 201 | if(length(input$responses_table_rows_selected) < 1 ){ 202 | modalDialog( 203 | title = "Warning", 204 | paste("Please select row(s)." ),easyClose = TRUE 205 | ) 206 | }) 207 | 208 | }) 209 | 210 | #edit data 211 | observeEvent(input$edit_button, priority = 20,{ 212 | 213 | SQL_df <- dbReadTable(pool, "responses_df") 214 | 215 | showModal( 216 | if(length(input$responses_table_rows_selected) > 1 ){ 217 | modalDialog( 218 | title = "Warning", 219 | paste("Please select only one row." ),easyClose = TRUE) 220 | } else if(length(input$responses_table_rows_selected) < 1){ 221 | modalDialog( 222 | title = "Warning", 223 | paste("Please select a row." ),easyClose = TRUE) 224 | }) 225 | 226 | if(length(input$responses_table_rows_selected) == 1 ){ 227 | 228 | entry_form("submit_edit") 229 | 230 | updateTextInput(session, "name", value = SQL_df[input$responses_table_rows_selected, "name"]) 231 | updateSelectInput(session, "sex", selected = SQL_df[input$responses_table_rows_selected, "sex"]) 232 | updateSliderInput(session, "age", value = SQL_df[input$responses_table_rows_selected, "age"]) 233 | updateTextAreaInput(session, "comment", value = SQL_df[input$responses_table_rows_selected, "comment"]) 234 | 235 | } 236 | 237 | }) 238 | 239 | observeEvent(input$submit_edit, priority = 20, { 240 | 241 | SQL_df <- dbReadTable(pool, "responses_df") 242 | row_selection <- SQL_df[input$responses_table_row_last_clicked, "row_id"] 243 | dbExecute(pool, sprintf('UPDATE "responses_df" SET "name" = ?, "sex" = ?, "age" = ?, 244 | "comment" = ? WHERE "row_id" = ("%s")', row_selection), 245 | param = list(input$name, 246 | input$sex, 247 | input$age, 248 | input$comment)) 249 | removeModal() 250 | 251 | }) 252 | 253 | 254 | output$responses_table <- DT::renderDataTable({ 255 | 256 | table <- responses_df() %>% select(-row_id) 257 | names(table) <- c("Date", "Name", "Sex", "Age", "Comment") 258 | table <- datatable(table, 259 | rownames = FALSE, 260 | options = list(searching = FALSE, lengthChange = FALSE) 261 | ) 262 | 263 | }) 264 | 265 | } 266 | 267 | # Run the application 268 | shinyApp(ui = ui, server = server) 269 | 270 | -------------------------------------------------------------------------------- /db.sqlite: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nvelden/sql_table/6092aaabb36a45a52abec08cdbd93b45e93f78b3/db.sqlite -------------------------------------------------------------------------------- /rsconnect/shinyapps.io/niels-van-der-velden/Editable_SQL_table.dcf: -------------------------------------------------------------------------------- 1 | name: Editable_SQL_table 2 | title: Editable_SQL_table 3 | username: 4 | account: niels-van-der-velden 5 | server: shinyapps.io 6 | hostUrl: https://api.shinyapps.io/v1 7 | appId: 1083719 8 | bundleId: 2325652 9 | url: https://niels-van-der-velden.shinyapps.io/Editable_SQL_table/ 10 | when: 1565953208.23507 11 | asMultiple: FALSE 12 | asStatic: FALSE 13 | -------------------------------------------------------------------------------- /rsconnect/shinyapps.io/niels-van-der-velden/sql_table.dcf: -------------------------------------------------------------------------------- 1 | name: sql_table 2 | title: sql_table 3 | username: 4 | account: niels-van-der-velden 5 | server: shinyapps.io 6 | hostUrl: https://api.shinyapps.io/v1 7 | appId: 1077005 8 | bundleId: 2303785 9 | url: https://niels-van-der-velden.shinyapps.io/sql_table/ 10 | when: 1565346750.82084 11 | asMultiple: FALSE 12 | asStatic: FALSE 13 | --------------------------------------------------------------------------------