dbplyr_packages.qmd

# Building analytic pipelines for a data model {#sec-dbplyr_packages}

In the previous chapters we've seen that after connecting to a database we can create references to the various tables we've interested in it and write bespoke analytic code to query them. However, if we are working with the same database over and over again we are likely to want to build some tooling for tasks we are often performing.

To see how we can develop a data model with associated methods and functions we'll use the Lahman baseball data. We can see below how the data is stored across various related tables.

![](images/lahman.jpg)

## Defining a data model

```{r, message=FALSE, warning=FALSE, echo = TRUE}
library(dplyr)
library(dbplyr)
library(tidyr)
library(duckdb)
library(DBI)
library(Lahman)

db <- dbConnect(duckdb(), dbdir = ":memory:")
copy_lahman(db)
```

Instead of manually creating references to tables of interest as we go, we will write a function to create a single reference to the Lahman data.

```{r, message=FALSE, warning=FALSE, echo = TRUE}
lahmanFromCon <- function(con) {
  tables <- c(
    "AllstarFull", "Appearances", "AwardsManagers", "AwardsPlayers", "AwardsManagers",
    "AwardsShareManagers", "Batting", "BattingPost", "CollegePlaying", "Fielding",
    "FieldingOF", "FieldingOFsplit", "FieldingPost", "HallOfFame", "HomeGames",
    "LahmanData", "Managers", "ManagersHalf", "Parks", "People", "Pitching",
    "PitchingPost", "Salaries", "Schools", "SeriesPost", "Teams", "TeamsFranchises",
    "TeamsHalf"
  )
  lahmanRef <- purrr::set_names(tables, tables) |> 
               purrr::map(~ tbl(con, .))
  class(lahmanRef) <- c("lahman_ref", class(lahmanRef))
  lahmanRef
}
```

With this function we can now easily get references to all our lahman tables in one go using our `lahmanFromCon()` function.

```{r, message=FALSE, warning=FALSE}
lahman <- lahmanFromCon(db)

lahman$People |>
  glimpse()
```

::: {.callout-note collapse="true"}
## The dm package

In this chapter we will be creating a bespoke data model for our database. This approach can be further extended using the `dm` package, which also provides various helpful functions for creating a data model and working with it.

Similar to above, we can use `dm` to create a single object to access our database tables.

```{r, message=FALSE, warning=FALSE}
library(dm)
lahman_dm <- dm(batting = tbl(db, "Batting"), 
                people = tbl(db, "People"))
lahman_dm
```

Using this approach, we can make use of various utility functions. For example here we specify primary and foreign keys and then check that the key constraints are satisfied.

```{r, echo=TRUE}
lahman_dm <- lahman_dm %>%
  dm_add_pk(people, playerID) %>%
  dm_add_fk(batting, playerID, people) 

lahman_dm

dm_examine_constraints(lahman_dm)
```

For more information on the dm package see <https://dm.cynkra.com/index.html>
:::

## Creating functions for the data model

We can also now make various functions specific to our Lahman data model to facilitate data analyses. Given we know the structure of the data, we can build a set of functions that abstract away some of the complexities of working with data in a database.

Let's start by making a small function to get the teams players have played for. We can see that the code we use follows on from the last couple of chapters.

```{r, message = FALSE, warning = FALSE, echo = TRUE}
getTeams <- function(lahman, name = "Barry Bonds") {
  lahman$Batting |>
    dplyr::inner_join(
      lahman$People |>
        dplyr::mutate(full_name = paste0(nameFirst, " ", nameLast)) |>
        dplyr::filter(full_name %in% name) |>
        dplyr::select("playerID"),
      by = join_by(playerID)
    ) |>
    dplyr::select(
      "teamID",
      "yearID"
    ) |>
    dplyr::distinct() |>
    dplyr::left_join(lahman$Teams,
      by = dplyr::join_by(teamID, yearID)
    ) |>
    dplyr::select("name") |>
    dplyr::distinct()
}
```

Now we can easily get the different teams a player represented. We can see how changing the player name changes the SQL that is getting run behind the scenes.

```{r, message = FALSE, warning = FALSE, echo = TRUE}
getTeams(lahman, "Babe Ruth")
```

