R/ai.R

Defines functions aiask .r4vn_ai_apply .r4vn_ai_print .r4vn_ai_comment .r4vn_ai_get .r4vn_ai_too_large_error .r4vn_ai_attach .r4vn_ai_http .r4vn_ai_extract_chat .r4vn_ai_extract_responses .r4vn_ai_json_error .r4vn_ai_payload .r4vn_ai_user_prompt .r4vn_ai_to_text .r4vn_ai_extract_text .r4vn_ai_candidate_key .r4vn_ai_discover .r4vn_ai_printed_result .r4vn_ai_trim_print_text .r4vn_ai_clean_print_lines .r4vn_ai_is_r4vn .r4vn_ai_vector_text .r4vn_ai_frame_text .r4vn_ai_compact_frame .r4vn_ai_clean_cell .r4vn_ai_context_name .r4vn_ai_atomic_score .r4vn_ai_table_score .r4vn_ai_col_score .r4vn_ai_name_score .r4vn_ai_noise_name .r4vn_ai_norm_name .r4vn_ai_analysis_guide .r4vn_ai_rules .r4vn_ai_language .r4vn_ai_resolve aisetup .r4vn_ai_list .r4vn_ai_delete_config .r4vn_ai_get_token .r4vn_ai_token_label .r4vn_ai_keyring_delete .r4vn_ai_keyring_get .r4vn_ai_keyring_set .r4vn_ai_keyring_service .r4vn_ai_url .r4vn_ai_api .r4vn_ai_provider .r4vn_ai_clean_name .r4vn_ai_state .r4vn_ai_write_file .r4vn_ai_read_file .r4vn_ai_empty_state .r4vn_ai_config_file .r4vn_ai_scalar_flag .r4vn_ai_scalar_text .r4vn_ai_null

Documented in aiask aisetup

# AI engine for R4VN
# Public functions: aisetup(), aiask()
# Required packages in DESCRIPTION: curl, jsonlite
# Optional package in Suggests: keyring

.r4vn_ai_env <- new.env(parent = emptyenv())
.r4vn_ai_env$state <- list(default = NULL, configs = list())
.r4vn_ai_env$tokens <- list()

.r4vn_ai_null <- function(x, y) {
  if (is.null(x) || length(x) == 0L) y else x
}

.r4vn_ai_scalar_text <- function(x, name, allow_null = TRUE) {
  if (is.null(x) && allow_null) return(NULL)
  if (!is.character(x) || length(x) != 1L || is.na(x) || !nzchar(trimws(x))) {
    stop(sprintf("`%s` must be one non-empty character value.", name), call. = FALSE)
  }
  trimws(x)
}

.r4vn_ai_scalar_flag <- function(x, name) {
  if (!is.logical(x) || length(x) != 1L || is.na(x)) {
    stop(sprintf("`%s` must be TRUE or FALSE.", name), call. = FALSE)
  }
  x
}

.r4vn_ai_config_file <- function() {
  file.path(tools::R_user_dir("R4VN", "config"), "ai-config.rds")
}

.r4vn_ai_empty_state <- function() {
  list(default = NULL, configs = list())
}

.r4vn_ai_read_file <- function() {
  path <- .r4vn_ai_config_file()
  if (!file.exists(path)) return(.r4vn_ai_empty_state())
  out <- tryCatch(readRDS(path), error = function(e) NULL)
  if (!is.list(out) || !is.list(out$configs)) return(.r4vn_ai_empty_state())
  if (is.null(out$default)) out$default <- NULL
  out
}

.r4vn_ai_write_file <- function(state) {
  path <- .r4vn_ai_config_file()
  dir.create(dirname(path), recursive = TRUE, showWarnings = FALSE)
  tmp <- tempfile("r4vn-ai-", tmpdir = dirname(path), fileext = ".rds")
  saveRDS(state, tmp, version = 2)
  if (file.exists(path)) unlink(path, force = TRUE)
  ok <- file.rename(tmp, path)
  if (!ok) {
    file.copy(tmp, path, overwrite = TRUE)
    unlink(tmp, force = TRUE)
  }
  try(Sys.chmod(path, mode = "0600"), silent = TRUE)
  invisible(path)
}

.r4vn_ai_state <- function() {
  saved <- .r4vn_ai_read_file()
  session <- .r4vn_ai_env$state
  if (!is.list(session) || !is.list(session$configs)) session <- .r4vn_ai_empty_state()
  for (nm in names(session$configs)) saved$configs[[nm]] <- session$configs[[nm]]
  if (!is.null(session$default)) saved$default <- session$default
  saved
}

.r4vn_ai_clean_name <- function(name) {
  name <- .r4vn_ai_scalar_text(name, "name", allow_null = FALSE)
  if (!grepl("^[A-Za-z][A-Za-z0-9.-]*$", name)) {
    stop("`name` must begin with a letter and contain only letters, numbers, dots, or hyphens.", call. = FALSE)
  }
  name
}

.r4vn_ai_provider <- function(provider) {
  provider <- tolower(.r4vn_ai_scalar_text(provider, "provider", allow_null = FALSE))
  provider <- gsub("[ _-]", "", provider)
  if (provider %in% c("openai", "gpt")) return("openai")
  if (provider %in% c("compatible", "openaicompatible", "custom", "local")) return("compatible")
  stop("`provider` must be \"openai\" or \"compatible\".", call. = FALSE)
}

.r4vn_ai_api <- function(api, provider, url = NULL) {
  if (is.null(api)) {
    if (!is.null(url) && grepl("/chat/completions/?$", url, ignore.case = TRUE)) return("chat")
    if (!is.null(url) && grepl("/responses/?$", url, ignore.case = TRUE)) return("responses")
    return(if (identical(provider, "openai")) "responses" else "chat")
  }
  api <- tolower(.r4vn_ai_scalar_text(api, "api", allow_null = FALSE))
  api <- gsub("[ _-]", "", api)
  if (api %in% c("response", "responses")) return("responses")
  if (api %in% c("chat", "chatcompletion", "chatcompletions")) return("chat")
  stop("`api` must be \"responses\" or \"chat\".", call. = FALSE)
}

.r4vn_ai_url <- function(url, provider, api) {
  endpoint <- if (identical(api, "responses")) "responses" else "chat/completions"
  if (is.null(url)) {
    if (identical(provider, "openai")) return(paste0("https://api.openai.com/v1/", endpoint))
    stop("`url` is required when `provider = \"compatible\"`.", call. = FALSE)
  }
  url <- .r4vn_ai_scalar_text(url, "url", allow_null = FALSE)
  url <- sub("/+$", "", url)
  if (!grepl("^https?://", url, ignore.case = TRUE)) {
    stop("`url` must begin with http:// or https://.", call. = FALSE)
  }
  if (grepl("/v1$", url, ignore.case = TRUE)) return(paste0(url, "/", endpoint))
  if (identical(provider, "openai") && grepl("^https://api\\.openai\\.com$", url, ignore.case = TRUE)) {
    return(paste0(url, "/v1/", endpoint))
  }
  url
}

.r4vn_ai_keyring_service <- function() {
  "R4VN AI"
}

.r4vn_ai_keyring_set <- function(name, token) {
  if (!requireNamespace("keyring", quietly = TRUE)) return(FALSE)
  ok <- tryCatch({
    keyring::key_set_with_value(
      service = .r4vn_ai_keyring_service(),
      username = name,
      password = token
    )
    TRUE
  }, error = function(e) FALSE)
  ok
}

