R/Agent.R

#' Agent: A General-Purpose LLM Agent
#'
#' @description
#' The `Agent` class defines a modular LLM-based agent capable of responding to prompts using a defined role/instruction.
#' It wraps an OpenAI-compatible chat model via the [`ellmer`](https://github.com/llrs/ellmer) package.
#'
#' Each agent maintains its own message history and unique identity.
#'
#' @importFrom R6 R6Class
#' @importFrom uuid UUIDgenerate
#' @importFrom checkmate assert_string assert_flag assert_character assert_integerish assert_environment
#' @importFrom cli cli_abort cli_alert_success cli_alert_warning cli_alert_info cli_rule cli_text cli_ul
#' @importFrom glue glue
#' @importFrom ellmer type_object type_string type_number
#' @importFrom rlang parse_expr eval_bare caller_env

#' @export
Agent <- R6::R6Class(
  classname = "Agent",

  public = list(
    #' @description
    #' Initializes a new Agent with a specific role/instruction.
    #'
    #' @param name A short identifier for the agent (e.g. `"translator"`).
    #' @param instruction The system prompt that defines the agent's role.
    #' @param llm_object The LLM object generate by ellmer (eg. output of ellmer::chat_openai)
    #' @param budget Numerical value denoting the amount to set for the budget in US$ to a specific agent,
    #' if the budget is reached, an error will be thrown.
    #' @examples
    #'   # An API KEY is required in order to invoke the Agent
    #'   openai_4_1_mini <- ellmer::chat(
    #'     name = "openai/gpt-4.1-mini",
    #'     api_key = Sys.getenv("OPENAI_API_KEY"),
    #'     echo = "none"
    #'   )
    #'
    #'   polar_bear_researcher <- Agent$new(
    #'     name = "POLAR BEAR RESEARCHER",
    #'     instruction = paste0(
    #'     "You are an expert in polar bears, ",
    #'     "you task is to collect information about polar bears. Answer in 1 sentence max."
    #'     ),
    #'     llm_object = openai_4_1_mini
    #'   )
    #'
    initialize = function(name, instruction, llm_object, budget = NA) {
      checkmate::assert_string(name)
      checkmate::assert_string(instruction)

      if (!"Chat" %in% class(llm_object)) {
        cli::cli_abort("The llm_object must be generated by ellmer")
      }

      self$name <- name
      self$instruction <- instruction
      self$llm_object <- llm_object$clone(deep = TRUE)

      meta_data <- self$llm_object$get_provider()
      self$model_provider <- meta_data@name
      self$model_name <- meta_data@model

      self$llm_object$set_system_prompt(value = instruction)

      private$._messages <- list(
        list(role = "system", content = instruction)
      )

      self$agent_id <- uuid::UUIDgenerate()

      checkmate::assert_numeric(budget)

      self$budget <- budget

      self$budget_policy <- list(
        on_exceed = "abort",
        warn_at = 0.8
      )

      self$cost <- NA

    },

    #' @description
    #' Sends a user prompt to the agent and returns the assistant's response.
    #'
    #' @param prompt A character string prompt for the agent to respond to.
    #' @return The LLM-generated response as a character string.
    #' @examples \dontrun{
    #' # An API KEY is required in order to invoke the Agent
    #' openai_4_1_mini <- ellmer::chat(
    #'     name = "openai/gpt-4.1-mini",
    #'     api_key = Sys.getenv("OPENAI_API_KEY"),
    #'     echo = "none"
    #' )
    #' agent <- Agent$new(
    #'  name = "translator",
    #'  instruction = "You are an Algerian citizen",
    #'  llm_object = openai_4_1_mini
    #' )
    #' agent$invoke("Continue this sentence: 1 2 3 viva")
    #' }
    invoke = function(prompt) {

      checkmate::assert_string(prompt)

      if (!is.na(self$budget)) {
        private$.check_budget()
      }

      response <- self$llm_object$chat(prompt)

      cost <- self$llm_object$get_cost()

      if (!is.na(cost)) {
        self$cost <- as.numeric(round(cost, 4))
      }

      private$.set_messages_from_turns()

      return(response)
    },

    #' @description
    #' Generate R code from natural language descriptions and optionally validate/execute it
    #'
    #' @param code_description Character string describing the R code to generate
    #' @param validate Logical indicating whether to validate the generated code syntax
    #' @param execute Logical indicating whether to execute the generated code (use with caution)
    #' @param interactive Logical; if TRUE, ask for user confirmation before executing generated code
    #' @param env Environment in which to execute the code if execute = TRUE. Default to \code{globalenv}
    #' @return A list containing the generated code and validation/execution results
    #' @examples
    #' \dontrun{
    #' openai_4_1_mini <- ellmer::chat(
    #'   name = "openai/gpt-4.1-mini",
    #'   api_key = Sys.getenv("OPENAI_API_KEY"),
    #'   echo = "none"
    #' )
    #' r_assistant <- Agent$new(
    #'   name = "R Code Assistant",
    #'   instruction = paste("You are an expert R programmer",
    #'   llm_object = openai_4_1_mini
    #' )
    #' # Generate code for data manipulation
    #' result <- r_assistant$generate_execute_r_code(
    #'   code_description = "Calculate the summary of the mtcars dataframe",
    #'   validate = TRUE,
    #'   execute = TRUE,
    #'   interactive = TRUE
    #' )
    #' print(result)
    #' }
    generate_execute_r_code = function(
    code_description,
    validate = FALSE,
    execute = FALSE,
    interactive = TRUE,
    env = globalenv()
    ) {

      checkmate::assert_string(code_description)
      checkmate::assert_flag(validate)
      checkmate::assert_flag(execute)
      checkmate::assert_environment(env)
      checkmate::assert_flag(interactive)

      code_prompt <- paste0(
        "Generate R code for the following task. Return ONLY the R code that will be executed without any explanations, ",
        "markdown formatting, or additional text:\n\n",
        "if you run several commands, use the ';' character to separate them. \n\n",
        "DO NOT add additional spaces that would be interpreted later as '\\n'. \n\n",
        "DO NOT enclose the code using Markdown syntax like R`\n\n",
        code_description
      )

      generated_code <- self$invoke(code_prompt)

      clean_code <- gsub("```\\{?r\\}?|```", "", generated_code)
      clean_code <- gsub("```\\{?r\\}?|```", "", generated_code)
      clean_code <- trimws(clean_code)

      result <- list(
        description = code_description,
        code = clean_code,
        validated = FALSE,
        validation_message = NA_character_,
        executed = FALSE,
        execution_result = NULL,
        execution_error = NULL
      )

      if (validate) {
        result <- private$.validate_r_code(r_code = clean_code, result = result)
      }

      if (execute) {
        if (!validate || !result$validated) {
          cli::cli_alert_warning("Code execution skipped: code must be validated first")
          return(result)
        }

        if (interactive) {
          cli::cli_h1("Generated code preview:")
          cat(paste0("\n", clean_code, "\n\n"))
          user_input <- readline(prompt = "Do you want to execute this code? [y/N]: ")
          if (tolower(user_input) != "y") {
            cli::cli_alert_info("Execution cancelled by user.")
            return(result)
          }
        }

        cli::cli_alert_info("Executing generated R code...")

        execution_result <- tryCatch({
          output <- capture.output({
            eval_result <- eval(parse(text = clean_code), envir = env)
          })

          result$executed <- TRUE
          result$execution_result <- list(
            value = eval_result,
            output = output
          )
          result$execution_error <- NULL

          cli::cli_alert_success("Code executed successfully")

        }, error = function(e) {
          result$executed <- FALSE
          result$execution_error <- e$message
          cli::cli_alert_danger(paste("Execution error:", e$message))
        })
      }

      return(result)
    },

    #' @description
    #' Set a budget to a specific agent, if the budget is reached, an error will be thrown
    #'
    #' @param amount_in_usd Numerical value denoting the amount to set for the budget,
    #' @examples \dontrun{
    #' # An API KEY is required in order to invoke the Agent
    #' openai_4_1_mini <- ellmer::chat(
    #'     name = "openai/gpt-4.1-mini",
    #'     api_key = Sys.getenv("OPENAI_API_KEY"),
    #'     echo = "none"
    #' )
    #' agent <- Agent$new(
    #'  name = "translator",
    #'  instruction = "You are an Algerian citizen",
    #'  llm_object = openai_4_1_mini
    #' )
    #' agent$set_budget(amount_in_usd = 10.5) # this is equivalent to 10.5$
    #' }
    set_budget = function(amount_in_usd) {

      checkmate::assert_number(amount_in_usd, lower = 0)

      self$budget <- amount_in_usd

      cli::cli_alert_success(glue::glue("Budget successfully set to {amount_in_usd}$"))
      cli::cli_alert_info(glue::glue("Budget policy: on_exceed='{self$budget_policy$on_exceed}', warn_at={self$budget_policy$warn_at}"))
      cli::cli_alert_info("Use the set_budget_policy() method to configure the budget policy.")
      invisible(self)
    },

    #' @description
    #' Configure how the agent behaves as it approaches or exceeds its budget.
    #' Use `warn_at` (0-1) to emit a one-time warning when spending reaches the
    #' specified fraction of the budget. When the budget is exceeded, `on_exceed`
    #' controls behavior: abort, warn and proceed, or ask interactively.
    #' @param on_exceed One of "abort", "warn", or "ask".
    #' @param warn_at Numeric in (0,1); fraction of budget to warn at. Default 0.8.
    #' @examples \dontrun{
    #' agent$set_budget(5)
    #' agent$set_budget_policy(on_exceed = "ask", warn_at = 0.9)
    #' }
    set_budget_policy = function(on_exceed = "abort", warn_at = 0.8) {

      checkmate::assert_choice(on_exceed, c("abort", "warn", "ask"))
      checkmate::assert_number(warn_at, lower = 0, upper = 1)

      self$budget_policy <- list(
        on_exceed = on_exceed,
        warn_at = warn_at
      )

      cli::cli_alert_success(glue::glue(
        "Budget policy set: on_exceed='{on_exceed}', warn_at={warn_at}"
      ))

      invisible(self)
    },

    #' @description
    #' Keep only the most recent `n` messages, discarding older ones while keeping
    #' the system prompt.
    #' @param n Number of most recent messages to keep.
    #' @examples \dontrun{
    #' openai_4_1_mini <- ellmer::chat(
    #'   name = "openai/gpt-4.1-mini",
    #'   api_key = Sys.getenv("OPENAI_API_KEY"),
    #'   echo = "none"
    #' )
    #' agent <- Agent$new(
    #'   name = "capital finder",
    #'   instruction = "You are an assistant.",
    #'   llm_object = openai_4_1_mini
    #' )
    #' agent$invoke("What is the capital of Algeria")
    #' agent$invoke("What is the capital of Germany")
    #' agent$invoke("What is the capital of Italy")
    #' agent$keep_last_n_messages(n = 2)
    #' }
    keep_last_n_messages = function(n = 2) {

      checkmate::assert_integerish(n, lower = 1)

      ln_messags <- length(self$messages)

      messages_to_keep <- self$messages[(ln_messags - n + 1):ln_messags]

      system_prompt <- self$llm_object$get_system_prompt()

      tmp_sp <- list(
        list(role = "system", content = system_prompt)
      )

      private$._messages <- append(tmp_sp, messages_to_keep)
      private$.set_turns_from_messages()

      cli::cli_alert_success("Conversation truncated to last {n} messages.")

      invisible(self)

    },

    #' @description
    #' Add a pre-formatted message to the conversation history
    #'
    #' @param role The role of the message ("user", "assistant", or "system")
    #' @param content The content of the message
    #' @examples
    #' \dontrun{
    #' openai_4_1_mini <- ellmer::chat(
    #'   name = "openai/gpt-4.1-mini",
    #'   api_key = Sys.getenv("OPENAI_API_KEY"),
    #'   echo = "none"
    #' )
    #' agent <- Agent$new(
    #'   name = "AI assistant",
    #'   instruction = "You are an assistant.",
    #'   llm_object = openai_4_1_mini
    #')
    #' agent$add_message("user", "Hello, how are you?")
    #' agent$add_message("assistant", "I'm doing well, thank you!")
    #' }
    add_message = function(role, content) {
      checkmate::assert_string(role)
      checkmate::assert_string(content)
      checkmate::assert_choice(role, c("user", "assistant", "system"))

      private$.add_message(content, role)
      private$.set_turns_from_messages()

      cli::cli_alert_success("Added {role} message: {substr(content, 1, 50)}...")
      invisible(self)
    },

    #' @description
    #' Summarises the agent's conversation history into a concise form and appends it
    #' to the system prompt. Unlike `update_instruction()`, this method does not override
    #' the existing instruction but augments it with a summary for future context.
    #'
    #' After creating the summary, the method clears the conversation history and
    #' retains only the updated system prompt. This ensures that subsequent interactions
    #' start fresh but with the summary preserved as context.
    #'
    #' @examples \dontrun{
    #'   # Requires an OpenAI-compatible LLM from `ellmer`
    #'   openai_4_1_mini <- ellmer::chat(
    #'     name = "openai/gpt-4.1-mini",
    #'     api_key = Sys.getenv("OPENAI_API_KEY"),
    #'     echo = "none"
    #'   )
    #'
    #'   agent <- Agent$new(
    #'     name = "summariser",
    #'     instruction = "You are a summarising assistant",
    #'     llm_object = openai_4_1_mini
    #'   )
    #'
    #'   agent$invoke("The quick brown fox jumps over the lazy dog.")
    #'   agent$invoke("This is another example sentence.")
    #'
    #'   # Summarises and resets history
    #'   agent$summarise_messages()
    #'
    #'   # Now only the system prompt (with summary) remains
    #'   agent$messages
    #' }
    #'

    clear_and_summarise_messages = function() {

      if (length(self$messages) <= 1) {
        cli::cli_alert_info("No conversation history to summarise.")
        return(invisible(NULL))
      }

      summary_prompt <- paste0(
        "Summarise the following conversation history in a concise paragraph:\n\n",
        paste(
          vapply(self$messages, function(m) {
            paste0(m$role, ": ", m$content)
          }, character(1)),
          collapse = " \n "
        )
      )

      summary <- self$llm_object$chat(summary_prompt)
      summary <- as.character(summary)

      new_system_prompt <- paste(
        self$instruction,
        "\n\n--- Conversation Summary ---\n",
        summary
      )

      self$llm_object$set_system_prompt(value = new_system_prompt)

      private$._messages <- list(
        list(role = "system", content = new_system_prompt)
      )
      private$.set_turns_from_messages()

      cli::cli_alert_success("Conversation history summarised and appended to system prompt.")
      cli::cli_alert_info("Summary: {substr(summary, 1, 100)}...")

      invisible(self)
    },

    #' @description
    #' Update the system prompt/instruction
    #' @param new_instruction New instruction to use. Not that the new instruction
    #' will override the old one
    #' @examples \dontrun{
    #' openai_4_1_mini <- ellmer::chat(
    #'   name = "openai/gpt-4.1-mini",
    #'   api_key = Sys.getenv("OPENAI_API_KEY"),
    #'   echo = "none"
    #' )
    #' agent <- Agent$new(
    #'   name = "assistant",
    #'   instruction = "You are an assistant.",
    #'   llm_object = openai_4_1_mini
    #' )
    #' agent$update_instruction("You are a concise assistant.")
    #' }
    update_instruction = function(new_instruction) {

      checkmate::assert_string(new_instruction)

      old_instruction <- self$instruction
      self$instruction <- new_instruction
      self$llm_object$set_system_prompt(value = new_instruction)

      private$._messages[[1]]$content <- new_instruction
      private$.set_turns_from_messages()

      cli::cli_alert_success("Instruction successfully updated")
      cli::cli_alert_info("Old: {substr(old_instruction, 1, 50)}...")
      cli::cli_alert_info("New: {substr(new_instruction, 1, 50)}...")

      invisible(self)
    },

    #' @description
    #' Get the current token count and estimated cost of the conversation
    #'
    #' @return A list with token counts and cost information
    #' @examples
    #' \dontrun{
    #' openai_4_1_mini <- ellmer::chat(
    #'   name = "openai/gpt-4.1-mini",
    #'   api_key = Sys.getenv("OPENAI_API_KEY"),
    #'   echo = "none"
    #' )
    #' agent <- Agent$new(
    #'   name = "assistant",
    #'   instruction = "You are an assistant.",
    #'   llm_object = openai_4_1_mini
    #' )
    #' agent$set_budget(1)
    #' agent$invoke("What is the capital of Algeria?")
    #' stats <- agent$get_usage_stats()
    #' stats
    #' }
    get_usage_stats = function() {

      current_cost <- self$cost

      budget_remaining <- NA

      if (!is.na(self$budget)) {
        budget_remaining <- self$budget - as.numeric(current_cost)
      }

      llm_costs <- list(
        estimated_cost = current_cost,
        budget = round(self$budget, 4),
        budget_remaining = round(budget_remaining, 4)
      )

      llm_costs

    },

    #' @description
    #' Reset the agent's conversation history while keeping the system instruction
    #'
    #' @examples
    #' \dontrun{
    #' openai_4_1_mini <- ellmer::chat(
    #'   name = "openai/gpt-4.1-mini",
    #'   api_key = Sys.getenv("OPENAI_API_KEY"),
    #'   echo = "none"
    #' )
    #' agent <- Agent$new(
    #'   name = "AI assistant",
    #'   instruction = "You are an assistant.",
    #'   llm_object = openai_4_1_mini
    #')
    #' agent$invoke("Hello, how are you?")
    #' agent$invoke("Tell me about machine learning")
    #' agent$reset_conversation_history()  # Clears all messages except system prompt
    #' }
    reset_conversation_history = function() {
      system_prompt <- self$llm_object$get_system_prompt()

      private$._messages <- list(
        list(role = "system", content = system_prompt)
      )
      private$.set_turns_from_messages()

      cli::cli_alert_success("Conversation history reset. System prompt preserved.")
      invisible(self)
    },

    #' @description
    #' Saves the agent's current conversation history as a JSON file on disk.
    #' @param file_path Character string specifying the file path where the JSON
    #' file should be saved. Defaults to a file named
    #' `"<agent_name>_messages.json"` in the current working directory.
    #'
    #' @examples
    #' \dontrun{
    #' openai_4_1_mini <- ellmer::chat(
    #'   name = "openai/gpt-4.1-mini",
    #'   api_key = Sys.getenv("OPENAI_API_KEY"),
    #'   echo = "none"
    #' )
    #' agent <- Agent$new(
    #'   name = "capital_finder",
    #'   instruction = "You are an assistant.",
    #'   llm_object = openai_4_1_mini
    #')
    #' agent$invoke("What is the capital of Algeria")
    #' agent$invoke("What is the capital of Italy")
    #' agent$export_messages_history()
    #' }
    #'
    #' @seealso [load_messages_history()] for reloading a saved message history.
    #'
    export_messages_history = function(
    file_path = paste0(getwd(), "/", paste0(self$name, "_messages.json"))
    ) {

      checkmate::assert_string(file_path)

      jsonlite::write_json(
        self$messages,
        path = file_path,
        auto_unbox = TRUE,
        pretty = TRUE
      )

      cli::cli_alert_success(glue::glue("Conversation saved to {file_path}"))

    },

    #' @description
    #' Load an agent's conversation history as a JSON file from disk.
    #' @param file_path Character string specifying the file path where the JSON
    #' file is stored. Defaults to a file named
    #' `"<agent_name>_messages.json"` in the current working directory.
    #'
    #' @examples
    #' \dontrun{
    #' openai_4_1_mini <- ellmer::chat(
    #'   name = "openai/gpt-4.1-mini",
    #'   api_key = Sys.getenv("OPENAI_API_KEY"),
    #'   echo = "none"
    #' )
    #' agent <- Agent$new(
    #'   name = "capital_finder",
    #'   instruction = "You are an assistant.",
    #'   llm_object = openai_4_1_mini
    #')
    #' # use the export_messages_history to save the interaction first
    #' agent$load_messages_history("path/to/messages.json")
    #' agent$messages
    #' agent$llm_object
    #' }
    #'
    #' @seealso [export_messages_history()] for exporting the messages object to json.
    #'
    load_messages_history = function(
    file_path = paste0(getwd(), "/", paste0(self$name, "_messages.json"))
    ) {

      checkmate::assert_string(file_path)

      if (!file.exists(file_path)) {
        cli::cli_abort("File does not exist.")
      }

      messages <- jsonlite::read_json(file_path, simplifyVector = FALSE)

      self$messages <- messages

      cli::cli_alert_success(glue::glue("Conversation history loaded from {file_path}"))

    },

    #' @description
    #' Validates an agent's response against custom criteria using LLM-based validation.
    #' This method uses the agent's LLM to evaluate whether a response meets specified
    #' validation criteria (e.g., accuracy, completeness, tone, format).
    #' @param prompt The prompt used to generate the response.
    #' @param response The response text to validate.
    #' @param validation_criteria The criteria for validation.
    #' (e.g., "The response should be accurate and complete", "The response must be under 100 words").
    #' @param validation_score A numeric from 0 to 1 denoting the score to consider for
    #' the evaluation. During the evaluation, the agent will provide a score from 0 to 1,
    #' a provided score greater or equal to the `validation_score` will result in a `valid` response.
    #' Defaults to 0.8.
    #' @return list object
    #' @examples
    #' \dontrun{
    #' openai_4_1_mini <- ellmer::chat(
    #'   name = "openai/gpt-4.1-mini",
    #'   api_key = Sys.getenv("OPENAI_API_KEY"),
    #'   echo = "none"
    #' )
    #' agent <- Agent$new(
    #'   name = "fact_checker",
    #'   instruction = "You are a factual assistant.",
    #'   llm_object = openai_4_1_mini
    #' )
    #' prompt <- "What is the capital of Algeria?"
    #' response <- agent$invoke(prompt)
    #' validation <- agent$validate_response(
    #'   response = response,
    #'   prompt = prompt,
    #'   validation_criteria = "The response must be accurate and mention Algiers",
    #'   validation_score = 0.8
    #' )
    #' print(validation)
    #' }
    validate_response = function(
    prompt,
    response,
    validation_criteria,
    validation_score = 0.8
    ) {

      checkmate::assert_string(validation_criteria)
      checkmate::assert_string(response)
      checkmate::assert_string(prompt)
      checkmate::assert_numeric(validation_score, lower = 0, upper = 1)

      validation_prompt <- paste0(
        "You are a response validation assistant. Evaluate the following response ",
        "against the specified criteria.\n\n",
        "Validation Criteria: ", validation_criteria, "\n\n",
        "Original Prompt: ", prompt, "\n\n",
        "Response to Validate:\n", response, "\n\n",
        "Provide your evaluation in the following format:\n",
        "SCORE: [0-1] If the response is extremely valid it gets a score of 1.\n",
        "FEEDBACK: [detailed feedback explaining your evaluation]\n\n",
        "Return ONLY the three lines above, nothing else."
      )

      original_system_prompt <- self$llm_object$get_system_prompt()

      validation_system_prompt <- paste0(
        "You are a response validation assistant. ",
        "Your task is to evaluate responses against given criteria. ",
        "Be objective and thorough in your evaluation.",
        "Provide a score and a feedback. The score should evaluate the validitiy of the ",
        "response, it goes from 0 to 1 (1 is the best score and 0 the worst score)"
      )

      self$llm_object$set_system_prompt(value = validation_system_prompt)

      on.exit(
        self$llm_object$set_system_prompt(value = original_system_prompt),
        add = TRUE,
        after = FALSE
      )

      validation_result <- self$llm_object$chat_structured(
        validation_prompt,
        type = ellmer::type_object(
          score = ellmer::type_number(
            description = "The validity score. If a response is extremely valid, it gets a score of 1",
            required = TRUE
          ),
          feedback = ellmer::type_string(
            description = "Feedback concerning the evaluation of the response according to the prompt",
            required = TRUE
          )
        )
      )

      score <- validation_result$score

      if (score >= validation_score) {
        valid <- TRUE
      } else {
        valid <- FALSE
      }

      validation_result <- append(
        list(
          prompt = prompt,
          response = response,
          validation_criteria = validation_criteria,
          validation_score = validation_score,
          valid = valid
        ),
        validation_result
      )

      if (valid) {
        cli::cli_alert_success(glue::glue(
          "The response is considered valid with a score of {score}"
        ))
      } else {
        cli::cli_alert_warning(
          glue::glue(
            "The response is considered invalid with a score of {score}"
          )
        )
      }

      validation_result
    },

    #' @description
    #' Register one or more tools with the agent
    #' @param tools A list of ellmer tool objects or a single tool object
    #' @examples
    #' \dontrun{
    #' openai_4_1_mini <- ellmer::chat(
    #'   name = "openai/gpt-4.1-mini",
    #'   api_key = Sys.getenv("OPENAI_API_KEY"),
    #'   echo = "none"
    #' )
    #' agent <- Agent$new(
    #'   name = "file_assistant",
    #'   instruction = "You are a file management assistant.",
    #'   llm_object = openai_4_1_mini
    #' )
    #' # Register predefined tools
    #' agent$register_tools(list(change_directory_tool(), list_files_tool()))
    #' }
    register_tools = function(tools) {
      if (!is.list(tools)) {
        tools <- list(tools)
      }

      for (tool in tools) {
        if (!inherits(tool, "ellmer::ToolDef")) {
          cli::cli_abort("All tools must be valid ellmer Tool objects")
        }

        tool_name <- tool@name
        self$tools[[tool_name]] <- tool
        cli::cli_alert_success("Registered tool: {tool_name}")
      }

      private$.update_llm_tools()

      invisible(self)
    },

    #' @description
    #' List all registered tools
    #' @return Character vector of tool names
    #' @examples
    #' \dontrun{
    #' agent$list_tools()
    #' }
    list_tools = function() {
      tool_names <- names(self$tools)

      if (length(tool_names) == 0) {
        cli::cli_alert_info("No tools registered")
        return(character(0))
      }

      tool_names
    },

    #' @description
    #' Remove tools from the agent
    #' @param tool_names Character vector of tool names to remove
    #' @examples
    #' \dontrun{
    #' agent$remove_tools(c("change_directory", "list_files"))
    #' }
    remove_tools = function(tool_names) {
      checkmate::assert_character(tool_names)

      for (tool_name in tool_names) {
        if (tool_name %in% names(self$tools)) {
          self$tools[[tool_name]] <- NULL
          cli::cli_alert_success("Removed tool: {tool_name}")
        } else {
          cli::cli_alert_warning("Tool not found: {tool_name}")
        }
      }

      private$.update_llm_tools()

      invisible(self)
    },

    #' @description
    #' Clear all registered tools
    #' @examples
    #' \dontrun{
    #' agent$clear_tools()
    #' }
    clear_tools = function() {
      tool_count <- length(self$tools)
      self$tools <- list()

      private$.update_llm_tools()

      cli::cli_alert_success("Cleared {tool_count} tool{?s}")
      invisible(self)
    },

    #' @description
    #' Generate and register a tool from a natural language description.
    #' This method uses the agent's LLM to create both the R function and the
    #' ellmer tool definition based on your description, then automatically registers it.
    #' @param description Character string describing what the tool should do
    #' @examples
    #' \dontrun{
    #' openai_4_1_mini <- ellmer::chat(
    #'   name = "openai/gpt-4.1-mini",
    #'   api_key = Sys.getenv("OPENAI_API_KEY"),
    #'   echo = "none"
    #' )
    #' agent <- Agent$new(
    #'   name = "file_assistant",
    #'   instruction = "You are a helpful assistant.",
    #'   llm_object = openai_4_1_mini
    #' )
    #' # Generate and register a tool from description
    #' agent$generate_and_register_tool(
    #'   description = "Create a tool that saves text content to a file on disk"
    #' )
    #' # Now the tool is available to use
    #' agent$list_tools()
    #' }
    generate_and_register_tool = function(description) {

      checkmate::assert_string(description)

      cli::cli_h2("Generating tool from description")
      cli::cli_alert_info("Description: {description}")

      generation_prompt <- glue::glue(
        "Generate R code to create an ellmer tool based on this description: <<<<<description>>>>>

          Requirements:
          1. Create a complete R function that implements the tool's functionality
          2. Wrap it with ellmer::tool() to create a tool definition
          3. Use appropriate type specifications: ellmer::type_string(), ellmer::type_number(), ellmer::type_integer(), ellmer::type_boolean(), ellmer::type_enum(), ellmer::type_array(), ellmer::type_object()
          4. Include clear descriptions for the tool and each parameter
          Format your response as valid R code that can be evaluated directly. Include ONLY the R code without markdown formatting, explanations, or comments. The code should define the function and create the tool in one block.
          5. Do not use parameters that do not exist, for example, there is no 'output' parameter in the ellmer::tool function
          Example format 1:
          save_file_function <- function(content, filepath) {{
              writeLines(content, filepath)
              paste('File saved to', filepath)
          }}
          ellmer::tool(
            save_file_function,
            name = 'save_file',
            description = 'Save text content to a file',
            arguments = list(
              content = ellmer::type_string(description = 'Text content to save'),
              filepath = ellmer::type_string(description = 'Path where file should be saved')
            )
          )

        Example format 2:

        get_current_time <- function(tz = 'UTC') {
          format(Sys.time(), tz = tz, usetz = TRUE)
        }

        get_current_time <- ellmer::tool(
          get_current_time,
          name = 'get_current_time',
          description = 'Returns the current time.',
          arguments = list(
           tz = ellmer::type_string(
           'Time zone to display the current time in. Defaults to `\"UTC\"`.',
           required = FALSE
          )
        )
        )
        "
      , .open = "<<<<<", .close = ">>>>>")

      # Store original system prompt
      original_system_prompt <- self$llm_object$get_system_prompt()
      tool_generation_prompt <- paste0(
        "You are an expert R programmer specializing in creating ellmer tools. ",
        "Generate clean, functional R code that creates tools for LLM use."
      )

      self$llm_object$set_system_prompt(value = tool_generation_prompt)

      # Restore original system prompt on exit
      on.exit(
        self$llm_object$set_system_prompt(value = original_system_prompt),
        add = TRUE,
        after = FALSE
      )

      # Generate the tool code
      generated_code <- self$llm_object$chat(generation_prompt)

      cli::cli_h2("The following tool will be registered")
      cli::cli_code(generated_code)

      # Clean the generated code
      clean_code <- gsub("```\\{?r\\}?|```", "", generated_code)
      clean_code <- trimws(clean_code)
      clean_code <- paste0("{", clean_code, "}")

      expr <- rlang::parse_expr(clean_code)

      tool_result <- rlang::eval_bare(
        expr,
        env = rlang::caller_env()
      )

      self$register_tools(tool_result)

      cli::cli_alert_success("Tool successfully generated and registered")
      cli::cli_alert_info("Call '<agent-name>$llm_object$get_tools()' to inspect the tools")
      cli::cli_alert_info("If satisfied, you can copy the tool and put in your corresponding R file")
    },

    #' @description
    #' Create a copy of the agent with the same instruction and configuration but a new unique ID.
    #' Useful for creating multiple instances of the same agent type.
    #'
    #' @param new_name Optional character string to assign a new name to the cloned agent.
    #' If NULL, the cloned agent retains the original name.
    #' @examples
    #' \dontrun{
    #' openai_4_1_mini <- ellmer::chat(
    #'   name = "openai/gpt-4.1-mini",
    #'   api_key = Sys.getenv("OPENAI_API_KEY"),
    #'   echo = "none"
    #' )
    #' agent <- Agent$new(
    #'   name = "translator",
    #'   instruction = "You are a translator.",
    #'   llm_object = openai_4_1_mini
    #' )
    #' # Clone with same name
    #' agent_copy <- agent$clone_agent()
    #' }
    clone_agent = function(new_name = NULL) {

      if (!is.null(new_name)) {
        checkmate::assert_string(new_name)
      }

      cloned_agent <- self$clone(deep = TRUE)

      cloned_agent$agent_id <- uuid::UUIDgenerate()

      if (!is.null(new_name)) {
        cloned_agent$name <- new_name
      }

      cli::cli_alert_success(glue::glue(
        "Agent cloned successfully. New ID: {cloned_agent$agent_id}"
      ))

      return(cloned_agent)
    },

    #' @field name The agent's name.
    name = NULL,
    #' @field instruction The agent's role/system prompt.
    instruction = NULL,
    #' @field llm_object The underlying `ellmer::chat_openai` object.
    llm_object = NULL,
    #' @field agent_id A UUID uniquely identifying the agent.
    agent_id = NULL,
    #'@field model_provider The name of the entity providing the model (eg. OpenAI)
    model_provider = NULL,
    #'@field model_name The name of the model to be used (eg. gpt-4.1-mini)
    model_name = NULL,
    #'@field broadcast_history A list of all past broadcast interactions.
    broadcast_history = list(),
    #'@field budget A budget in $ that the agent should not exceed.
    budget = NULL,
    #'@field budget_policy A list controlling budget behavior: on_exceed and warn_at.
    budget_policy = NULL,
    #'@field budget_warned Internal flag indicating whether warn_at notice was emitted.
    budget_warned = NULL,
    #'@field cost The current cost of the agent
    cost = NULL,
    #'@field tools A list of registered tools available to the agent
    tools = list()

  ),

  active = list(
    #' @field messages Public active binding for the conversation history.
    #' Assignment is validated automatically.
    messages = function(value) {
      if (missing(value)) {
        return(private$._messages)
      }

      if (!is.list(value)) {
        cli::cli_abort("messages must be a list of message objects")
      }

      for (msg in value) {
        if (!is.list(msg) || !all(c("role", "content") %in% names(msg))) {
          cli::cli_abort("Each message must be a list with 'role' and 'content'")
        }
        if (!msg$role %in% c("system", "user", "assistant")) {
          cli::cli_abort(paste0("Invalid role: ", msg$role))
        }
      }

      # SYNC DIRECTION 1: Messages → Turns (triggered by user assignment)
      # When user assigns: agent$messages <- new_list
      # This active binding stores the new messages and syncs them to ellmer turns.
      # The sync flag is TRUE here, so .set_turns_from_messages() will execute.
      private$._messages <- value
      private$.set_turns_from_messages()  # Sync the new messages to ellmer object

    }
  ),

  private = list(
    ._messages = NULL,
    # Synchronization control flag to prevent infinite recursion between
    # messages and turns. When TRUE, allows normal sync operations.
    # When FALSE, prevents .set_turns_from_messages() from executing.
    .sync_flag = TRUE,
    .add_message = function(message, type) {
      private$._messages[[length(private$._messages) + 1]] <- list(
        role = type,
        content = message
      )
    },

    .add_assistant_message = function(message, type = "assistant") {
      private$.add_message(message, type)
    },

    .add_user_message = function(message, type = "user") {
      private$.add_message(message, type)
    },
    .format_arguments = function(args) {
      parts <- mapply(
        function(name, value) {
          # Quote character values
          if (is.character(value)) {
            sprintf('%s = "%s"', name, value)
          } else {
            sprintf('%s = %s', name, value)
          }
        },
        names(args), args,
        USE.NAMES = FALSE
      )

      paste(parts, collapse = ", ")
    },

    .set_messages_from_turns = function() {

      turns <- self$llm_object$get_turns(include_system_prompt = TRUE)

      messages <- lapply(turns, function(turn) {

        role <- turn@role

        contents <- turn@contents


        content_strings <- vapply(contents, function(ct) {

          cls <- class(ct)[[1]]

          if (grepl("ContentText", cls, ignore.case = TRUE)) {

            msg <- ct@text

            return(msg)

          } else if (grepl("ContentToolRequest", cls, ignore.case = TRUE)) {

            call_id <- ct@id
            tool_name <- ct@name
            args <- private$.format_arguments(ct@arguments)

            msg <- sprintf(
              "[tool request id=%s]: %s(%s)",
              call_id,
              tool_name,
              args
            )

            return(msg)

          } else if (grepl("ContentToolResult", cls, ignore.case = TRUE)) {

            call_id <- ct@request@id
            result <- ct@value

            if (is.list(result)) {
              result <- glue::glue_collapse(
                glue::glue("{names(result)}: {lapply(result, toString)}"),
                sep = "     "
              )
            }

            msg <- sprintf(
              "[tool result id=%s]: %s",
              call_id,
              result
            )

            return(msg)
          } else {
            return(as.character(ct@text))
          }

        }, FUN.VALUE = character(1))

        content <- paste(content_strings, collapse = "\n")

        list(
          role = role,
          content = content
        )
      })

      first_message <- messages[[1]]

      if (!first_message$role == "system") {

        messages <- append(
          list(
            list(
              role = "system",
              content = self$instruction
            )
          ),
          messages
        )
      }

      # SYNC DIRECTION 2: Turns → Messages (prevents recursion)
      # Temporarily disable sync flag to prevent the messages active binding
      # from triggering .set_turns_from_messages() again when we update messages.
      # This breaks the potential infinite loop:
      # .set_messages_from_turns() -> messages assignment -> active binding -> .set_turns_from_messages()
      private$.sync_flag <- FALSE
      private$._messages <- messages  # Direct assignment bypasses active binding
      private$.sync_flag <- TRUE      # Re-enable sync for future operations
    },

    .set_turns_from_messages = function() {
      # SYNC DIRECTION 1: Messages → Turns (respects sync flag)
      # Check sync flag to prevent execution during recursive calls.
      # When .set_messages_from_turns() is running, this prevents infinite loops.
      if (!private$.sync_flag) {
        return(invisible(NULL))
      }

      messages <- self$messages
      turns <- list()
      content_tool_requests <- list()
      existing_turns <- self$llm_object$get_turns(
        include_system_prompt = TRUE
      )

      for (i in seq_along(messages)) {

        msg <- messages[[i]]

        if (grepl("[tool request id=", msg$content, fixed = TRUE)) {

          id <- sub(".*id=([^]]+)].*", "\\1", msg$content)
          func_name <- sub(".*]: ([a-zA-Z0-9_]+)\\(.*", "\\1", msg$content)
          params_str <- sub(".*\\((.*)\\).*", "\\1", msg$content)
          tool <- eval(parse(text = func_name))

          params_list <- eval(parse(text = paste0("list(", params_str, ")")))

          content_to_consider <- ellmer::ContentToolRequest(
            id = id,
            name = func_name,
            arguments = params_list,
            tool = tool
          )

          tmp_list <- list(
            content_to_consider
          )

          tmp_list <- setNames(tmp_list, id)

          content_tool_requests <- append(
            content_tool_requests,
            tmp_list
          )

        } else if (grepl("[tool result id=", msg$content, fixed = TRUE)) {

          id <- sub(".*id=([^]]+)].*", "\\1", msg$content)

          result <- sub(".*]:\\s*", "", msg$content)

          if (length(content_tool_requests) > 0 & !id %in% names(content_tool_requests)) {
            cli::cli_abort(
              glue::glue(
                "{id} tool result detected but no corresponding tool request found, please fix."
              )
            )
          }

          request <- content_tool_requests[[id]]

          content_to_consider <- ellmer::ContentToolResult(
            value = result,
            request = request
          )

        } else {
          content_to_consider <- ellmer::ContentText(msg$content)
        }

        tokens <- c(0, 0, 0)

        if (i <= length(existing_turns)) {
          turn_to_consider <- existing_turns[[i]]
          if (S7::prop_exists(turn_to_consider, "tokens")) {
            tokens <- as.vector(turn_to_consider@tokens)
          }
        }

        turn <- ellmer::Turn(
          role = msg$role,
          contents = list(content_to_consider),
          tokens = tokens
        )

        turns <- append(turns, list(turn))
      }

      self$llm_object$set_turns(turns)

    },

    .validate_r_code = function(r_code, result) {

      validation <- tryCatch({
        parsed <- parse(text = r_code)
        result$validated <- TRUE
        result$validation_message <- "Syntax is valid"
        return(result)
      }, error = function(e) {
        result$validated <- FALSE
        result$validation_message <- paste("Syntax error:", e$message)
        return(result)
      })

    },

    .check_budget = function() {

      current_cost <- as.numeric(self$llm_object$get_cost())

      warn_at <- self$budget_policy$warn_at
      ratio <- current_cost / as.numeric(self$budget)

      budget_exceeded <- current_cost > self$budget

      if (ratio >= warn_at && !budget_exceeded) {
        cli::cli_alert_warning(
          glue::glue(
            "{self$name} budget nearing limit: Cost {round(current_cost, 4)} / . ",
            "Budget {round(self$budget, 4)} ({round(ratio * 100, 1)}%)"
          ))
      }

      if (!budget_exceeded) {
        return(invisible(NULL))
      }

      policy <- self$budget_policy$on_exceed

      if (policy == "warn") {
        cli::cli_alert_warning(glue::glue(
          "{self$name} exceeded budget: Cost {round(current_cost,4)} > ",
          "Budget {round(self$budget,4)}. Proceeding per policy 'warn'."
        ))
      }

      if (policy == "ask") {
        user_input <- readline(prompt = glue::glue(
          "Budget exceeded (Cost {round(current_cost,4)} > Budget {round(self$budget,4)}). ",
          "Continue? [y/N]: "
        ))
        if (tolower(user_input) != "y") {
          cli::cli_abort(glue::glue(
            "{self$name} agent cancelled due to budget exceedance. ",
            "Cost: {round(current_cost,4)}, Budget: {round(self$budget,4)}"
          ))
          return(invisible(NULL))
        }
      }

      if (policy == "abort") {
        cli::cli_abort(glue::glue(
          "{self$name} agent has exceeded its budget. ",
          "Cost: {round(current_cost, 4)}, Budget: {round(self$budget, 4)}"
        ))
      }
    },

    .update_llm_tools = function() {
      if (length(self$tools) > 0) {
        tool_list <- unname(self$tools)
        suppressMessages({
          self$llm_object$register_tools(tool_list)
        })
      } else {
        suppressMessages({
          self$llm_object$set_tools(list())
        })
      }
    }
  )
)

Try the mini007 package in your browser

Any scripts or data that you put into this service are public.

mini007 documentation built on Jan. 12, 2026, 5:08 p.m.