::: {.callout-note collapse="true"}
## Show query

```{r, message=FALSE, warning=FALSE, echo=FALSE}
getTeams(lahman, "Babe Ruth") |>
  show_query()
```
:::

```{r, message = FALSE, warning = FALSE, echo = TRUE}
getTeams(lahman, "Barry Bonds")
```

::: {.callout-note collapse="true"}
## Show query

```{r, message=FALSE, warning=FALSE, echo=FALSE}
getTeams(lahman, "Barry Bonds") |>
  show_query()
```
:::

::: {.callout-tip collapse="true"}
## Choosing the right time to collect data into R

The function `collect()` brings data out of the database and into R. When working with large datasets, as is often the case when interacting with a database, we typically want to keep as much computation as possible on the database side. In the case of our `getTeams()` function, for example, it does everything on the database side and so collecting will just bring out the result of the teams the person played for. In this case we could also use `pull()` to get our result out as a vector rather that a data frame.

```{r, message=FALSE, warning=FALSE}
getTeams(lahman, "Barry Bonds") |>
  collect()

getTeams(lahman, "Barry Bonds") |>
  pull()
```

In other cases however we may need to collect data so as to perform further analysis steps that are not possible using SQL. This might be the case for plotting or for other analytic steps like fitting statistical models. In such cases we should try to only bring out the data that we need (as we will likely have much less memory available on our local computer than is available for the database).
:::

Similarly we could make a function to add the a player's year of birth to a table.

```{r, message = FALSE, warning = FALSE, echo = TRUE}
addBirthCountry <- function(lahmanTbl){
  lahmanTbl |> 
    dplyr::left_join(lahman$People |> 
              dplyr::select("playerID", "birthCountry"),
              dplyr::join_by("playerID"))
}
```

```{r, message = FALSE, warning = FALSE, echo = TRUE}
lahman$Batting |>
  addBirthCountry()
```

::: {.callout-note collapse="true"}
## Show query

```{r, message=FALSE, warning=FALSE, echo=FALSE}
lahman$Batting |>
  addBirthCountry() |>
  show_query()
```
:::

```{r, message = FALSE, warning = FALSE, echo = TRUE}
lahman$Pitching |>
  addBirthCountry()
```

::: {.callout-note collapse="true"}
## Show query

```{r, message=FALSE, warning=FALSE, echo=FALSE}
lahman$Pitching |>
  addBirthCountry() |>
  show_query()
```
:::

We could then use our `addBirthCountry()` function as part of a larger query to summarise the proportion of players from each country over time (based on their presence in the batting table).

```{r, message = FALSE, warning = FALSE, echo = TRUE}
plot_data <- lahman$Batting |>
  select(playerID, yearID) |> 
  addBirthCountry() |>
  filter(yearID > 1960) |> 
  mutate(birthCountry = case_when(
    birthCountry == "USA" ~ "USA",
    birthCountry == "D.R." ~ "Dominican Republic",
    birthCountry == "Venezuela" ~ "Venezuela",
    birthCountry == "P.R." ~ "Puerto Rico ",
    birthCountry == "Cuba" ~ "Cuba",
    birthCountry == "CAN" ~ "Canada",
    birthCountry == "Mexico" ~ "Mexico",
    .default = "Other"
  )) |> 
  summarise(n = n(), .by = c("yearID", "birthCountry")) |> 
  group_by(yearID) |>
  mutate(percentage = n / sum(n) * 100) |> 
  ungroup() |> 
  collect()
```

::: {.callout-note collapse="true"}
## Show query

```{r, message=FALSE, warning=FALSE, echo=FALSE}
lahman$Batting |>
  select(playerID, yearID) |> 
  addBirthCountry() |>
  filter(yearID > 1960) |> 
  mutate(birthCountry = case_when(
    birthCountry == "USA" ~ "USA",
    birthCountry == "D.R." ~ "Dominican Republic",
    birthCountry == "Venezuela" ~ "Venezuela",
    birthCountry == "P.R." ~ "Puerto Rico ",
    birthCountry == "Cuba" ~ "Cuba",
    birthCountry == "CAN" ~ "Canada",
    birthCountry == "Mexico" ~ "Mexico",
    .default = "Other"
  )) |> 
  summarise(n = n(), .by = c("yearID", "birthCountry")) |> 
  group_by(yearID) |>
  mutate(percentage = n / sum(n) * 100) |> 
  ungroup() |> 
  show_query()
```
:::

