What webrcli & spidy wants to achieve

In a nutshell, the goal of webrcli & spidyr is to provide an interface for bringing your R functions inside a NodeJS runtime.

Think of it as something that wants to achieve the following interation:

• An R dev writes, builds and shares a package called {rfuns}, which contains a function called hello_world()

• A NodeJS dev takes this package, can call it with rfuns.hello_world(), access and manipulate the results with JavaScript.

An important note

With webR & the tools described below, there is no R session running while the NodeJS app is running. spidyr imports an R function converted to a native JS. rfuns.hello_world does not call an R session running somewhere else.

That also means that if you build a container containing the app, you don’t need to install R in it. It’s a NodeJS app.

Below are some updates recently made to both webrcli & spidyr.

Making the template code smaller

When drafting the first code of webrcli & spidyr, I focused on providing a minimal template for an index.js loading your R functions, contained in a subdirectory inside your node project.

This worked, but might have been a bit complex to grasp. Provided you don’t change the default names of the folders (in that case you’ll need to modify the default parameters), the new default index.js look like this:

const {
  initSpidyr,
  mountLocalPackage
} = require('spidyr');

(async () => {

  await initSpidyr()

  const rfuns = await mountLocalPackage("./rfuns");

  const hw = await rfuns.hello_world()

  console.log(hw.values);

  console.log("✅ Everything is ready!");
})();

This minimal template makes it easier to read and understand what the code does. Note that you’ll get this template if you run webrcli init myproject.

Let’s decompose what this code does :

• await initSpidyr() will create an object called spidyr_webR stored as globalThis.spidyr_webR, init() it (as in webr.init()), and load the packages contained in the ./webr_packages folder inside your project dir, the one containing the packages installed with webrcli install.

• const rfuns = await mountLocalPackage("./rfuns"); will take the R package contained in ./rfuns, load it into the webR instance (spidyr_webR), recursively get all the exported functions from your package, and store them inside the rfuns object.

• const hw = await rfuns.hello_world() will call the hello_world() function from {rfuns}. The values are then console.loged.

new Library() is now library()

Calling a package is now const spongebob = library("spongebob") instead of the previous approach which was const spongebob = new Library("spongebob");await spongebob.load(globalThis.webR);

Better installation from package.json & DESCRIPTION

The previous version of webrcli did not stored nor re-installed the R package installed in the project, meaning that if you git cloned a project, you had to guess what R packages to re-install.

Now, a project initiated with webrcli will store all the packages installed with webrcli install inside the package.json file. Then, when running the npm install command, the R packages will also be redownloaded.

You can also installed a series of packages based on a DESCRIPTION file with webrcli installFromDesc.

Other tools

• shareEnv allows to copy one, several or all env var from node to the webR instance.

Workflow summary

• webrcli init myproject will create a project skeleton at ./myproject

• webrcli install spongebob will download the version of {spongebob} compiled for webR, and add it to ./webr_packages.

• You can then modify you R code with your own functions.

• Call your R function from rfuns.xyz() in Node

• Run with npm start

Please do give it a shot

I think I’ve been the only user for now 😅, so please do try these and let me know what you think.

Future works

Here are what I plan on working in the upcoming weeks:

• webrcli init should allow for specifying a webr version from npm issue 17

• initSpidyr should allow to pass params to webR.init() issue 12

• Allow to install from r-universe, something like webrcli installFromRUniverse issue 16. Probably in the future it will be merged to webrcli install and we’ll have a way to guess what the user wants based on the input.

• A small converter from R named list to JS objects Issue 3

• More documentation, and probably documenting the conversion of an existing {shiny} app to a spidyr based one.

Again, a new project?

Most of the previous posts have been about poking around with webR inside NodeJS, but nothing stable on how to build an app.

That’s something I’m trying to change. Based on the experience gathered building apps in R (in {shiny} with {golem}) and in JavaScript, I’ve tried to come up with a solution for a starter kit for building what I think will be the perfect skeleton for webR/NodeJS project.

The idea is to have one project with inside:

• One R package
• One JS app
• A tool that brings the R package into the NodeJS app and allow to use the R functions inside JavaScript

This skeleton needed a toolkit to perform the following task:

1️⃣ From a cli point of view:

• init the project with a specific skeleton
• allow to install packages from the webrCRAN to a local webr library, in the spirit of previous post.
• allow to install the deps from a DESCRIPTION file

2️⃣ From a NodeJS point of view:

• Load the packages downloaded in a local webr library
• Create an interface to load and manipulate the functions from a package downloaded from CRAN, and use them in JS.
• Same but with a local package folder

For the function manipulation mechanism, I wanted something that would allow to think in terms of pkg::fun() but in JavaScript, which would translate as pkg.fun() in your Node app. Something I had implemented in another old NodeJS module called hordes, which I can now safely deprecate in favor of the following tools.

The reasoning being: the R dev writes a standalone package that exports an xyz function, then the web team can load this package, and launch xyz() without writing any R code.

webrcli & spidyr

So, here comes webrcli and spidyr.

❗️ Please note that these tools are work in progress and has been used very few times and only for example apps, will need a lot of bug fixes and documentation, so if ever you plan on using it be indulgent, and report any bug or feature request ❗️

# Global installing webrcli
npm install -g webrcli
# Init a webrcli project
cd /tmp
webrcli init webrspongebob

👉 Initializing project ----
(This may take some time, please be patient)
👉 Copying template ----
👉 Installing {pkgload} ----
✅ {pkgload} downloaded and extracted ----

✅ {cli} downloaded and extracted ----

✅ {crayon} downloaded and extracted ----

✅ {desc} downloaded and extracted ----

✅ {fs} downloaded and extracted ----

✅ {glue} downloaded and extracted ----

✅ {pkgbuild} downloaded and extracted ----

✅ {rlang} downloaded and extracted ----

✅ {rprojroot} downloaded and extracted ----

✅ {withr} downloaded and extracted ----

✅ {R6} downloaded and extracted ----

✅ {callr} downloaded and extracted ----

✅ {processx} downloaded and extracted ----

✅ {ps} downloaded and extracted ----

cd ./webrspongebob
tree -L 1

.
├── index.js
├── node_modules
├── package-lock.json
├── package.json
├── rfuns
└── webr_packages

4 directories, 3 files

node index.js
👉 Loading WebR ----
👉 Loading R packages ----
ℹ Loading rfuns
[ 'Hello, world!' ]
✅ Everything is ready

const path = require('path');
const { WebR } = require('webr');
const { loadPackages, LibraryFromLocalFolder } = require('spidyr');

const rfuns = new LibraryFromLocalFolder("rfuns");


(async () => {

  console.log("👉 Loading WebR ----");
  globalThis.webR = new WebR();
  await globalThis.webR.init();

  console.log("👉 Loading R packages ----");

  await loadPackages(
    globalThis.webR,
    path.join(__dirname, 'webr_packages')
  )

  await rfuns.mountAndLoad(
    globalThis.webR,
    path.join(__dirname, 'rfuns')
  );

  const hw = await rfuns.hello_world()

  console.log(hw.values);

  console.log("✅ Everything is ready!");

})();

const rfuns = new LibraryFromLocalFolder("rfuns");

await loadPackages(
  globalThis.webR,
  path.join(__dirname, 'webr_packages')
)

await rfuns.mountAndLoad(
  globalThis.webR,
  path.join(__dirname, 'rfuns')
);

webrcli install spongebob

✅ {spongebob} downloaded and extracted ----

const path = require('path');
const { WebR } = require('webr');
const { loadPackages, LibraryFromLocalFolder, Library } = require('spidyr');

const rfuns = new LibraryFromLocalFolder("rfuns");
const spongebob = new Library("spongebob");

(async () => {

  console.log("👉 Loading WebR ----");
  globalThis.webR = new WebR();
  await globalThis.webR.init();

  console.log("👉 Loading R packages ----");

  await loadPackages(
    globalThis.webR,
    path.join(__dirname, 'webr_packages')
  )

  await rfuns.mountAndLoad(
    globalThis.webR,
    path.join(__dirname, 'rfuns')
  );

  await spongebob.load(
    globalThis.webR
  );

  const hw = await rfuns.hello_world()

  console.log(hw.values);

  const said = await spongebob.tospongebob("hello from spongebob")

  console.log(said.values)

  console.log("✅ Everything is ready!");;

})();

node index.js

👉 Loading WebR ----
👉 Loading R packages ----
ℹ Loading rfuns
[ 'Hello, world!' ]
[ 'helLo fROm spONgEbOb' ]
✅ Everything is ready!

Some random notes

The webrspongebob example is available at https://github.com/ColinFay/webrspongebob

The problem

Ok, so now that we have our webR / NodeJS machinery up and running, let’s try something more interesting: use our own R functions inside webR.

How can I do that?

There are at least three ways I could think of:

1️⃣ Writing a function inside the JS code to define a function, something like :

await globalThis.webR.evalR("my_fun <- function(x){...}");

But that doesn’t check what I would expect from something I’ll use in prod and I’m pretty sure you don’t need me to detail why 😅

• ❌ Well organized
• ❌ Documented
• ❌ Tested
• ❌ Safely installable

2️⃣ Simply create an R script and source it. Something like:

const fs = require('fs');
const path = require('path');
const script = path.join(__dirname, 'script.R')
const data = fs.readFileSync(script);
await globalThis.webR.FS.writeFile(
  "/home/web_user/script.R",
  data
);
await globalThis.webR.evalR("source('/home/web_user/script.R')");

That’s a bit better, we can at least organize our code in a script and it will be:

• ✅ Well organized (more or less)
• ✅ Documented (more or less)
• ❌ Tested
• ❌ Safely installable

