## ----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() }