.r4vn_ai_keyring_get <- function(name) {
  if (!requireNamespace("keyring", quietly = TRUE)) {
    stop("The token is stored in the system keyring, but package `keyring` is not available.", call. = FALSE)
  }
  tryCatch(
    keyring::key_get(service = .r4vn_ai_keyring_service(), username = name),
    error = function(e) stop("Could not read the AI token from the system keyring.", call. = FALSE)
  )
}

.r4vn_ai_keyring_delete <- function(name) {
  if (!requireNamespace("keyring", quietly = TRUE)) return(invisible(FALSE))
  tryCatch({
    keyring::key_delete(service = .r4vn_ai_keyring_service(), username = name)
    TRUE
  }, error = function(e) FALSE)
}

.r4vn_ai_token_label <- function(cfg) {
  if (!is.null(cfg$tokenenv)) return(paste0("env:", cfg$tokenenv))
  if (identical(cfg$tokenstore, "keyring")) return("keyring")
  if (identical(cfg$tokenstore, "session")) return("session")
  "none"
}

.r4vn_ai_get_token <- function(cfg) {
  if (!is.null(cfg$tokenenv)) {
    token <- Sys.getenv(cfg$tokenenv, unset = "")
    if (!nzchar(token)) {
      stop(sprintf("Environment variable `%s` does not contain an API token.", cfg$tokenenv), call. = FALSE)
    }
    return(token)
  }
  if (identical(cfg$tokenstore, "keyring")) return(.r4vn_ai_keyring_get(cfg$name))
  token <- .r4vn_ai_env$tokens[[cfg$name]]
  if (is.character(token) && length(token) == 1L && nzchar(token)) return(token)
  if (identical(cfg$provider, "compatible")) return("")
  stop(sprintf("No API token is available for AI configuration `%s`.", cfg$name), call. = FALSE)
}

.r4vn_ai_delete_config <- function(name) {
  saved <- .r4vn_ai_read_file()
  session <- .r4vn_ai_env$state
  cfg <- .r4vn_ai_state()$configs[[name]]
  if (!is.null(cfg) && identical(cfg$tokenstore, "keyring")) .r4vn_ai_keyring_delete(name)

  saved$configs[[name]] <- NULL
  if (identical(saved$default, name)) saved$default <- NULL
  .r4vn_ai_write_file(saved)

  session$configs[[name]] <- NULL
  if (identical(session$default, name)) session$default <- NULL
  .r4vn_ai_env$state <- session
  .r4vn_ai_env$tokens[[name]] <- NULL
  invisible(TRUE)
}

.r4vn_ai_list <- function() {
  state <- .r4vn_ai_state()
  if (!length(state$configs)) {
    out <- data.frame(
      name = character(), provider = character(), api = character(),
      model = character(), default = logical(), token = character(),
      language = character(), url = character(), stringsAsFactors = FALSE
    )
    print(out, row.names = FALSE)
    return(invisible(out))
  }
  out <- do.call(rbind, lapply(names(state$configs), function(nm) {
    z <- state$configs[[nm]]
    data.frame(
      name = nm,
      provider = .r4vn_ai_null(z$provider, ""),
      api = .r4vn_ai_null(z$api, ""),
      model = .r4vn_ai_null(z$model, ""),
      default = identical(state$default, nm),
      token = .r4vn_ai_token_label(z),
      language = .r4vn_ai_null(z$language, ""),
      url = .r4vn_ai_null(z$url, ""),
      stringsAsFactors = FALSE
    )
  }))
  rownames(out) <- NULL
  print(out, row.names = FALSE)
  invisible(out)
}

