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/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 83d67de..3a0dd00 100644 --- a/r/R/m-backend-submit.R +++ b/r/R/m-backend-submit.R @@ -89,34 +89,46 @@ 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) { - 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" + 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) + ) + } + 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) + 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_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 - } - ) + ) + 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 @@ -127,9 +139,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..ba69590 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..f57d7ba 100644 --- a/r/tests/testthat/test-m-backend-submit.R +++ b/r/tests/testthat/test-m-backend-submit.R @@ -31,11 +31,20 @@ 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( + backend = "simulate_llm", + model = "echo", + .silent = TRUE, + .force = TRUE, + .cache = .mall_test$cache ) - llm_use("simulate_llm", "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( @@ -43,36 +52,18 @@ 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( 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(