3️⃣ I bet you saw me coming, the best way let’s put stuff into an R package, so that we can check all the boxes.

• ✅ Well organized
• ✅ Documented
• ✅ Tested
• ✅ Safely installable

Jeroen has written a Docker image to compile an R package to WASM, but I was looking for something that wouldn’t involve compiling via a docker container every time I make a change on my R package (even if that does sound appealing, I’m pretty sure this wouldn’t make for a seamless workflow).

So here is what I’m thinking should be a well structured NodeJS / WebR app:

• Putting all the web stuff inside the NodeJS app, because, well, NodeJS is really good at doing that.
• Putting all the “business logic”, data-crunching, modeling stuff (and everything R is really good at) into an R package.
• load webR, write my R package to the webR file system, and pkgload::load_all() it into webR.

That way, I can enjoy the best of both worlds:

• NodeJS is really good at doing web related things, and there are plenty of ways to test and deploy the code.
• And same goes for the R package: if you’re reading my blog I’m pretty sure I don’t need to convince you of why packages are the perfect tool for sharing production code.

The how

Let’s start by creating our project:

mkdir webr-preload-funs
cd webr-preload-funs
npm init -y
touch index.js
npm install express webr
R -e "usethis::create_package('rfuns', rstudio = FALSE)"

Let’s now create a simple function :

> usethis::use_r("sw")

#' @title Star Wars by Species
#' @description Return a tibble of Star Wars characters by species
#' @import dplyr
#' @export
#' @param species character
#' @return tibble
#' @examples
#' star_wars_by_species("Human")
#' star_wars_by_species("Droid")
#' star_wars_by_species("Wookiee")
#' star_wars_by_species("Rodian")
star_wars_by_species <- function(species){
  dplyr::starwars |>
    filter(species == {{species}})
}

We can now add {dplyr} and {pkgload} to our DESCRIPTION (we’ll need {pkgload} to load_all() the package).

usethis::use_package("dplyr")
usethis::use_package("pkgload")
devtools::document()

Now that we have a package skeleton, we’ll have to upload it to webR.

As described in the previous post, I’ve started a webrtools NodeJS module, which will contains function to play with webR. Before this post, it had one function, loadPackages, that was used to build a webR dependency library (see Preloading your R packages in webR in an Express JS API for more info).

We’ll need to add two features :

• Install deps from DESCRIPTION (not just a package name), so a wrapper around the Rscript ./node_modules/webrtools/r/install.R dplyr from before
• Copy the package folder in NodeJS, so a more generic version of loadPackages, that can load any folder to the webR filesystem.

First, in R, we’ll need to read the DESCRIPTION and build the lib:

download_packs_and_deps_from_desc <- function (
  description,
  path_to_installation = "./webr_packages"
)
{
    if (!file.exists(description)) {
        stop("DESCRIPTION file not found")
    }
    deps <- desc::desc_get_deps(description)
    for (pak in deps$package) {
        webrtools::download_packs_and_deps(pak, path_to_installation = path_to_installation)
    }
}

Note: the code of webrtools::download_packs_and_deps() is a wrapper around the R code described in Preloading your R packages in webR in an Express JS API

And in Node, we’ll rework our loadPackages and split it into two functions — one to load into any folder, and one to load into the package library.

Note that this function is bundled in the webrtools npm module.

async function loadFolder(webR, dirPath, outputdir = "/usr/lib/R/library") {
  // function from webrtools
  const files = getDirectoryTree(
    dirPath
  )
  for await (const file of files) {
    if (file.type === 'directory') {
      await globalThis.webR.FS.mkdir(
        `${outputdir}/${file.path}`,
      );
    } else {
      const data = fs.readFileSync(`${dirPath}/${file.path}`);
      await globalThis.webR.FS.writeFile(
        `${outputdir}/${file.path}`,
        data
      );
    }
  }
}

async function loadPackages(webR, dirPath) {
  await loadFolder(webR, dirPath, outputdir = "/usr/lib/R/library");
}

The end app

We now have everything we need!

npm i webrtools@0.0.2
Rscript ./node_modules/webrtools/r/install_from_desc.R $(pwd)/rfuns/DESCRIPTION

And now, to our index.js

const app = require('express')()
const path = require('path');
const { loadPackages, loadFolder } = require('webrtools');
const { WebR } = require('webr');

(async () => {
  globalThis.webR = new WebR();
  await globalThis.webR.init();

  console.log("🚀 webR is ready 🚀");

  await loadPackages(
    globalThis.webR,
    path.join(__dirname, 'webr_packages')
  )

  await loadFolder(
    globalThis.webR,
    path.join(__dirname, 'rfuns'),
    "/home/web_user"
  )

  console.log("📦 Packages written to webR 📦");

  // see https://github.com/r-wasm/webr/issues/292
  await globalThis.webR.evalR("options(expressions=1000)")
  await globalThis.webR.evalR("pkgload::load_all('/home/web_user')");

  app.listen(3000, '0.0.0.0', () => {
    console.log('http://localhost:3000')
  })

})();

app.get('/', async (req, res) => {
  let result = await globalThis.webR.evalR(
    'unique(dplyr::starwars$species)'
  );
  let js_res = await result.toJs()
  res.send(js_res.values)
})


app.get('/:n', async (req, res) => {
  let result = await globalThis.webR.evalR(
    'star_wars_by_species(n)',
    { env: { n: req.params.n } }
    );
  try {
    const result_js = await result.toJs();
    res.send(result_js)
  } finally {
    webR.destroy(result);
  }
});

Let’s now try from another terminal:

curl http://localhost:3000

["Human","Droid","Wookiee","Rodian","Hutt","Yoda's species","Trandoshan","Mon Calamari","Ewok","Sullustan","Neimodian","Gungan",null,"Toydarian","Dug","Zabrak","Twi'lek","Vulptereen","Xexto","Toong","Cerean","Nautolan","Tholothian","Iktotchi","Quermian","Kel Dor","Chagrian","Geonosian","Mirialan","Clawdite","Besalisk","Kaminoan","Aleena","Skakoan","Muun","Togruta","Kaleesh","Pau'an"]

curl http://localhost:3000/Rodian

{"type":"list","names":["name","height","mass","hair_color","skin_color","eye_color","birth_year","sex","gender","homeworld","species","films","vehicles","starships"],"values":[{"type":"character","names":null,"values":["Greedo"]},{"type":"integer","names":null,"values":[173]},{"type":"double","names":null,"values":[74]},{"type":"character","names":null,"values":[null]},{"type":"character","names":null,"values":["green"]},{"type":"character","names":null,"values":["black"]},{"type":"double","names":null,"values":[44]},{"type":"character","names":null,"values":["male"]},{"type":"character","names":null,"values":["masculine"]},{"type":"character","names":null,"values":["Rodia"]},{"type":"character","names":null,"values":["Rodian"]},{"type":"list","names":null,"values":[{"type":"character","names":null,"values":["A New Hope"]}]},{"type":"list","names":null,"values":[{"type":"character","names":null,"values":[]}]},{"type":"list","names":null,"values":[{"type":"character","names":null,"values":[]}]}]}

Yeay 🎉 .

You can find the code here, and see it live at srv.colinfay.me/webr-preload-funs/.

You can also try it with

docker run -it -p 3000:3000 colinfay/webr-preload-funs

The problem

In the two last posts, I’ve been deploying two REST APIs that use functions from the base distribution of R:

• tools::toTitleCase() in express-webr-hello-world
• cut() & faithful for express-webr-old-faithful

One of the strengths of the R ecosystem is its extensive list of contributed packages: a wide collection of code written by R nerds from all over the world. It would be unfortunate to use webR to create a web applications or API without taking advantage of this extensive library of packages: R wouldn’t be R without its packages.

Yet, bringing packages to webR is not that simple: it’s a distribution of R compiled for WASM, and you can’t just install a package from any CRAN repo.

Thankfully we don’t need to scratch our head too much anymore: the webR team has precompiled more than 18000 (at the time of writing this post) packages that we can install by simply calling webr::install() inside the webR instance.

That’s awesome, but there’s an issue with that: you can only install it from the webR JavaScript object As far as I know, there is no way to download them beforehand and upload them to the webR filesystem, as I reported in this issue. (Note: at the time of writing these lines, there has been some discussion on the GH issue, but there is at the moment no native, efficient way to do what I want to do 😅 — there might be one though if you’re reading this post in the future).

That means that every time the API is launched, webR has to download and reinstall the packages, as shown by this simple example:

const app = require('express')()
const { WebR } = require('webr');

(async () => {
  globalThis.webR = new WebR();
  await globalThis.webR.init();
  await globalThis.webR.installPackages(['attempt'])
  app.listen(3000, '0.0.0.0', () => {
    console.log('http://localhost:3000')
  })
})();


app.get('/', async (req, res) => {
  res.send("hello")
});

If I launch the app twice, the packages are downloaded twice 👇

$ node index.js
webR is ready
Downloading webR package: rlang

Downloading webR package: attempt

http://localhost:3000

$ node index.js
webR is ready
Downloading webR package: rlang

Downloading webR package: attempt

http://localhost:3000

This approach is definitely suboptimal: imagine having to reinstall packages every time you source() an R script, instead of benefiting from pre-installed packages in your lib. That’s kind of what is happening right now in this webR example.

Sure, it works, but it means that:

• I’m downloading the (same) packages every time the app is launched, which feels weird
• If I have a lot of packages, it would take a lot of time every time
• I can’t deploy this on a service that has no access to internet
• I can’t build my app just as any other language does: by relying on pre-downloaded /pre-installed modules
• I can’t benefit from caching the package installation in a Docker layer