#' Configure AI services for R4VN
#'
#' Adds, updates, lists, selects, or removes named AI configurations. Only the
#' configuration is saved by R4VN. A token supplied through `tokenenv` remains
#' in an environment variable. A token supplied directly is stored in the
#' system keyring when package `keyring` is available; otherwise it is kept only
#' for the current R session.
#'
#' @param name Configuration name, for example `"gpt"` or `"local"`.
#' @param provider `"openai"` or `"compatible"`. The latter is for services
#'   implementing an OpenAI-compatible endpoint.
#' @param model Model identifier required by the selected service.
#' @param url Full API endpoint or API base ending in `/v1`. When omitted for
#'   `provider = "openai"`, the official OpenAI endpoint is used.
#' @param token Optional API token. It is never written into the R4VN
#'   configuration file.
#' @param tokenenv Optional environment-variable name containing the token.
#' @param api `"responses"` or `"chat"`. It is inferred from `provider` and
#'   `url` when omitted.
#' @param language Default language for AI comments. Common values are `"vi"`
#'   and `"en"`.
#' @param prompt Optional permanent instruction added to every request using
#'   this configuration.
#' @param default Logical; make this configuration the default.
#' @param use Name of an existing configuration to make default.
#' @param list Logical; list current configurations.
#' @param clear `FALSE`, `TRUE`, or a configuration name. `TRUE` removes all
#'   configurations.
#' @param save Logical; save the configuration for future R sessions.
#' @param timeout Request timeout in seconds.
#' @param temperature Optional model temperature. Leave `NULL` for provider
#'   defaults and maximum compatibility.
#' @param maxtokens Maximum generated tokens.
#' @param inputtokens Approximate target maximum tokens for statistical results
#'   sent to the AI service. `aiask()` automatically reduces this budget and
#'   retries when the provider reports that a request is too large.
#' @param overwrite Logical; permit replacing an existing configuration.
#'
#' @return Invisibly returns the saved configuration, the configuration table,
#'   or `TRUE` after a management action.
#'
#' @examples
#' \dontrun{
#' # Recommended: keep the token in .Renviron
#' # OPENAI_API_KEY=your-token
#' aisetup(
#'   name = "gpt",
#'   provider = "openai",
#'   model = "gpt-5.6",
#'   tokenenv = "OPENAI_API_KEY",
#'   default = TRUE
#' )
#'
#' # Direct token: saved securely when keyring is installed
#' aisetup(
#'   name = "gpt",
#'   provider = "openai",
#'   model = "gpt-5.6",
#'   token = "your-token",
#'   default = TRUE
#' )
#'
#' # OpenAI-compatible local or third-party service
#' aisetup(
#'   name = "local",
#'   provider = "compatible",
#'   model = "local-model",
#'   url = "http://localhost:11434/v1",
#'   default = TRUE
#' )
#'
#' aisetup(list = TRUE)
#' aisetup(use = "gpt")
#' aisetup(clear = "local")
#' }
#'
#' @export
aisetup <- function(name = NULL, provider = "openai", model = NULL, url = NULL,
                    token = NULL, tokenenv = NULL, api = NULL, language = "vi",
                    prompt = NULL, default = FALSE, use = NULL, list = FALSE,
                    clear = FALSE, save = TRUE, timeout = 120,
                    temperature = NULL, maxtokens = 1200,
                    inputtokens = 3000, overwrite = TRUE) {
  list <- .r4vn_ai_scalar_flag(list, "list")
  save <- .r4vn_ai_scalar_flag(save, "save")
  default <- .r4vn_ai_scalar_flag(default, "default")
  overwrite <- .r4vn_ai_scalar_flag(overwrite, "overwrite")

  actions <- c(list, !is.null(use), !identical(clear, FALSE))
  if (sum(actions) > 1L) stop("Use only one of `list`, `use`, or `clear` at a time.", call. = FALSE)

  if (list) return(.r4vn_ai_list())

  if (!is.null(use)) {
    use <- .r4vn_ai_clean_name(use)
    state <- .r4vn_ai_state()
    if (is.null(state$configs[[use]])) stop(sprintf("AI configuration `%s` was not found.", use), call. = FALSE)
    saved <- .r4vn_ai_read_file()
    if (!is.null(saved$configs[[use]]) && save) {
      saved$default <- use
      .r4vn_ai_write_file(saved)
    } else {
      .r4vn_ai_env$state$default <- use
    }
    message(sprintf("Default AI configuration: %s", use))
    return(invisible(TRUE))
  }

  if (!identical(clear, FALSE)) {
    if (identical(clear, TRUE)) {
      state <- .r4vn_ai_state()
      for (nm in names(state$configs)) {
        if (identical(state$configs[[nm]]$tokenstore, "keyring")) .r4vn_ai_keyring_delete(nm)
      }
      path <- .r4vn_ai_config_file()
      if (file.exists(path)) unlink(path, force = TRUE)
      .r4vn_ai_env$state <- .r4vn_ai_empty_state()
      .r4vn_ai_env$tokens <- base::list()
      message("All AI configurations were removed.")
      return(invisible(TRUE))
    }
    clear <- .r4vn_ai_clean_name(clear)
    if (is.null(.r4vn_ai_state()$configs[[clear]])) {
      warning(sprintf("AI configuration `%s` was not found.", clear), call. = FALSE)
      return(invisible(FALSE))
    }
    .r4vn_ai_delete_config(clear)
    message(sprintf("AI configuration `%s` was removed.", clear))
    return(invisible(TRUE))
  }

  if (is.null(name) && is.null(model) && is.null(url) && is.null(token) && is.null(tokenenv)) {
    return(.r4vn_ai_list())
  }

  name <- .r4vn_ai_clean_name(name)
  provider <- .r4vn_ai_provider(provider)
  api <- .r4vn_ai_api(api, provider, url)
  url <- .r4vn_ai_url(url, provider, api)
  model <- .r4vn_ai_scalar_text(model, "model", allow_null = FALSE)
  language <- .r4vn_ai_scalar_text(language, "language", allow_null = FALSE)
  prompt <- if (is.null(prompt)) NULL else paste(as.character(prompt), collapse = "\n")
  tokenenv <- .r4vn_ai_scalar_text(tokenenv, "tokenenv", allow_null = TRUE)
  token <- .r4vn_ai_scalar_text(token, "token", allow_null = TRUE)

  if (!is.null(token) && !is.null(tokenenv)) {
    stop("Use either `token` or `tokenenv`, not both.", call. = FALSE)
  }
  if (!is.numeric(timeout) || length(timeout) != 1L || is.na(timeout) || timeout <= 0) {
    stop("`timeout` must be one positive number.", call. = FALSE)
  }
  if (!is.null(temperature) &&
      (!is.numeric(temperature) || length(temperature) != 1L || is.na(temperature))) {
    stop("`temperature` must be NULL or one number.", call. = FALSE)
  }
  if (!is.numeric(maxtokens) || length(maxtokens) != 1L || is.na(maxtokens) || maxtokens < 1) {
    stop("`maxtokens` must be one positive number.", call. = FALSE)
  }
  if (!is.numeric(inputtokens) || length(inputtokens) != 1L ||
      is.na(inputtokens) || inputtokens < 500) {
    stop("`inputtokens` must be one number >= 500.", call. = FALSE)
  }

  current <- .r4vn_ai_state()
  if (!is.null(current$configs[[name]]) && !overwrite) {
    stop(sprintf("AI configuration `%s` already exists. Use `overwrite = TRUE` to replace it.", name), call. = FALSE)
  }
  oldtokenstore <- if (is.null(current$configs[[name]])) NULL else current$configs[[name]]$tokenstore

  tokenstore <- if (!is.null(tokenenv)) "environment" else "none"
  if (!is.null(token)) {
    .r4vn_ai_env$tokens[[name]] <- token
    tokenstore <- "session"
    if (save && .r4vn_ai_keyring_set(name, token)) tokenstore <- "keyring"
    if (save && identical(tokenstore, "session")) {
      warning(
        paste0(
          "Package `keyring` is not available or the system keyring could not store the token. ",
          "The configuration was saved, but the token is available only in this R session. ",
          "Install `keyring` or use `tokenenv` for persistent use."
        ),
        call. = FALSE
      )
    }
  }

  if (identical(provider, "openai") && is.null(token) && is.null(tokenenv)) {
    stop("An OpenAI configuration requires `token` or `tokenenv`.", call. = FALSE)
  }
  if (save && identical(oldtokenstore, "keyring") && !identical(tokenstore, "keyring")) {
    .r4vn_ai_keyring_delete(name)
  }

  cfg <- base::list(
    name = name,
    provider = provider,
    api = api,
    model = model,
    url = url,
    tokenenv = tokenenv,
    tokenstore = tokenstore,
    language = language,
    prompt = prompt,
    timeout = as.numeric(timeout),
    temperature = temperature,
    maxtokens = as.integer(maxtokens),
    inputtokens = as.integer(inputtokens),
    created = Sys.time()
  )

  if (save) {
    saved <- .r4vn_ai_read_file()
    saved$configs[[name]] <- cfg
    if (default || is.null(saved$default) && length(saved$configs) == 1L) saved$default <- name
    .r4vn_ai_write_file(saved)
    .r4vn_ai_env$state$configs[[name]] <- NULL
    if (default) .r4vn_ai_env$state$default <- NULL
  } else {
    .r4vn_ai_env$state$configs[[name]] <- cfg
    if (default || is.null(.r4vn_ai_state()$default)) .r4vn_ai_env$state$default <- name
  }

  if (default) {
    if (save) {
      saved <- .r4vn_ai_read_file()
      saved$default <- name
      .r4vn_ai_write_file(saved)
    } else {
      .r4vn_ai_env$state$default <- name
    }
  }

  message(sprintf(
    "AI configuration `%s` was %s%s.",
    name,
    if (save) "saved" else "set for this R session",
    if (default) " and set as default" else ""
  ))
  invisible(cfg)
}

.r4vn_ai_resolve <- function(ai = TRUE) {
  state <- .r4vn_ai_state()
  if (is.logical(ai)) {
    if (length(ai) != 1L || is.na(ai)) stop("`ai` must be FALSE, TRUE, or a configuration name.", call. = FALSE)
    if (!ai) return(NULL)
    name <- state$default
    if (is.null(name) && length(state$configs) == 1L) name <- names(state$configs)[1L]
    if (is.null(name)) {
      if (!length(state$configs)) stop("No AI configuration exists. Run `aisetup()` first.", call. = FALSE)
      stop("Several AI configurations exist but none is default. Use `aisetup(use = \"name\")` or `ai = \"name\"`.", call. = FALSE)
    }
  } else {
    name <- .r4vn_ai_clean_name(ai)
  }
  cfg <- state$configs[[name]]
  if (is.null(cfg)) stop(sprintf("AI configuration `%s` was not found.", name), call. = FALSE)
  cfg
}

.r4vn_ai_language <- function(x) {
  z <- tolower(trimws(x))
  if (z %in% c("vi", "vie", "vietnamese", "tieng viet", "ti\u1ebfng vi\u1ec7t")) return("Vietnamese")
  if (z %in% c("en", "eng", "english")) return("English")
  x
}

