# === 配置 === MODELSCOPE_OPENAI_URL <- "https://api-inference.modelscope.cn/v1" MODELSCOPE_API_KEY <- Sys.getenv("MODELSCOPE_API_KEY", "ms-b2746d72-f897-4faf-8089-89e5e511ed5a") MODEL_ID <- "deepseek-ai/DeepSeek-V3.1" # === 低层封装:单次对话 === #' @export chat_completion <- function(user_prompt, max_tokens = 1500, temperature = 0.3) { req <- httr2::request(paste0(MODELSCOPE_OPENAI_URL, "/chat/completions")) %>% httr2::req_headers( "Authorization" = paste("Bearer", MODELSCOPE_API_KEY), "Content-Type" = "application/json" ) %>% httr2::req_body_json(list( model = MODEL_ID, messages = list(list(role = "user", content = user_prompt)), temperature = temperature, max_tokens = max_tokens, stream = FALSE )) resp <- httr2::req_perform(req) body <- httr2::resp_body_json(resp) if (is.null(body$choices[[1]]$message$content)) stop("ModelScope API 返回空内容:", body) body$choices[[1]]$message$content } # === 构造发给模型的 Prompt === #' @export build_r_prompt <- function(user_prompt, data_call) { sprintf( "你是 R 语言专家,必须严格遵守以下规则: 〓 输出格式 〓 - 只返回可运行 R 代码,用 ```r 包裹,禁止任何解释、注释、空行。 - 若用户请求不符合下方【白名单】,一律返回空代码块(仅 ```r\n``` ),不对话。 〓 白名单关键词(必须至少出现 1 个)〓 箱线图|柱状图|条形图|散点图|折线图|密度图|直方图|热图|森林图|瀑布图|饼图|气泡图|生存曲线|KM 曲线|ggsurvplot|tbl_summary|tableone|CreateTableOne|描述性统计|基线表|相关性|group comparison|distribution|ggplot|geom_|patchwork 〓 否定示例(立即返回空块)〓 - 仅输入:“图表”“表格”“画图”“来张图” - 非医学/统计描述:笑话、故事、计算、翻译、写文章、写代码注释、解释概念、生成非 ggplot 图形(base、lattice) 〓 技术细节 〓 1. 数据集已读入:%s 2. 主题函数带括号:theme_minimal()、theme_bw() ... 3. 多张图用 patchwork 拼页。 4. 包函数写全名,不得省略括号。 用户请求:%s", data_call, user_prompt ) } #' @export ai_generate <- function(prompt, dataset, envir = parent.frame()) { data_call <- ai_get_data_call(dataset, envir) sys_prompt <- build_r_prompt(prompt, data_call) r_code <- try(chat_completion(sys_prompt), silent = TRUE) if (inherits(r_code, "try-error")) stop("AI 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("(theme_minimal|theme_bw|theme_classic|theme_gray|theme_void|theme_dark)\\b(?!\\s*\\()", "\\1()", r_code, perl = TRUE) r_code <- paste0(data_call, "\n", r_code) 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 ai_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 ai_run_code <- function(r_code, envir = parent.frame()) { eval(parse(text = r_code), envir = envir) }