```{r, message = FALSE, warning = FALSE, echo = TRUE}
library(ggplot2)
plot_data |> 
  ggplot() +
  geom_col(aes(yearID, 
              percentage, 
              fill = birthCountry), width=1) + 
  theme_minimal() + 
  theme(legend.title = element_blank(), 
        legend.position = "top")
    
```

::: {.callout-note collapse="true"}
## Defining methods for the data model

As part of our `lahmanFromCon()` function our data model object has the class "lahman_ref". Therefore as well as creating user-facing functions to work with our lahman data model, we can also define methods for this object.

```{r, message=FALSE, warning=FALSE}
class(lahman)
```

With this we can make some specific methods for a "lahman_ref" object. For example, we can define a print method like so:

```{r, message=FALSE, warning=FALSE}
print.lahman_ref <- function(x, ...) {
  len <- length(names(x))
  cli::cli_h1("# Lahman reference - {len} tables")
  cli::cli_li(paste(
    "{.strong tables:}",
    paste(names(x), collapse = ", ")
  ))
  invisible(x)
}
```

Now we can see a summary of our lahman data model when we print the object.

```{r, echo = TRUE}
lahman
```

And we can see that this print is being done by the method we defined.

```{r, message = FALSE, warning = FALSE, echo = TRUE}
library(sloop)
s3_dispatch(print(lahman))
```
:::

## Building efficient analytic pipelines

### The risk of "clean" R code

Following on from the above approach, we might think it a good idea to make another function `addBirthYear()`. We can then use it along with our `addBirthCountry()` to get a summarise average salary by birth country and birth year.

```{r, message = FALSE, warning = FALSE, echo = TRUE}
addBirthYear <- function(lahmanTbl){
  lahmanTbl |> 
    left_join(lahman$People |> 
              select("playerID", "birthYear"),
              join_by("playerID"))
}

lahman$Salaries |> 
  addBirthCountry() |> 
  addBirthYear() |> 
  summarise(average_salary = mean(salary), 
            .by = c("birthCountry", "birthYear"))
```

Although the R code on the face of it looks fine, when we look at the SQL we can see that our query has two joins to the People table. One join gets information on the birth country and the other on the birth year.

::: {.callout-note collapse="true"}
## Show query

```{r, message=FALSE, warning=FALSE, echo=FALSE}
lahman$Salaries |> 
  addBirthCountry() |> 
  addBirthYear() |> 
  summarise(average_salary = mean(salary), 
            .by = c("birthCountry", "birthYear")) |> 
  show_query()
```
:::

To improve performance, we could instead have a single function to get both of these, birth country and birth year, at the same time.

```{r, message = FALSE, warning = FALSE, echo = TRUE}
addCharacteristics <- function(lahmanTbl){
  lahmanTbl |> 
    left_join(lahman$People |> 
              select("playerID", "birthYear", "birthCountry"),
              join_by("playerID"))
}

lahman$Salaries |> 
  addCharacteristics() |> 
  summarise(average_salary = mean(salary), 
            .by = c("birthCountry", "birthYear"))
```

::: {.callout-note collapse="true"}
## Show query

```{r, message=FALSE, warning=FALSE, echo=FALSE}
lahman$Salaries |> 
  addCharacteristics() |> 
  summarise(average_salary = mean(salary), 
            .by = c("birthCountry", "birthYear")) |> 
  show_query()
```
:::

Now this query outputs the same result but is simpler than the previous one, thus lowering the computational cost of the analysis. All this is to show that when working with databases we should keep in mind what is going on behind the scenes in terms of the SQL code actually being executed.

### Piping and SQL

Although piping functions has little impact on performance when using R with data in memory, when working with a database the SQL generated will differ when using multiple function calls (with a separate operation specified in each) instead of multiple operations within a single function call.

For example, a single mutate function creating two new variables would generate the below SQL.