.r4vn_ai_rules <- function(language) {
  paste(
    "You are an experienced biostatistician and scientific medical writer.",
    "Your task is to write the Results text for a scientific manuscript based only on the supplied statistical output.",
    "",
    "STRICT RULES:",
    "1. Report results only. Do not discuss mechanisms, explanations, implications, limitations, causality, clinical recommendations, or future research.",
    "2. Write as if the text will be placed directly in the Results section of an international peer-reviewed medical or public health article.",
    "3. Focus on the main findings, not on the statistical methods.",
    "4. Do not describe which statistical tests were used unless this is essential to understand the result.",
    "5. Do not mention internal variable names, object fields, software structures, or technical metadata.",
    "6. Use the variable labels and group labels shown in the displayed result.",
    "7. For comparative analyses, report the direction and magnitude of important differences together with the relevant values and p-values when available.",
    "8. Report statistically significant findings first, followed by a concise statement about important non-significant findings when useful.",
    "9. Do not say that a non-significant result proves no difference. Use wording such as 'no statistically significant difference was observed'.",
    "10. Do not complain that effect sizes, confidence intervals, outcomes, tests, or other statistics are missing when they were not part of the displayed analysis.",
    "11. Do not invent missing values or infer unreported analyses.",
    "12. Do not repeat every number in the table. Select only the values needed to communicate the main results.",
    "13. Unless the user explicitly requests otherwise, write one cohesive paragraph only.",
    "14. Keep the writing concise, precise, academic, and suitable for publication.",
    "15. Do not include a heading, bullet points, numbered lists, markdown, references, or concluding discussion.",
    sprintf(
      "16. Write entirely in %s.",
      .r4vn_ai_language(language)
    ),
    sep = "\n"
  )
}

.r4vn_ai_analysis_guide <- function(x) {
  paste(
    "Infer the analysis type from the displayed result.",
    "For a descriptive table, summarize the major characteristics of the study sample.",
    "For a group-comparison table, describe the most important differences between groups, prioritizing statistically significant findings and reporting the corresponding values and p-values.",
    "For regression models, report the main associations using the appropriate effect measure and confidence interval.",
    "For longitudinal analyses, report time, group, and interaction effects when available.",
    "For survival analyses, report survival estimates, group differences, and hazard ratios when available.",
    "For diagnostic analyses, report the main diagnostic-accuracy measures and their uncertainty when available.",
    "For scale analyses, report the principal reliability, validity, and factor-analysis findings.",
    "Write Results, not Discussion.",
    sep = "\n"
  )
}

.r4vn_ai_norm_name <- function(x) {
  x <- tolower(gsub("[^a-z0-9]+", " ", .r4vn_ai_null(x, "")))
  trimws(x)
}

.r4vn_ai_noise_name <- function(name) {
  z <- .r4vn_ai_norm_name(name)
  if (!nzchar(z)) return(FALSE)
  grepl(
    paste(
      c(
        "\\braw\\b", "\\bhtml\\b", "\\bcss\\b", "\\bstyle\\b",
        "\\bformat\\b", "\\bformatted\\b", "\\bfootnote",
        "\\bcall\\b", "\\bformula\\b", "\\bterms?\\b", "\\benvironment\\b",
        "\\bplot\\b", "\\bgraph\\b", "\\bggplot\\b", "\\bimage\\b",
        "\\bdata(set)?\\b", "\\boriginal\\b", "\\bsource\\b",
        "\\blabels?\\b", "\\blevels?\\b", "\\bcontrasts?\\b",
        "\\bresiduals?\\b", "\\bfitted\\b", "\\bmodel frame\\b",
        "\\bxlevels?\\b", "\\bqr\\b"
      ),
      collapse = "|"
    ),
    z
  )
}

.r4vn_ai_name_score <- function(name) {
  z <- .r4vn_ai_norm_name(name)
  if (!nzchar(z)) return(0)
  score <- 0
  if (grepl("\\btable\\b|\\btab\\b", z)) score <- score + 70
  if (grepl("\\bresult(s)?\\b|\\boutput\\b", z)) score <- score + 65
  if (grepl("\\bsummary\\b", z)) score <- score + 50
  if (grepl("\\bestimate(s)?\\b|\\bcoefficient(s)?\\b|\\beffect(s)?\\b", z)) score <- score + 55
  if (grepl("\\bdiagnostic(s)?\\b|\\bmetric(s)?\\b|\\btest(s)?\\b", z)) score <- score + 35
  if (grepl("\\bfit\\b|\\banova\\b|\\bcontrast(s)?\\b", z)) score <- score + 25
  if (.r4vn_ai_noise_name(name)) score <- score - 120
  score
}

.r4vn_ai_col_score <- function(nm) {
  z <- .r4vn_ai_norm_name(nm)
  if (!nzchar(z)) return(0)
  score <- 0
  if (grepl("\\b(variable|term|level|category|group|outcome|predictor|exposure)\\b", z)) score <- score + 25
  if (grepl("\\b(or|rr|pr|hr|irr|beta|estimate|effect|coefficient)\\b", z)) score <- score + 35
  if (grepl("\\b(ci|confidence|lower|upper|lcl|ucl)\\b", z)) score <- score + 30
  if (grepl("\\b(p|pvalue|p value|prob|significance)\\b", z)) score <- score + 30
  if (grepl("\\b(n|count|percent|percentage|mean|sd|median|iqr|min|max|se)\\b", z)) score <- score + 18
  if (grepl("\\b(time|survival|hazard|event|risk|rate|auc|sensitivity|specificity)\\b", z)) score <- score + 20
  score
}

.r4vn_ai_table_score <- function(x, name = "", path = "") {
  nr <- NROW(x)
  nc <- NCOL(x)
  if (!is.finite(nr) || !is.finite(nc) || nr < 1L || nc < 1L) return(-Inf)

  score <- 35 + .r4vn_ai_name_score(name)

  if (nr <= 100L) score <- score + 25
  else if (nr <= 300L) score <- score + 10
  else if (nr > 1000L) score <- score - 150

  if (nc <= 20L) score <- score + 15
  else if (nc > 60L) score <- score - 80

  cn <- colnames(x)
  if (!is.null(cn)) {
    score <- score + min(80, sum(vapply(cn, .r4vn_ai_col_score, numeric(1))))
  }

  # Large generic frames are likely row-level source data.
  if (nr > 500L && .r4vn_ai_name_score(name) < 40) score <- score - 120
  if (.r4vn_ai_noise_name(name) || .r4vn_ai_noise_name(path)) score <- score - 120
  score
}

.r4vn_ai_atomic_score <- function(x, name = "") {
  if (length(x) < 1L || length(x) > 80L) return(-Inf)
  score <- .r4vn_ai_name_score(name)
  if (!is.null(names(x))) {
    score <- score + min(60, sum(vapply(names(x), .r4vn_ai_col_score, numeric(1))))
  }
  if (is.numeric(x) || is.integer(x) || is.logical(x)) score <- score + 20
  if (length(x) <= 20L) score <- score + 10
  if (.r4vn_ai_noise_name(name)) score <- score - 120
  score
}

