Nothing
# 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))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.