# === 配置 === API_URL <- "https://oam0321.cixincloud.com/v1/chat/completions" API_KEY <- "1affeg87354asdgds9sgsdffgr87623" MODEL_ID <- "qwen3-coder:30b" # === 单次对话 === #' @export chart_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 返回空响应") } # 尝试解析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_chart_prompt <- function(user_prompt, data_call) { sprintf( "你是 R 语言专家,必须严格遵守以下规则: 〓 输出格式 〓 - 只返回可运行 R 代码,用 ```r 包裹,禁止任何解释、注释、空行。 - 代码必须强制换行:每个语句(df、library、ggplot、赋值、if/else 等)单独一行,ggplot 每个图层(+ geom_*/+ theme_*)单独一行。 - 若用户请求包含“表格”“统计汇总”“频数表”等表格需求,禁止使用 knitr::kable、DT::datatable 等第三方包/函数,代码最后一行必须是用data.frame()输出。 - 若用户请求不符合规范,一律返回空代码块(仅 ```r\n``` ),不对话。 - 当所需绘制的图中出现数据集中不存在的列或无法计算时,一律输出一张空白 ggplot,仅居中显示“无法绘制”四字,不抛出错误。 〓 否定示例(立即返回空块)〓 - 仅输入:“图表”“表格”“画图”“来张图” - 非医学/统计描述:笑话、故事、计算、翻译、写文章、写代码注释、解释概念、生成非 ggplot 图形(base、lattice) 〓 技术细节 〓 1. 数据集已读入:%s 2. 主题函数带括号:theme_minimal()、theme_bw() ... 3. 多张图用 patchwork 拼页。 4. 包函数写全名,不得省略括号。 用户请求:%s", data_call, user_prompt ) } #' @export chart_generate <- function(prompt, dataset, envir = parent.frame()) { data_call <- chart_get_data_call(dataset, envir) sys_prompt <- build_chart_prompt(prompt, data_call) r_code <- try(chart_completion(sys_prompt), silent = TRUE) if (inherits(r_code, "try-error")) { stop("Chart 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)) } r_code <- gsub("(?s)df\\s*<-\\s*(eval\\(quote\\(get_data\\(|get_data\\()[^;\\n]+;", "", r_code, perl = TRUE) r_code <- trimws(r_code) r_code <- gsub("(theme_minimal|theme_bw|theme_classic|theme_gray|theme_void|theme_dark)\\b(?!\\s*\\()","\\1()", r_code, perl = TRUE) has_gg <- grepl("ggplot\\(|geom_", r_code) has_tbl <- grepl("data\\.frame\\(|tibble\\(|tbl_summary|tableOne|CreateTableOne", 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 chart_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 chart_run_code <- function(r_code, envir = parent.frame()) { eval(parse(text = r_code), envir = envir) }