.r4vn_ai_context_name <- function(name) {
  z <- .r4vn_ai_norm_name(name)
  if (!nzchar(z) || .r4vn_ai_noise_name(name)) return(FALSE)
  grepl(
    paste(
      c(
        "\\banalysis\\b", "\\btitle\\b", "\\boutcome\\b", "\\bevent\\b",
        "\\breference\\b", "\\bref\\b", "\\bmethod\\b", "\\bmodel type\\b",
        "\\bmeasure\\b", "\\bfamily\\b", "\\blink\\b", "\\btime\\b",
        "\\bgroup\\b", "\\bby\\b", "\\bsuperby\\b", "\\badjusted\\b",
        "\\bsample\\b", "^n$", "\\btotal n\\b"
      ),
      collapse = "|"
    ),
    z
  )
}

.r4vn_ai_clean_cell <- function(x) {
  if (length(x) == 0L) return("")
  if (is.factor(x)) x <- as.character(x)
  if (inherits(x, c("Date", "POSIXct", "POSIXlt"))) x <- as.character(x)
  if (is.list(x)) {
    x <- vapply(
      x,
      function(z) paste(as.character(z), collapse = ", "),
      character(1)
    )
  }
  x <- as.character(x)
  x[is.na(x)] <- "NA"
  x <- gsub("[\r\n\t]+", " ", x)
  trimws(x)
}

.r4vn_ai_compact_frame <- function(x, maxcols = 30L) {
  if (is.matrix(x)) x <- as.data.frame(x, stringsAsFactors = FALSE)
  x <- as.data.frame(x, stringsAsFactors = FALSE, optional = TRUE)
  if (!ncol(x) || !nrow(x)) return(x)

  for (j in seq_along(x)) x[[j]] <- .r4vn_ai_clean_cell(x[[j]])

  keep_col <- vapply(
    x,
    function(z) any(nzchar(trimws(z)) & z != "NA"),
    logical(1)
  )
  if (any(keep_col)) x <- x[, keep_col, drop = FALSE]

  keep_row <- apply(
    x,
    1L,
    function(z) any(nzchar(trimws(z)) & z != "NA")
  )
  if (any(keep_row)) x <- x[keep_row, , drop = FALSE]

  # Only exceptionally wide tables are reduced. Normal subgroup tables remain intact.
  if (ncol(x) > maxcols) {
    cn <- colnames(x)
    cs <- if (is.null(cn)) rep(0, ncol(x)) else vapply(cn, .r4vn_ai_col_score, numeric(1))
    priority <- unique(c(seq_len(min(5L, ncol(x))), order(cs, decreasing = TRUE)))
    x <- x[, head(priority, maxcols), drop = FALSE]
  }
  x
}

.r4vn_ai_frame_text <- function(x, maxchars = Inf) {
  x <- .r4vn_ai_compact_frame(x)
  if (!nrow(x) || !ncol(x)) return("")

  render <- function(z) {
    paste(
      utils::capture.output(
        utils::write.table(
          z,
          sep = "\t",
          row.names = FALSE,
          col.names = TRUE,
          quote = FALSE,
          na = "NA"
        )
      ),
      collapse = "\n"
    )
  }

  full <- render(x)
  if (!is.finite(maxchars) || nchar(full, type = "chars") <= maxchars) return(full)

  # Keep full rows. Never cut text halfway through a row.
  lo <- 1L
  hi <- nrow(x)
  best <- ""
  while (lo <= hi) {
    mid <- floor((lo + hi) / 2)
    txt <- render(x[seq_len(mid), , drop = FALSE])
    if (mid < nrow(x)) txt <- paste0(txt, "\n[additional rows omitted]")
    if (nchar(txt, type = "chars") <= maxchars) {
      best <- txt
      lo <- mid + 1L
    } else {
      hi <- mid - 1L
    }
  }
  best
}

.r4vn_ai_vector_text <- function(x) {
  vals <- .r4vn_ai_clean_cell(x)
  if (is.null(names(x))) return(paste(vals, collapse = ", "))
  paste(paste0(names(x), "=", vals), collapse = "; ")
}


.r4vn_ai_is_r4vn <- function(x) {
  cls <- class(x)
  length(cls) > 0L && any(grepl("^r4vn", cls, ignore.case = TRUE))
}

.r4vn_ai_clean_print_lines <- function(lines) {
  if (!length(lines)) return(character())

  lines <- enc2utf8(as.character(lines))
  lines <- gsub("\r", "", lines, fixed = TRUE)
  lines <- sub("[[:space:]]+$", "", lines)

  # Remove prior AI output if aiask() is called again on an already interpreted object.
  ai_head <- which(
    grepl(
      "^#{0,3}[[:space:]]*(AI-assisted interpretation|Nh.n x.t h. tr. b.i AI|Nh\u1eadn x\u00e9t h\u1ed7 tr\u1ee3 b\u1edfi AI)",
      lines,
      ignore.case = TRUE
    )
  )
  if (length(ai_head)) lines <- lines[seq_len(max(0L, ai_head[1L] - 1L))]

  # Drop only low-value definitional footnotes. Keep reference categories,
  # adjustment information, model notes, and other statistically meaningful notes.
  low_value <- grepl(
    paste0(
      "^\\s*(M\\s*:\\s*mean\\b|",
      "SD\\s*:\\s*standard deviation\\b|",
      "IQR\\s*:\\s*interquartile range\\b|",
      "Values are\\s+n\\s*\\(%\\)|",
      "Percentages use non-missing observations as the denominator\\.?\\s*$)"
    ),
    lines,
    ignore.case = TRUE
  )
  lines <- lines[!low_value]

  # Collapse excessive blank lines but preserve table structure.
  out <- character()
  blank <- FALSE
  for (z in lines) {
    is_blank <- !nzchar(trimws(z))
    if (is_blank && blank) next
    out <- c(out, z)
    blank <- is_blank
  }

  while (length(out) && !nzchar(trimws(out[1L]))) out <- out[-1L]
  while (length(out) && !nzchar(trimws(out[length(out)]))) out <- out[-length(out)]
  out
}

.r4vn_ai_trim_print_text <- function(lines, maxchars) {
  if (!length(lines)) return("")
  if (!is.finite(maxchars)) return(paste(lines, collapse = "\n"))

  used <- 0L
  keep <- character()
  for (z in lines) {
    add <- nchar(z, type = "chars") + if (length(keep)) 1L else 0L
    if (used + add > maxchars) break
    keep <- c(keep, z)
    used <- used + add
  }

  if (!length(keep)) return("")
  if (length(keep) < length(lines)) {
    keep <- c(keep, "[additional displayed rows omitted]")
  }
  paste(keep, collapse = "\n")
}

.r4vn_ai_printed_result <- function(x, budgetchars = Inf) {
  if (!.r4vn_ai_is_r4vn(x)) return(NULL)

  # The print method is the package's own definition of the user-facing result.
  # It is therefore a better universal AI source than arbitrary internal list fields.
  txt <- tryCatch(
    utils::capture.output(print(x)),
    error = function(e) character()
  )

  txt <- .r4vn_ai_clean_print_lines(txt)
  if (!length(txt)) return(NULL)

  joined <- paste(txt, collapse = "\n")

  # A class-specific print method may have nothing useful to print for a
  # lightweight/synthetic object (for example, print.r4vn_tablong() when
  # `$data` is absent). Do not let a trivial "NULL" print block the generic
  # structural extractor.
  trivial <- trimws(joined)
  if (!nzchar(trivial) || trivial %in% c("NULL", "list()")) return(NULL)

  # Reject suspiciously verbose/default-list printing; fall back to structural discovery.
  listish <- sum(grepl("^\\$|^\\[\\[[0-9]+\\]\\]", trimws(txt)))
  if (listish >= 5L || nchar(joined, type = "chars") > 200000L) return(NULL)

  joined <- .r4vn_ai_trim_print_text(txt, maxchars = budgetchars)
  if (!nzchar(trimws(joined))) return(NULL)
  joined
}

