R processing layer

WarningCaution

This section is being revised. Thank you for your patience.

This document translates the contents of lab 2 in R. The source Quarto document can be found in _labs/lab2/R/model-vetiver-r.qmd.

fs::dir_tree("_labs/lab2/R/")
## _labs/lab2/R/
## └── model-vetiver-r.qmd

Load packages

library(palmerpenguins)
library(plumber)
library(dplyr)
library(duckdb)
library(fastDummies)
library(vetiver)
library(pins)

Get Data

Load the palmerpenguins data, create a connection with dbConnect(), register the R data frame with duckdb, create the penguins table:

penguins_data <- palmerpenguins::penguins

con <- dbConnect(duckdb::duckdb(), "my-db.duckdb")

duckdb_register(con, "penguins_data", penguins_data)

dbExecute(con, "CREATE OR REPLACE TABLE penguins AS SELECT * FROM penguins_data")

Omit missing, disconnect from DB:

df <- dbGetQuery(con, "SELECT * FROM penguins") |>
  na.omit()

dbDisconnect(con)

View top rows of df:

head(df, 3)

Define Model and Fit

Create dummy variables (one-hot encoding) and fit linear regression model.

X <- df |>
  select(bill_length_mm, species, sex) |>
  dummy_cols(
    select_columns = c("species", "sex"), 
    remove_first_dummy = TRUE) |>
  select(-species, -sex)

y <- df$body_mass_g

model <- lm(y ~ ., data = X)

Get some information

r_squared <- summary(model)$r.squared
intercept <- coef(model)[1]
coefficients <- coef(model)[-1]
column_names <- names(X)

cat("R^2:", r_squared, "\n")
cat("Intercept:", intercept, "\n")
cat("Columns:", paste(column_names, collapse = ", "), "\n")
cat("Coefficients:", paste(coefficients, collapse = ", "), "\n")

Turn into Vetiver Model

v <- vetiver_model(model, model_name = "penguin_model")

Below we can see the model information stored in the models/ folder:

fs::dir_tree("_labs/lab2/R/models/")
## _labs/lab2/R/models/
## └── penguin_model
##     └── 20250923T141916Z-cca3d
##         ├── data.txt
##         └── penguin_model.rds

Save to Board

model_board <- board_folder("./models")
vetiver_pin_write(model_board, v)

Turn model into API

Unlike Python, we’ll need to create a plumber router from plumber::pr() to pass to the vetiver_api() (along with the deployable vetiver_model() object).

app <- pr() |> 
  vetiver_api(v)