So, faced with something I needed but didn’t find, I behave like any other software engineer: I built my own solution to pre-load R packages in webR, without having to re-download them every time. The rest of this blogpost explains this process.

Preloading R packages in my ExpressJS/webR API

> setwd(tempdir())
> dir.create("webr_packages")
> install.packages("dplyr", lib="webr_packages", repos = "https://repo.r-wasm.org/")
# [...TRUNCATED]
* DONE (dplyr)
> list.files("webr_packages/")
[1] "dplyr"

#!/usr/bin/env Rscript

# This script only works if you pass it at least one arg
if (is.na(commandArgs(trailingOnly = TRUE)[1])) {
  stop("This script requires at least one argument")
} else {
  pk_to_install <- commandArgs(trailingOnly = TRUE)[1]
}

# If no second value, defaulting to webr_packages
if (is.na(commandArgs(trailingOnly = TRUE)[2])) {
  path_to_installation <- "./webr_packages"
} else {
  path_to_installation <- commandArgs(trailingOnly = TRUE)[2]
}

# Build the repos url
repos <- sprintf(
  "https://repo.r-wasm.org/bin/emscripten/contrib/%s.%s",
  # Get major R version
  R.version$major,
  substr(R.version$minor, 1, 1)
)

deps <- unique(
  unlist(
    use.names = FALSE,
    tools::package_dependencies(
      recursive = TRUE,
      pk_to_install
    )
  )
)

# Now the package list
pkg_deps <- c(
  pk_to_install,
  deps
)

# I don't want to re-download things so I'm listing all the already
# downloaded folders
already_installed <- list.files(
  path_to_installation
)

# Getting the list of available package
info <- utils::available.packages(contriburl = repos)

# Now we can install
for (pkg in pkg_deps){
  # Don't redownload things
  if (pkg %in% already_installed) {
    message("Package ", pkg, " already installed")
    next
  }
  # Not available: either it's not on the repo or it's included
  # in the base distribution of R
  if (!(pkg %in% info[, "Package"])) {
    message("Package {", pkg, "} not found in repo (unavailable or is base package)")
    next
  }
  message("Installing ", pkg)
  # Name of the targz, should be on the form of pkg_version.this.that.tgz
  targz_file <- paste0(pkg, "_", info[info[, "Package"] == pkg, "Version"], ".tgz")
  # Location of file on the repo
  url <- paste0(repos, "/", targz_file)
  # Download the file and untar the archive on the local lib
  tmp <- tempfile(fileext = ".tgz")
  download.file(url, destfile = tmp)
  untar(tmp, exdir = path_to_installation)
  unlink(tmp)
}

message("Done")

mkdir webr_packages
script tools/installR.r attempt
✔ Loading metadata database ... done
Installing attempt
trying URL 'https://repo.r-wasm.org/bin/emscripten/contrib/4.3/attempt_0.3.1.tgz'
Content type 'application/x-tar' length 93561 bytes (91 KB)
==================================================
downloaded 91 KB

Installing rlang
trying URL 'https://repo.r-wasm.org/bin/emscripten/contrib/4.3/rlang_1.1.1.tgz'
Content type 'application/x-tar' length 1062482 bytes (1.0 MB)
==================================================
downloaded 1.0 MB

Done

Rscript -e "fs::dir_tree('webr_packages')"
webr_packages
├── attempt
│   ├── DESCRIPTION
│   ├── INDEX
│   ├── LICENSE
│   ├── Meta
│   │   ├── Rd.rds
│   │   ├── features.rds
│   │   ├── hsearch.rds
│   │   ├── links.rds
│   │   ├── nsInfo.rds
│   │   ├── package.rds
│   │   └── vignette.rds
│   ├── NAMESPACE
│   ├── NEWS.md
│   ├── R
│   │   ├── attempt
│   │   ├── attempt.rdb
│   │   └── attempt.rdx
│   ├── doc
│   │   ├── a_intro_attempt.R
│   │   ├── a_intro_attempt.Rmd
│   │   ├── a_intro_attempt.html
│   │   ├── b_try_catch.R
│   │   ├── b_try_catch.Rmd
│   │   ├── b_try_catch.html
│   │   ├── c_adverbs.R
│   │   ├── c_adverbs.Rmd
│   │   ├── c_adverbs.html
│   │   ├── d_if.R
│   │   ├── d_if.Rmd
│   │   ├── d_if.html
│   │   ├── e_conditions.R
│   │   ├── e_conditions.Rmd
│   │   ├── e_conditions.html
│   │   └── index.html
│   ├── help
│   │   ├── AnIndex
│   │   ├── aliases.rds
│   │   ├── attempt.rdb
│   │   ├── attempt.rdx
│   │   └── paths.rds
│   └── html
│       ├── 00Index.html
│       └── R.css
└── rlang
    ├── DESCRIPTION
    ├── INDEX
    ├── LICENSE
    ├── Meta
    │   ├── Rd.rds
    │   ├── features.rds
    │   ├── hsearch.rds
    │   ├── links.rds
    │   ├── nsInfo.rds
    │   └── package.rds
    ├── NAMESPACE
    ├── NEWS.md
    ├── R
    │   ├── rlang
    │   ├── rlang.rdb
    │   └── rlang.rdx
    ├── backtrace-ver
    ├── help
    │   ├── AnIndex
    │   ├── aliases.rds
    │   ├── figures
    │   │   ├── lifecycle-archived.svg
    │   │   ├── lifecycle-defunct.svg
    │   │   ├── lifecycle-deprecated.svg
    │   │   ├── lifecycle-experimental.svg
    │   │   ├── lifecycle-maturing.svg
    │   │   ├── lifecycle-questioning.svg
    │   │   ├── lifecycle-retired.svg
    │   │   ├── lifecycle-soft-deprecated.svg
    │   │   ├── lifecycle-stable.svg
    │   │   ├── lifecycle-superseded.svg
    │   │   └── logo.png
    │   ├── paths.rds
    │   ├── rlang.rdb
    │   └── rlang.rdx
    ├── html
    │   ├── 00Index.html
    │   └── R.css
    └── libs
        └── rlang.so

const fs = require('fs');
const path = require('path');

// comments are mine

// Recursive function to get files, thank you chatGPT
function getDirectoryTree(dirPath, currentPath = '') {
  // Get a list of all the files/folders in the currently inspected folder
  const items = fs.readdirSync(path.join(dirPath, currentPath));
  // output
  const tree = [];

  // Looping on all the files/folders
  for (const item of items) {
    // Inspecting the item
    const itemPath = path.join(dirPath, currentPath, item);
    const isDirectory = fs.statSync(itemPath).isDirectory();
    const relativePath = path.join(currentPath, item);

    if (isDirectory) {
      // If it's a directory, we'll go inside and repeat the
      // current mechanism
      const subtree = getDirectoryTree(dirPath, relativePath);
      // pushing the current item, and its subtree
      tree.push({ path: relativePath, type: 'directory' });
      tree.push(...subtree);
    } else {
      tree.push({ path: relativePath, type: 'file' });
    }
  }
  // Getting the tree
  return tree;
}