.r4vn_ai_discover <- function(x, maxdepth = 7L, maxnodes = 2500L) {
  candidates <- base::list()
  context <- character()
  nodes <- 0L

  add_candidate <- function(value, path, name, score, kind) {
    if (!is.finite(score) || score < 10) return(invisible(NULL))
    candidates[[length(candidates) + 1L]] <<- base::list(
      value = value,
      path = path,
      name = name,
      score = score,
      kind = kind
    )
    invisible(NULL)
  }

  add_context <- function(name, value) {
    if (!.r4vn_ai_context_name(name)) return(invisible(NULL))
    if (length(value) != 1L || is.na(value)) return(invisible(NULL))
    txt <- .r4vn_ai_clean_cell(value)
    if (!nzchar(txt) || nchar(txt, type = "chars") > 200L) return(invisible(NULL))
    item <- paste0(name, ": ", txt)
    if (!item %in% context) context <<- c(context, item)
    invisible(NULL)
  }

  walk <- function(obj, path = "x", name = "", depth = 0L) {
    nodes <<- nodes + 1L
    if (nodes > maxnodes || depth > maxdepth || is.null(obj)) return(invisible(NULL))

    if (tolower(name) %in% c("ai", "aicomment", "aiinfo", "aidata", "aiinput")) {
      return(invisible(NULL))
    }

    # Ignore high-volume formatting/raw branches before descending.
    if (.r4vn_ai_noise_name(name) && !is.data.frame(obj) && !is.matrix(obj)) {
      return(invisible(NULL))
    }

    if (is.data.frame(obj) || is.matrix(obj)) {
      add_candidate(
        obj, path, name,
        .r4vn_ai_table_score(obj, name, path),
        "table"
      )
      return(invisible(NULL))
    }

    # Do not descend into raw fitted model objects or graphics.
    if (inherits(
      obj,
      c(
        "lm", "glm", "coxph", "survfit", "lmerMod", "glmerMod",
        "ggplot", "grob", "recordedplot"
      )
    )) {
      return(invisible(NULL))
    }

    if (is.atomic(obj)) {
      if (length(obj) == 1L) add_context(name, obj)
      score <- .r4vn_ai_atomic_score(obj, name)
      total_chars <- sum(nchar(as.character(obj), type = "chars"), na.rm = TRUE)
      if (is.finite(score) && score >= 30 && total_chars <= 4000L) {
        add_candidate(obj, path, name, score, "vector")
      }
      return(invisible(NULL))
    }

    if (is.list(obj)) {
      nms <- names(obj)
      for (i in seq_along(obj)) {
        nm <- if (
          !is.null(nms) && length(nms) >= i &&
          !is.na(nms[i]) && nzchar(nms[i])
        ) nms[i] else paste0("[[", i, "]]")
        walk(obj[[i]], paste0(path, "$", nm), nm, depth + 1L)
        if (nodes > maxnodes) break
      }
    }
    invisible(NULL)
  }

  # Direct input is intentional: allow summarized character/table objects.
  if (is.character(x)) {
    candidates[[1L]] <- base::list(
      value = x, path = "x", name = "text", score = 100, kind = "vector"
    )
  } else if (is.data.frame(x) || is.matrix(x)) {
    candidates[[1L]] <- base::list(
      value = x, path = "x", name = "table", score = 100, kind = "table"
    )
  } else {
    walk(x)
  }

  if (length(candidates)) {
    sc <- vapply(candidates, function(z) z$score, numeric(1))
    candidates <- candidates[order(sc, decreasing = TRUE)]
  }

  base::list(
    candidates = candidates,
    context = unique(context),
    nodes = nodes
  )
}

.r4vn_ai_candidate_key <- function(z) {
  if (identical(z$kind, "table")) {
    x <- .r4vn_ai_compact_frame(z$value, maxcols = 12L)
    preview <- .r4vn_ai_frame_text(utils::head(x, 3L), maxchars = 1500L)
    return(paste(NROW(x), NCOL(x), preview, sep = "|"))
  }
  paste(.r4vn_ai_clean_cell(utils::head(z$value, 20L)), collapse = "|")
}

.r4vn_ai_extract_text <- function(x, budgettokens = 3000L) {
  budgettokens <- max(500L, as.integer(budgettokens))

  # Conservative approximation for Vietnamese/English statistical text.
  budgetchars <- as.integer(budgettokens * 3.2)

  # FIRST CHOICE FOR R4VN:
  # use exactly the result that the package's print method presents to the user.
  # This is universal across tab(), tabmulti(), tablong(), tabsurv(), etc.,
  # and avoids internal metadata such as variable_start, adjusted_all, raw HTML,
  # model internals, and formatting fields.
  printed <- .r4vn_ai_printed_result(
    x,
    budgetchars = max(500L, budgetchars - 200L)
  )

  if (!is.null(printed)) {
    text <- paste(
      paste0("OBJECT CLASS: ", paste(class(x), collapse = ", ")),
      "DISPLAYED R4VN RESULT:",
      printed,
      sep = "\n\n"
    )

    return(
      base::list(
        text = enc2utf8(text),
        estimated_tokens = ceiling(nchar(text, type = "chars") / 3.2),
        chars = nchar(text, type = "chars"),
        candidates = 1L,
        kept = 1L,
        omitted = 0L,
        source = "print"
      )
    )
  }

  # FALLBACK:
  # for non-R4VN objects, or R4VN objects without a usable print method,
  # discover result-like components structurally.
  found <- .r4vn_ai_discover(x)
  cand <- found$candidates

  if (!length(cand)) {
    stop(
      paste0(
        "No suitable summarized statistical results were found in this object. ",
        "`aiask()` intentionally did not send the whole object because it may ",
        "contain raw data, model internals, or formatting."
      ),
      call. = FALSE
    )
  }

  keys <- vapply(cand, .r4vn_ai_candidate_key, character(1))
  cand <- cand[!duplicated(keys)]

  class_line <- paste(class(x), collapse = ", ")
  if (!nzchar(class_line)) class_line <- typeof(x)

  pieces <- paste0("OBJECT CLASS: ", class_line)
  used <- nchar(pieces, type = "chars")

  if (length(found$context)) {
    ctx <- paste(c("CONTEXT", utils::head(found$context, 20L)), collapse = "\n")
    if (nchar(ctx, type = "chars") <= budgetchars * 0.15) {
      pieces <- c(pieces, ctx)
      used <- used + nchar(ctx, type = "chars")
    }
  }

  kept <- 0L
  omitted <- 0L

  for (i in seq_along(cand)) {
    z <- cand[[i]]
    remaining <- budgetchars - used - 160L

    if (remaining < 300L) {
      omitted <- omitted + length(cand) - i + 1L
      break
    }

    label <- paste0("RESULT ", kept + 1L, " [", z$path, "]")

    txt <- if (identical(z$kind, "table")) {
      .r4vn_ai_frame_text(
        z$value,
        maxchars = max(250L, remaining - nchar(label, type = "chars") - 5L)
      )
    } else {
      .r4vn_ai_vector_text(z$value)
    }

    if (!nzchar(trimws(txt))) {
      omitted <- omitted + 1L
      next
    }

    block <- paste(label, txt, sep = "\n")
    if (nchar(block, type = "chars") > remaining) {
      omitted <- omitted + 1L
      next
    }

    pieces <- c(pieces, block)
    used <- used + nchar(block, type = "chars")
    kept <- kept + 1L

    if (kept >= 8L) {
      omitted <- omitted + max(0L, length(cand) - i)
      break
    }
  }

  if (!kept) {
    stop(
      "Result components were found, but none could fit within the AI input budget.",
      call. = FALSE
    )
  }

  if (omitted > 0L) {
    pieces <- c(
      pieces,
      sprintf(
        "COMPACTION NOTE: %d lower-priority or oversized component(s) were omitted automatically.",
        omitted
      )
    )
  }

  text <- paste(pieces, collapse = "\n\n")

  base::list(
    text = enc2utf8(text),
    estimated_tokens = ceiling(nchar(text, type = "chars") / 3.2),
    chars = nchar(text, type = "chars"),
    candidates = length(cand),
    kept = kept,
    omitted = omitted,
    source = "discover"
  )
}

