This tutorial describes how to make a DataTable as shown below in Shiny with Add, Edit, Copy and Delete functionality. Entries are stored in a local SQL database which makes it possible to retrieve the data between sessions. The code can be downloaded from my github. Part of the code is based on the tutorial of Dean Attali on mimicking a Google form with a Shiny app.

Note: The app is deployed on my own server and therefore changes are saved. Shinyapps.io does not support local file storage and therefore entries will reset after a while.

Start

This tutorial will not go into the basics of making a Shiny app and requires already some experience building apps. For getting started see the Shiny webpage: How to build a Shiny app.

Downloading and installing packages

library(shiny)
library(DT)
library(RSQLite)
library(pool)
library(shinyjs)
library(uuid)
library(dplyr)

Create the SQL database and responses table

Create sql lite database

pool <- dbPool(RSQLite::SQLite(), dbname = "db.sqlite")

create the dataframe. The “row_id” column is used to store a unique identifier that can be used to identify each row.

responses_df <- data.frame(row_id = character(),
                           name = character(),
                           sex = character(),
                           age = character(), 
                           comment = character(),
                           date = as.Date(character()),
                           stringsAsFactors = FALSE)

Create responses table in sql database

dbWriteTable(pool, 
             "responses_df", 
             responses_df, 
             overwrite = FALSE, 
             append = TRUE)

Create function to label mandatory fields with a *

This function will be used later on to mark any fields in the entry form that are mandatory.

labelMandatory <- function(label) {
  tagList(
  label,
  span("*", class = "mandatory_star")
  )
}

appCSS <- ".mandatory_star { color: red; }"

User Interface

Create the action buttons and DataTable outputs

ui <- fluidPage(
  shinyjs::useShinyjs(),
  shinyjs::inlineCSS(appCSS),
  fluidRow(
    actionButton("add_button", "Add", icon("plus")),
    actionButton("edit_button", "Edit", icon("edit")),
    actionButton("copy_button", "Copy", icon("copy")),
    actionButton("delete_button", "Delete", icon("trash-alt"))
  ),
  br(),
   fluidRow(width="100%",
   dataTableOutput("responses_table", width = "100%")
  )
)

Server

