Edit tables in a relational database

If it is your first time using editbl, make sure to first read the introductory vignette on how to work with relational databases (vignette("howto_relational_db")).

This document describes how make use of the {dm} package. This package is useful to extract relational data models out of a database into R. Which can help in setting up a correct configuration for editbl.

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(shiny)
library(editbl)
library(dm)

## ! Package igraph is not installed. dm will use a pure R fallback.
## ℹ Install igraph for better performance: `install.packages("igraph")`
## ℹ Set `options(dm.use_igraph = FALSE)` to suppress this message.

## 
## Attaching package: 'dm'

## The following object is masked from 'package:stats':
## 
##     filter

library(bslib)

## 
## Attaching package: 'bslib'

## The following object is masked from 'package:utils':
## 
##     page

Creating a database connection

The first thing you need is a database connection. Here we connect to an sqlite file, which is a portable database format.

tmpFile <- tempfile(fileext = ".sqlite")
file.copy(system.file("extdata", "chinook.sqlite", package = 'editbl'), tmpFile) 
conn <-   DBI::dbConnect(
    dbname = tmpFile,
    drv = RSQLite::SQLite()
)

Setting up the data model

dm <- dm::dm_from_con(conn, learn_keys = TRUE)

Fully fletched table editor

A relational database consists out of many normalized tables. This is a perfect model for storing data, since it avoids duplicate information. However, it often leads to rather incomprehensible tables with a lot of ‘id’ columns. The goal of this editor is therefore to give people the opportunity to edit a table in its ‘flat’ form. Meaning you join all tables with additional information based on these ‘id’ keys. See also this function of dm:

dm::dm_flatten_to_tbl(dm, "Album", .recursive = TRUE)

## # A query:  ?? x 4
## # Database: sqlite 3.53.3 [/tmp/RtmpPwEukR/filee0c3d1a01d1.sqlite]
##    AlbumId Title                                 ArtistId Name                
##      <int> <chr>                                    <int> <chr>               
##  1       1 For Those About To Rock We Salute You        1 AC/DC               
##  2       2 Balls to the Wall                            2 Accept              
##  3       3 Restless and Wild                            2 Accept              
##  4       4 Let There Be Rock                            1 AC/DC               
##  5       5 Big Ones                                     3 Aerosmith           
##  6       6 Jagged Little Pill                           4 Alanis Morissette   
##  7       7 Facelift                                     5 Alice In Chains     
##  8       8 Warner 25 Anos                               6 Antônio Carlos Jobim
##  9       9 Plays Metallica By Four Cellos               7 Apocalyptica        
## 10      10 Audioslave                                   8 Audioslave          
## # ℹ more rows

As you can see, providing the ArtistName to a user is way more convenient than just the ArtistId.

editbl::eDT can handle similar joins by its foreignTbls argument. Let us define a function that extracts the needed information from a dm object.

getForeignTbls <- function(dm, table){
  dm_fks <- dm::dm_get_all_fks(dm)
  dm_fks <- dm_fks[dm_fks$child_table == table,]
  tbl_list <- dm::dm_get_tables(dm)
  
  foreignTbls <- lapply(seq_len(nrow(dm_fks)), function(i){
      r <- dm_fks[i,]   
      x <- tbl_list[r$child_table][[1]]
      
      # Try to flatten the foreign tibble
      # Cyclic relations give errors, hence prevent those problems
      y <- tryCatch({
            tryCatch({
                # 1 try recursive flattening
                dm::dm_flatten_to_tbl(dm, !!(r$parent_table), .recursive = TRUE)
            },
              error = function(e){
                # 2 try non-recursive flattening
                dm::dm_flatten_to_tbl(dm, !!(r$parent_table), .recursive = FALSE)
            })
      },
      error = function(e){
        # 3 return table as  is
        tbl_list[r$parent_table][[1]]
      })
      
      child_fks <- unlist(r$child_fk_cols)
      parent_fks <- unlist(r$parent_key_cols)
      
      # Renaming of parent colums to avoid naming conflicts
      # Done a bit heuristically here for convenience.
      lookup <- parent_fks
      names(lookup) <- child_fks
      other_parent_cols <- setdiff(colnames(y), parent_fks)
      names(other_parent_cols) <- paste(r$parent_table, other_parent_cols, sep = '.')
      lookup <- c(lookup, other_parent_cols)
      y <- y %>% dplyr::rename(all_of(lookup))
      
      editbl::foreignTbl(
        x = x,
        y = y,
        by = child_fks,
        naturalKey = colnames(y)
    )
    
  })
  foreignTbls
  }

Next, let’s use this to build a shiny app.

tableUI <- function(id){
    ns <- NS(id)
    fluidPage(
        eDTOutput(id = ns('DT')),
        actionButton(inputId = ns('refresh'), label = 'refresh', icon = shiny::icon('arrow-rotate-left'))
    )
}

tableServer <- function(id, table, dm) {
  moduleServer(
      id,
      function(input, output, session) {
        ns <- session$ns
        rv <- reactiveValues(refresh = 0)
        tables <- dm::dm_get_tables(dm)
        
        output$selectUI <- renderUI({
          selectInput(ns('table'), label = 'table', choices = names(tables))  
        })
            
        observeEvent(input$refresh,{
            showModal(
            modalDialog(
                title = "Sure you want to refresh?",
                'Changes will be lost.',
                footer = div(
                actionButton(inputId= ns('confirmRefresh'), label='Yes'),
                modalButton('cancel')
                )
            )
        )
        })
        
        observeEvent(input$confirmRefresh,{
          shiny::removeModal()
          rv$refresh = rv$refresh + 1
        })
        
        data <- reactive({
              rv$refresh
              tables[table][[1]]
              })
        
        foreignTbls <-  reactive({
              getForeignTbls(dm, table)
              })
        
        eDT(
            id = "DT",
            data = data,
            foreignTbls = foreignTbls,
            in_place = TRUE
        )
          
        invisible()
      }
  )
}


dbUI <- function(id) {
  ns <- NS(id)
  page_fluid(
      uiOutput(outputId = ns('tablesUI'))
  )
}

dbServer <- function(id, dm) {
  moduleServer(
      id,
      function(input, output, session) {
        ns <- session$ns
        
        tables <- names(dm::dm_get_tables(dm))
        
        output$tablesUI <- renderUI({
            accordion(
            lapply(tables, function(x){
                 accordion_panel( 
                    title = x, 
                    tableUI(id=ns(paste0('DT_',x))) 
                  )
            }),
            id = 'tables',
            multiple = TRUE,
            open = FALSE
          )
        })
        
        servers <- lapply(tables, function(x){
            tableServer(id=paste0('DT_',x), table=x, dm=dm) 
        })
          
        invisible()
      }
  )
}

shiny::shinyApp( 
    ui = dbUI('id'),
    server =  function(input, output,session){
      dbServer('id', dm)
    })

Shiny applications not supported in static R Markdown documents

As you click the ‘edit’ button, you will notice you can now select rows from the referenced tables. This makes it easier to navigate compared to just having id’s to work with.

Edit tables in a relational database - dm package

Creating a database connection

Setting up the data model

Fully fletched table editor