.r4vn_ai_to_text <- function(x, budgettokens = 3000L) {
  .r4vn_ai_extract_text(x, budgettokens = budgettokens)$text
}

.r4vn_ai_user_prompt <- function(x, result_text, cfg, prompt = NULL) {
  parts <- c(
    "ANALYSIS-SPECIFIC GUIDANCE:",
    .r4vn_ai_analysis_guide(x)
  )
  if (!is.null(cfg$prompt) && nzchar(trimws(cfg$prompt))) {
    parts <- c(parts, "", "PERMANENT USER PREFERENCE:", cfg$prompt)
  }
  if (!is.null(prompt)) {
    prompt <- paste(as.character(prompt), collapse = "\n")
    if (nzchar(trimws(prompt))) parts <- c(parts, "", "REQUEST FOR THIS RESULT:", prompt)
  }
  parts <- c(
    parts, "",
    "SUMMARIZED STATISTICAL RESULTS:",
    result_text,
    "",
    "Write one concise, cohesive paragraph suitable for the Results section of a scientific manuscript."
  )
  paste(parts, collapse = "\n")
}

.r4vn_ai_payload <- function(cfg, system, user) {
  if (identical(cfg$api, "responses")) {
    body <- list(model = cfg$model, instructions = system, input = user)
    if (!is.null(cfg$temperature)) body$temperature <- cfg$temperature
    if (!is.null(cfg$maxtokens)) body$max_output_tokens <- cfg$maxtokens
    return(body)
  }
  body <- list(
    model = cfg$model,
    messages = list(
      list(role = "system", content = system),
      list(role = "user", content = user)
    )
  )
  if (!is.null(cfg$temperature)) body$temperature <- cfg$temperature
  if (!is.null(cfg$maxtokens)) body$max_tokens <- cfg$maxtokens
  body
}

.r4vn_ai_json_error <- function(text, status) {
  parsed <- tryCatch(jsonlite::fromJSON(text, simplifyVector = FALSE), error = function(e) NULL)
  msg <- NULL
  if (is.list(parsed) && is.list(parsed$error)) msg <- parsed$error$message
  if (is.null(msg) && is.list(parsed) && is.character(parsed$message)) msg <- parsed$message
  if (is.null(msg) || !nzchar(msg)) msg <- trimws(text)
  if (!nzchar(msg)) msg <- paste("HTTP status", status)
  msg
}

.r4vn_ai_extract_responses <- function(parsed) {
  if (is.character(parsed$output_text) && length(parsed$output_text)) {
    z <- paste(parsed$output_text, collapse = "\n")
    if (nzchar(trimws(z))) return(z)
  }
  texts <- character()
  walk <- function(node) {
    if (!is.list(node)) return(invisible(NULL))
    if (identical(node$type, "output_text") && is.character(node$text)) {
      texts <<- c(texts, node$text)
      return(invisible(NULL))
    }
    for (item in node) walk(item)
    invisible(NULL)
  }
  walk(parsed$output)
  paste(texts[nzchar(texts)], collapse = "\n")
}

.r4vn_ai_extract_chat <- function(parsed) {
  if (!is.list(parsed$choices) || !length(parsed$choices)) return("")
  msg <- parsed$choices[[1L]]$message
  content <- if (is.list(msg)) msg$content else NULL
  if (is.character(content)) return(paste(content, collapse = "\n"))
  if (is.list(content)) {
    texts <- unlist(lapply(content, function(z) {
      if (is.character(z)) return(z)
      if (is.list(z) && is.character(z$text)) return(z$text)
      character()
    }), use.names = FALSE)
    return(paste(texts[nzchar(texts)], collapse = "\n"))
  }
  if (is.character(parsed$choices[[1L]]$text)) return(parsed$choices[[1L]]$text)
  ""
}

.r4vn_ai_http <- function(cfg, payload) {
  if (!requireNamespace("curl", quietly = TRUE)) {
    stop("Package `curl` is required. Install it with install.packages(\"curl\").", call. = FALSE)
  }
  if (!requireNamespace("jsonlite", quietly = TRUE)) {
    stop("Package `jsonlite` is required. Install it with install.packages(\"jsonlite\").", call. = FALSE)
  }

  token <- .r4vn_ai_get_token(cfg)
  body <- jsonlite::toJSON(payload, auto_unbox = TRUE, null = "null", na = "null", digits = NA)

  handle <- curl::new_handle()
  headers <- c(
    "Content-Type" = "application/json",
    "Accept" = "application/json",
    "User-Agent" = paste0("R4VN/", tryCatch(as.character(utils::packageVersion("R4VN")), error = function(e) "development"))
  )
  if (nzchar(token)) headers <- c(headers, "Authorization" = paste("Bearer", token))
  curl::handle_setheaders(handle, .list = as.list(headers))
  curl::handle_setopt(
    handle,
    customrequest = "POST",
    postfields = enc2utf8(body),
    timeout = cfg$timeout,
    connecttimeout = min(30, cfg$timeout)
  )

  response <- tryCatch(
    curl::curl_fetch_memory(cfg$url, handle = handle),
    error = function(e) stop(sprintf("AI request failed: %s", conditionMessage(e)), call. = FALSE)
  )
  text <- rawToChar(response$content)
  status <- response$status_code
  if (status < 200L || status >= 300L) {
    stop(sprintf("AI API error (%s): %s", status, .r4vn_ai_json_error(text, status)), call. = FALSE)
  }

  parsed <- tryCatch(
    jsonlite::fromJSON(text, simplifyVector = FALSE),
    error = function(e) stop("The AI API returned invalid JSON.", call. = FALSE)
  )
  comment <- if (identical(cfg$api, "responses")) {
    .r4vn_ai_extract_responses(parsed)
  } else {
    .r4vn_ai_extract_chat(parsed)
  }
  comment <- trimws(comment)
  if (!nzchar(comment)) stop("The AI API returned no text comment.", call. = FALSE)
  usage <- NULL
  if (is.list(parsed$usage)) {
    usage <- base::list(
      prompt_tokens = .r4vn_ai_null(
        parsed$usage$prompt_tokens,
        parsed$usage$input_tokens
      ),
      completion_tokens = .r4vn_ai_null(
        parsed$usage$completion_tokens,
        parsed$usage$output_tokens
      ),
      total_tokens = parsed$usage$total_tokens
    )
  }

  base::list(comment = comment, usage = usage)
}