```{r, echo = TRUE}
lahman$People |> 
  mutate(birthDatePlus1 = 
           add_years(birthDate, 1L),
         birthDatePlus10 = 
           add_years(birthDate, 10L)) |> 
  select("playerID", 
         "birthDatePlus1",
         "birthDatePlus10") |> 
  show_query()
```

Whereas the SQL will be different if these were created using multiple mutate calls (with now one being created in a sub-query).

```{r, echo = TRUE}
lahman$People |> 
  mutate(birthDatePlus1 = 
           add_years(birthDate, 1L)) |> 
  mutate(birthDatePlus10 = 
           add_years(birthDate, 10L)) |> 
  select("playerID", 
         "birthDatePlus1",
         "birthDatePlus10") |> 
  show_query()
```

### Computing intermediate queries

Let's say we want to summarise home runs in the batting table and stike outs in the pitching table by the college players attended and their birth year. We could do this like so:

```{r, echo = TRUE}
players_with_college <- lahman$People |> 
  select(playerID, birthYear) |> 
  inner_join(lahman$CollegePlaying |> 
              filter(!is.na(schoolID)) |> 
              select(playerID, schoolID) |> 
              distinct(),
            by = join_by(playerID))

lahman$Batting |> 
  left_join(players_with_college,
            by = join_by(playerID)) |> 
  summarise(home_runs = sum(H, na.rm = TRUE), 
                        .by = c(schoolID, birthYear)) |> 
  collect()

lahman$Pitching |> 
  left_join(players_with_college,
            by = join_by(playerID)) |> 
  summarise(strike_outs = sum(SO, na.rm = TRUE), 
                        .by = c(schoolID, birthYear))|> 
  collect()
```

Looking at the SQL we can see, however, that there is some duplication, because as part of each full query we have run our players_with_college query.

::: {.callout-note collapse="true"}
## Show query

```{r, message=FALSE, warning=FALSE, echo=FALSE}
lahman$Batting |> 
  left_join(players_with_college,
            by = join_by(playerID)) |> 
  summarise(home_runs = sum(H, na.rm = TRUE), 
                        .by = c(schoolID, birthYear)) |> 
  show_query()

lahman$Pitching |> 
  left_join(players_with_college,
            by = join_by(playerID)) |> 
  summarise(strike_outs = sum(SO, na.rm = TRUE), 
                        .by = c(schoolID, birthYear)) |> 
  show_query()
```
:::

To avoid this we could instead make use of the `compute()` function to force the computation of this first, intermediate, query to a temporary table in the database.

```{r, echo = TRUE}
players_with_college <- players_with_college |> 
  compute()
```

Now we have a temporary table with the result of our players_with_college query, and we can use this in both of our aggregation queries.

```{r, echo = TRUE}
players_with_college |> 
  show_query()
```

```{r, echo = TRUE}
lahman$Batting |> 
  left_join(players_with_college,
            by = join_by(playerID)) |> 
  summarise(home_runs = sum(H, na.rm = TRUE), 
                        .by = c(schoolID, birthYear)) |> 
  collect()

lahman$Pitching |> 
  left_join(players_with_college,
            by = join_by(playerID)) |> 
  summarise(strike_outs = sum(SO, na.rm = TRUE), 
                        .by = c(schoolID, birthYear))|> 
  collect()
```

::: {.callout-note collapse="true"}
## Show query

```{r, message=FALSE, warning=FALSE, echo=FALSE}
lahman$Batting |> 
  left_join(players_with_college,
            by = join_by(playerID)) |> 
  summarise(home_runs = sum(H, na.rm = TRUE), 
                        .by = c(schoolID, birthYear)) |> 
  show_query()

lahman$Pitching |> 
  left_join(players_with_college,
            by = join_by(playerID)) |> 
  summarise(strike_outs = sum(SO, na.rm = TRUE), 
                        .by = c(schoolID, birthYear)) |> 
  show_query()
```
:::

In this case the SQL from our initial approach was not so complicated. However, you can imagine that without using computation to intermediate tables, the SQL associated with a series of data manipulations could quickly become unmanageable. Moreover, we can end up with inefficient code that repeatedly gets the same result as part of a larger query. Therefore although we don't want to overuse computation of intermediate queries, it is often a necessity when creating our analytic pipelines.