> getDirectoryTree("webr_packages")
[
  { path: 'attempt', type: 'directory' },
  { path: 'attempt/DESCRIPTION', type: 'file' },
  { path: 'attempt/INDEX', type: 'file' },
  { path: 'attempt/LICENSE', type: 'file' },
  { path: 'attempt/Meta', type: 'directory' },
  { path: 'attempt/Meta/Rd.rds', type: 'file' },
  { path: 'attempt/Meta/features.rds', type: 'file' },
  { path: 'attempt/Meta/hsearch.rds', type: 'file' },
  { path: 'attempt/Meta/links.rds', type: 'file' },
  { path: 'attempt/Meta/nsInfo.rds', type: 'file' },
  { path: 'attempt/Meta/package.rds', type: 'file' },
  { path: 'attempt/Meta/vignette.rds', type: 'file' },
  { path: 'attempt/NAMESPACE', type: 'file' },
  { path: 'attempt/NEWS.md', type: 'file' },
  { path: 'attempt/R', type: 'directory' },
  { path: 'attempt/R/attempt', type: 'file' },
  { path: 'attempt/R/attempt.rdb', type: 'file' },
  { path: 'attempt/R/attempt.rdx', type: 'file' },
  { path: 'attempt/doc', type: 'directory' },
  { path: 'attempt/doc/a_intro_attempt.R', type: 'file' },
  { path: 'attempt/doc/a_intro_attempt.Rmd', type: 'file' },
  { path: 'attempt/doc/a_intro_attempt.html', type: 'file' },
  { path: 'attempt/doc/b_try_catch.R', type: 'file' },
  { path: 'attempt/doc/b_try_catch.Rmd', type: 'file' },
  { path: 'attempt/doc/b_try_catch.html', type: 'file' },
  { path: 'attempt/doc/c_adverbs.R', type: 'file' },
  { path: 'attempt/doc/c_adverbs.Rmd', type: 'file' },
  { path: 'attempt/doc/c_adverbs.html', type: 'file' },
  { path: 'attempt/doc/d_if.R', type: 'file' },
  { path: 'attempt/doc/d_if.Rmd', type: 'file' },
  { path: 'attempt/doc/d_if.html', type: 'file' },
  { path: 'attempt/doc/e_conditions.R', type: 'file' },
  { path: 'attempt/doc/e_conditions.Rmd', type: 'file' },
  { path: 'attempt/doc/e_conditions.html', type: 'file' },
  { path: 'attempt/doc/index.html', type: 'file' },
  { path: 'attempt/help', type: 'directory' },
  { path: 'attempt/help/AnIndex', type: 'file' },
  { path: 'attempt/help/aliases.rds', type: 'file' },
  { path: 'attempt/help/attempt.rdb', type: 'file' },
  { path: 'attempt/help/attempt.rdx', type: 'file' },
  { path: 'attempt/help/paths.rds', type: 'file' },
  { path: 'attempt/html', type: 'directory' },
  { path: 'attempt/html/00Index.html', type: 'file' },
  { path: 'attempt/html/R.css', type: 'file' },
  { path: 'rlang', type: 'directory' },
  { path: 'rlang/DESCRIPTION', type: 'file' },
  { path: 'rlang/INDEX', type: 'file' },
  { path: 'rlang/LICENSE', type: 'file' },
  { path: 'rlang/Meta', type: 'directory' },
  { path: 'rlang/Meta/Rd.rds', type: 'file' },
  { path: 'rlang/Meta/features.rds', type: 'file' },
  { path: 'rlang/Meta/hsearch.rds', type: 'file' },
  { path: 'rlang/Meta/links.rds', type: 'file' },
  { path: 'rlang/Meta/nsInfo.rds', type: 'file' },
  { path: 'rlang/Meta/package.rds', type: 'file' },
  { path: 'rlang/NAMESPACE', type: 'file' },
  { path: 'rlang/NEWS.md', type: 'file' },
  { path: 'rlang/R', type: 'directory' },
  { path: 'rlang/R/rlang', type: 'file' },
  { path: 'rlang/R/rlang.rdb', type: 'file' },
  { path: 'rlang/R/rlang.rdx', type: 'file' },
  { path: 'rlang/backtrace-ver', type: 'file' },
  { path: 'rlang/help', type: 'directory' },
  { path: 'rlang/help/AnIndex', type: 'file' },
  { path: 'rlang/help/aliases.rds', type: 'file' },
  { path: 'rlang/help/figures', type: 'directory' },
  { path: 'rlang/help/figures/lifecycle-archived.svg', type: 'file' },
  { path: 'rlang/help/figures/lifecycle-defunct.svg', type: 'file' },
  { path: 'rlang/help/figures/lifecycle-deprecated.svg', type: 'file' },
  { path: 'rlang/help/figures/lifecycle-experimental.svg',type: 'file'},
  { path: 'rlang/help/figures/lifecycle-maturing.svg', type: 'file' },
  { path: 'rlang/help/figures/lifecycle-questioning.svg',type: 'file'},
  { path: 'rlang/help/figures/lifecycle-retired.svg', type: 'file' },
  { path: 'rlang/help/figures/lifecycle-soft-deprecated.svg',type: 'file'},
  { path: 'rlang/help/figures/lifecycle-stable.svg', type: 'file' },
  { path: 'rlang/help/figures/lifecycle-superseded.svg', type: 'file' },
  { path: 'rlang/help/figures/logo.png', type: 'file' },
  { path: 'rlang/help/paths.rds', type: 'file' },
  { path: 'rlang/help/rlang.rdb', type: 'file' },
  { path: 'rlang/help/rlang.rdx', type: 'file' },
  { path: 'rlang/html', type: 'directory' },
  { path: 'rlang/html/00Index.html', type: 'file' },
  { path: 'rlang/html/R.css', type: 'file' },
  { path: 'rlang/libs', type: 'directory' },
  { path: 'rlang/libs/rlang.so', type: 'file' }
]

async function loadPackages(webR, dirPath){
  // Our function from before
  const files = getDirectoryTree(
    dirPath
  )
  for await (const file of files) {
    // If the entry is a directory, we'll
    // call mkdir
    if (file.type === 'directory') {
      await globalThis.webR.FS.mkdir(
        `/usr/lib/R/library/${file.path}`,
      );
    } else {
    // case 2, the entry is a file, then we can use fs.readFileSync
    // That will return a ArrayBuffer that can be directly passed
    // to webR.FS.writeFile
      const data = fs.readFileSync(`webr_packages/${file.path}`);
      await globalThis.webR.FS.writeFile(
        `/usr/lib/R/library/${file.path}`,
        data
      );
    }
  }
}

cd webr-example
mkdir webr-preloadr
cd webr-preloadr
npm init -y
npm install express webr webrtools
Rscript ./node_modules/webrtools/r/install.R dplyr
touch index.js

const app = require('express')()
const path = require('path');
const { loadPackages } = require('webrtools');
const { WebR } = require('webr');

(async () => {
  globalThis.webR = new WebR();
  await globalThis.webR.init();

  console.log("🚀 webR is ready 🚀");

  await loadPackages(
    globalThis.webR,
    path.join(__dirname, 'webr_packages')
  )

  console.log("📦 Packages written to webR 📦");

  const res = await globalThis.webR.FS.lookupPath("/usr/lib/R/library");
  console.log(res)

  await globalThis.webR.evalR("library(dplyr)");
  app.listen(3000, '0.0.0.0', () => {
    console.log('http://localhost:3000')
  })
})();


app.get('/', async (req, res) => {
  let result = await globalThis.webR.evalR('sample_n(mtcars, 10)');
  let output = await result.toJs();
  res.send(output.values)
});

node index.js

$ curl http://localhost:3000
[{"type":"double","names":null,"values":[21,24.4,14.3,32.4,18.7,17.8,22.8,10.4,30.4,21.4]},{"type":"double","names":null,"values":[6,4,8,4,8,6,4,8,4,4]},{"type":"double","names":null,"values":[160,146.7,360,78.7,360,167.6,108,460,75.7,121]},{"type":"double","names":null,"values":[110,62,245,66,175,123,93,215,52,109]},{"type":"double","names":null,"values":[3.9,3.69,3.21,4.08,3.15,3.92,3.85,3,4.93,4.11]},{"type":"double","names":null,"values":[2.62,3.19,3.57,2.2,3.44,3.44,2.32,5.424,1.615,2.78]},{"type":"double","names":null,"values":[16.46,20,15.84,19.47,17.02,18.9,18.61,17.82,18.52,18.6]},{"type":"double","names":null,"values":[0,1,0,1,0,1,1,0,1,1]},{"type":"double","names":null,"values":[1,0,0,1,0,0,1,0,1,1]},{"type":"double","names":null,"values":[4,4,3,4,3,4,4,3,4,4]},{"type":"double","names":null,"values":[4,2,4,1,2,4,1,4,2,2]}]

FROM r-base:4.3.1

# Create app directory
WORKDIR /usr/src/app

RUN apt update && \
  apt install nodejs npm -y

COPY package*.json ./

RUN npm install

RUN Rscript ./node_modules/webrtools/r/install.R dplyr

COPY . .

EXPOSE 3000

CMD [ "node", "index.js" ]

docker run -it -p 3000:3000 colinfay/webr-preloadr

Final notes

Introductory notes

Before starting, here are two notes regarding the app built in this post:

• this app could have been build in full “web mode” (no server required, just an HTML page), but this is not the approach I’m currently experimenting with. Going full browser-based doesn’t work for all cases, and most of the time with production apps you’ll need some part of your code to be computed by the server (because of resources, because you’ll connect to API with token, because you need access to DB with passwords, because you don’t want the full data to be available in the brower, or many other good reason…).

• In order to recreate the app, my first approach was to try to draw the histogram in base R and send it back to the browser. boB has a great blogpost about how to do exactly that, but after a lot of bad code and good 4 letter words, I realized there was no sane reason for me to display a base R plot instead of a JavaScript based one. That’s why I chose to return the data for the barplot (using the cut() function from R) and draw with chart.js, instead of trying to display the “not so user friendly” base plot.

Project init

Let’s start by creating a new Express app:

mkdir express-webr-old-faithful
cd express-webr-old-faithful
npm init -y
# Installing the deps we'll need
npm i @r-wasm/webr express
# Creating a server, and the front page
touch index.js
touch index.html

Server

Let’s move to the server side first (index.js ). We’ll start by taking the file from the previous blog post, and modify it to:

• serve index.html on /
• create a route that returns the data of the bins for our histogram

Let’s start with our code to init webR.

'use strict';
const express = require("express")
// For serving the html
const path = require("path")
const app = express()
const { WebR } = require('@r-wasm/webr');

(async () => {
  globalThis.webR = new WebR();
  await globalThis.webR.init();
  // Given that we will reuse this value,
  // we assign it at launch
  await globalThis.webR.evalR('x <- faithful[, 2]')
  console.log("webR is ready");
  app.listen(3000, '0.0.0.0', () => {
    console.log('http://localhost:3000')
  })
})();

Then, an endpoint that serves index.html:

app.get("/", (req, res) => {
  res.sendFile(path.join(__dirname, "index.html"))
})

And an endpoint that sends the bins for our plot, using ExpressJS parameter notation (path/:n). The value is sent to webR via the env option of evalR

app.get("/hist-data/:n", async (req, res) => {
  let result = await globalThis.webR.evalR(
    'table(cut(x, seq(min(x), max(x), length.out = n + 1)))',
    { env: { n: parseInt(req.params.n) } }
  );
  let output = await result.toJs();
  res.send(output)
})

Now that our backend is ready, let’s check that we can now call it from the command line:

curl http://localhost:3000/hist-data/10
{"type":"integer","names":["(43,48.3]","(48.3,53.6]","(53.6,58.9]","(58.9,64.2]","(64.2,69.5]","(69.5,74.8]","(74.8,80.1]","(80.1,85.4]","(85.4,90.7]","(90.7,96]"],"values":[15,28,26,24,9,23,62,55,23,6]}

Front

Now, time to build the front.

We’ll start with the Boostrap boilerplate from https://getbootstrap.com/docs/5.3/getting-started/introduction/#quick-start.

Note also that I’ve chosen (for simplicity’s sake) to use the CDN version of the external deps, instead of installing them in my Node project, which would be what I would do in a normal context.