.r4vn_ai_attach <- function(x, info) {
  if (is.list(x) && !is.data.frame(x)) {
    x$ai <- info
  } else {
    attr(x, "ai") <- info
  }
  x
}

.r4vn_ai_too_large_error <- function(message) {
  if (is.null(message) || !length(message)) return(FALSE)
  z <- tolower(paste(as.character(message), collapse = " "))
  patterns <- c(
    "http[^0-9]*413", "api error \\(413\\)", "request too large",
    "payload too large", "content too large", "context length",
    "context_length", "maximum context", "max context",
    "too many tokens", "token limit", "input is too long",
    "prompt is too long", "reduce.*tokens", "exceeds.*token"
  )
  any(vapply(patterns, function(p) grepl(p, z, perl = TRUE), logical(1)))
}

.r4vn_ai_get <- function(x) {
  if (is.list(x) && !is.data.frame(x) && is.list(x$ai)) return(x$ai)
  attr(x, "ai", exact = TRUE)
}

.r4vn_ai_comment <- function(x) {
  z <- .r4vn_ai_get(x)
  if (is.list(z) && identical(z$status, "success")) z$comment else NULL
}

.r4vn_ai_print <- function(info, language = "vi") {
  if (!is.list(info) || !identical(info$status, "success")) return(invisible(NULL))
  cat("\n", info$comment, "\n", sep = "")
  invisible(info)
}

.r4vn_ai_apply <- function(x, ai = FALSE, prompt = NULL, show = FALSE) {
  if (!is.null(prompt) && identical(ai, FALSE)) ai <- TRUE
  if (identical(ai, FALSE) || is.null(ai)) return(x)

  cfg <- tryCatch(.r4vn_ai_resolve(ai), error = function(e) e)
  if (inherits(cfg, "error")) {
    info <- base::list(
      status = "error",
      error = conditionMessage(cfg),
      created = Sys.time()
    )
    warning(conditionMessage(cfg), call. = FALSE)
    return(.r4vn_ai_attach(x, info))
  }

  input_budget <- max(
    500L,
    as.integer(.r4vn_ai_null(cfg$inputtokens, 3000L))
  )
  output_budget <- max(
    300L,
    as.integer(.r4vn_ai_null(cfg$maxtokens, 1200L))
  )

  attempt <- 0L
  last_error <- NULL
  extraction <- NULL
  response <- NULL

  while (attempt < 3L) {
    attempt <- attempt + 1L

    extraction <- tryCatch(
      .r4vn_ai_extract_text(x, budgettokens = input_budget),
      error = function(e) e
    )

    if (inherits(extraction, "error")) {
      last_error <- conditionMessage(extraction)
      break
    }

    cfg_try <- cfg
    cfg_try$maxtokens <- output_budget

    system <- .r4vn_ai_rules(cfg_try$language)
    user <- .r4vn_ai_user_prompt(
      x,
      extraction$text,
      cfg_try,
      prompt
    )

    response <- tryCatch(
      .r4vn_ai_http(
        cfg_try,
        .r4vn_ai_payload(cfg_try, system, user)
      ),
      error = function(e) e
    )

    if (!inherits(response, "error")) break

    last_error <- conditionMessage(response)

    if (!.r4vn_ai_too_large_error(last_error) || attempt >= 3L) break

    # Reduce both input and requested output before retrying.
    input_budget <- max(500L, floor(input_budget * 0.55))
    output_budget <- max(300L, floor(output_budget * 0.65))
  }

  if (inherits(response, "error") || is.null(response)) {
    out <- base::list(
      status = "error",
      name = cfg$name,
      provider = cfg$provider,
      api = cfg$api,
      model = cfg$model,
      language = cfg$language,
      prompt = if (is.null(prompt)) NULL else paste(as.character(prompt), collapse = "\n"),
      error = .r4vn_ai_null(last_error, "AI request failed."),
      attempts = attempt,
      created = Sys.time()
    )
  } else {
    out <- base::list(
      status = "success",
      name = cfg$name,
      provider = cfg$provider,
      api = cfg$api,
      model = cfg$model,
      language = cfg$language,
      prompt = if (is.null(prompt)) NULL else paste(as.character(prompt), collapse = "\n"),
      comment = response$comment,
      usage = response$usage,
      input = base::list(
        source = .r4vn_ai_null(extraction$source, "discover"),
        estimated_tokens = extraction$estimated_tokens,
        chars = extraction$chars,
        candidates = extraction$candidates,
        kept = extraction$kept,
        omitted = extraction$omitted
      ),
      attempts = attempt,
      created = Sys.time()
    )
  }

  ans <- .r4vn_ai_attach(x, out)

  if (identical(out$status, "error")) {
    warning(
      sprintf("AI interpretation unavailable: %s", out$error),
      call. = FALSE
    )
  } else if (show) {
    .r4vn_ai_print(out, cfg$language)
  }

  ans
}

#' Ask an AI service to interpret summarized statistical results
#'
#' Automatically discovers compact statistical result components inside an
#' object, sends only the most useful results to the selected AI service, and
#' attaches the returned interpretation. Lists receive an `ai` element; other
#' objects receive an `"ai"` attribute.
#'
#' The extractor is generic rather than command-specific. It recursively searches
#' for result-like tables, matrices, estimates, tests, diagnostics, and short
#' statistical context while ignoring raw data, HTML/CSS, formatting objects,
#' plots, model internals, residuals, and other high-volume noise. The same
#' `aiask()` can therefore be used for R4VN descriptive, multivariable,
#' longitudinal, survival, diagnostic, scale, regression, and future result
#' objects without a separate prepare function for every command.
#'
#' A conservative input budget is applied before the API call. If the provider
#' reports that the request is too large, `aiask()` automatically compacts the
#' results further and retries up to two times.
#'
#' @param x An R4VN result object, summarized list, result table/matrix, or
#'   character result. `aiask()` automatically finds useful result components.
#' @param ai `TRUE` to use the default configuration or a configuration name.
#' @param prompt Optional request specific to the current result. It is added
#'   after the permanent prompt stored by `aisetup()`.
#'
#' @return Invisibly returns `x` with an attached AI result. Successful results
#'   contain `status`, `name`, `model`, `comment`, `input`, optional `usage`,
#'   and `created`. API failures are attached with `status = "error"` and do not
#'   destroy `x`.
#'
#' @examples
#' \dontrun{
#' aisetup(
#'   name = "gpt",
#'   provider = "openai",
#'   model = "gpt-5.6",
#'   tokenenv = "OPENAI_API_KEY",
#'   default = TRUE
#' )
#'
#' result <- list(
#'   analysis = "Logistic regression",
#'   outcome = "Hypertension",
#'   estimates = data.frame(
#'     variable = c("Age", "Smoking"),
#'     OR = c(1.05, 1.82),
#'     lower = c(1.02, 1.15),
#'     upper = c(1.08, 2.88),
#'     p = c(0.001, 0.011)
#'   )
#' )
#'
#' result <- aiask(result)
#' result$ai$comment
#'
#' result <- aiask(
#'   result,
#'   ai = "gpt",
#'   prompt = "Focus on modifiable risk factors."
#' )
#' }
#'
#' @export
aiask <- function(x, ai = TRUE, prompt = NULL) {
  invisible(.r4vn_ai_apply(x, ai = ai, prompt = prompt, show = TRUE))
}

Try the R4VN package in your browser

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

R4VN documentation built on Sept. 30, 2026, 5:13 p.m.