# === 配置 === API_URL <- "https://oam0321.cixincloud.com/v1/chat/completions" API_KEY <- "1affeg87354asdgds9sgsdffgr87623" MODEL_ID <- "qwen3-coder:30b" # === 单次对话 === #' @export metrics_completion <- function(user_prompt) { Sys.unsetenv("http_proxy") Sys.unsetenv("https_proxy") # 构建请求体 req_body <- list( model = MODEL_ID, messages = list(list( role = "user", content = user_prompt )), stream = FALSE ) # 转换为JSON json_body <- jsonlite::toJSON(req_body, auto_unbox = TRUE, pretty = TRUE) # 使用 curl 包发送请求 h <- curl::new_handle() curl::handle_setheaders(h, "Content-Type" = "application/json", "Authorization" = paste("Bearer", API_KEY) ) curl::handle_setopt(h, postfields = json_body) curl::handle_setopt(h, timeout = 60) # 捕获响应 con <- curl::curl(API_URL, handle = h) result <- readLines(con, warn = FALSE) close(con) # 检查响应是否为空 if (length(result) == 0 || all(result == "")) { stop("API 返回空响应") } # 解析响应 body <- jsonlite::fromJSON(paste(result, collapse = ""), simplifyVector = FALSE) # 尝试解析JSON body <- tryCatch({ jsonlite::fromJSON(paste(result, collapse = ""), simplifyVector = FALSE) }, error = function(e) { stop("JSON解析失败: ", e$message, "\n原始响应: ", paste(result, collapse = "")) }) # 检查是否有错误字段 if (!is.null(body$error)) { stop("API 返回错误: ", jsonlite::toJSON(body$error, auto_unbox = TRUE)) } # 提取内容 if (!is.list(body) || !is.list(body$choices) || length(body$choices) == 0) { stop("API 响应格式异常: ", paste(result, collapse = "")) } response_content <- body$choices[[1]]$message$content if (is.null(response_content) || trimws(response_content) == "") { stop("API 返回空内容: ", paste(result, collapse = "")) } response_content } # === 构造发给模型的 Prompt === #' @export build_metrics_prompt <- function(user_prompt, data_call) { sprintf( "你是 R 语言科研统计专家,精通所有主流统计方法(t检验、方差分析、回归分析、卡方检验、相关性分析等),必须严格遵守以下规则,任何违反均视为无效输出: 〓 输出格式铁律 〓 1. 仅返回可直接运行的 R 代码,用 ```r 包裹,无任何解释、注释、空行,代码必须包含「结果输出语句」(否则无法展示统计结果)。 2. 不符合规范的请求,直接返回空代码块(仅 ```r\n``` ),不额外对话: - 模糊无具体目标的请求 - 非科研统计需求(生成图表、翻译、写文章、解释概念等) 3. 无法计算时(如列不存在、变量类型不匹配、方法不适用),仅输出 `print('无法计算:[具体原因,如“目标列bmi不存在”“卡方检验要求分类变量”]')`,不抛出错误。 〓 统计逻辑核心约束 〓 1. 方法匹配:必须根据用户请求选择「标准科研统计方法」(仅用 R 官方 stats 包或主流统计包如 broom、car、nnet 的标准函数,禁止自创方法)。 2. 参数正确性: - 原假设参数:用户指定的原假设定值(如“原假设均值为0”则 mu=0,“原假设相关系数为0”则 rho=0),禁止设为数据自身的统计量(如 mu=mean(df$bmi) 是严重错误)。 - 变量适配:严格匹配方法对变量类型的要求(如 t检验要求连续变量,卡方检验要求分类变量,回归分析因变量需连续),类型不匹配则触发“无法计算”。 - 缺失值处理:所有涉及数据计算的函数必须加 na.rm=TRUE(方法不支持则除外)。 3. 默认参数:用户未指定时,按科研规范设默认值并在结果中体现: - 置信水平默认 0.95(conf.level='0.95') - 多重比较调整方法默认(p.adjust.method='none') - 假设检验默认双侧检验(alternative='two.sided') 〓 技术规范(确保结果结构化、可展示)〓 1. 数据集已读入为:%s(直接用 df$列名 引用变量)。 2. 结果输出要求: - 禁止使用broom::tidy()、data.frame()等函数将统计结果转为结构化数据框,必须保持原始统计结果 - 必须将统计结果的关键指标通过 cat() 函数逐行输出,确保每行一个指标,清晰可读。最后一行需要将统计的原始结果print出来。 - 输出必须包含以下上下文信息:数据集名称(来自进行统计计算的 dataset)、变量名称(如 age, charges等变量原名称)、检验类型、原假设、样本信息(n, 缺失值数量)、关键统计量(t, df, p, CI, 均值等) 3. 函数规范:统计函数必须写全名+完整括号(如 t.test()、lm()、chisq.test()),禁止省略括号或简写。 4. 变量校验:自动校验变量存在性和类型(如分组变量必须是因子/字符型,连续变量不能用于卡方检验),校验失败则输出“无法计算”。 用户请求:%s", data_call, user_prompt ) } #' @export metrics_generate <- function(prompt, dataset, envir = parent.frame()) { data_call <- metrics_get_data_call(dataset, envir) sys_prompt <- build_metrics_prompt(prompt, data_call) r_code <- try(metrics_completion(sys_prompt), silent = TRUE) if (inherits(r_code, "try-error")) stop("Metrics API error: ", attr(r_code, "condition")$message) r_code <- gsub("(?s)```r\\s*|```", "", r_code, perl = TRUE) r_code <- trimws(r_code) if (r_code == "") { return(list(r_code = "", type = "empty", auto_run = FALSE)) } has_gg <- grepl("ggplot\\(|geom_", r_code) has_tbl <- grepl("data\\.frame\\(|tibble\\(|tbl_summary|tableOne|CreateTableOne|t.test|lm|cor.test|anova", r_code) type <- if (has_gg) "plot" else if (has_tbl) "table" else "text" list(r_code = r_code, type = type, auto_run = TRUE) } #' @export metrics_get_data_call <- function(dataset, envir) { df_name <- if (is_string(dataset)) dataset else deparse1(substitute(dataset)) paste0("df <- eval(quote(get_data(\"", df_name, "\", envir = ", deparse1(substitute(envir)), ")), envir = parent.frame())") } #' @export metrics_run_code <- function(r_code, envir = parent.frame()) { output_lines <- capture.output({ eval(parse(text = r_code), envir = envir) }) paste(output_lines, collapse = "\n") }