<!doctype html>
<html lang="en">
  <head>
    <meta charset="utf-8">
    <meta name="viewport" content="width=device-width, initial-scale=1">
    <title>Bootstrap demo</title>
    <link href="https://cdn.jsdelivr.net/npm/bootstrap@5.3.0/dist/css/bootstrap.min.css" rel="stylesheet" integrity="sha384-9ndCyUaIbzAi2FUVXJi0CjmCapSmO7SnpJef0486qhLnuZ2cdeRhO02iuK6FUUVM" crossorigin="anonymous">
  </head>
  <body>
    <h1>Hello, world!</h1>
    <script src="https://cdn.jsdelivr.net/npm/bootstrap@5.3.0/dist/js/bootstrap.bundle.min.js" integrity="sha384-geWF76RCwLtnZ8qwWowPQNguL3RmwHVBC9FhGdlKrxdiJJigb/j/68SIy3Te4Bkz" crossorigin="anonymous"></script>
  </body>
</html>

Let’s change the title, and add:

• the range input
• a div to receive the chart

<div class="container">
  <h1>Old Faithful Geyser Data</h1>
  <!-- Bootstrap grid system -->
  <div class="row align-items-start">
    <div class="col-4">
      <label for="customRange1" class="form-label">Number of bins:</label>
      <input type="range" class="form-range" id="customRange1" min=1 max=30 value=10>
      <div id="bins">Selected: 10</div>
    </div>
    <div class="col-8">
      <div>
        <!-- Where we'll get the chart drawn -->
        <canvas id="myChart"></canvas>
      </div>
    </div>
  </div>
</div>

In order to draw the graph, I’ll rely on a dead simple (yet powerful) JavaScript lib called Chart.js. It has a great bar chart graph that will work perfectly for our case.

Let’s start by adding the lib with <script src="https://cdn.jsdelivr.net/npm/chart.js"></script>.

We then need some JavaScript to:

• Initiate the chart at launch

// https://colinfay.me/api-from-client-shiny/
// Default to 10 bins
fetch("hist-data/10")
      .then((data) =>{
        // Convert the data to json and
        // create a chart
        data.json().then((res) => {
          // Keeping a global object with the chart
          globalThis.chart = new Chart(
          // This is where the chart will go
          document.getElementById('myChart'), {
          type: 'bar',
          data: {
            // webR returns the names
            labels: res.names,
            datasets: [{
              label: "Histogram of waiting times",
              data: res.values
            }]
          }
        });
        })
        .catch((error) => {
          alert("Error catchin result from R")
        })
      })
      .catch((error) => {
        alert("Error catchin result from R")
      })

• Update the chart when the slider is moved

    const update = function (n = 10) {
      fetch(`hist-data/${n}`).then((data) => {
        data.json().then((res) => {
          globalThis.chart.data.labels = res.names;
          globalThis.chart.data.datasets.forEach(dataset => {
            dataset.data = res.values;
          })
          globalThis.chart.update();
        })
      })
      document.querySelector('#bins').innerHTML = `Selected: ${n}`;

    }
document.querySelector('#customRange1').addEventListener(
  'change',
  function() { update(this.value); }
 );

And here it is! You can see the app live at srv.colinfay.me/express-webr-old-faithful. You can find the code here.

You can also try it with:

docker run -it -p 3000:3000 colinfay/express-webr-old-faithful

webR? wat again?

As described in the doc:

WebR is a version of the statistical language R compiled for the browser and Node.js using WebAssembly, via Emscripten.

In this post, I won’t go into details into what webR is, as if you want to know more, you’ll probably get a better understanding by going through the documentation.

But if like a normal person you don’t read the doc, let’s sum up what webR is. Simply put, WebAssembly (shorten wasm) is a format that can be used to encode a programming language to something that can then be called from a JavaScript runtime (in the browser or in NodeJS). Schematically, you take one language, you translate it to wasm, and the output can be read and used from JavaScript.

If you still have no idea what wasm is but want to get a better grasp on what it is, I suggest reading this blogpost that really sums it well, especially this quote:

WASM is a way to use non-Javascript code and run it in your browser.

I also suggest reading the blogposts by boB on the subject.

The rest of this post assume that you understand what wasm & webR are.

Playing with webR

I’ve been interested with WebAssembly for a while now, and can remember talking about it late during the night at R conferences around 2018 and 2019… but that’s a story for another time 😅

Today’s story is about exploring how to build tools in JavaScript that will call webR.

I’ll try to document my experimentations, and this post is the first one of a series that I hope I’ll find time to continue over the summer.

Hello World! - Creating an API where we call webR

I’ll start with a simple Express JS REST API that uses webR to run R code.

# Initiating a projet and opening it with VSCode
mkdir webrexpresshelloworld
code webrexpresshelloworld

# Quick init of a node project
npm init -y
touch index.js
npm install express

We’ll now install the webR nodejs package

npm i @r-wasm/webr

And now, let’s move to our index.js file. We’ll start with the basics of Express JS: creating the app object.

// Creating the express app
const app = require('express')()

Then, we’ll import WebR from @r-wasm/webr.

// importing the `WebR` class inside the runtime
const { WebR } = require('@r-wasm/webr');

We’ll now be initiating the webR session by: - creating an instance of webR - binding it to globalThis so that it’s available everywhere - calling the init method - Once webR is ready, we’ll launch the app

As webR communicates via the worker thread asynchronously, we need to use async/await.

(async () => {
  globalThis.webR = new WebR();
  await globalThis.webR.init();
  console.log("webR is ready");
  // Starting the express app
  // only after webR is ready
  app.listen(3000, () => {
    console.log('http://localhost:3000')
  })
})();

Finally, we add a route that returns an hello world:

// Creating a route for the express app
// that will return a titleCase hello world from r
app.get('/', async (req, res) => {
  // Evaluating the R code inside the R worker
  let result = await globalThis.webR.evalR('tools::toTitleCase("hello from r!")');
  // Converting the result to a JS object
  let output = await result.toJs();
  // Sending the result back to the client,
  // (webR outputs an object with types/names/values
  // and here we only want the values)
  res.send(output.values)
});

And now, let’s run our app!

node index.js

You can find the code here, and see it live at srv.colinfay.me/express-webr-hello-world.

You can also try it with

docker run -it -p 3000:3000 colinfay/express-webr-hello-world

Disclaimer

Disclaimer Obviously, this post contains a big spoiler about Advent of Code, as it gives solutions for solving 2021-02.

[Disclaimer bis] I’m no JavaScript expert so this might not be the perfect solution. TBH, that’s also the case for the R solution.

About the JavaScript code

The JavaScript code has been written in the same RMarkdown as the R code. It runs thanks to the {bubble} package: https://github.com/ColinFay/bubble.

bubble::set_node_engine()

Instructions

Reading inputs

# Read
ipt <- read.delim("2021-02-aoc.txt", header = FALSE)$V1

const fs = require('fs')
var ipt = fs.readFileSync("2021-02-aoc.txt", 'utf8').split("\n").filter(x => x.length != 0);

Part one

# Horizontal and depth
start_pos <- c(horizontal = 0, depth = 0)
for (moves in ipt) {
  move <- strsplit(moves, " ")[[1]]

  if (move[1] == "up") {
    start_pos[2] <- start_pos[2] - as.numeric(move[2])
  }
  if (move[1] == "down") {
    start_pos[2] <- start_pos[2] + as.numeric(move[2])
  }
  if (move[1] == "forward") {
    start_pos[1] <- start_pos[1] + as.numeric(move[2])
  }
}

start_pos[1] * start_pos[2]

## horizontal
##    1727835

var start_pos = [0, 0]

// Gotcha: R for(x in y) is JS for(x of y)

for (moves of ipt) {
  // In JS, object have methods, so the split function
  // is containes inside the string object
  move = moves.split(' ')

  // Small gotcha here, JS i 0 based index
  if (move[0] == "up") {
    // R as.numeric is parseInt()
    start_pos[1] = start_pos[1] - parseInt(move[1])
  }
  if (move[0] == "down") {
    start_pos[1] = start_pos[1] + parseInt(move[1])
  }
  if (move[0] == "forward") {
    start_pos[0] = start_pos[0] + parseInt(move[1])
  }
}

start_pos[0] * start_pos[1]

## 1727835

Part two

# Horizontal, depth, and aim
start_pos <- c(horizontal = 0, depth = 0, aim = 0)
for (moves in ipt) {
  move <- strsplit(moves, " ")[[1]]

  if (move[1] == "up") {
    start_pos[3] <- start_pos[3] - as.numeric(move[2])
  }
  if (move[1] == "down") {
    start_pos[3] <- start_pos[3] + as.numeric(move[2])
  }
  if (move[1] == "forward") {
    start_pos[1] <- start_pos[1] + as.numeric(move[2])
    start_pos[2] <- start_pos[2] + (start_pos[3] * as.numeric(move[2]))
  }
}

start_pos[1] * start_pos[2]

## horizontal
## 1544000595

var start_pos = [0, 0, 0]

for (moves of ipt) {
  move = moves.split(' ')
  if (move[0] == "up") {
    start_pos[2] = start_pos[2] - parseInt(move[1])
  }
  if (move[0] == "down") {
    start_pos[2] = start_pos[2] + parseInt(move[1])
  }
  if (move[0] == "forward") {
    start_pos[0] = start_pos[0] + parseInt(move[1])
    start_pos[1] = start_pos[1] + (start_pos[2] * parseInt(move[1]))
  }
}

start_pos[0] * start_pos[1]

## 1544000595

Disclaimer

Disclaimer Obviously, this post contains a big spoiler about Advent of Code, as it gives solutions for solving day 1.

