Commit 8d152d15 authored by wuzekai's avatar wuzekai

增加了大模型对话助手

parent 53dd5828
...@@ -31,6 +31,7 @@ export(p975) ...@@ -31,6 +31,7 @@ export(p975)
export(p99) export(p99)
export(prop) export(prop)
export(qscatter) export(qscatter)
export(quickgen_chat_server)
export(sdpop) export(sdpop)
export(sdprop) export(sdprop)
export(se) export(se)
......
...@@ -3,7 +3,7 @@ MODELSCOPE_OPENAI_URL <- "https://api-inference.modelscope.cn/v1" ...@@ -3,7 +3,7 @@ MODELSCOPE_OPENAI_URL <- "https://api-inference.modelscope.cn/v1"
MODELSCOPE_API_KEY <- Sys.getenv("MODELSCOPE_API_KEY", "ms-5b9f3668-ea8e-4a2c-8cd3-a1a9ba04810b") MODELSCOPE_API_KEY <- Sys.getenv("MODELSCOPE_API_KEY", "ms-5b9f3668-ea8e-4a2c-8cd3-a1a9ba04810b")
MODEL_ID <- "deepseek-ai/DeepSeek-V3.1" MODEL_ID <- "deepseek-ai/DeepSeek-V3.1"
# === 低层封装:单次对话 === # === 单次对话 ===
#' @export #' @export
chat_completion <- function(user_prompt, chat_completion <- function(user_prompt,
max_tokens = 1500, max_tokens = 1500,
...@@ -38,10 +38,8 @@ build_r_prompt <- function(user_prompt, data_call) { ...@@ -38,10 +38,8 @@ build_r_prompt <- function(user_prompt, data_call) {
〓 输出格式 〓 〓 输出格式 〓
- 只返回可运行 R 代码,用 ```r 包裹,禁止任何解释、注释、空行。 - 只返回可运行 R 代码,用 ```r 包裹,禁止任何解释、注释、空行。
- 若用户请求不符合下方【白名单】,一律返回空代码块(仅 ```r\n``` ),不对话。 - 若用户请求不符合规范,一律返回空代码块(仅 ```r\n``` ),不对话。
- 当所需绘制的图中出现数据集中不存在的列或无法计算时,一律输出一张空白 ggplot,仅居中显示“无法绘制”四字,不抛出错误。
〓 白名单关键词(必须至少出现 1 个)〓
箱线图|柱状图|条形图|散点图|折线图|密度图|直方图|热图|森林图|瀑布图|饼图|气泡图|生存曲线|KM 曲线|ggsurvplot|tbl_summary|tableone|CreateTableOne|描述性统计|基线表|相关性|group comparison|distribution|ggplot|geom_|patchwork
〓 否定示例(立即返回空块)〓 〓 否定示例(立即返回空块)〓
- 仅输入:“图表”“表格”“画图”“来张图” - 仅输入:“图表”“表格”“画图”“来张图”
......
#' @export
quickgen_chat_server <- function(input, output, session, r_values = NULL, r_data) {
# 当前这个模块不需要复杂的server逻辑
# 所有功能都在UI的renderUI中实现
# 保留函数签名以兼容Radiant框架
}
\ No newline at end of file
help_quickgen <- c( help_quickgen <- c(
"一键生成描述性统计" = "quickgen_basic.md", "一键生成描述性统计" = "quickgen_basic.md",
"大模型对话引导助手" = "quickgen_chat.md",
"大模型生成描述性统计" = "quickgen_ai.md" "大模型生成描述性统计" = "quickgen_ai.md"
) )
output$help_quickgen <- reactive(append_help("help_quickgen", file.path(getOption("radiant.path.quickgen"), "app/tools/help"), Rmd = TRUE)) output$help_quickgen <- reactive(append_help("help_quickgen", file.path(getOption("radiant.path.quickgen"), "app/tools/help"), Rmd = TRUE))
......
## urls for menu ## urls for menu
r_url_list <- getOption("radiant.url.list") r_url_list <- getOption("radiant.url.list")
r_url_list[["Generate descriptive statistics with one click"]] <- "quickgen/basic/" r_url_list[["Generate descriptive statistics with one click"]] <- "quickgen/basic/"
r_url_list[["AI chat guidance"]] <- "quickgen/chat/"
r_url_list[["LLM generates descriptive statistics"]] <- "quickgen/ai/" r_url_list[["LLM generates descriptive statistics"]] <- "quickgen/ai/"
options(radiant.url.list = r_url_list) options(radiant.url.list = r_url_list)
rm(r_url_list) rm(r_url_list)
...@@ -15,6 +16,7 @@ options( ...@@ -15,6 +16,7 @@ options(
tags$script(src = "www_quickgen/js/run_return.js") tags$script(src = "www_quickgen/js/run_return.js")
), ),
tabPanel(i18n$t("Generate descriptive statistics with one click"), uiOutput("quickgen_basic")), tabPanel(i18n$t("Generate descriptive statistics with one click"), uiOutput("quickgen_basic")),
tabPanel(i18n$t("AI chat guidance"), uiOutput("quickgen_chat")),
tabPanel(i18n$t("AI generates descriptive statistics"), uiOutput("quickgen_ai")) tabPanel(i18n$t("AI generates descriptive statistics"), uiOutput("quickgen_ai"))
) )
) )
......
library(shinyjs)
library(shinyAce)
## ===== 统一入口=====
output$quickgen_chat <- renderUI({
tagList(
useShinyjs(),
stat_tab_panel(
menu = i18n$t("One-click generation > AI chat guidance"),
tool = i18n$t("AI chat guidance"),
tool_ui = "chat_main_ui",
output_panels = tabPanel(
title = i18n$t("Chat history"),
value = "chat_panel",
uiOutput("chat_history_area")
)
)
)
})
## ===== 左侧区域=====
output$chat_main_ui <- renderUI({
tagList(
useShinyjs(),
wellPanel(
div(style = "font-weight:bold; color:#1976d2; margin-bottom:10px;",
icon("database"), " ", i18n$t("Dataset Fields Information")
),
uiOutput("field_info_display"),
tags$hr(),
div(style = "color:#666; font-size:0.9em; margin-top:5px;",
i18n$t("The current dataset's field information is automatically passed to the AI assistant.")
),
style = "max-height:450px; overflow-y:auto; background-color:#f8f9fa;"
),
help_and_report(
modal_title = i18n$t("AI chat guidance"),
fun_name = "quickgen_chat",
help_file = inclMD(file.path(getOption("radiant.path.quickgen"), "app/tools/help/quickgen_chat.md")),
lic = "by-sa"
)
)
})
## ===== 右侧区域=====
output$chat_history_area <- renderUI({
field_info_encoded <- get_field_info()
if (is.null(field_info_encoded)) {
return(create_no_data_ui())
}
iframe_src <- paste0(
"http://180.169.131.147:8106/chat/9f51e1707c61027e?field_info=",
field_info_encoded
)
tagList(
div(
id = "chat_box",
style = "height:700px; overflow-y:auto; border:1px solid #ddd;
border-radius:4px; padding:0; background:#fff; margin-bottom:10px;",
tags$iframe(
src = iframe_src,
style = "width: 100%; height: 100%; border: 0;",
frameborder = 0,
allow = "microphone"
)
)
)
})
# 生成左侧展示的格式化字段文本
output$field_info_display <- renderUI({
if (is.null(input$dataset) || !exists("r_data")) {
return(tags$pre(
i18n$t("Please select a dataset in another page first"),
style = "margin:0; background-color:#f9f9f9; border:1px solid #ddd; padding:10px; font-size:0.9em;"
))
}
df <- tryCatch({
get(input$dataset, envir = r_data)
}, error = function(e) NULL)
if (is.null(df) || !is.data.frame(df) || nrow(df) == 0) {
return(tags$pre(
i18n$t("Current dataset is empty"),
style = "margin:0; background-color:#f9f9f9; border:1px solid #ddd; padding:10px; font-size:0.9em;"
))
}
# 生成带换行的格式
field_lines <- sprintf('"%s": "%s"', names(df), sapply(df, function(x) class(x)[1]))
formatted_text <- paste(field_lines, collapse = ",\n")
tags$pre(
formatted_text,
style = "margin:0; background-color:#f9f9f9; border:1px solid #ddd;
padding:10px; font-size:0.9em; line-height:1.5; white-space:pre-wrap;"
)
})
# 获取并编码字段信息
get_field_info <- function() {
if (is.null(input$dataset) || !exists("r_data")) {
return(NULL)
}
df <- tryCatch({
get(input$dataset, envir = r_data)
}, error = function(e) NULL)
if (is.null(df) || !is.data.frame(df) || nrow(df) == 0) {
return(NULL)
}
# 构建带数据集名称的JSON结构
fields_list <- list()
for (col_name in names(df)) {
fields_list[[col_name]] <- class(df[[col_name]])[1]
}
json_struct <- list(
dataset_name = input$dataset,
fields = fields_list
)
URLencode(
jsonlite::toJSON(json_struct, auto_unbox = TRUE),
reserved = TRUE
)
}
# 无数据时的UI
create_no_data_ui <- function() {
tagList(
div(
id = "chat_box",
style = "height:700px; overflow-y:auto; border:1px solid #ddd;
border-radius:4px; padding:20px; background:#fff; margin-bottom:10px;",
p(i18n$t("请选择数据集"), style = "text-align:center; margin-top:50px; color:#888;")
)
)
}
\ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment