Meet geom_focus()

Map info to the description that belongs in the legend, and geom_focus() does the rest: it numbers the points 1, 2, 3 in data order, draws each number in a marker, and builds a legend whose keys carry the same numbers.

# install.packages("pak")
pak::pak("discindo/ggindex")

library(ggplot2)
library(ggindex)

sites <- data.frame(
  x = c(6, 7, 8, 9, 10),
  y = c(6, 9, 7, 10, 8),
  name = c("Library", "Main hall", "Sports centre", "Cafeteria", "Car park")
)

ggplot(sites, aes(x, y, info = name)) +
  geom_focus() +
  theme_minimal()

To choose the numbers yourself, for example a rank or a building code, map label as well. The legend is then sorted by label, so it reads in the same order as the numbers.

Focus on a few points

Usually only a handful of points deserve a number. Map focus to a logical variable and only those observations get a marker; add geom_point() underneath to show the rest.

cars <- mtcars
cars$model <- rownames(cars)
cars$rank <- rank(-cars$mpg, ties.method = "first")

ggplot(cars, aes(wt, mpg)) +
  geom_point(colour = "grey60") +
  geom_focus(aes(label = rank, focus = rank <= 5, info = model)) +
  scale_info_discrete("Most efficient") +
  labs(x = "Weight (1000 lbs)", y = "Miles per gallon")

See more on the package’s website: discindo.github.io/ggindex/

Some notes on packaging

Overall, providing an AUR package is a simple process. Using any existing PKGBUILD can serve as a template. However, I had to make changes to few PKGBUILDS because not all releases on GitHub follow the same directory structure. Also sometimes files were named differently then expected, for example having LICENSE.md instead of just LICENSE would promt changes to the packaging files.

Additionally, it seems the authors of these tools were not always too mindful of other tools that exist with the same name. This is the case with air (a Go package), ark (the KDE archiving tool), and rig (A random identity generator) where binaries for other purposes alreary exist in the Linux distribution, so renaming those to r-air, r-ark, and r-rig was necessary to avoid conflicts.

Anyway, hopefully people find these useful. And if you try them out please report any issues.

Setting up a Ducklake

Assuming you have opened a new Rstudio project with git enabled, and the duckdb package is installed on your system setting up Ducklake is as follows:

library("duckdb")

con <- dbConnect(duckdb(), dbdir=":memory:")

dbExecute(con, "INSTALL ducklake;")

dbExecute(con, "ATTACH 'ducklake:metadata.ducklake' AS r_ducklake;")

dbExecute(con, "USE r_ducklake;")

This creates a in memory duckdb database, installs the ducklake extension and then creates the ducklake on disk. In your project you will see two files: metadata.ducklake and metadata.ducklake.wal. The first one is a duckdb database with a different extension and the second is the write-ahead log that duckdb uses to manage the metadata.