[Disclaimer bis] I’m no JavaScript expert so this might not be the perfect solution. TBH, that’s also the case for the R solution.

About the JavaScript code

The JavaScript code has been written in the same RMarkdown as the R code. It runs thanks to the {bubble} package: https://github.com/ColinFay/bubble

Instructions

• Count the number of times n is larger that n-1

• Count the number of times n + n-1 + n-2 is larger that n-1 + n-2 + n-3

Find the complete instructions at: https://adventofcode.com/2021/day/1.

Reading inputs

# Read
library(purrr)
ipt <- read.delim("2021-01-aoc.txt", header = FALSE)$V1

// Reading the file and converting it to int

const fs = require('fs')
var ipt = fs.readFileSync("2021-01-aoc.txt", 'utf8').split("\n").filter(x => x.length != 0);
ipt = ipt.map(x => parseInt(x));

Part one

2:length(ipt) |>
  map_dbl(
    ~ ipt[.x] - ipt[.x - 1]
  ) |>
  keep(
    ~ .x > 0
  ) |>
  length()

## [1] 1154

ipt.map(
  // inside map() in JS, the second argument to the anonymous
  // function is the index inside the array.
  // It mimics what we have in map(2:length(ipt)) in R
  (x, y) => ipt[y] - ipt[y-1]
  ).filter(
    // filter() will keep the element that matches the anonymous
    // predicate function
    x => x >= 0
    ).length;

## 1154

Part two

tmp <- 3:length(ipt) |>
  map_dbl(
    ~ ipt[.x] + ipt[.x - 1] + ipt[.x - 2]
  )

2:length(tmp) |>
  map_dbl(
    ~ tmp[.x] - tmp[.x - 1]
  ) |>
  keep(
    ~ .x > 0
  ) |>
  length()

## [1] 1127

var tmp = ipt.
  map(
    // Creating n + n-1 + n-2
    (x, y) => ipt[y] + ipt[y-1] + ipt[y-2]
    );

tmp.
  map(
    // Same as part 1
    (x, y) => tmp[y] - tmp[y-1]
    ).
  filter(
    // keeping the ones that have raised
    x => x > 0
  ).
  length;

## undefined
## undefined
## 1127

Multi-page in {shiny}, and random thoughts about designing web applications

Something that has been bugging me for a while is the inability to really share a specific part of a {shiny} dashboard, at least natively, using a specific path. In other words, I’ve always wanted to be able to do something like my-uberapp.io/contact to share with someone a specific part of the app. And only this part.

Another need I was facing, probably born out of building web applications using NodeJS, is a natural way to manipulate endpoints, http requests and responses, so that I could do something pretty common in web application: a home page, and next to it a login page that verifies your identity, and redirects you to another page after setting a cookie. That of course, leads to the necessity of having the ability to define various endpoints with a specific behavior for each: a unique UI, and a 18 server response. Pure, native, multi-endpoint applications, not one big ball of UI with parts hidden using JavaScript & CSS, and a global server function that might launch computation you don’t need for your page.

A few weeks back, I’ve decided to focus on this question. Multi-page in {shiny} is not new: I’ve found both {shiny.router}, and {blaze} that already implement a form of “multi-page”.

Note: both these packages work perfectly, and they definitely do what they are designed for. There are the product of tremendous work with smart implementations and my goal is in no way to undermine these packages. They just don’t answer the need I was having, hence my new approach to this question. {brochure} will answer the needs for more large and complex applications built with {shiny}, while both the {shiny.router} & {blaze} should be easier to get started with.

As far as I saw it, these two packages didn’t answer what I was looking for: “real” multi-page. Both {shiny.router} & {blaze} still produce a form of Single Page Application, but plays with the URL to make you feel like you’re on a multi-page application.

For example, {shiny.router} hides the parts of the app via JS & CSS – if you browse the source code, you’ll still see the hidden HTML. That also implies that they are potential conflicts between ids: you have to be sure that all your pages have unique id on their ouputs/inputs, otherwise the app doesn’t render, meaning that a “page” doesn’t have its own server function. And of course, if you look at the Network tab of your browser developer tool, you’ll see that there is no new GET request made whenever a new “page” is loaded: this new page is still the same application, with parts hidden through JavaScript.

Hiding UI parts is a practice that has always been bothering me in term of performance – on a large {shinydashboard}, for example, you’ll be transferring the full HTML, CSS and JavaScript for the whole application when the app launches, even if the user never visits all the tabs. {shiny} is very smart when it comes to transferring CSS and JS files: for example, it will only serve the external resources for the sliderInput() if there is one in the app. But if you’ve got a {shinydashboard} dashboard with 19 pages, and the sliderInput() is on page 19 and will only be seen by 0.1% of the visitors, it will still be transferred to every user, regardless of whether or not they need it. This might result in lowering the performance of the app, as it might be raising the time to ‘First Meaningful Paint’, and of course it is a waste of resources, especially if your application is served to people with low bandwidth, and/or browsing your app using cellular data. I know this is a question you’ve probably never asked yourself before ;) - but performance is a pretty common question in the web development world, and something to be aware if you’re serving your app at scale. If this is something you’re interested in, I suggest reading Why does speed matter? from the Google dev center, and Web Performance from Mozilla Web Docs. See also 14.2.2 Profiling {shiny} from the Engineering Shiny book.

And, another final thing I wanted is a way to “flush” objects when you change page: in the current implementation of {shinydashboard}, if you create something on tab1, it will still be there in tab2, taking some space in the RAM, even if you don’t need it. It’s rather convenient because you don’t have to think about these things: you start a {shiny} session, and all the objects will still be there as long as the session lives. But that also means that as soon as the session stops, there is no way to get the values back as they only live in the RAM, inside the session.

On the other hand, with an implementation where every page gets its own {shiny} session, you need to find a way to identify the user with a form of id, save the relevant values (potentially write in a DB), then fetch these values again using the id stored in the browser (typically, you have a session cookie in the browser that is used as a key to search the DB). A process forcing you to think more carefully about the data flow of your app. What that also means is that as the id is a cookie in the browser, whenever the app crashes, it will be able to reload to the exact same place as long as the cookie is still in the browser (well, not exactly but you understand the idea).

So, back to our first topic – what was I looking for? My goal was to find a way to build {shiny} applications that are natively multi-page. In other words, an application that answers to a request on /page2, not an app that silently redirect to /, nor an application that requires playing with /#!/page2 in the url. (Reminder, # is traditionally used as an anchor tag in a web page). And, of course, I wanted each page to have its own shiny session, its own UI and server functions.

I was also looking for a way to manipulate both the GET request from the server and the httpResponse that is sent back, for example in order to set httpOnly cookies in the header of the HTTP Response or change the HTTP status code, the same way you can manipulate these when building an application with NodeJS for example. This is something that you’d find in the {ambiorix} project by the amazing John Coene (who will get some SEO juice thanks to this backlink). It’s an amazing approach that definitely resonated with me as I’ve been a NodeJS & express.js user for some time now, but that’s still far from the way you’d build things in {shiny}, and will probably require a lot of coding to get an application up and running (which is good, because I love coding, but let’s use our {shiny} knowledge for now :) ).

To sum up, I wanted a way to get closer to how you build applications in other languages, but will as little deviation as possible from the {shiny} way of building apps.

Here comes {brochure}

As said on the top of the article, this package is still a work in progress, so you might see some changes in the near future :)

[Disclaimer, again] The way you will build applications with {brochure} is different from the way you usually build {shiny} apps, as we no longer operate under the single page app paradigm. Please keep this in mind and everything should be fine.

remotes::install_github("ColinFay/brochure")

library(shiny)
library(brochure)

## 
## Attaching package: 'brochure'

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

brochureApp(
  # First page
  page(
    href = "/",
    ui = fluidPage(
      h1("This is my first page"), 
      plotOutput("plot")
    ),
    server = function(input, output, session){
      output$plot <- renderPlot({
        plot(iris)
      })
    }
  ), 
  # Second page, without any server-side function
  page(
    href = "/page2", 
    ui =  fluidPage(
      h1("This is my second page"), 
      tags$p("There is no server function in this one")
    )
  )
)

brochureApp(
  page(
    href = "/",
    ui = tagList(
      h1("This is my first page")
    )
  ),
  redirect(
    from = "/nothere",
    to =  "/"
  ),
  redirect(
    from = "/colinfay",
    to =  "https://colinfay.me"
  )
)

req_handlers & res_handlers

log_where <- function(req){
  cli::cat_rule(
    sprintf(
      "%s - %s", 
      Sys.time(), 
      req$PATH_INFO
    )
  )
  req
}

nav_links <- tags$ul(
  tags$li(
    tags$a(href = "/", "home"), 
  ),
  tags$li(
    tags$a(href = "/page2", "page2"), 
  ),
  tags$li(
    tags$a(href = "/contact", "contact"), 
  )
)

page_1 <- function(){
  page(
    href = "/",
    ui = function(request){
      tagList(
        h1("This is my first page"),
        nav_links,
        plotOutput("plot")
      )
    },
    server = function(input, output, session){
      output$plot <- renderPlot({
        plot(mtcars)
      })
    }
  )
}

page_2 <- function(){
  page(
    href = "/page2",
    ui =  function(request){
      tagList(
        h1("This is my second page"),
        nav_links,
        plotOutput("plot")
      )
    }, 
    server = function(input, output, session){
      output$plot <- renderPlot({
        plot(mtcars)
      })
    }
  )
}

page_contact <- function(){
  page(
    href = "/contact",
    ui =  tagList(
      h1("Contact us"),
      nav_links,
      tags$ul(
        tags$li("Here"),
        tags$li("There")
      )
    )
  )
}