server <- function(input, output, session) {

load the SQL table

Enter the inputs to make the df reactive to any input changes.

responses_df <- reactive({

input$submit
input$submit_edit
input$copy_button
input$delete_button

dbReadTable(pool, "responses_df")

})  

Toggle submit button

Enter the name of the fields that should be manditory to fill out.

fieldsMandatory <- c("name", "sex")

Function to observe if all mandatory fields are filled out. If TRUE the submit button will become activated.

observe({

  mandatoryFilled <-
  vapply(fieldsMandatory,
           function(x) {
           !is.null(input[[x]]) && input[[x]] != ""
           },
         logical(1))
  mandatoryFilled <- all(mandatoryFilled)

  shinyjs::toggleState(id = "submit", 
                      condition = mandatoryFilled)
})

Entry form

Function for the entry form that will pop-up in a model dialog when the Add and Edit buttons are pressed.

 entry_form <- function(button_id){

 showModal(
    modalDialog(
      div(id=("entry_form"),
         tags$head(tags$style(".modal-dialog{ width:400px}")), #Modify the width of the dialog
         tags$head(tags$style(HTML(".shiny-split-layout > div {overflow: visible}"))), #Necessary to show the input options
          fluidPage(
            fluidRow(
              splitLayout(
                cellWidths = c("250px", "100px"),
                cellArgs = list(style = "vertical-align: top"),
                textInput("name", labelMandatory("Name"), placeholder = ""),
                selectInput("sex", labelMandatory("Sex"), multiple = FALSE, choices = c("", "M", "F"))
              ),
              sliderInput("age", "Age", 0, 100, 1, ticks = TRUE, width = "354px"),
              textAreaInput("comment", "Comment", placeholder = "", height = 100, width = "354px"),
              helpText(labelMandatory(""), paste("Mandatory field.")),
              actionButton(button_id, "Submit")
            ),
            easyClose = TRUE
          )
       )
    )
  )
 }

Add Data

Function to save the data into df format.

formData <- reactive({

  formData <- data.frame(row_id = UUIDgenerate(),
                         name = input$name,
                         sex = input$sex,
                         age = input$age, 
                         comment = input$comment,
                         date = as.character(format(Sys.Date(), format="%d-%m-%Y")),
                         stringsAsFactors = FALSE)
  return(formData)
})

Function to append data to the SQL table

appendData <- function(data){
  quary <- sqlAppendTable(pool, "responses_df", data, row.names = FALSE)
  dbExecute(pool, quary)
}

When add button is clicked it will activate the entry_form with an action button called submit. Priority is added in order to make sure that no reactive values are updated untill the event is finished.

observeEvent(input$add_button, priority = 20,{

    entry_form("submit")

})

When the submit button is clicked the formdata is appended to the SQL table, the values in the form are reset and the modal is removed.

observeEvent(input$submit, priority = 20,{

  appendData(formData())
  shinyjs::reset("entry_form")
  removeModal()

})

Delete Data

Function to delete the selected row(s) from the SQL database. The unique row_id is used to identify which row has been selected.

deleteData <- reactive({

  SQL_df <- dbReadTable(pool, "responses_df")
  row_selection <- SQL_df[input$responses_table_rows_selected, "row_id"]

  quary <- lapply(row_selection, function(nr){
  dbExecute(pool, sprintf('DELETE FROM "responses_df" WHERE "row_id" == ("%s")', nr))
  })
})

Delete rows when selected. Otherwise display error message.

observeEvent(input$delete_button, priority = 20,{

  if(length(input$responses_table_rows_selected)>=1 ){
  deleteData()
  }

showModal(

   if(length(input$responses_table_rows_selected) < 1 ){
     modalDialog(
      title = "Warning",
      paste("Please select row(s)." ),easyClose = TRUE
      )
    })
})

Copy Data

Function to add unique IDs to any rows that are copied

unique_id <- function(data){
 replicate(nrow(data), UUIDgenerate())
}

Function to copy data. selected rows are filtered from the SQL_df by row_id. The row_ids are replaced with new ones and the data is appended to the SQL_df.

copyData <- reactive({

  SQL_df <- dbReadTable(pool, "responses_df")
  row_selection <- SQL_df[input$responses_table_rows_selected, "row_id"] 
  SQL_df <- SQL_df %>% filter(row_id %in% row_selection)
  SQL_df$row_id <- unique_id(SQL_df)

 quary <- sqlAppendTable(pool, "responses_df", SQL_df, row.names = FALSE)
 dbExecute(pool, quary)
})

Copy rows when rows are selected. Otherwise, display an error message.

observeEvent(input$copy_button, priority = 20,{

  if(length(input$responses_table_rows_selected)>=1 ){
    copyData()
  }

  showModal(

    if(length(input$responses_table_rows_selected) < 1 ){
      modalDialog(
        title = "Warning",
        paste("Please select row(s)." ),easyClose = TRUE
      )
    })
  })

Edit Data

Update form values with the selected row values. Errors are displayed if there are non or more then 1 row selected.

observeEvent(input$edit_button, priority = 20,{

  SQL_df <- dbReadTable(pool, "responses_df")

  showModal(
     if(length(input$responses_table_rows_selected) > 1 ){
      modalDialog(
        title = "Warning",
        paste("Please select only one row." ),easyClose = TRUE)
   } else if(length(input$responses_table_rows_selected) < 1){
      modalDialog(
        title = "Warning",
        paste("Please select a row." ),easyClose = TRUE)
    })  

  if(length(input$responses_table_rows_selected) == 1 ){

    entry_form("submit_edit")

    updateTextInput(session, "name", value = SQL_df[input$responses_table_rows_selected, "name"])
    updateSelectInput(session, "sex", selected = SQL_df[input$responses_table_rows_selected, "sex"])
    updateSliderInput(session, "age", value = SQL_df[input$responses_table_rows_selected, "age"])
    updateTextAreaInput(session, "comment", value = SQL_df[input$responses_table_rows_selected, "comment"])

  }

})

Update the selected row with the values that were entered in the form. Note that for identifying the selected row_id the “row_last_clicked” function is used instead of “rows_selected”. This is because upon showing the form module the row is deselected which results in a NULL when the rows_selected function is used.

observeEvent(input$submit_edit, priority = 20, {

 SQL_df <- dbReadTable(pool, "responses_df")
 row_selection <- SQL_df[input$responses_table_row_last_clicked, "row_id"] 
 dbExecute(pool, sprintf('UPDATE "responses_df" SET "name" = ?, "sex" = ?, "age" = ?,
                          "comment" = ? WHERE "row_id" = ("%s")', row_selection), 
            param = list(input$name,
                         input$sex,
                         input$age,
                         input$comment))
  removeModal()

})

Displaying the Data Table

Render the DataTable. The column with the row_id is hidden and the column names are changed to show capital letters.

output$responses_table <- DT::renderDataTable({

  table <- responses_df() %>% select(-row_id) 
  names(table) <- c("Date", "Name", "Sex", "Age", "Comment")
  table <- datatable(table, 
                     rownames = FALSE,
                     options = list(searching = FALSE, lengthChange = FALSE)
  )
})

}
shinyApp(ui = ui, server = server)

Done! You can now Add, Delete, Edit and Copy the data in the table and save it locally. Please be aware that local data storage is not supported on shinyapps.io but will work when you run your own Shiny server.