If we close this connection (but if you do this remember to run the above again before continuing below:

dbDisconnect(con)

And then open the ducklake file with a database browser, for example the duckdb cli:

$ duckdb -ui metadata.ducklake 

you will see that it is a database with the tables as described on the specification overview for the table format.

Writing data to the ducklake

Next I will pretend that the mtcars dataset needs to be cleaned and aggregated. There may be a better datasets to give this example, but it is simple to see the steps like this. I am also using SQL but same can be achieved with dplyr or anything handy in R:

# Bronze: raw data
dbWriteTable(con, "bronze_mtcars", mtcars)

# Silver: filtered / cleaned
dbExecute(con, "
  CREATE TABLE silver_mtcars AS
  SELECT *, (mpg/mean(mpg) OVER()) AS mpg_norm
  FROM bronze_mtcars;
")

# Gold: aggregated summary
dbExecute(con, "
  CREATE TABLE gold_mtcars AS
  SELECT cyl, AVG(mpg) AS avg_mpg, AVG(mpg_norm) AS avg_mpg_norm
  FROM silver_mtcars
  GROUP BY cyl;
")

In the medallion architecture the first layer, the raw data, is called bronze, and in this case we just write the mtcars as is.

Then the second layer, the silver layer, we sort of clean these data. I have no idea if normalizing miles per gallon makes sense, but hey why not.

The final layer is about an aggregate summary, a gold layer, so group by and summarize is what is happening there.

If you run the above in your demo project you will notice new files created:

[metadata.ducklake.files]$ tree
.
└── main
    ├── bronze_mtcars
    │   └── ducklake-01996884-c393-7134-bee0-cbffb31e19c7.parquet
    ├── gold_mtcars
    │   └── ducklake-01996884-c3cd-7ae6-bcaa-0b69196040cb.parquet
    └── silver_mtcars
        └── ducklake-01996884-c3b5-7d9d-b9f8-05e3c8377bee.parquet

This is ducklake keeping track of your data in parquet format.

Next we need to make something to track the relationships between the tables. For now i think this is not supported in ducklake(v.0.0.3), but probably will be in the future.

Ideally the following should be executed as each table is written, but for sake of example it is below:

dbExecute(con, "
CREATE TABLE IF NOT EXISTS ducklake_lineage (
  parent_table VARCHAR,
  child_table  VARCHAR,
  created_at   TIMESTAMP,
  description  VARCHAR
);
")

# After creating a silver table from bronze
dbExecute(con, "
    INSERT INTO ducklake_lineage (parent_table, child_table, created_at, description)
    VALUES ('bronze_mtcars', 'silver_mtcars', NOW(), 'normalization / filtering');
")

# After creating gold table from silver
dbExecute(con, "
    INSERT INTO ducklake_lineage (parent_table, child_table, created_at, description)
    VALUES ('silver_mtcars', 'gold_mtcars', NOW(), 'aggregation');
")

Let’s imagine that we have done some more transformation and maybe created 2 more silver tables and one more gold table. Of course, the decription should be updated to make more sense:

dbExecute(con, "
    INSERT INTO ducklake_lineage (parent_table, child_table, created_at, description)
    VALUES ('bronze_mtcars', 'silver_mtcars_2', NOW(), 'normalization / filtering');
")

dbExecute(con, "
    INSERT INTO ducklake_lineage (parent_table, child_table, created_at, description)
    VALUES ('bronze_mtcars', 'silver_mtcars_3', NOW(), 'normalization / filtering');
")

dbExecute(con, "
    INSERT INTO ducklake_lineage (parent_table, child_table, created_at, description)
    VALUES ('silver_mtcars', 'gold_mtcars_2', NOW(), 'aggregation');
")

Visualize relationships among tables

Since digging trough the parquet files to see what the relationships between the tables are does not make much sense, we can use some of good old ggplot2 and friend magic to visualize that.

library(igraph)
library(ggraph)

edges <- dbGetQuery(con, "SELECT parent_table AS from_table, child_table AS to_table FROM ducklake_lineage")
g <- graph_from_data_frame(edges, directed = TRUE)

ggraph(g, layout = "tree") +
  geom_edge_diagonal(arrow = arrow(length = unit(4, 'mm')), end_cap = circle(3, 'mm')) +
  geom_node_point(shape = 15, size = 8, color = "steelblue", fill = "lightblue") + 
  geom_node_text(aes(label = name), vjust = -1.2, size = 4) +               
  coord_flip() +
  scale_y_reverse() +  
  theme_void() +       
  ggtitle("DuckLake Medallion Lineage")

This is the sort of a thing you get to see under the lineage in Databricks’ Unity Catalog, although not as elaborate. However, a proper ggplot2 wizard may succeed in making duplicating that view.

You can imagine having this plot as part of a Quarto report or a Shiny app with some interactivity to keep track of the transformations that happen to the data you are managing.

Summary

As we set out in the beginning we set up a Ducklake with R, wrote some data to it and visualized relationships among tables. While the example is trivial, I think it is obvious that this could be a useful approach for managing local pipelines and for prototyping things that could run on the cloud.

For local pipelines in particular, I can see this approach been used with something like {maestro} to orchestrate a data pipeline.

The code above is available as a gist.

Why is it named r-air?

Because there is already a binary named Air: a Go library Air. In order not to overwite the user’s system that may have the Go binary, the name of the binary for the formatter is r-air.

See more at the github discussion with Posit here.

Plumber API for filter and aggregate

The {plumber} API is organized in the form of an R package.

├── DESCRIPTION
├── inst
│   └── plumber.r
├── man
│   ├── dot-aggregate.Rd
│   ├── dot-filter.Rd
│   └── run_api.Rd
├── NAMESPACE
├── plumb.ex.Rproj
├── R
│   ├── api.r
│   └── funs.r
└── test.r

The R directory contains the script funs.r where I define the .filter and .aggregate functions I covered in the previous two posts. The .api.r script contains a single function that starts the API on our preferred host and port (defaults to localhost and 5000).

#' start plumber api
#' @param host the host address
#' @param port the port to use
#' @importFrom plumber pr pr_run pr_get
#' @export
run_api <- function(port = 5000, host = "127.0.0.1") {
  path <- system.file("plumber.r", package = "plumb.ex")
  path |>
    pr() |>
    pr_run(port = port, host = host)
}

This is similar to {golem}’s run_app() function and it streamlines the development cycle. Whenever I make updates to the underlying code in funs.r or the {plumber} endpoints in inst/plumber.r, I can run:

devtools::document() # re-documents and loads all functions 
run_api()

and that would start the API making it accessible at http://127.0.0.1:5000, with the {swagger} interface for manual testing at http://127.0.0.1:5000/__docs__/. It is then ready for queries.

Endpoints

The package exports the .filter and .aggregate functions. Then the API uses these when defining the endpoints. In this example API we have three endpoints defined in inst/plumber.r:

# plumber.R.

#* @plumber
#* @apiTitle Plumber filter or aggregate
#* @apiDescription Plumber example for dynamic filtering and aggregation
#* @apiVersion 1.0.0
function(pr) {
  pr |>
    plumber::pr_set_serializer(plumber::serializer_unboxed_json())
}

#* Hello
#* @get /hello
function() {
  "Hello, there!"
}

#* Filter
#* @param data the name of the data frame to filter, `"iris"` or `"mtcars"`
#* @param instructions_list a list of instructions for aggregation.
#* @post /filter
function(data, instructions_list) {
  d <- get(data)
  l <- jsonlite::fromJSON(instructions_list, simplifyVector = FALSE)
  .filter(d, l)
}

#* Aggregate
#* @param data the name of the data frame to aggregate, `"iris"` or `"mtcars"`
#* @param instructions_list a list of instructions for aggregation.
#* @post /aggregate
function(data, instructions_list) {
  d <- get(data)
  l <- jsonlite::fromJSON(instructions_list, simplifyVector = FALSE)
  .aggregate(d, l)
}

The first is /hello and is simply a health check endpoint. Using httr2 we can make requests to it as follows:

r$> library(jsonlite)
    library(httr2)
 
    request("http://127.0.0.1:5000/hello") |>
      req_perform() |>
      resp_body_json()
[1] "Hello, there!"

The other two endpoints are simple wrappers around .filter and .aggregate to do two steps:

1. get the dataset requested by the user. For simplicity in this example, the dataset argument is passed on as a string, and then we user get to get that dataset, assuming its one of the ones prepackaged with R. But its easy to modify that and simply send JSON data to the endpoint.

2. convert the JSON received by the API into a list as required in R. This is needed because the instructions list for filtering or aggregation is sent with the request as JSON, and the validation within our functions expects a list. One could relax these requirement as well by allowing a JSON string in the instructions_list argument and parsing this internally.

Interactive demo

devtools::document() # re-documents and loads all functions 
run_api()

library(plumb.ex) # re-documents and loads all functions 
plumb.ex::run_api(port = 6000)

library(jsonlite)
library(httr2)

filter_data <- list(
  list(col = "Sepal.Length", fun = "between", min = 4.9, max = 5),
  list(col = "Species", fun = "in", val = c("setosa", "versicolor"))
)

filter_json <- jsonlite::toJSON(filter_data, auto_unbox = TRUE)
jsonlite::prettify(filter_json)

[
    {
        "col": "Sepal.Length",
        "fun": "between",
        "min": 4.9,
        "max": 5
    },
    {
        "col": "Species",
        "fun": "in",
        "val": [
            "setosa",
            "versicolor"
        ]
    }
]
 

request("http://127.0.0.1:6000") |>
  req_url_path("filter") |>
  req_body_json(
    data = list(data = "iris", instructions_list = filter_json),
    auto_unbox = TRUE
  ) |>
  req_perform() |>
  resp_body_json(simplifyVector = TRUE)

   Sepal.Length Sepal.Width Petal.Length Petal.Width    Species
1           4.9         3.0          1.4         0.2     setosa
2           5.0         3.6          1.4         0.2     setosa
3           5.0         3.4          1.5         0.2     setosa
4           4.9         3.1          1.5         0.1     setosa
5           5.0         3.0          1.6         0.2     setosa
6           5.0         3.4          1.6         0.4     setosa
7           4.9         3.1          1.5         0.2     setosa
8           5.0         3.2          1.2         0.2     setosa
9           4.9         3.6          1.4         0.1     setosa
10          5.0         3.5          1.3         0.3     setosa
11          5.0         3.5          1.6         0.6     setosa
12          5.0         3.3          1.4         0.2     setosa
13          4.9         2.4          3.3         1.0 versicolor
14          5.0         2.0          3.5         1.0 versicolor
15          5.0         2.3          3.3         1.0 versicolor

library(jsonlite)
library(httr2)

aggregate_instructions <- list(
  groups = list(col = "Species"),
  aggregates = list(
    list(col = "Sepal.Length", fun = "mean"),
    list(col = "Sepal.Width", fun = "mean")
  )
)

aggregate_json <- jsonlite::toJSON(aggregate_instructions, auto_unbox = TRUE)
jsonlite::prettify(aggregate_json)

{
    "groups": {
        "col": "Species"
    },
    "aggregates": [
        {
            "col": "Sepal.Length",
            "fun": "mean"
        },
        {
            "col": "Sepal.Width",
            "fun": "mean"
        }
    ]
}
 

request("http://127.0.0.1:5000") |>
  req_url_path("aggregate") |>
  req_body_json(
    data = list(data = "iris", instructions_list = aggregate_json),
    auto_unbox = TRUE
  ) |>
  req_perform() |>
  resp_body_json(simplifyVector = TRUE)

     Species Sepal.Length_mean Sepal.Width_mean
1     setosa              5.01             3.43
2 versicolor              5.94             2.77
3  virginica              6.59             2.97

How is this useful?

I struggle with this sometimes my self. Isn’t this why we have databases to begin with? Of course, having an API that queries a database would be preferable in most applications requiring large amounts of data. However, sometimes we don’t have the expertise, bandwidth, or budget for a database setup, or we could be working with local files, in arrow, parquet, qs or some other format where it might make sense or is justifiable to run the queries in R it self.

Summary

In this post, we demonstrated how to create a {plumber} API that provides endpoints for dynamic filtering and aggregation of datasets in R. We structured the API as an R package, defined the necessary functions, and set up the endpoints to handle JSON requests. We also provided examples of how to interact with the API using httr2 from R. This approach can be useful for scenarios where a database setup is not feasible, and we need to work with data files directly in R.

Dynamic aggregation

As with the dynamic filter, we want something of the form:

.aggregate(my_data, my_list_of_instructions)

For aggregation to work, we need to specify at least one grouping variable, and then the names and aggregation functions for the columns we would like to summarize. So the instructions list should have the form:

aggr_list <- list(
    groups = list(col = "group_var"),
    aggregates = list(
        list(col = "column 1", fun = "mean"),
        list(col = "column 2", fun = "sd"),
        ...
    )
)

To show an example, we could get the mean, median, and standard deviation of Sepal Length in species from the iris dataset:

d <- iris
l <- list(
  groups = list(col = "Species"),
  aggregates = list(
    list(col = "Sepal.Length", fun = "mean"),
    list(col = "Sepal.Length", fun = "median"),
    list(col = "Sepal.Length", fun = "sd")
  )
)
.aggregate(d, l)

Joining with `by = join_by(Species)`
Joining with `by = join_by(Species)`

     Species Sepal.Length_mean Sepal.Length_median Sepal.Length_sd
1     setosa              5.01                 5.0            0.35
2 versicolor              5.94                 5.9            0.52
3  virginica              6.59                 6.5            0.64

As we can tell, we in the aggregates list, we can specify the same column multiple times, and the resulting table will only contain the columns for which we’ve specified an aggregation.

A more complex example would be to group on more than variable and summarize multiple columns. For example, group by cylinder, gear and carburetor and find the mean of miles per gallon, the total horse power and the median weight of cars in the mtcars dataset:

d <- mtcars
l <- list(
  groups = list(col = c("cyl", "gear", "carb")),
  aggregates = list(
    list(col = "mpg", fun = "mean"),
    list(col = "hp", fun = "sum"),
    list(col = "wt", fun = "median")
  )
)
.aggregate(d, l)

Joining with `by = join_by(cyl, gear, carb)`
Joining with `by = join_by(cyl, gear, carb)`

   cyl gear carb mpg_mean hp_sum wt_median
1    6    4    4    19.75    466      3.16
2    4    4    1    29.10    290      2.07
3    6    3    1    19.75    215      3.34
4    8    3    2    17.15    650      3.48
5    8    3    4    12.62   1140      5.25
6    4    4    2    24.75    318      2.96
7    8    3    3    16.30    540      3.78
8    4    3    1    21.50     97      2.46
9    4    5    2    28.20    204      1.83
10   8    5    4    15.80    264      3.17
11   6    5    6    19.70    175      2.77
12   8    5    8    15.00    335      3.57

Neat. Again, the motivation here is not to replace the sweet {dplyr} syntax, rather to come up with a mechanism to do complex aggregation in one step, by creating an instructions list (or JSON) which, again, in {shiny} or {plumber} context would most likely be constructed programmatically.

How does it work?

Similar to our filtering function, we have two sections. First is input validation, again using {checkmate} because it’s awesome. We can make sure that the inputs are of correct type, that they are named, and that the columns specified as grouping and aggregation variables are present in the dataset. Likewise, we ensure that the requested aggregation functions are supported.

In the second section, we first convert the string passed to fun to a function, so it can be used downstream in dplyr::summarize. We do this with a helper function that can be called at the time summarize executes.

Then, we loop over the contents of the aggregates sub-list and apply each aggregation independently resulting in a list of aggregated datasets. For example, if we specified the mean, median, and sd for Sepal Length by Species, at this stage we would have a list of three data frames with the grouping column and another column representing the aggregate.

Finally, to collate the tables we use reduce with left_join, essentially joining the three data frames by species.

Note the nice argument .by for dplyr::summarize. In this case we just send the string from the groups$col slot in our instructions list. i.e we don’t need to use dplyr::group_by and the NSE construct it would require (converting it to symbol, and !! it).

#' Aggregate a dataset
#' @param .data the data frame
#' @param .arglist a list of column names to group by
#' @examples
#' d <- iris
#' l <- list(
#'   groups = list(col = "Species"),
#'   aggregates = list(
#'     list(col = "Sepal.Length", fun = "mean"),
#'     list(col = "Sepal.Width", fun = "mean")
#'   )
#' )
#' .aggregate(d, l)
#' @return a data frame with the columns aggregated
#' @export
.aggregate <- function(.data, .arglist) {
  checkmate::assert_data_frame(.data)
  checkmate::assert_list(.arglist, types = "list")
  checkmate::assert_named(.arglist)
  checkmate::assert_subset(
    names(.arglist),
    choices = c("groups", "aggregates")
  )
  checkmate::assert_list(.arglist$groups, len = 1)
  checkmate::assert_subset(
    purrr::pluck(.arglist, "groups", "col"),
    choices = names(.data)
  )
  checkmate::assert_subset(
    purrr::pluck(.arglist, "aggregates", "col"),
    choices = names(.data)
  )
  checkmate::assert_subset(
    purrr::pluck(.arglist, "aggregates", "fun"),
    choices = c(
      "mean", "median", "sum", "min", "max", "sd", "var", "count"
    )
  )

  .get_aggr_fun <- function(x) {
    switch(x,
      "mean" = mean,
      "median" = stats::median,
      "sum" = sum,
      "min" = min,
      "max" = max,
      "sd" = sd,
      "var" = var,
      "count" = length
    )
  }

  aggr_dataset <- purrr::map(
    .arglist$aggregates,
    .f = ~ dplyr::summarise(
      .data,
      !!paste(.x$col, .x$fun, sep = "_") :=
        .get_aggr_fun(.x$fun)(!!rlang::sym(.x$col)),
      .by = .arglist$groups$col
    )
  ) |>
    purrr::reduce(dplyr::left_join) |>
    dplyr::mutate_if(is.numeric, round, 2)

  aggr_dataset
}

In a {shiny} application, where we want to enable the user to select any column(s) to aggregate with some choices for aggregating function, it would require quite a bit of if/else logic to capture all the cases manually. Using this alternative, we simply harvest the user’s selections from the input and construct the list of instructions before plugging it into .aggregate to obtain our results.

Summary

In this post, we explored a method for dynamically aggregating datasets in R using purrr and dplyr. We created a function .aggregate that takes a data frame and a list of instructions specifying the grouping variables and the aggregation functions to apply. This approach is particularly useful in non-interactive or automated workflows, such as in {shiny} applications or {plumber} APIS, where the user might specify different aggregation requirements.

We demonstrated the usage of the .aggregate function with examples using the iris and mtcars datasets, showing how to group by one or more variables and apply various aggregation functions. The function ensures input validation using {checkmate} and dynamically applies the specified aggregation functions, collating the results into a single data frame.

This method provides a flexible and efficient way to perform complex aggregations programmatically, reducing the need for extensive if/else logic and making it easier to handle user-defined aggregation instructions.

Interactive and dynamic filtering

The {tidyverse}, and {dplyr} in particular, have made data manipulation in R a breeze. In an interactive setting, the pattern:

my_data |> 
    dplyr::filter(my_col == my_value) |>
    ...

gives a lot of power and joy to everyone, including beginner programmers.

However, we often run into hurdles when trying to translate our script written for interactive analysis into code that can be run automatically. Where we won’t know ahead of time what column to filter on, or what values we should retain.

In such cases, we often write if statements, along the lines of:

if (x == "my_col1") {
    dplyr::filter(my_col1 == my_val1)
} else if (x == my_col2) {
    dplyr::filter(my_col2 == my_val2)
} ...

Its easy to see how such approaches become long-winded, error prone, slow, and result in untidy, less extensible and maintainable code.

This is common, for example if you have a {plumber} API and an arbitrary user attempts to filter an arbitrary table in a data base. Or if you have a {shiny} application where the user uploads a table, with columns unknown to the code and then select one or more of them to filter on.

I have faced this many times, and have always wanted a solution where I can send instructions for filtering in the form of a named list, and get the filtered table. For this to work, the named list would need specify the column, filtering function, and values to retain (min, max, val). Then a function would take each element of the list, filter the dataset based on it, and finally return a table that combines all the filters. Or, more accurately, return the intersect of the filtered datasets.

Below is a function that solves this problem that I developed recently to add flexible dynamic filtering to a {shiny} application where the user can upload an arbitrary dataset, then select arbitrary filter columns and values and obtain the joint filtered result.

To find the iris flowers with sepal length between 4.9 and 5 and from species setosa and versicolor, we would write the following:

suppressPackageStartupMessages({
    library(checkmate)
    library(dplyr)
    library(purrr)
})
l <- list(
  list(col = "Sepal.Length", fun = "between", min = 4.9, max = 5),
  list(col = "Species", fun = "in", val = c("setosa", "versicolor"))
)
.filter(iris, l)

   Sepal.Length Sepal.Width Petal.Length Petal.Width    Species
1           4.9         3.0          1.4         0.2     setosa
2           5.0         3.6          1.4         0.2     setosa
3           5.0         3.4          1.5         0.2     setosa
4           4.9         3.1          1.5         0.1     setosa
5           5.0         3.0          1.6         0.2     setosa
6           5.0         3.4          1.6         0.4     setosa
7           4.9         3.1          1.5         0.2     setosa
8           5.0         3.2          1.2         0.2     setosa
9           4.9         3.6          1.4         0.1     setosa
10          5.0         3.5          1.3         0.3     setosa
11          5.0         3.5          1.6         0.6     setosa
12          5.0         3.3          1.4         0.2     setosa
13          4.9         2.4          3.3         1.0 versicolor
14          5.0         2.0          3.5         1.0 versicolor
15          5.0         2.3          3.3         1.0 versicolor

How does it work

The function below has two sections. First we do input validation using {checkmate}. In a non-interactive setting, we can’t rely on the inputs being always correct, so validating, and returning meaningful errors is essential. For this job, I prefer checkmate because it has a nice and consistent interface with many built-in checking, asserting, and testing functions, but any other approach, including base R’s stopifnot or assertthat would work.

The second part is the filtering bit, where we have purrr::map cycle over each element of the filter list, grab the required filter function and go into one of two paths. If the column is numeric (date, datetime, integer, double), we use dplyr::between to filter. If, the column is character (string), factor or logical, we go with %in%.

After cycling over all elements of the filter list, the output would be a list of filtered datasets. We must now combine these into a single table, i.e. the table that we would get if we applied all these filters in one call, or sequentially. To do this, we use a bit more functional programming magic with purrr::reduce with the intersect function from dplyr. This final step, reduces the list of data frames to a single table containing only the rows that are shared between the data frames.

#' Filter a dataset
#' @param .data the data frame
#' @param .arglist a list of filter specifications
#' @examples
#' d <- iris
#' l <- list(
#'   list(col = "Sepal.Length", fun = "between", min = 4, max = 5),
#'   list(col = "Species", fun = "in", val = c("setosa", "versicolor"))
#' )
#' .filter(d, l)
#' @import checkmate
#' @import purrr
#' @import dplyr
#' @export
.filter <- function(.data, .arglist) {
  checkmate::assert_data_frame(.data)
  checkmate::assert_list(.arglist, types = "list")
  checkmate::assert_subset(
    purrr::map_chr(.arglist, purrr::pluck, "col"),
    choices = names(.data)
  )
  checkmate::assert_subset(
    purrr::map_chr(.arglist, purrr::pluck, "fun"),
    choices = c("in", "between")
  )

  purrr::map(.arglist, function(x) {
    col <- x$col
    fun <- x$fun
    if (fun == "between") {
      min <- x$min
      max <- x$max
      if (is.null(min) || is.null(max)) {
        return(.data)
      }
      return(
        dplyr::filter(.data, dplyr::between(
          !!rlang::sym(col), min, max
        ))
      )
    }
    if (fun == "in") {
      val <- x$val
      if (is.null(val)) {
        return(.data)
      }
      return(dplyr::filter(.data, `%in%`(
        as.character(!!rlang::sym(col)), val
      )))
    }
  }) |> purrr::reduce(dplyr::intersect)
}

To show another example, filter cars with mpg between 15 and 20 and cyl in 4 or 6

l <- list(
    list(col = "mpg", fun = "between", min = 15, max = 20),
    list(col = "cyl", fun = "in", val = c(4, 6))
)
.filter(mtcars, l)

              mpg cyl  disp  hp drat   wt  qsec vs am gear carb
Valiant      18.1   6 225.0 105 2.76 3.46 20.22  1  0    3    1
Merc 280     19.2   6 167.6 123 3.92 3.44 18.30  1  0    4    4
Merc 280C    17.8   6 167.6 123 3.92 3.44 18.90  1  0    4    4
Ferrari Dino 19.7   6 145.0 175 3.62 2.77 15.50  0  1    5    6

Pretty neat. In future posts, I’ll show how I use this in {shiny} context, where the construction of the filter list should also be automated.

Summary

In this post, we explored a method to dynamically filter datasets in R using purrr and dplyr. We discussed the limitations of traditional filtering approaches and introduced a flexible function that accepts a list of filter specifications. This function validates inputs using checkmate and applies the filters using purrr and dplyr. We demonstrated its usage with examples on the iris and mtcars datasets. This approach is particularly useful in interactive applications like shiny, where users can upload arbitrary datasets and apply custom filters dynamically.

Prep code

options(browser = "/usr/bin/firefox")
options(launch.browser = TRUE)

library(shiny)
library(brochure)
library(cachem)

unlink("brochure_cache", recursive = TRUE)
brochure_cache <- cachem::cache_disk("brochure_cache")

Variables are not shared among {brochure} pages

One of the features of {brochure} is that each page runs in its own session and is ignorant of variables, reactives, inputs, etc. from other pages. We can show this easily with this basic example. The variable some_var is created in the home page (/) and when we try to renderPrint it in page2 we get an error that the object is not found.

brochureApp(
  # First page
  page(
    href = "/",
    ui = fluidPage(
      h1("This is my first page")
    ),
    server = function(input, output, session) {
      some_var <- 10
    }
  ),
  # Second page
  page(
    href = "/page2",
    ui = fluidPage(
      h1("This is my second page"),
      verbatimTextOutput("some_var")
    ),
    server = function(input, output, session) {
      output$some_var <- renderPrint(some_var)
    }
  )
)

Sharing variables with caching to disk

As we said, we have to store some_var somewhere outside the session of the page where it was created so we can retrieve it in the server of another page. The chunk below does that, in / we set the cache value some_var and in page2 we get it, and can print it in the UI.

brochureApp(
  # First page
  page(
    href = "/",
    ui = fluidPage(
      h1("This is my first page")
    ),
    server = function(input, output, session) {
      some_var <- 10
      brochure_cache$set("some_var", some_var)
    }
  ),
  # Second page
  page(
    href = "/page2",
    ui = fluidPage(
      h1("This is my second page"),
      verbatimTextOutput("some_var")
    ),
    server = function(input, output, session) {
      some_var <- brochure_cache$get("some_var")
      output$some_var <- renderPrint(some_var)
    }
  )
)

Now, this is all great, except if we have dozens of variables that we need to share between pages. In this case we’d have to individually cache each of them or update a list and then re-cache the list every time its updated. Or if we need to cache an input, we’d need an observer to monitor that input and cache it on each change, potentially adding unnecessary workload to the session. It becomes cumbersome quickly, and the code gets long and potentially complex, for a relatively basic operation.

brochureApp(
  # First page
  page(
    href = "/",
    ui = fluidPage(
      h1("This is my first page")
    ),
    server = function(input, output, session) {
      var1 <- 10
      brochure_cache$set("var1", var1)
      var2 <- 11
      brochure_cache$set("var2", var2)
      var3 <- 12
      brochure_cache$set("var3", var3)
      var4 <- 13
      brochure_cache$set("var4", var4)
      var5 <- 14
      brochure_cache$set("var5", var5)
      var6 <- 15
      brochure_cache$set("var6", var6)
    }
  ),
  # Second page
  page(
    href = "/page2",
    ui = fluidPage(
      h1("This is my second page"),
      verbatimTextOutput("some_var")
    ),
    server = function(input, output, session) {
      vars <- sapply(1:6, \(i) brochure_cache$get(paste0("var", i)))
      output$some_var <- renderPrint(sum(vars))
    }
  )
)

Simplifying the caching of several variables

What I was hoping for at the time is for a single-step caching of the state of the page session right before the user navigates to another page. It did not occur to me that a mechanism for this was already available in {shiny}. Simply use onSessionEnded to harvest and cache the variables you need to share with another page. So simple.

brochureApp(
  # First page
  page(
    href = "/",
    ui = fluidPage(
      h1("This is my first page")
    ),
    server = function(input, output, session) {
      var1 <- 1
      var2 <- 2
      var3 <- 3
      var4 <- 4
      var5 <- 5
      var6 <- 6

      onSessionEnded(function(x) {
        lapply(1:6, \(i) {
          brochure_cache$set(paste0("var", i), get(paste0("var", i)))
        })
      })
    }
  ),
  # Second page
  page(
    href = "/page2",
    ui = fluidPage(
      h1("This is my second page"),
      verbatimTextOutput("some_var")
    ),
    server = function(input, output, session) {
      vars <- sapply(1:6, \(i) brochure_cache$get(paste0("var", i)))
      output$some_var <- renderPrint(sum(vars))
    }
  )
)

Regardless of how many times var1 is updated during the session, we don’t have to worry about caching it. It will get done when the session is closed, i.e. when the user navigates to another page or closes the web page.

Cleaner approach. A list to store variables to be cached

Thinking about this some more, it certainly makes sense to have a page-level list of variables that need to be cached. Then, when we cache on session end, we can cycle over the contents of that list, not dozens of individual variables. Along the lines of:

brochureApp(
  # First page
  page(
    href = "/",
    ui = fluidPage(
      h1("This is my first page")
    ),
    server = function(input, output, session) {
      var1 <- 1
      var2 <- 2
      var3 <- 3
      var4 <- 4
      var5 <- 5
      var6 <- 6

      to_cache_list <- list()
      to_cache_list$var1 <- var1
      to_cache_list$var3 <- var3
      to_cache_list$var5 <- var5

      onSessionEnded(function() {
        lapply(names(to_cache_list), \(x) {
          brochure_cache$set(x, to_cache_list[[x]])
        })
      })
    }
  ),
  # Second page
  page(
    href = "/page2",
    ui = fluidPage(
      h1("This is my second page"),
      verbatimTextOutput("some_var")
    ),
    server = function(input, output, session) {
      var1 <- brochure_cache$get("var1")
      var3 <- brochure_cache$get("var3")
      var5 <- brochure_cache$get("var5")
      output$some_var <- renderPrint(sum(var1, var3, var5))
    }
  )
)

Still to cumbersome? Cache the kitchen sink

Finally, we can take this a step further, perhaps unwisely, and store the entire environment. Within onSessionEnded, we define a callback function whose environment is a child of the server’s environment. So we can collect the contents of the parent environment, convert to a list for easier handling, and simply cache all of it as pageX_data. Then, when we need to retrieve a value from pageX, we load the cache and index it with the benefit of knowing that the cache’s structure is going to reflect the structure of the pageX environment.

brochureApp(
  # First page
  page(
    href = "/",
    ui = fluidPage(
      h1("This is my first page"),
      sliderInput("slide", "Shared input", 1, 10, 1)
    ),
    server = function(input, output, session) {
      observe({
        slide_value <- brochure_cache$get("page_1_data")[["input"]][["slide"]]
        if (!is.null(slide_value)) {
          updateSliderInput(
            inputId = "slide",
            label = "Shared input",
            value = slide_value
          )
        }
      })
      var1 <- 6
      var2 <- 5
      var3 <- 4
      var4 <- 3
      var5 <- 2
      var6 <- 1

      onSessionEnded(function() {
        env <- environment()
        page_env <- as.list(parent.env(env))
        page_env$output <- NULL
        page_env$session <- NULL
        brochure_cache$set("page_1_data", page_env)
      })
    }
  ),
  # Second page
  page(
    href = "/page2",
    ui = fluidPage(
      h1("This is my second page"),
      h5("Sum of some variables"),
      verbatimTextOutput("some_var"),
      h5("Input from previous page"),
      verbatimTextOutput("slide_input")
    ),
    server = function(input, output, session) {
      var1 <- brochure_cache$get("page_1_data")[["var1"]]
      var3 <- brochure_cache$get("page_1_data")[["var3"]]
      var5 <- brochure_cache$get("page_1_data")[["var5"]]
      output$some_var <- renderPrint(sum(var1, var3, var5))
      slide <- reactive(brochure_cache$get("page_1_data")[["input"]][["slide"]])
      output$slide_input <- renderPrint(slide())
    }
  )
)

The example above also covers caching the input R6 from the {shiny} session and removes the output and session object, although if needed those could be cached as well. Apart from some input value being needed in another page, caching the input makes sense so we can update the input widget when we return to pageX. Again, as each page is its own session, unlike base {shiny}, when we return to pageX the input will be re-initialized with the value set in the code, not with the value previously set by the user, so updating it is necessary.

This last approach comes with a caveat. Its almost never a good idea to cache everything. The input object, for example, is a large R6 object. There could be data frames, lists, model results, etc within the session that have a large footprint and are not used in other pages. This could inflate the size of the cache or cause slowdowns when navigating between pages if saving takes a bit.

Personally, I prefer the approach of a page-level list of objects to be cached. It is more explicit and can be curated to minimize the size of the cache and potentially save time.

Summary

In this post, we explored various methods for sharing data between pages in a multi-page {brochure} {shiny} application. We started with a basic example demonstrating the isolation of sessions in {brochure} and the need for caching to share data. We then showed how to use cachem to store and retrieve variables between pages. To simplify the process, we introduced the use of onSessionEnded to cache variables at the end of a session. Finally, we discussed caching the entire environment and the potential pitfalls of this approach. These methods can help streamline data sharing in multi-page {brochure} applications, reducing repetitive code and improving maintainability.

Config JSON

Nothing particularly novel here. We just create a JSON file with a simple structure. The “meta” section has general info about the application and the client (logo, homepage, etc.). The “general” section contains info on the title of the particular app instance, and path to the data object. Depending on the needs this can be a folder (bucket) with several files, or a single file (like in the simple example here). Finally, we have the “pages” section where add information specific to the different pages/tabs the application has.

Some of the configurability comes in here. We can have separate pages for different types of data or subscription levels and enable/disable pages from this section accordingly.

{
  "meta" : {
    "name" : "Shiny golem config",
    "version" : "0.0.1",
    "description" : "An example of an app configured by a config file in the cloud",
    "author" : "Discindo",
    "email" : "hello@discindodata.com",
    "logo" : "www/logo.png",
    "favicon" : "favicon.ico",
    "theme" : "default",
    "language" : "en",
    "homepage" : "discindo.org"
  },
  "general" : {
    "title" : "Test Title",
    "subtitle" : "A little longer subtitle just to show it (disable with `null`)",
    "data_path" : "https://raw.githubusercontent.com/discindo/shiny-golem-json-config/refs/heads/main/iris.csv",
    "data_format" : "csv"
  },
  "pages" : {
   "home" : {
        "title" : "Home",
        "icon" : "home",
        "url" : "/",
        "template" : "inst/html/home.html",
        "ui" : null,
        "server" : null
    },
    "data" : {
        "title" : "Data",
        "icon" : "table",
        "url" : "/data",
        "template" : null,
        "ui" : "mod_data_ui",
        "server" : "mod_data_server"
    },
    "about" : {
        "title" : "About",
        "icon" : "info",
        "url" : "/about",
        "template" : "inst/html/about.html",
        "ui" : null,
        "server" : null
    }
  }
}

The config can be placed in the inst folder of the R package (if {golem}) or some other folder that is in the resource path of the Shiny app. But it can also live in the remote cloud location. Of course the Shiny app should have the required permissions to access these files.

In the example here, to keep things simple, the ‘remote-data’ folder is a public folder in the GitHub repository for the code used in this post. No additional files or variables are needed to access the config JSON and the data files. But if the data are in a private bucket at a cloud provider, the app would need to have read permissions for that bucket. Either through AWS IAM credentials, or Google cloud token, etc..

Shiny code

The Shiny app will need to load the config JSON from the cloud or local location, and use the configurations set by the user to generate the right content. In the example, I am using the {golem} setup, so there are separate app_ui.r and app_server.r scripts. Each one loads the JSON config using jsonlite and accesses the slots in the resulting list for the values it needs. If there are some expensive or repeated steps performed in the ui and server functions, we could use golem options or some other mechanism to parse the config JSON only once and pass the list as an argument or option to the main ui and server functions. But it this, admittedly simplified example, we parse the config twice, as its quite small.

In the {rhino} framework, something similar can be achieved by loading the config in app.R, and then using it in functions from /logic/. And in a “base” Shiny app, a straightforward approach would be to parse the config in global.r which would make the variable available in the scope of the ui and server functions.

app_ui <- function(request) {
  config <- jsonlite::read_json("https://raw.githubusercontent.com/discindo/shiny-golem-json-config/refs/heads/main/remote-data/app-config.json")
  pages <- purrr::map(
    config$pages, function(x) {
      if (!is.null(x$template)) {
        return(bslib::nav_panel(
          title = x$title,
          shiny::htmlTemplate(x$template)
        ))
      } else if (!is.null(x$ui)) {
        return(bslib::nav_panel(
          title = x$title,
          getFunction(x$ui)(id = "data_1")
        ))
      } else {
        return(bslib::nav_panel(
          title = x$title,
          x$title
        ))
      }
    }
  )
  shiny::tagList(
    # Leave this function for adding external resources
    golem_add_external_resources(),
    # Your application UI logic
    shiny::div(
      class = "container",
      bslib::page_navbar(
        theme = bslib::bs_theme(
          bootswatch = "litera",
          base_font = bslib::font_google("Lato")
        ),
        inverse = FALSE,
        underline = FALSE,
        title = shiny::a(
          href = config$meta$homepage,
          target = "_blank",
          shiny::img(src = config$meta$logo, height = "70px")
        ),
        header = shiny::div(
          class = "p-5 text-center",
          shiny::h4(config$general$title),
          shiny::h6(config$general$subtitle)
        ),
        bslib::nav_spacer(),
        rlang::splice(unname(pages))
      )
    )
  )
}

app_server <- function(input, output, session) {
  # Your application server logic
  config <- jsonlite::read_json("inst/app-config.json")
  data <- read.csv(config$general$data_path)
  purrr::map(config$pages, function(x) {
    if (!is.null(x$server)) {
      getFunction(x$server)(id = "data_1", data = data)
    }
  })
}

remote-data/
├── app-config.json
├── iris.csv
└── mtcars.csv

Summary

In this post, we explored how to configure a Shiny application using a remote JSON file. This approach allows for flexible and dynamic updates to the app’s content and appearance without major code refactoring. We discussed the structure of the JSON configuration file, how to load it in the Shiny app, and how to use it to generate the UI and server logic dynamically. This method can be particularly useful for applications that need to display different data or configurations for different clients, enabling easy updates by simply modifying the JSON file in a cloud storage location.

Step 1: Use renv for your projects.

I will not go into details here. I presume everyone is doing this? :)

When using renv you will notice the renv.lock that are being generated.

Step 2: Create a Github repository with folder for each renv.lock file

Assuming you have multiple projects/environments you need to check and build have a directory structure where each folder has a renv.lock file. For example:

my-renv-files/
├── my-first-comlicated-env/
    └── renv.lock
└── my-second-complicated-env/
    └── renv.lock

Maybe you would want to add a README.md there as well.

Step 3: Add a requirements.txt file to the repository

This will hold any system libraries that are needed - one per line. You probably know at least one at this point so just add it on the first line.

Step 4: Add a GitHub Action yaml file to the repository.

Create a .github/workflows folder in the repository and add the following as build_renv.yaml:

name: Build renv environments

on:
  pull_request:
    paths:
      - '**/renv.lock'
  workflow_dispatch: 

jobs:
  build-renv:
    runs-on: ubuntu-latest

    steps:
      # 1. Checkout the repository
      - name: Checkout repository
        uses: actions/checkout@v4
        with:
          fetch-depth: 0

      # 2. Set up R environment
      - name: Set up R
        uses: r-lib/actions/setup-r@v2
        with:
          r-version: '4.4.1' # Specify your desired R version

      # 3. Install system dependencies
      - name: Install system dependencies
        run: |
          sudo apt-get update
          sudo apt-get install -y $(cat requirements.txt)

      # 4. Install renv package in R
      - name: Install renv
        run: |
          Rscript -e "install.packages('renv')"

      # 5. Rebuild the R environment for the changed renv.lock file
      - name: Rebuild R environment
        run: |
          # Extract the changed renv.lock file
          file=$(git diff --name-only ${{ github.event.pull_request.base.sha }} ${{ github.event.pull_request.head.sha }} | grep 'renv.lock')
          dir=$(dirname "$file")

          echo "Restoring renv environment for $dir"
          cd "$dir"
          Rscript -e "renv::restore(prompt = FALSE)"
        env:
          RENV_PATHS_CACHE: ~/.cache/R/renv

This will run automatically on any pull requests that have renv.lock files, and also can be manually triggered (good for testing!).

Then it will setup R, install the dependencies, and set up renv.

Then in the final step 5 it will try to build the environment for each folder and fail if system dependencies are missing. So then you can update the requirements.txt and have it run again until you have a green pass and a complete requiremtenst.txt that you can share with the administrator. :)

Now, this runs on Ubuntu and the server that runs the RStudio Server may be on a different Linux distribution. And while not ideal, you will still know what are the names of the missing libraries, though their names for the other distribution maybe slightly different.

Still, a nice way to keep track of renv environments, and especially convenient if you have a very specific one that you need to share with coworkers or with the public.

Deploy a project with multiple R scripts and {renv}-managed environment to AWS Lambda

It has been a while since I’ve had the chance to work on my {r2lambda} project. In particular, there were a couple of good points made by a user on GitHub about functionality that is missing from the package. The option to deploy multiple files, e.g., one runtime function that depends on helpers in the same project organized in different files. And another, to enable {renv} management of the R environment within the AWS Lambda docker image. Both excellent points that I wished I addressed earlier. But better late than never.

Both of these features required minor adjustments to the codebase. Copying additional supports scripts and restoring the {renv} environment should both happen when the AWS Lambda docker image is built, so the logic to create the Dockerfile needed to be updated. Accordinly, the r2lambda::build_lambda function now has two additional arguments:

#' @param support_path path to the support files (if any). Either NULL 
#' (the default) if all needed code is in the same `runtime_path` script, or a 
#' character vector of paths to additional files needed by the runtime script.
#' @param renvlock_path path to the renv.lock file (if any). Default is NULL.
#' 
#' @details Use either `renvlock_path` or `dependencies` to install required
#' packages, not both. By default, both are `NULL`, so the Docker image will
#' have no additional packages installed.

To include any support scripts, provide a character vector script paths to the support_path argument when building the Lambda docker image locally with build_lamdba.

[Note that, multi-file project was supported previously as well, although perhaps not explicitly. An approach that I like is to create an ‘R’ package that exports the runtime function needed for the Lambda. Then one just needs to make that custom R package a dependency of the project and either install in the AWS Lambda docker image it through dependencies or renvlock_path.]

To use an existing renv.lock for installation of dependencies, provide its path to the renvlock_path argument to build_lambda. This instructs the code to copy the renv.lock file to the image and run renv::restore() which will reconstruct the R environment inside the docker image. I really like this feature, as it minimizes the size of the Dockefile and removes some potential headaches with R package dependencies from different repositories (CRAN, BioConductor, GitHub, etc).

Demo code

Assuming we have a folder with the following structure:

~/Desktop$ ls -1 iris-lambda/
renv/
renv.lock
runtime.r
support.r
test-code.r

Where, support.r defines some function that runtime.r uses for the Lambda:

get_iris_summary_by_species <- function(species) {
    iris |>
    dplyr::filter(Species == species) |>
    dplyr::summarise(
      mean = mean(Sepal.Length),
      sd = sd(Sepal.Length)
    )
}

Then runtime.r, sources the support script, and calls the function defined there:

source("support.r")

iris_summary <- function(species) {
  get_iris_summary_by_species(species)
}

lambdr::start_lambda()

Then the following should work, passing the support script and renv.lock to r2lambda::build_lambda:

dir("~/Desktop/iris-lambda")
runtime_function <- "iris_summary"
runtime_path <- "~/Desktop/iris-lambda/runtime.r"
support_path <- "~/Desktop/iris-lambda/support.r"
renvlock_path <- "~/Desktop/iris-lambda/renv.lock"
dependencies <- NULL

# Might take a while, its building a docker image
build_lambda(
  tag = "my_iris_lambda",
  runtime_function = runtime_function,
  runtime_path = runtime_path,
  support_path = support_path,
  renvlock_path = renvlock_path,
  dependencies = dependencies
)

# test
payload <- list(species = "setosa")
tag <- "my_iris_lambda"
test_lambda(tag = tag, payload)


# deploy

# Might take a while, its pushing it to a remote repository
deploy_lambda(
  tag = "my_iris_lambda",
  Timeout = 30
)

invoke_lambda(
  function_name = "my_iris_lambda",
  invocation_type = "RequestResponse",
  payload = list(species = "versicolor"),
  include_logs = FALSE
)

invoke_lambda(
  function_name = "my_iris_lambda",
  invocation_type = "RequestResponse",
  payload = list(species = "setosa"),
  include_logs = FALSE
)