From 361b40dd5159c882987e0acd8c1c8544c54e87c4 Mon Sep 17 00:00:00 2001 From: Edgar Ruiz <77294576+edgararuiz@users.noreply.github.com> Date: Fri, 25 Jul 2025 17:38:27 -0500 Subject: [PATCH 1/4] Adds support for parallel_chat_text() --- r/R/m-backend-submit.R | 43 +++++++-------------- r/R/m-vec-prompt.R | 6 ++- r/tests/testthat/_snaps/m-backend-submit.md | 16 +++----- r/tests/testthat/helper-ellmer.R | 14 +++++++ r/tests/testthat/test-m-backend-submit.R | 33 ++++++---------- 5 files changed, 49 insertions(+), 63 deletions(-) create mode 100644 r/tests/testthat/helper-ellmer.R diff --git a/r/R/m-backend-submit.R b/r/R/m-backend-submit.R index 83d67de..feb4caf 100644 --- a/r/R/m-backend-submit.R +++ b/r/R/m-backend-submit.R @@ -89,34 +89,20 @@ m_ollama_tokens <- function() { #' @export m_backend_submit.mall_ellmer <- function(backend, x, prompt, preview = FALSE) { - if (preview) { - x <- head(x, 1) - map_here <- map - } else { - map_here <- map_chr - } - map_here( - x, - \(x) { - .args <- c( - glue(prompt[[1]]$content, x = x), - echo = "none" + system_prompt <- prompt[[1]][["content"]] + system_prompt <- glue(system_prompt, x = "") + if(preview) { + return( + exprs( + ellmer_obj$set_system_prompt(!!system_prompt), + ellmer_obj$chat(as.list(!!head(x,1))) ) - res <- NULL - if (preview) { - res <- expr(x$chat(!!!.args)) - } - if (m_cache_use() && is.null(res)) { - hash_args <- hash(.args) - res <- m_cache_check(hash_args) - } - if (is.null(res)) { - res <- exec("m_ellmer_chat", !!!.args) - m_cache_record(.args, res, hash_args) - } - res - } - ) + ) + } + ellmer_obj <- backend[["args"]][["ellmer_obj"]] + temp_ellmer <- ellmer_obj$clone()$set_turns(list()) + temp_ellmer$set_system_prompt(system_prompt) + parallel_chat_text(temp_ellmer, as.list(x)) } # Using a function so that it can be mocked in testing @@ -127,9 +113,6 @@ m_ellmer_chat <- function(...) { temp_ellmer$chat(...) } -dummy_func <- function(x, y) { - parallel_chat_text(x, y) -} # ------------------------------ Simulate -------------------------------------- diff --git a/r/R/m-vec-prompt.R b/r/R/m-vec-prompt.R index a96b4ca..97e3648 100644 --- a/r/R/m-vec-prompt.R +++ b/r/R/m-vec-prompt.R @@ -39,7 +39,11 @@ m_vec_prompt <- function(x, preview = preview ) if (preview) { - return(resp[[1]]) + if(length(resp) == 1) { + return(resp[[1]]) + } else { + return(resp) + } } # Checks for invalid output and marks them as NA diff --git a/r/tests/testthat/_snaps/m-backend-submit.md b/r/tests/testthat/_snaps/m-backend-submit.md index 393cba4..00a92bb 100644 --- a/r/tests/testthat/_snaps/m-backend-submit.md +++ b/r/tests/testthat/_snaps/m-backend-submit.md @@ -25,17 +25,13 @@ # ellmer code is covered Code - m_backend_submit(backend = ellmer_session, x = "test", prompt = list(list( - content = "test")), preview = TRUE) + m_backend_submit(backend = ellmer_session, x = "this is x", prompt = list(list( + content = "this is the prompt")), preview = TRUE) Output [[1]] - x$chat("test", echo = "none") + ellmer_obj$set_system_prompt("this is the prompt") + + [[2]] + ellmer_obj$chat(as.list("this is x")) - ---- - - Code - m_ellmer_chat() - Output - [1] "test" diff --git a/r/tests/testthat/helper-ellmer.R b/r/tests/testthat/helper-ellmer.R new file mode 100644 index 0000000..6e5412a --- /dev/null +++ b/r/tests/testthat/helper-ellmer.R @@ -0,0 +1,14 @@ +temp_ellmer_obj <- function() { + list( + clone = function() { + list( + set_turns = function(...) { + list( + chat = function(x) NULL, + set_system_prompt = function(...) NULL + ) + } + ) + } + ) +} diff --git a/r/tests/testthat/test-m-backend-submit.R b/r/tests/testthat/test-m-backend-submit.R index 8cedc23..9bfe9b7 100644 --- a/r/tests/testthat/test-m-backend-submit.R +++ b/r/tests/testthat/test-m-backend-submit.R @@ -31,11 +31,18 @@ test_that("No cache is saved if turned off", { test_that("ellmer code is covered", { local_mocked_bindings( - m_ellmer_chat = function(...) "test" + parallel_chat_text = function(x, y) return(as.character(y)) ) - llm_use("simulate_llm", "echo", .silent = TRUE, .force = TRUE, .cache = .mall_test$cache) + llm_use( + backend = "simulate_llm", + model = "echo", + .silent = TRUE, + .force = TRUE, + .cache = .mall_test$cache + ) ellmer_session <- .env_llm$session class(ellmer_session) <- c("mall_ellmer") + ellmer_session$args[["ellmer_obj"]] <- temp_ellmer_obj() test_txt <- rep("test", times = 15) expect_equal( m_backend_submit( @@ -48,31 +55,13 @@ test_that("ellmer code is covered", { expect_snapshot( m_backend_submit( backend = ellmer_session, - x = "test", - prompt = list(list(content = "test")), + x = "this is x", + prompt = list(list(content = "this is the prompt")), preview = TRUE ) ) - expect_snapshot( - m_ellmer_chat() - ) }) -temp_ellmer_obj <- function() { - list( - clone = function() { - list( - set_turns = function(...) { - list( - chat = function(x) { - NULL - } - ) - } - ) - } - ) -} test_that("ellmer code is covered - part II", { withr::with_envvar( From 2558895669832d24d0ea2f1cdfa7c137b35b525a Mon Sep 17 00:00:00 2001 From: Edgar Ruiz <77294576+edgararuiz@users.noreply.github.com> Date: Sun, 27 Jul 2025 16:18:04 -0500 Subject: [PATCH 2/4] Adds support for cache in ellmer parallelized --- r/DESCRIPTION | 2 +- r/R/m-backend-submit.R | 35 +++++++++++++++++++++++++++++------ 2 files changed, 30 insertions(+), 7 deletions(-) diff --git a/r/DESCRIPTION b/r/DESCRIPTION index 30007d4..a46f57d 100644 --- a/r/DESCRIPTION +++ b/r/DESCRIPTION @@ -1,7 +1,7 @@ Package: mall Title: Run Multiple Large Language Model Predictions Against a Table, or Vectors -Version: 0.1.0.9002 +Version: 0.1.0.9003 Authors@R: c( person("Edgar", "Ruiz", , "edgar@posit.co", role = c("aut", "cre")), person(given = "Posit Software, PBC", role = c("cph", "fnd")) diff --git a/r/R/m-backend-submit.R b/r/R/m-backend-submit.R index feb4caf..9b56109 100644 --- a/r/R/m-backend-submit.R +++ b/r/R/m-backend-submit.R @@ -91,18 +91,41 @@ m_ollama_tokens <- function() { m_backend_submit.mall_ellmer <- function(backend, x, prompt, preview = FALSE) { system_prompt <- prompt[[1]][["content"]] system_prompt <- glue(system_prompt, x = "") - if(preview) { + if (preview) { return( exprs( - ellmer_obj$set_system_prompt(!!system_prompt), - ellmer_obj$chat(as.list(!!head(x,1))) + ellmer_obj$set_system_prompt(!!system_prompt), + ellmer_obj$chat(as.list(!!head(x, 1))) ) ) } ellmer_obj <- backend[["args"]][["ellmer_obj"]] - temp_ellmer <- ellmer_obj$clone()$set_turns(list()) - temp_ellmer$set_system_prompt(system_prompt) - parallel_chat_text(temp_ellmer, as.list(x)) + + if (m_cache_use()) { + hashed_x <- map(x, function(x) hash(c(ellmer_obj, system_prompt, x))) + from_cache <- map(hashed_x, m_cache_check) + null_cache <- map_lgl(from_cache, is.null) + x <- x[null_cache] + } + if (length(x) > 0) { + temp_ellmer <- ellmer_obj$clone()$set_turns(list()) + temp_ellmer$set_system_prompt(system_prompt) + from_llm <- parallel_chat_text(temp_ellmer, as.list(x)) + } + if (m_cache_use()) { + walk( + seq_along(from_llm), + function(y) { + m_cache_record(list(system_prompt, x[y]), from_llm[y], hashed_x[y]) + } + ) + res <- rep("", times = length(null_cache)) + res[null_cache] <- from_llm + res[!null_cache] <- from_cache[!null_cache] + res + } else { + from_llm + } } # Using a function so that it can be mocked in testing From 5c79dd32ec5c9d649866136542acaef43a258ea5 Mon Sep 17 00:00:00 2001 From: Edgar Ruiz <77294576+edgararuiz@users.noreply.github.com> Date: Sun, 27 Jul 2025 16:44:23 -0500 Subject: [PATCH 3/4] Initializes variable --- r/R/m-backend-submit.R | 1 + 1 file changed, 1 insertion(+) diff --git a/r/R/m-backend-submit.R b/r/R/m-backend-submit.R index 9b56109..5a010de 100644 --- a/r/R/m-backend-submit.R +++ b/r/R/m-backend-submit.R @@ -107,6 +107,7 @@ m_backend_submit.mall_ellmer <- function(backend, x, prompt, preview = FALSE) { null_cache <- map_lgl(from_cache, is.null) x <- x[null_cache] } + from_llm <- NULL if (length(x) > 0) { temp_ellmer <- ellmer_obj$clone()$set_turns(list()) temp_ellmer$set_system_prompt(system_prompt) From fda71a2c5af5abaea9d540196d02d2b5a5801ed1 Mon Sep 17 00:00:00 2001 From: Edgar Ruiz <77294576+edgararuiz@users.noreply.github.com> Date: Wed, 30 Jul 2025 08:49:45 -0500 Subject: [PATCH 4/4] Fixes test --- r/R/llm-use.R | 2 +- r/R/m-backend-submit.R | 4 +++- r/R/m-vec-prompt.R | 2 +- r/tests/testthat/test-m-backend-submit.R | 16 +++++++++------- 4 files changed, 14 insertions(+), 10 deletions(-) diff --git a/r/R/llm-use.R b/r/R/llm-use.R index cc3bf12..94f780f 100644 --- a/r/R/llm-use.R +++ b/r/R/llm-use.R @@ -61,7 +61,7 @@ llm_use <- function( if (!is.null(backend) && !is.null(model)) { not_init <- FALSE } - if(is.null(backend) && is.null(m_defaults_backend())) { + if (is.null(backend) && is.null(m_defaults_backend())) { backend <- getOption(".mall_chat") } if (inherits(backend, "Chat")) { diff --git a/r/R/m-backend-submit.R b/r/R/m-backend-submit.R index 5a010de..3a0dd00 100644 --- a/r/R/m-backend-submit.R +++ b/r/R/m-backend-submit.R @@ -89,8 +89,11 @@ m_ollama_tokens <- function() { #' @export m_backend_submit.mall_ellmer <- function(backend, x, prompt, preview = FALSE) { + # Treats prompt as a system prompt system_prompt <- prompt[[1]][["content"]] system_prompt <- glue(system_prompt, x = "") + # Returns two expressions if on preview: setting the system prompt and the + # first chat call if (preview) { return( exprs( @@ -100,7 +103,6 @@ m_backend_submit.mall_ellmer <- function(backend, x, prompt, preview = FALSE) { ) } ellmer_obj <- backend[["args"]][["ellmer_obj"]] - if (m_cache_use()) { hashed_x <- map(x, function(x) hash(c(ellmer_obj, system_prompt, x))) from_cache <- map(hashed_x, m_cache_check) diff --git a/r/R/m-vec-prompt.R b/r/R/m-vec-prompt.R index 97e3648..ba69590 100644 --- a/r/R/m-vec-prompt.R +++ b/r/R/m-vec-prompt.R @@ -39,7 +39,7 @@ m_vec_prompt <- function(x, preview = preview ) if (preview) { - if(length(resp) == 1) { + if (length(resp) == 1) { return(resp[[1]]) } else { return(resp) diff --git a/r/tests/testthat/test-m-backend-submit.R b/r/tests/testthat/test-m-backend-submit.R index 9bfe9b7..f57d7ba 100644 --- a/r/tests/testthat/test-m-backend-submit.R +++ b/r/tests/testthat/test-m-backend-submit.R @@ -31,15 +31,17 @@ test_that("No cache is saved if turned off", { test_that("ellmer code is covered", { local_mocked_bindings( - parallel_chat_text = function(x, y) return(as.character(y)) + parallel_chat_text = function(x, y) { + return(as.character(y)) + } ) llm_use( - backend = "simulate_llm", - model = "echo", - .silent = TRUE, - .force = TRUE, + backend = "simulate_llm", + model = "echo", + .silent = TRUE, + .force = TRUE, .cache = .mall_test$cache - ) + ) ellmer_session <- .env_llm$session class(ellmer_session) <- c("mall_ellmer") ellmer_session$args[["ellmer_obj"]] <- temp_ellmer_obj() @@ -50,7 +52,7 @@ test_that("ellmer code is covered", { x = test_txt, prompt = list(list(content = "test")) ), - test_txt + as.list(test_txt) ) expect_snapshot( m_backend_submit(