In this post, we write a shiny app that lets you display and modify data that is stored in a database table.

Shiny and Databases

Everybody loves Shiny, and rightly so. It lets you publish reproducible research, brings R applications to non-R users, and can even serve as a general purpose GUI for R code.

However, sometimes I’m surprised how difficult some basic tasks are. For example, creating a CRUD screen for a database table (CRUD stands for Create, Read, Update and Delete), is often one of the first examples in web frameworks.

To be fair, working with databases is not what most R-people do, and writing business applications is not what Shiny has been built for either. However, multiple of my customers do exactly that: They have a database (mysql, MongoDB, or other), store data in it, and write lots of financial models in R. They use Shiny to build interactive dashboards and to verify the P&L during the trading day. Some of them have only R know-how, so it’s natural for them to ask to leverage that know-how by writing Shiny apps that let them maintain their data directly from their browser.

This post shows you step by step how to build a Shiny app that lets you create, update and delete data in a table.

You can see the app in action here: https://gluc.shinyapps.io/crud

The full source-code is in this gist.

Prerequisites

Basic understanding of Shiny and reactivity is certainly helpful to read this article. If you want to build this app yourself and play with it, all you need is RStudio and a recent version of R. You won’t need MySQL or MongoDB or any other database, because we abstracted that part away. In fact, we’ll work with an in-memory database, aka data.frame

Shiny UI

Let’s start with the UI, as this is very simple and straight forward: In the top part of our browser window, we want to display a DataTable reflecting the database table. Below it, we show a group of inputs (one for each column), that lets us create new records, or modify existing records. Finally, a few action buttons complement our CRUD screen:

ui <- fluidPage(
  #use shiny js to disable the ID field
  shinyjs::useShinyjs(),
  
  #data table
  DT::dataTableOutput("responses", width = 300), 
  
  #input fields
  tags$hr(),
  textInput("id", "Id", "0"),
  textInput("name", "Name", ""),
  checkboxInput("used_shiny", "Used Shiny", FALSE),
  sliderInput("r_num_years", "R Years", 0, 25, 2, ticks = FALSE),
  
  #action buttons
  actionButton("submit", "Submit"),
  actionButton("new", "New"),
  actionButton("delete", "Delete")
)

Shiny Server

The server part is almost equally simple: We define reactive events for

• the inputs, as a group
• the action buttons
• the DataTable row selection

Finally, we render the table.

server <- function(input, output, session) {
  
  # input fields are treated as a group
  formData <- reactive({
    sapply(names(GetTableMetadata()$fields), function(x) input[[x]])
  })
  
  # Click "Submit" button -> save data
  observeEvent(input$submit, {
    if (input$id != "0") {
      UpdateData(formData())
    } else {
      CreateData(formData())
      UpdateInputs(CreateDefaultRecord(), session)
    }
  })
  
  # Press "New" button -> display empty record
  observeEvent(input$new, {
    UpdateInputs(CreateDefaultRecord(), session)
  })
  
  # Press "Delete" button -> delete from data
  observeEvent(input$delete, {
    DeleteData(formData())
    UpdateInputs(CreateDefaultRecord(), session)
  })
  
  # Select row in table -> show details in inputs
  observeEvent(input$responses_rows_selected, {
    if (length(input$responses_rows_selected) > 0) {
      data <- ReadData()[input$responses_rows_selected, ]
      UpdateInputs(data, session)
    }
    
  })

  shinyjs::disable("id")
  
  # display table
  output$responses <- DT::renderDataTable({
    #update after submit is clicked
    input$submit
    #update after delete is clicked
    input$delete
    ReadData()
  }, server = FALSE, selection = "single",
  colnames = unname(GetTableMetadata()$fields)[-1]
  )     
  
}

Helpers

If you read the above code, you’ll find a few methods that do … stuff. As this “stuff” is done in more than one location, we factor it out into helper methods.

This method casts from the inputs to a one-row data.frame. We use it, for instance, when the user creates a new record by typing in values into the inputs, and then clicks “Submit”:

CastData <- function(data) {
  datar <- data.frame(name = data["name"], 
                      used_shiny = as.logical(data["used_shiny"]), 
                      r_num_years = as.integer(data["r_num_years"]),
                      stringsAsFactors = FALSE)

  rownames(datar) <- data["id"]
  return (datar)
}

This creates an empty record, to be used e.g. to fill the inputs with the default values when the user clicks the “New” button:

CreateDefaultRecord <- function() {
  mydefault <- CastData(list(id = "0", name = "", used_shiny = FALSE, r_num_years = 2))
  return (mydefault)
}

And this method takes the data as selected in the DataTable, and updates the inputs with the respective values:

UpdateInputs <- function(data, session) {
  updateTextInput(session, "id", value = unname(rownames(data)))
  updateTextInput(session, "name", value = unname(data["name"]))
  updateCheckboxInput(session, "used_shiny", value = as.logical(data["used_shiny"]))
  updateSliderInput(session, "r_num_years", value = as.integer(data["r_num_years"]))
}

This function finds the next ID of a new record. In mysql, this could be done by an incremental index, automatically. But here, we do it manually, ourselves:

GetNextId <- function() {
  if (exists("responses")) {
    max(as.integer(rownames(responses))) + 1
  } else {
    return (1)
  }
}

CRUD Methods

The methods that mimic the actual CRUD functionality are then straight forward.

Create

CreateData <- function(data) {
  
  data <- CastData(data)
  rownames(data) <- GetNextId()
  if (exists("responses")) {
    responses <<- rbind(responses, data)
  } else {
    responses <<- data
  }
}

Read

ReadData <- function() {
  if (exists("responses")) {
    responses
  }
}

Update

UpdateData <- function(data) {
  data <- CastData(data)
  responses[row.names(responses) == row.names(data), ] <<- data
}

Delete

DeleteData <- function(data) {
  responses <<- responses[row.names(responses) != unname(data["id"]), ]
}

The only thing that might not be straight forward is the GetTableMetadata function. We’ll use it as a starting point for further development, as described below. For now, it’s just a method that defines the names of the columns in our table:

GetTableMetadata <- function() {
  fields <- c(id = "Id", 
              name = "Name", 
              used_shiny = "Used Shiny", 
              r_num_years = "R Years")
  
  result <- list(fields = fields)
  return (result)
}

Database Binding

In order to hook the app with a “true” database, you will need to replace “responses” with your database. The good news: You can take whatever database, driver, and binding framework you want. The bad news: You will have to implement CreateData, ReadData, UpdateData, and DeleteData functions yourself.

Read this RStudio article for more about database binding.

Caveats

The app works in a multi-user environment, yet with limitations. For one thing, no transactions are implemented. As a result, the last person to click submit will simply win, and possibly overwrite another users changes without noticing. In many situations this is ok, but it certainly is not in a public web-application which is used by thousands of simultaneous users.

Furthermore, reactivity does not work cross-user. If another user changes a record, your DataTable will not automatically update. You will need to hit F5 for that.

Further Developments

Many of the hard-coded mentioning of the fields and labels could be generalised. Ideally, we would like to re-use the code for different tables. This is less difficult than what you might think. You need to generalise the GetTableMetadata function and return information on the field types (Text, Number, Boolean, Choice, etc.), derive the Input type (textInput, sliderInput, etc.), and create this code generically. If there is enough interest, I will build such an app in a future post.

Credits

The featured image is the record label of the Detroit industrial rock n’roll band CRUD, whose members probably know neither R nor Shiny. The converse may not be true, however, even though I have not heard a single song from them. In any case, I hope for them that this free publicity brings them many new fans.

The post Shiny CRUD App appeared first on ipub.