inst/doc/embeddings.R

In foundryR: Data Frame Workflows for 'Microsoft Foundry'

## ----setup, include = FALSE---------------------------------------------------
# This vignette runs against recorded, credential-free API fixtures. When the
# fixtures are present (they are recorded once with data-raw/record-doc-outputs.R
# and committed under vignettes/embeddings/), every foundry_*() call below is
# executed and its real output is shown. When they are absent, the API chunks are
# not evaluated so the vignette still builds anywhere without Azure credentials.
fixture_dir <- "embeddings"
recording <- nzchar(Sys.getenv("FOUNDRY_RECORD_DOCS"))
have_fixtures <- dir.exists(fixture_dir) && length(list.files(fixture_dir)) > 0
run_api <- requireNamespace("httptest2", quietly = TRUE) &&
  (recording || have_fixtures)

# Attach foundryR before start_vignette(): httptest2 only sources the package's
# inst/httptest2/start-vignette.R (which sets replay placeholders) from attached
# packages.
library(foundryR)

if (run_api) {
  httptest2::start_vignette(fixture_dir)
}

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  eval = run_api
)

## ----austen-lines-------------------------------------------------------------
library(foundryR)

austen_lines <- c(
  "It is a truth universally acknowledged, that a single man in possession of a good fortune, must be in want of a wife.",
  "However little known the feelings or views of such a man may be on his first entering a neighbourhood.",
  "Mr. Bennet was so odd a mixture of quick parts, sarcastic humour, reserve, and caprice."
)

embedding <- foundry_embed(austen_lines[1], model = "text-embedding-3-small")
embedding

## ----multiple-embed-----------------------------------------------------------
doc_embeddings <- foundry_embed(austen_lines, model = "text-embedding-3-small")
doc_embeddings

## ----reduced-dims-------------------------------------------------------------
compact <- foundry_embed(
  austen_lines[1],
  model = "text-embedding-3-small",
  dimensions = 256
)
compact$n_dims

## ----similarity---------------------------------------------------------------
mixed <- c(
  "It is a truth universally acknowledged, that a single man in possession of a good fortune, must be in want of a wife.",
  "Mr. Bennet was so odd a mixture of quick parts, sarcastic humour, reserve, and caprice.",
  "The quarterly revenue report showed a sharp rise in cloud subscriptions.",
  "Analysts raised their earnings forecast after the strong cloud numbers."
)

similarities <- foundry_embed(mixed, model = "text-embedding-3-small") |>
  foundry_similarity()
similarities

## ----similarity-heatmap, echo = FALSE, eval = run_api && requireNamespace("ggplot2", quietly = TRUE), fig.alt = "Heatmap of cosine similarity across four sentences from two domains."----
label_for <- function(x) {
  dplyr::case_when(
    startsWith(x, "It is a truth") ~ "Austen 1",
    startsWith(x, "Mr. Bennet") ~ "Austen 2",
    startsWith(x, "The quarterly") ~ "Finance 1",
    TRUE ~ "Finance 2"
  )
}

heatmap_data <- similarities |>
  dplyr::mutate(
    a = label_for(text_1),
    b = label_for(text_2)
  )

ggplot2::ggplot(heatmap_data, ggplot2::aes(x = b, y = a, fill = similarity)) +
  ggplot2::geom_tile(color = "white", linewidth = 0.6) +
  ggplot2::geom_text(ggplot2::aes(label = sprintf("%.2f", similarity)), size = 3.2) +
  ggplot2::scale_fill_gradient(low = "#E6F2FB", high = "#0078D4") +
  ggplot2::labs(
    title = "Cosine similarity separates the two domains",
    x = NULL, y = NULL, fill = "Similarity"
  ) +
  ggplot2::theme_minimal(base_size = 12) +
  ggplot2::theme(panel.grid = ggplot2::element_blank(), legend.position = "bottom")

## ----semantic-search----------------------------------------------------------
library(dplyr)

documents <- c(
  "How to install R packages using install.packages()",
  "Data visualization with ggplot2 in R",
  "Introduction to machine learning with Python",
  "Statistical hypothesis testing explained",
  "Building web applications with Shiny",
  "Deep learning with TensorFlow and Keras"
)

doc_embeddings <- foundry_embed(documents, model = "text-embedding-3-small")
query_embedding <- foundry_embed(
  "How do I create charts and graphs in R?",
  model = "text-embedding-3-small"
)

cosine <- function(a, b) sum(a * b) / (sqrt(sum(a^2)) * sqrt(sum(b^2)))
query_vec <- query_embedding$embedding[[1]]

doc_embeddings |>
  mutate(similarity = vapply(embedding, cosine, numeric(1), b = query_vec)) |>
  arrange(desc(similarity)) |>
  select(text, similarity) |>
  head(3)

## ----clustering---------------------------------------------------------------
texts <- c(
  "Python is great for machine learning",
  "R excels at statistical analysis",
  "JavaScript powers modern web applications",
  "Italian pasta with tomato sauce",
  "Sushi is a popular Japanese dish",
  "French croissants are flaky and buttery",
  "Soccer is the world's most popular sport",
  "Basketball requires speed and agility",
  "Tennis matches can last for hours"
)

cluster_embeddings <- foundry_embed(texts, model = "text-embedding-3-small")
embedding_matrix <- do.call(rbind, cluster_embeddings$embedding)

set.seed(42)
clusters <- kmeans(embedding_matrix, centers = 3, nstart = 10)

cluster_embeddings |>
  mutate(cluster = clusters$cluster) |>
  arrange(cluster) |>
  select(text, cluster)

## ----projection, echo = FALSE, eval = run_api && requireNamespace("ggplot2", quietly = TRUE), fig.alt = "Two-dimensional PCA projection of sentence embeddings, colored by k-means cluster."----
pca <- prcomp(embedding_matrix, rank. = 2)
projection <- tibble::tibble(
  pc1 = pca$x[, 1],
  pc2 = pca$x[, 2],
  cluster = factor(clusters$cluster),
  label = substr(texts, 1, 18)
)

ggplot2::ggplot(projection, ggplot2::aes(pc1, pc2, color = cluster, label = label)) +
  ggplot2::geom_point(size = 3.2, alpha = 0.9) +
  ggplot2::geom_text(nudge_y = 0.15, size = 3, show.legend = FALSE) +
  ggplot2::scale_color_manual(values = c("#0078D4", "#107C10", "#5C2D91")) +
  ggplot2::labs(
    title = "A PCA projection makes the clusters visible",
    x = "PC 1", y = "PC 2", color = "Cluster"
  ) +
  ggplot2::theme_minimal(base_size = 12) +
  ggplot2::theme(legend.position = "bottom", panel.grid.minor = ggplot2::element_blank())

## ----batch-example, eval = TRUE-----------------------------------------------
# Defining this helper is local; calling it requires Azure credentials.
batch_embed <- function(texts, model, batch_size = 100) {
  n_batches <- ceiling(length(texts) / batch_size)
  results <- vector("list", n_batches)
  for (i in seq_len(n_batches)) {
    start_idx <- (i - 1) * batch_size + 1
    end_idx <- min(i * batch_size, length(texts))
    results[[i]] <- foundry_embed(texts[start_idx:end_idx], model = model)
    Sys.sleep(0.5)
  }
  dplyr::bind_rows(results)
}

## ----cleanup, include = FALSE-------------------------------------------------
if (run_api) {
  httptest2::end_vignette()
}