# Reusing the pages from before
brochureApp(
  req_handlers = list(
    log_where
  ),
  # Pages
  page_1(),
  page_2(),
  page_contact(),
  page(
    href = "/healthcheck",
    # As this is a pure backend exchange, 
    # We don't need a UI
    ui =  tagList(), 
    # As this req_handler returns an httpResponse,
    # This response will be returned directly to the browser, 
    # without passing through the usual dance
    req_handlers = list(
      # If you have shiny < 1.6.0, you'll need to 
      # do shiny:::httpResponse (triple `:`) 
      # as it is not exported until 1.6.0.
      # Otherwise, see ?shiny::httpResponse
      ~ shiny::httpResponse( 200, content = "OK")
    )
  )
)

Listening on http://127.0.0.1:4879
── 2021-02-17 21:52:16 - / ──────────────────────────────
── 2021-02-17 21:52:17 - /page2 ─────────────────────────
── 2021-02-17 21:52:19 - /contact ───────────────────────

> httr::GET("http://127.0.0.1:4879/healthcheck")
Response [http://127.0.0.1:4879/healthcheck]
  Date: 2021-02-17 21:55
  Status: 200
  Content-Type: text/html; charset=UTF-8
  Size: 2 B

brochure::parse_cookie_string( "a=12;session=blabla" )

##        a  session 
##     "12" "blabla"

# Creating a navlink
nav_links <- tags$ul(
  tags$li(
    tags$a(href = "/", "home"), 
  ),
  tags$li(
    tags$a(href = "/login", "login"), 
  ),
  tags$li(
    tags$a(href = "/logout", "logout"), 
  )
)

home <- function(){
  page(
    href = "/",
    ui = tagList(
      h1("This is my first page"), 
      tags$p("It will contain BROCHURECOOKIE depending on the last page you've visited (/login or /logout)"),
      verbatimTextOutput("cookie"),
      nav_links
    ),
    server = function(input, output, session){
      output$cookie <- renderPrint({
        parse_cookie_string(
          session$request$HTTP_COOKIE
        )
      })
    }
  )
}

login <- function(){
  page(
    href = "/login",
    ui =  tagList(
      h1("You've just logged!"),
      verbatimTextOutput("cookie"),
      actionButton("redirect", "Redirect to the home page"),
      nav_links
    ), 
    server = function(input, output, session){
      output$cookie <- renderPrint({
        parse_cookie_string(
          session$request$HTTP_COOKIE
        )
      })
      observeEvent( input$redirect , {
        # Using brochure to redirect to another page
        server_redirect("/")
      })
      
    },
    res_handlers = list(
      # We'll add a cookie here
      function(res, req){
        res$headers$`Set-Cookie` <- "BROCHURECOOKIE=12; HttpOnly;"
        res
      }
    )
  )
}

logout <- function(){
  page(
    href = "/logout",
    ui =  tagList(
      h1("You've logged out"),
      nav_links,
      verbatimTextOutput("cookie"),
      actionButton("redirect", "Redirect to the home page"),
    ), 
    server = function(input, output, session){
      output$cookie <- renderPrint({
        parse_cookie_string(
          session$request$HTTP_COOKIE
        )
      })
      observeEvent( input$redirect , {
        # Using brochure to redirect to another page
        server_redirect("/")
      })
    },
    res_handlers = list(
      # We'll add a cookie here
      function(res, req){
        res$headers$`Set-Cookie` <- "BROCHURECOOKIE=12; Expires=Wed, 21 Oct 1950 07:28:00 GMT"
        res
      }
    )
  )
}

brochureApp(
  # Pages
  home(),
  login(),
  logout()
)

Random notes about design patterns

library(glouton)
# Creating a storage system
cache_system <- cachem::cache_disk(tempdir())

nav_links <- tags$ul(
  tags$li(
    tags$a(href = "/", "home"), 
  ),
  tags$li(
    tags$a(href = "/page2", "page2"), 
  )
)

cookie_set <- function(){
  r <- reactiveValues()
  
  observeEvent(TRUE, {
    # Fetch the cookies using {glouton}
    r$cook <- fetch_cookies()
    
    # If there is no stored cookie for {brochure}, we generate it
    if (is.null(r$cook$brochure_cookie)){
      # Generate a random id
      session_id <- digest::sha1(paste(Sys.time(), sample(letters, 16)))
      # Add this id as a cookie
      add_cookie("brochure_cookie", session_id)
      # Store in in the reactiveValues list
      r$cook$brochure_cookie <- session_id
    }
    # For debugging purpose
    print(r$cook$brochure_cookie )
  }, once = TRUE)
  return(r)
}

page_1 <- function(){
  page(
    href = "/",
    ui = tagList(
      h1("This is my first page"),
      nav_links,
      # The text enter on page 1 will be available on page 2, using
      # a session cookie and a storage system
      textInput("textenter", "Enter a text"), 
      actionButton("save", "Save my text and go to page2")
    ),
    server = function(input, output, session){
      r <- cookie_set()
      observeEvent( input$save , {
        # Use the session id to save on the cache system
        cache_system$set(
          paste0(
            r$cook$brochure_cookie,
            "text"
          ),
          input$textenter
        )
        server_redirect("/page2")
      })
    }
  )
}

page_2 <- function(){
  page(
    href = "/page2",
    ui =  tagList(
      h1("This is my second page"),
      nav_links,
      # The text enter on page 1 will be available here, reading
      # the storage system
      verbatimTextOutput("textdisplay")
    ), 
    server = function(input, output, session){
      r <- cookie_set()
      output$textdisplay <- renderPrint({
        # Getting the content value based on the session cookie
        cache_system$get(
          paste0(
            r$cook$brochure_cookie,
            "text"
          )
        )
      })
    }
  )
}

brochureApp(
  # Setting {glouton} globally
  use_glouton(),
  # Pages
  page_1(),
  page_2()
  # Redirections
)

.
├── DESCRIPTION
├── NAMESPACE
├── R
│   ├── app_config.R
│   ├── home.R ### YOUR PAGE 
│   ├── login.R ### YOUR PAGE 
│   ├── logout.R ### YOUR PAGE 
│   └── run_app.R ### YOUR PAGE 
├── dev
│   ├── 01_start.R
│   ├── 02_dev.R
│   ├── 03_deploy.R
│   └── run_dev.R
├── inst
│   ├── app
│   │   └── www
│   │       ├── favicon.ico
│   └── golem-config.yml
├── man
│   └── run_app.Rd

run_app <- function(
  onStart = NULL,
  options = list(), 
  enableBookmarking = NULL,
  ...
) {
  with_golem_options(
    app = brochureApp(
      # Putting the resources here
      golem_add_external_resources(),
      home(),
      login(),
      logout(),
      onStart = onStart,
      options = options, 
      enableBookmarking = enableBookmarking
    ), 
    golem_opts = list(...)
  )
}

Improvement & further work

• Testers and apps. If you want to give {brochure} a shot, please do! It’s still a young project that needs more testing, so if you feel like you want to build an app with it, please do. I’d be happy to help you if you have some questions so feel free to reach me on Twitter, or comment on the post below.

• Functions to manipulate cookies (create and delete them).

• Built-in handlers for req & res that will answer common use cases.

• Allow a way to implement :id: in the URL, the way express.js does: you can set a route as /profile/:id: and the app will answers to /profile/colin, /profile/jean, /profile/whatever, setting the id as a variable that can be reused in the response. In the context of {shiny}, this would of course be available the server.

• Auto build a proxy based on the application. This will allow to create one R session by page, then create a proxy that will plug each endpoint to an R session, allowing a little bit of scalability “for free”.

If you have any idea or question, please open an issue on the GitHub repo!

Instructions

We have a XMAS code, which:

• Start with 25 numbers

• Any following number should be the sum of one of the possible pairs from the previous 25

• In step 2, find the consecutive set of number that sums to the result of part 1, and add its min and max

Find the complete instructions at: https://adventofcode.com/2020/day/9.

R solution

# Reading the data
input <- read.delim(
  sep = " ",
  "2020-09-aoc.txt",
  header = FALSE,
  stringsAsFactors = FALSE
)

for (i in 26:length(input$V1)){
  # The 25 starting numbers
  to_get <- (i - 25):(i-1)

  # The 26th number should be between the
  # sum of the two lowest number and the sum
  # of the two highest
  lower_bond <- sum(
    head(
      sort(input$V1[to_get]),
      2
    )
  )

  higher_bond <- sum(
    tail(
      sort(
        input$V1[to_get]
      ),
      2
    )
  )

  if (
    !dplyr:::between(input$V1[i], lower_bond, higher_bond)
  ){
    output1 <<- input$V1[i]
    print(output1)
    break

  }
}

## [1] 530627549

for (i in 1:length(input$V1)){
  # We will try to find any sequence in 1:n, then 2:n,
  # then 3:n, etc, that sums to output1
  selection <- input$V1[i:length(input$V1)]
  c_s <- cumsum(selection) == output1
  if (
    any(c_s)
  ){
    bounds <- selection[1:which(c_s)]

    print(
      sum(
        min(bounds),
        max(bounds)
      )
    )
    break
  }
}

## [1] 77730285

Instructions

Input looks like this

nop +0
acc +1
jmp +4
acc +3
jmp -3
acc -99
acc +1
jmp -4
acc +6

• There is a global var called accumulator, starting at 0

• acc n increases or decreases accumulator by n, and goes to next row

• jmp n jumps to a its position + n

• nop does nothing but going to the next execution

• If the program tries to execute a row twice, we stop, and the eturned value is the value just before that

Find the complete instructions at: https://adventofcode.com/2020/day/8.

R solution

# Reading the data
input <- read.delim(
  sep = " ",
  "2020-08-aoc.txt",
  header = FALSE,
  stringsAsFactors = FALSE
)

give_me_a_break <- function(input){

  accumultor <- 0
  current_row <- 1
  done_row <- c()
  exit_code <- 0

  while(TRUE){
    if (current_row %in% done_row){
      exit_code <- 1
      break
    }
    if (current_row > nrow(input)){
      break
    }
    done_row <- c(done_row, current_row)
    curr_row <- input[current_row, ]
    if (curr_row$V1 == "nop") {
      current_row <- current_row + 1
    }
    if (curr_row$V1 == "acc") {
      accumultor <- accumultor + curr_row$V2
      current_row <- current_row + 1
    }
    if (curr_row$V1 == "jmp") {
      current_row <- current_row + curr_row$V2
    }
  }
  return(
    list(
      accumultor = accumultor,
      exit_code = exit_code
    )
  )
}


give_me_a_break(input)

## $accumultor
## [1] 1528
##
## $exit_code
## [1] 1

for (i in which(input$V1 %in% c("nop", "jmp"))){

  modified_ipt <- input

  if (modified_ipt[i, 'V1'] == "nop"){
    modified_ipt[i, 'V1'] <- "jmp"
  } else {
    modified_ipt[i, 'V1'] <- "nop"
  }

  res <- give_me_a_break(modified_ipt)

  if (res$exit_code == 0){
    print(res$accumultor)
    break
  }

}

## [1] 640

Instructions

Find the complete instructions at: https://adventofcode.com/2020/day/7.

R & Neo4j solution

As today’s options was a graph challenge, I decided to play a little bit with R and Neo4J.

library(tidyverse)

## ── Attaching packages ───────────── tidyverse 1.3.0 ──

## ✓ ggplot2 3.3.0     ✓ purrr   0.3.4
## ✓ tibble  3.0.1     ✓ dplyr   1.0.2
## ✓ tidyr   1.0.3     ✓ stringr 1.4.0
## ✓ readr   1.3.1     ✓ forcats 0.5.0

## ── Conflicts ──────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

# Reading the data
input <- read.delim(
  "2020-07-aoc.txt",
  header = FALSE,
  stringsAsFactors = FALSE
) %>% as_tibble()


clean <- input %>%
  # Extracting the origin
  mutate(
    origin = gsub("(.*) bags .*", "\\1", V1),
    contain = gsub(".* contain (.*) bags*\\.", "\\1", V1),
    contain = map(contain, ~ (strsplit(.x, ","))[[1]])
  ) %>%
  unnest(contain) %>%
  # Extracting what they can contain
  mutate(
    n_contain = gsub(".*([0-9]+).*", "\\1", contain),
    n_contain = case_when(
      n_contain == "no other" ~ "0",
      TRUE  ~  n_contain
    ) %>% as.character(),
    contain = gsub(" bags*", "", contain),
    contain = gsub("[0-9]*", "", contain),
    contain = stringr::str_trim(contain)
  ) %>%
  # Keeping only the needed elements
  select(
    origin, contain, n_contain
  )
clean

## # A tibble: 1,395 x 3
##    origin         contain         n_contain
##    <chr>          <chr>           <chr>
##  1 clear maroon   dull lavender   1
##  2 wavy turquoise vibrant magenta 4
##  3 wavy turquoise light violet    4
##  4 wavy turquoise bright gold     5
##  5 wavy turquoise faded black     2
##  6 wavy beige     plaid magenta   3
##  7 wavy beige     wavy lime       3
##  8 wavy beige     clear turquoise 2
##  9 wavy beige     muted cyan      3
## 10 mirrored black plaid red       1
## # … with 1,385 more rows

# Launching the container
#
system("docker run --rm --name neo4j --env NEO4J_AUTH=neo4j/password --publish=7687:7687 --publish=7474:7474 -v $(pwd):/var/lib/neo4j/import -d neo4j:3.4")

library(neo4r)
# Connecting to the Neo4j API
con <- neo4j_api$new(
  url = "http://localhost:7474",
  user = "neo4j",
  password = "password"
)

# Waiting for the container to be ready
Sys.sleep(10)
while (try(con$ping()) != 200){
  Sys.sleep(10)
}

# Writing CSV for Neo4J
data.frame(
  nodes = unique(clean$origin, clean$contain)
) %>%
  write_csv("aoc07_nodes.csv")
clean %>%
  write_csv("aoc07_relationships.csv")

# Adding constraint of uniqueness on names
"CREATE CONSTRAINT ON (origin:origin) ASSERT origin.name IS UNIQUE;" %>%
  call_neo4j(con, include_stats = TRUE)

## No data returned.

## # A tibble: 12 x 2
##    type                  value
##    <chr>                 <dbl>
##  1 contains_updates          1
##  2 nodes_created             0
##  3 nodes_deleted             0
##  4 properties_set            0
##  5 relationships_created     0
##  6 relationship_deleted      0
##  7 labels_added              0
##  8 labels_removed            0
##  9 indexes_added             0
## 10 indexes_removed           0
## 11 constraints_added         1
## 12 constraints_removed       0

"CREATE CONSTRAINT ON (contain:contain) ASSERT contain.name IS UNIQUE;" %>%
  call_neo4j(con, include_stats = TRUE)

## No data returned.

## # A tibble: 12 x 2
##    type                  value
##    <chr>                 <dbl>
##  1 contains_updates          1
##  2 nodes_created             0
##  3 nodes_deleted             0
##  4 properties_set            0
##  5 relationships_created     0
##  6 relationship_deleted      0
##  7 labels_added              0
##  8 labels_removed            0
##  9 indexes_added             0
## 10 indexes_removed           0
## 11 constraints_added         1
## 12 constraints_removed       0

# Load the nodes
'LOAD CSV WITH HEADERS FROM "file:///aoc07_nodes.csv" AS csvLine
MERGE (:bag {name : csvLine.nodes} ) ' %>%
  call_neo4j(con, include_stats = TRUE)

## No data returned.

## # A tibble: 12 x 2
##    type                  value
##    <chr>                 <dbl>
##  1 contains_updates          1
##  2 nodes_created           594
##  3 nodes_deleted             0
##  4 properties_set          594
##  5 relationships_created     0
##  6 relationship_deleted      0
##  7 labels_added            594
##  8 labels_removed            0
##  9 indexes_added             0
## 10 indexes_removed           0
## 11 constraints_added         0
## 12 constraints_removed       0

#
# # Load the relationships
'LOAD CSV WITH HEADERS FROM "file:///aoc07_relationships.csv" AS csvLine
MATCH (c:bag {name : csvLine.contain})
MATCH (o:bag {name : csvLine.origin})
MERGE (o) -[:CAN_CONTAIN {n_contain: csvLine.n_contain}]->(c);' %>%
  call_neo4j(con, include_stats = TRUE)

## No data returned.

## # A tibble: 12 x 2
##    type                  value
##    <chr>                 <dbl>
##  1 contains_updates          1
##  2 nodes_created             0
##  3 nodes_deleted             0
##  4 properties_set         1385
##  5 relationships_created  1385
##  6 relationship_deleted      0
##  7 labels_added              0
##  8 labels_removed            0
##  9 indexes_added             0
## 10 indexes_removed           0
## 11 constraints_added         0
## 12 constraints_removed       0

# Count all the bags that can eventually contain a shiny gold ones
'MATCH (b:bag)-[:CAN_CONTAIN*1..]-> (:bag {name:"shiny gold"}) RETURN count( DISTINCT b) AS count' %>%
  call_neo4j(con)

## $count
## # A tibble: 1 x 1
##   value
##   <int>
## 1   126
##
## attr(,"class")
## [1] "neo"  "list"

'MATCH (:bag {name:"shiny gold"})-[r:CAN_CONTAIN*1..]-> (:bag) WITH reduce(tot = 1, i IN r| tot * toInteger(i.n_contain)) AS total RETURN sum(total) AS total' %>%
  call_neo4j(con)

## $total
## # A tibble: 1 x 1
##    value
##    <int>
## 1 220149
##
## attr(,"class")
## [1] "neo"  "list"

# Removing the container
system("docker kill neo4j")

unlink("aoc07_nodes.csv")
unlink("aoc07_relationships.csv")

Instructions

Find the complete instructions at: https://adventofcode.com/2020/day/6.

R solution

library(magrittr)
library(purrr, warn.conflicts = FALSE)
# Read the data
readLines("2020-06-aoc.txt" ) %>%
  # pasting everything into one big character string
  paste(collapse = "\n") %>%
  # splitting where there are two \n\n (new lines)
  strsplit("\n\n") %>%
  .[[1]] %>%
  map_dbl(~ {
    # Removing the new lines of each group
    .x <- gsub("\n", "", .x)
    # Splitting the string
    strsplit(.x, "") %>%
      .[[1]] %>%
      # Computing the number of unique answer
      unique() %>%
      length()
  }) %>%
  sum()

## [1] 6534

library(dplyr, warn.conflicts = FALSE)
# Read the data
readLines("2020-06-aoc.txt" ) %>%
  # pasting everything into one big character string
  paste(collapse = "\n") %>%
  # splitting where there are two \n\n (new lines)
  strsplit("\n\n") %>%
  .[[1]] %>%
  map_dbl(~ {
    # Removing the new lines of each group
    x <- strsplit(.x, "\n")[[1]]
    # Getting the group size
    ngroup <- length(x)
    # Splitting the original string
    strsplit(.x, "")[[1]] %>%
      data.frame(
        x = .
      ) %>%
      # Counting the number of occurrences of each letter
      count(x) %>%
      # Keeping only the questions that occur in all
      filter(n == ngroup) %>%
      nrow()
  }) %>%
  sum()

## [1] 3402