Adds support for parallel chat

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"))

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")) {

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 --------------------------------------
 

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

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"
 

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
+          )
+        }
+      )
+    }
+  )
+}

r/tests/testthat/test-m-backend-submit.R

@@ -31,48 +31,39 @@ 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(
       backend = ellmer_session,
       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(