diff --git a/radiant.quickgen/NAMESPACE b/radiant.quickgen/NAMESPACE index 162efd20462b752e8ea31299f01830ce4bea0a40..b2f28ca976714ba70e5ad65566fe93daf362727a 100644 --- a/radiant.quickgen/NAMESPACE +++ b/radiant.quickgen/NAMESPACE @@ -3,11 +3,12 @@ S3method(dtab,explore) S3method(store,explore) S3method(summary,explore) -export(ai_generate) -export(ai_get_data_call) -export(ai_run_code) -export(build_r_prompt) -export(chat_completion) +export(build_chart_prompt) +export(build_metrics_prompt) +export(chart_completion) +export(chart_generate) +export(chart_get_data_call) +export(chart_run_code) export(cv) export(does_vary) export(empty_level) @@ -16,6 +17,10 @@ export(flip) export(ln) export(me) export(meprop) +export(metrics_completion) +export(metrics_generate) +export(metrics_get_data_call) +export(metrics_run_code) export(modal) export(n_missing) export(n_obs) diff --git a/radiant.quickgen/R/quickgen_ai.R b/radiant.quickgen/R/quickgen_ai.R deleted file mode 100644 index c5f6c705dcf166a78949576fed006d8aedd0d632..0000000000000000000000000000000000000000 --- a/radiant.quickgen/R/quickgen_ai.R +++ /dev/null @@ -1,96 +0,0 @@ -# === 配置 === -MODELSCOPE_OPENAI_URL <- "https://api-inference.modelscope.cn/v1" -MODELSCOPE_API_KEY <- Sys.getenv("MODELSCOPE_API_KEY", "ms-5b9f3668-ea8e-4a2c-8cd3-a1a9ba04810b") -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``` ),不对话。 -- 当所需绘制的图中出现数据集中不存在的列或无法计算时,一律输出一张空白 ggplot,仅居中显示“无法绘制”四字,不抛出错误。 - -〓 否定示例(立即返回空块)〓 -- 仅输入:“图表”“表格”“画图”“来张图” -- 非医学/统计描述:笑话、故事、计算、翻译、写文章、写代码注释、解释概念、生成非 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) -} \ No newline at end of file diff --git a/radiant.quickgen/R/quickgen_chart.R b/radiant.quickgen/R/quickgen_chart.R new file mode 100644 index 0000000000000000000000000000000000000000..3a7f8f90f51e4995c794c28241b928c78786bad8 --- /dev/null +++ b/radiant.quickgen/R/quickgen_chart.R @@ -0,0 +1,95 @@ +# === 配置 === +OLLAMA_URL <- "http://180.169.131.147:8139/api/generate" +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, + prompt = user_prompt, + stream = FALSE + ) + + # 使用 curl 包发送请求 + h <- curl::new_handle() + curl::handle_setheaders(h, "Content-Type" = "application/json") + curl::handle_setopt(h, postfields = jsonlite::toJSON(req_body, auto_unbox = TRUE)) + curl::handle_setopt(h, timeout = 60) + + con <- curl::curl(OLLAMA_URL, handle = h) + result <- readLines(con, warn = FALSE) + close(con) + + # 解析响应 + body <- jsonlite::fromJSON(paste(result, collapse = "")) + + if (is.null(body$response) || trimws(body$response) == "") + stop("Ollama API 返回空内容:", paste(result, collapse = "")) + + body$response +} + +# === 构造发给模型的 Prompt === +#' @export +build_chart_prompt <- function(user_prompt, data_call) { + sprintf( + "你是 R 语言专家,必须严格遵守以下规则: +〓 输出格式 〓 +- 只返回可运行 R 代码,用 ```r 包裹,禁止任何解释、注释、空行。 +- 代码必须强制换行:每个语句(df、library、ggplot、赋值、if/else 等)单独一行,ggplot 每个图层(+ geom_*/+ theme_*)单独一行。 +- 若用户请求包含“表格”“统计汇总”“频数表”等表格需求,禁止使用knitr::kable等会使表格字符串化的函数/包,必须输出标准表格形式。 +- 若用户请求不符合规范,一律返回空代码块(仅 ```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) +} \ No newline at end of file diff --git a/radiant.quickgen/R/quickgen_metrics.R b/radiant.quickgen/R/quickgen_metrics.R new file mode 100644 index 0000000000000000000000000000000000000000..8cb3dfd6d9c2c9c0e5c719d1e49cf7d2ecaee042 --- /dev/null +++ b/radiant.quickgen/R/quickgen_metrics.R @@ -0,0 +1,96 @@ +# === 配置 === +OLLAMA_URL <- "http://172.29.2.110:8139/api/generate" +MODEL_ID <- "qwen3-coder:30b" + +# === 单次对话 === +#' @export +metrics_completion <- function(user_prompt) { + # 构建 Ollama 请求体 + req <- httr2::request(OLLAMA_URL) %>% + httr2::req_headers( + "Content-Type" = "application/json" + ) %>% + httr2::req_body_json(list( + model = MODEL_ID, + prompt = user_prompt, + stream = FALSE + )) + + resp <- httr2::req_perform(req) + body <- httr2::resp_body_json(resp) + + # 解析 Ollama 响应 + if (is.null(body$response) || trimws(body$response) == "") + stop("Ollama API 返回空内容:", jsonlite::toJSON(body)) + + body$response # 返回 Ollama 生成的核心代码/结果 +} +# === 构造发给模型的 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() 或 broom::glance() 将统计结果转为结构化数据框(包含统计量、p值、置信区间、自由度、显著性标记等核心指标),再用 print() 输出。 + - 若 broom 包不支持该方法(如部分复杂模型),直接 print(统计函数结果),确保保留显著性标记(***、**、*)。 +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)) + } + + 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|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()) { + eval(parse(text = r_code), envir = envir) +} diff --git a/radiant.quickgen/inst/app/help.R b/radiant.quickgen/inst/app/help.R index a62134bcb6fe5e0f703e5c510bf501bba1ffeb18..751b5ed72ff5ac60965df95ea42efb1a23800049 100644 --- a/radiant.quickgen/inst/app/help.R +++ b/radiant.quickgen/inst/app/help.R @@ -1,7 +1,8 @@ help_quickgen <- c( "一键生成描述性统计" = "quickgen_basic.md", "大模型对话引导助手" = "quickgen_chat.md", - "大模型生成描述性统计" = "quickgen_ai.md" + "大模型生成描述性统计(图表)" = "quickgen_chart.md", + "大模型生成描述性统计(指标)" = "quickgen_metrics.md" ) output$help_quickgen <- reactive(append_help("help_quickgen", file.path(getOption("radiant.path.quickgen"), "app/tools/help"), Rmd = TRUE)) diff --git a/radiant.quickgen/inst/app/init.R b/radiant.quickgen/inst/app/init.R index 7c3ebf24e3a454a809c9b8713f49e77cd30d3fee..6406319d62d74cf52e1e5dbc5c008f823a03fc50 100644 --- a/radiant.quickgen/inst/app/init.R +++ b/radiant.quickgen/inst/app/init.R @@ -2,7 +2,7 @@ r_url_list <- getOption("radiant.url.list") 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[["AI generates descriptive statistics(chart)"]] <- "quickgen/chart" options(radiant.url.list = r_url_list) rm(r_url_list) @@ -15,9 +15,12 @@ options( tags$head( tags$script(src = "www_quickgen/js/run_return.js") ), + "----", i18n$t("Quick Statistics"), tabPanel(i18n$t("Generate descriptive statistics with one click"), uiOutput("quickgen_basic")), + "----", i18n$t("AI assistance"), 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(chart)"), uiOutput("quickgen_chart")), + tabPanel(i18n$t("AI generates descriptive statistics(metrics)"), uiOutput("quickgen_metrics")), ) ) ) \ No newline at end of file diff --git a/radiant.quickgen/inst/app/tools/analysis/quickgen_ai_ui.R b/radiant.quickgen/inst/app/tools/analysis/quickgen_ai_ui.R deleted file mode 100644 index 72d9270fe42e1b9c0eae0883f6f486d008353469..0000000000000000000000000000000000000000 --- a/radiant.quickgen/inst/app/tools/analysis/quickgen_ai_ui.R +++ /dev/null @@ -1,295 +0,0 @@ -# quickgen_ai_ui.R -library(shinyjs) -library(shinyAce) - -## ==================== 右下角浮框 ==================== -ui_ai_progress <- tags$div( - id = "ai_progress_box", - style = "display:none; - position:fixed; - bottom:15px; right:15px; - width:220px; z-index:9999; - background:#f5f5f5; color:#333; - border:1px solid #337ab7; border-radius:4px; - padding:10px 15px; box-shadow:0 2px 8px rgba(0,0,0,.25);", - tags$strong(i18n$t("AI running...")), - tags$div(class = "progress", - tags$div(class = "progress-bar progress-bar-striped active", - style = "width:100%")) -) - -## ======== 警告弹窗======== -ui_ai_warn <- tags$div( - id = "ai_warn_box", - style = "display:none; - position:fixed; - bottom:15px; right:15px; - width:220px; z-index:9999; - background:#fff3cd; color:#856404; - border:1px solid #ffeaa7; border-radius:4px; - padding:10px 15px; box-shadow:0 2px 8px rgba(0,0,0,.25);", - tags$strong(i18n$t("Warning:Please enter a request related to descriptive statistics or visualization.")) -) - -## ==================== 统一入口 ==================== -output$quickgen_ai <- renderUI({ - stat_tab_panel( - menu = i18n$t("Oneclick generation > AI generates descriptive statistics"), - tool = i18n$t("AI generates descriptive statistics"), - tool_ui = "ai_main_ui", - output_panels = tabPanel( - title = i18n$t("AI assistant"), - value = "ai_panel", - uiOutput("ai_result_area") - ) - ) -}) - -## ==================== 右侧 AI 面板 ==================== -output$ai_main_ui <- renderUI({ - tagList( - useShinyjs(), - ui_ai_progress, - ui_ai_warn, - wellPanel( - i18n$t("Describe your analysis request"), - returnTextAreaInput("ai_prompt", - label = NULL, - placeholder = i18n$t("e. g. Please help me draw a scatter plot of diamonds prices and carats"), - rows = 4, - value = state_init("ai_prompt", "")), - fluidRow( - column(6, uiOutput("ui_ai_submit")), - column(6, uiOutput("ai_loading")) - ) - ), - - wellPanel( - i18n$t("Generated R code"), - uiOutput("ai_r_code_block"), - fluidRow( - column(6, actionButton("ai_run_code", i18n$t("Run code"), icon = icon("play"), class = "btn-success")), - column(6, actionButton("ai_edit_code", i18n$t("Edit code"), icon = icon("edit"), class = "btn-default")) - ) - ), - - help_and_report( - modal_title = i18n$t("AI generates descriptive statistics"), - fun_name = "quickgen_ai", - help_file = inclMD(file.path(getOption("radiant.path.quickgen"), "app/tools/help/quickgen_ai.md")), - lic = "by-sa" - ) - ) -}) - -## ==================== 控件渲染 ==================== -output$ui_ai_submit <- renderUI({ - req(input$dataset) - actionButton("ai_submit", i18n$t("Send"), icon = icon("magic"), class = "btn-primary") -}) - -output$ai_loading <- renderUI({ - if (isTRUE(r_values$ai_loading)) - tags$div(class = "progress", - tags$div(class = "progress-bar progress-bar-striped active", - style = "width:100%", - i18n$t("Calling AI model..."))) -}) - -## ==================== reactiveValues ==================== -r_values <- reactiveValues( - ai_r_code = "", - ai_result_type = "text", - ai_result_ready = FALSE, - ai_loading = FALSE -) - -## ==================== 生成代码 ==================== -observeEvent(input$ai_submit, { - if (is.empty(input$ai_prompt)) - return(showNotification(i18n$t("Please enter an analysis request"), type = "error")) - - r_values$ai_loading <- TRUE - shinyjs::show("ai_progress_box") # 显示右下角进度框 - on.exit({ - r_values$ai_loading <- FALSE - shinyjs::hide("ai_progress_box") # 无论成功失败都隐藏 - }) - - res <- try(do.call(ai_generate, - list(prompt = input$ai_prompt, - dataset = input$dataset, - envir = r_data)), - silent = TRUE) - if (inherits(res, "try-error")) { - showNotification(paste(i18n$t("AI API error:"), res), type = "error") - return() - } - - r_values$ai_r_code <- res$r_code - r_values$ai_result_type <- res$type - r_values$ai_result_ready <- FALSE - r_values$auto_run <- res$auto_run - - if (res$type == "empty") { - shinyjs::show("ai_warn_box") - shinyjs::delay(3000, shinyjs::hide("ai_warn_box")) - return() - } - - if (isTRUE(r_values$auto_run)) - shinyjs::click("ai_run_code") -}) - -## ==================== 显示 R 代码 ==================== -output$ai_r_code_block <- renderUI({ - codes <- r_values$ai_r_code - tags$pre(codes, style = "background:#f5f5f5; padding:10px; border-radius:4px; - font-family:monospace; white-space:pre-wrap; min-height:100px;") -}) - -## ==================== 运行代码 ==================== -observeEvent(input$ai_run_code, { - shinyjs::hide("ai_progress_box") - if (is.empty(r_values$ai_r_code)) return() - - if (trimws(r_values$ai_r_code) == "" || identical(r_values$ai_result_type, "empty")) { - shinyjs::show("ai_warn_box") - shinyjs::delay(3000, shinyjs::hide("ai_warn_box")) - return() - } - - tryCatch({ - result <- do.call(ai_run_code, - list(r_code = r_values$ai_r_code, envir = r_data)) - r_data$ai_temp_result <- result - - if (inherits(result, "gg") || inherits(result, "ggplot")) { - r_values$ai_result_type <- "plot" - output$ai_result_plot <- renderPlot(print(result)) - } else if (is.data.frame(result) || is.matrix(result)) { - r_values$ai_result_type <- "table" - output$ai_result_table <- DT::renderDataTable( - DT::datatable(result, options = list(scrollX = TRUE, pageLength = 10))) - } else { - r_values$ai_result_type <- "text" - output$ai_result_text <- renderText(capture.output(print(result))) - } - r_values$ai_result_ready <- TRUE - }, error = function(e) { - r_values$ai_result_type <- "error" - output$ai_result_error <- renderText(paste0(i18n$t("Error: "), e$message)) - r_values$ai_result_ready <- TRUE - showNotification(paste0(i18n$t("Run code error: "), e$message), - type = "error", duration = NULL) - }) -}, ignoreInit = TRUE) - -## ======== 结果展示区======== -output$ai_result_area <- renderUI({ - req(r_values$ai_result_ready) - tagList( - conditionalPanel( - condition = "output.ai_result_type == 'plot'", - download_link("dlp_ai_plot"), br(), - plotOutput("ai_result_plot", width = "100%", height = "500px") - ), - conditionalPanel( - condition = "output.ai_result_type == 'table'", - download_link("dlp_ai_table"), br(), - DT::dataTableOutput("ai_result_table") - ), - conditionalPanel( - condition = "output.ai_result_type == 'text' || output.ai_result_type == 'error'", - verbatimTextOutput("ai_result_text") - ) - ) -}) - - -output$ai_result_type <- reactive({ - r_values$ai_result_type -}) - -outputOptions(output, "ai_result_type", suspendWhenHidden = FALSE) - -## ==================== 编辑代码模态框 ==================== -observeEvent(input$ai_edit_code, { - showModal( - modalDialog( - title = i18n$t("Edit R Code"), - size = "l", - footer = tagList( - actionButton("ai_save_code", i18n$t("Save Changes"), class = "btn-primary"), - modalButton(i18n$t("Cancel")) - ), - aceEditor( - "ai_code_editor", - mode = "r", - theme = getOption("radiant.ace_theme", "tomorrow"), - wordWrap = TRUE, - value = r_values$ai_r_code, - placeholder = i18n$t("Edit the generated R code here..."), - vimKeyBinding = getOption("radiant.ace_vim.keys", FALSE), - tabSize = getOption("radiant.ace_tabSize", 2), - useSoftTabs = getOption("radiant.ace_useSoftTabs", TRUE), - showInvisibles = getOption("radiant.ace_showInvisibles", FALSE), - autoScrollEditorIntoView = TRUE, - minLines = 15, - maxLines = 30 - ) - ) - ) -}) - -## ==================== 保存代码 ==================== -observeEvent(input$ai_save_code, { - r_values$ai_r_code <- input$ai_code_editor - r_values$auto_run <- FALSE - removeModal() -}) - -## ==================== PNG 下载处理器 ==================== -dlp_ai_plot <- function(path) { - result <- r_data$ai_temp_result - if (inherits(result, "gg") || inherits(result, "ggplot")) { - png(path, width = 800, height = 500, res = 96) - print(result) - dev.off() - } else { - png(path, width = 400, height = 400) - plot(1, type = "n", axes = FALSE, xlab = "", ylab = "") - text(1, 1, "No plot available", cex = 1.5) - dev.off() - } -} -download_handler( - id = "dlp_ai_plot", - fun = dlp_ai_plot, - fn = function() paste0("plot_", Sys.Date()), - type = "png", - caption = i18n$t("Save AI-generated plot") -) - -# ======== 表格 CSV 下载处理器 ======== -dlp_ai_table <- function(path) { - result <- r_data$ai_temp_result - if (is.data.frame(result)) { - write.csv(result, file = path, row.names = FALSE) - } else { - write.csv(data.frame(msg = "No table available"), file = path, row.names = FALSE) - } -} -download_handler( - id = "dlp_ai_table", - fun = dlp_ai_table, - fn = function() paste0("table_", Sys.Date()), - type = "csv", - caption = i18n$t("Save AI-generated table") -) - -## ==================== 报告 / 截图 ==================== -ai_report <- function() {} -observeEvent(input$ai_report, ai_report()) -observeEvent(input$ai_screenshot, radiant_screenshot_modal("modal_ai_screenshot")) -observeEvent(input$modal_ai_screenshot, { ai_report(); removeModal() }) \ No newline at end of file diff --git a/radiant.quickgen/inst/app/tools/analysis/quickgen_basic_ui.R b/radiant.quickgen/inst/app/tools/analysis/quickgen_basic_ui.R index 5a5406be9da2c6969971f18bae5a4e321a6ba1e1..ee5ceea089fcf193e704c359007356d1eecf8455 100644 --- a/radiant.quickgen/inst/app/tools/analysis/quickgen_basic_ui.R +++ b/radiant.quickgen/inst/app/tools/analysis/quickgen_basic_ui.R @@ -1145,7 +1145,7 @@ observeEvent(input$qgb_invert_selection, { output$quickgen_basic <- renderUI({ stat_tab_panel( - menu = i18n$t("Oneclick generation > Generate descriptive statistics"), + menu = i18n$t("Oneclick generation > Quick Statistics"), tool = i18n$t("Generate descriptive statistics with one click"), tool_ui = "ui_quickgen_basic", output_panels = tagList( diff --git a/radiant.quickgen/inst/app/tools/analysis/quickgen_chart_ui.R b/radiant.quickgen/inst/app/tools/analysis/quickgen_chart_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..234d0a34cdd9f50ec7c916acd8492c36208d9f53 --- /dev/null +++ b/radiant.quickgen/inst/app/tools/analysis/quickgen_chart_ui.R @@ -0,0 +1,302 @@ +# quickgen_chart_ui.R +library(shinyjs) +library(shinyAce) + +## ==================== 右下角浮框 ==================== +ui_chart_progress <- tags$div( + id = "chart_progress_box", + style = "display:none; + position:fixed; + bottom:15px; right:15px; + width:220px; z-index:9999; + background:#f5f5f5; color:#333; + border:1px solid #337ab7; border-radius:4px; + padding:10px 15px; box-shadow:0 2px 8px rgba(0,0,0,.25);", + tags$strong(i18n$t("AI generating...")), + tags$div(class = "progress", + tags$div(class = "progress-bar progress-bar-striped active", + style = "width:100%")) +) + +## ======== 警告弹窗======== +ui_chart_warn <- tags$div( + id = "chart_warn_box", + style = "display:none; + position:fixed; + bottom:15px; right:15px; + width:220px; z-index:9999; + background:#fff3cd; color:#856404; + border:1px solid #ffeaa7; border-radius:4px; + padding:10px 15px; box-shadow:0 2px 8px rgba(0,0,0,.25);", + tags$strong(i18n$t("Warning:Please enter a request related to descriptive statistics or visualization.")) +) + +## ==================== 统一入口 ==================== +output$quickgen_chart <- renderUI({ + stat_tab_panel( + menu = i18n$t("Oneclick generation > AI assistance"), + tool = i18n$t("AI generates descriptive statistics(chart)"), + tool_ui = "chart_main_ui", + output_panels = tabPanel( + title = i18n$t("Chart Assistant"), + value = "chart_panel", + uiOutput("chart_result_area") + ) + ) +}) + +## ==================== 右侧 Chart 面板 ==================== +output$chart_main_ui <- renderUI({ + tagList( + useShinyjs(), + ui_chart_progress, + ui_chart_warn, + wellPanel( + i18n$t("Describe your analysis request"), + returnTextAreaInput("chart_prompt", + label = NULL, + placeholder = i18n$t("e. g. Please help me generate a cross frequency histogram of sex and smoker"), + rows = 4, + value = state_init("chart_prompt", "")), + fluidRow( + column(6, uiOutput("ui_chart_submit")), + column(6, uiOutput("chart_loading")) + ) + ), + + wellPanel( + i18n$t("Generated R code"), + uiOutput("chart_r_code_block"), + fluidRow( + column(6, actionButton("chart_run_code", i18n$t("Run code"), icon = icon("play"), class = "btn-success")), + column(6, actionButton("chart_edit_code", i18n$t("Edit code"), icon = icon("edit"), class = "btn-default")) + ) + ), + + help_and_report( + modal_title = i18n$t("AI generates descriptive statistics(chart)"), + fun_name = "quickgen_chart", + help_file = inclMD(file.path(getOption("radiant.path.quickgen"), "app/tools/help/quickgen_chart.md")), + lic = "by-sa" + ) + ) +}) + +## ==================== 控件渲染 ==================== +output$ui_chart_submit <- renderUI({ + req(input$dataset) + actionButton("chart_submit", i18n$t("Send"), icon = icon("magic"), class = "btn-primary") +}) +output$chart_loading <- renderUI({ + if (isTRUE(r_values$chart_loading)) + tags$div(class = "progress", + tags$div(class = "progress-bar progress-bar-striped active", + style = "width:100%", + i18n$t("Calling chart generation model..."))) +}) + +## ==================== reactiveValues ==================== +r_values <- reactiveValues( + chart_r_code = "", + chart_result_type = "text", + chart_result_ready = FALSE, + chart_loading = FALSE +) + +## ==================== 生成代码 ==================== +observeEvent(input$chart_submit, { + if (is.empty(input$chart_prompt)) + return(showNotification(i18n$t("Please enter an analysis request"), type = "error")) + + r_values$chart_loading <- TRUE + shinyjs::show("chart_progress_box") # 显示右下角进度框 + on.exit({ + r_values$chart_loading <- FALSE + shinyjs::hide("chart_progress_box") # 无论成功失败都隐藏 + }) + + res <- try(do.call(chart_generate, + list(prompt = input$chart_prompt, + dataset = input$dataset, + envir = r_data)), + silent = TRUE) + if (inherits(res, "try-error")) { + showNotification(paste(i18n$t("Chart API error:"), res), type = "error") + return() + } + + r_values$chart_r_code <- res$r_code + r_values$chart_result_type <- res$type + r_values$chart_result_ready <- FALSE + r_values$auto_run <- res$auto_run + + if (res$type == "empty") { + shinyjs::show("chart_warn_box") + shinyjs::delay(3000, shinyjs::hide("chart_warn_box")) + return() + } + + if (isTRUE(r_values$auto_run)) + shinyjs::click("chart_run_code") +}) + +## ==================== 显示 R 代码 ==================== +output$chart_r_code_block <- renderUI({ + codes <- r_values$chart_r_code + tags$pre(codes, style = "background:#f5f5f5; padding:10px; border-radius:4px; + font-family:monospace; white-space:pre-wrap; min-height:100px;") +}) + +## ==================== 运行代码 ==================== +observeEvent(input$chart_run_code, { + shinyjs::hide("chart_progress_box") + if (is.empty(r_values$chart_r_code)) return() + + if (trimws(r_values$chart_r_code) == "" || identical(r_values$chart_result_type, "empty")) { + shinyjs::show("chart_warn_box") + shinyjs::delay(3000, shinyjs::hide("chart_warn_box")) + return() + } + + tryCatch({ + result <- do.call(chart_run_code, + list(r_code = r_values$chart_r_code, envir = r_data)) + r_data$chart_temp_result <- result + + if (inherits(result, "gg") || inherits(result, "ggplot")) { + r_values$chart_result_type <- "plot" + output$chart_result_plot <- renderPlot(print(result)) + } else if (is.data.frame(result) || is.matrix(result)) { + r_values$chart_result_type <- "table" + output$chart_result_table <- DT::renderDataTable( + DT::datatable(result, options = list(scrollX = TRUE, pageLength = 10))) + } else { + r_values$chart_result_type <- "text" + output$chart_result_text <- renderText(capture.output(print(result))) + } + r_values$chart_result_ready <- TRUE + }, error = function(e) { + r_values$chart_result_type <- "error" + output$chart_result_error <- renderText(paste0(i18n$t("Error: "), e$message)) + r_values$chart_result_ready <- TRUE + showNotification(paste0(i18n$t("Run code error: "), e$message), + type = "error", duration = NULL) + }) +}, ignoreInit = TRUE) + +## ======== 结果展示区======== +output$chart_result_area <- renderUI({ + req(r_values$chart_result_ready) + tagList( + conditionalPanel( + condition = "output.chart_result_type == 'plot'", + download_link("dlp_chart_plot"), br(), + plotOutput("chart_result_plot", width = "100%", height = "500px") + ), + conditionalPanel( + condition = "output.chart_result_type == 'table'", + download_link("dlp_chart_table"), br(), + DT::dataTableOutput("chart_result_table") + ), + conditionalPanel( + condition = "output.chart_result_type == 'text' || output.chart_result_type == 'error'", + verbatimTextOutput("chart_result_text") + ) + ) +}) +output$chart_result_type <- reactive({ + r_values$chart_result_type +}) +outputOptions(output, "chart_result_type", suspendWhenHidden = FALSE) + +## ==================== 编辑代码模态框 ==================== +observeEvent(input$chart_edit_code, { + showModal( + modalDialog( + title = i18n$t("Edit R Code"), + size = "l", + footer = tagList( + actionButton("chart_save_code", i18n$t("Save Changes"), class = "btn-primary"), + modalButton(i18n$t("Cancel")) + ), + aceEditor( + "chart_code_editor", + mode = "r", + theme = getOption("radiant.ace_theme", "tomorrow"), + wordWrap = TRUE, + value = r_values$chart_r_code, + placeholder = i18n$t("Edit the generated R code here..."), + vimKeyBinding = getOption("radiant.ace_vim.keys", FALSE), + tabSize = getOption("radiant.ace_tabSize", 2), + useSoftTabs = getOption("radiant.ace_useSoftTabs", TRUE), + showInvisibles = getOption("radiant.ace_showInvisibles", FALSE), + autoScrollEditorIntoView = TRUE, + minLines = 15, + maxLines = 30 + ) + ) + ) +}) + +## ==================== 保存代码 ==================== +observeEvent(input$chart_save_code, { + r_values$chart_r_code <- input$chart_code_editor + r_values$auto_run <- FALSE + removeModal() +}) + +## ==================== PNG 下载处理器 ==================== +dlp_chart_plot <- function(path) { + result <- r_data$chart_temp_result + if (inherits(result, "gg") || inherits(result, "ggplot")) { + png(path, width = 800, height = 500, res = 96) + print(result) + dev.off() + } else { + png(path, width = 400, height = 400) + plot(1, type = "n", axes = FALSE, xlab = "", ylab = "") + text(1, 1, "No plot available", cex = 1.5) + dev.off() + } +} + +download_handler( + id = "dlp_chart_plot", + fun = dlp_chart_plot, + fn = function() paste0("plot_", Sys.Date()), + type = "png", + caption = i18n$t("Save chart-generated plot") +) + +# ======== 表格 CSV 下载处理器 ======== +dlp_chart_table <- function(path) { + result <- r_data$chart_temp_result + if (is.data.frame(result)) { + df <- result + } else if (is.table(result)) { + df <- as.data.frame(result, stringsAsFactors = FALSE) + } else if (is.matrix(result)) { + df <- as.data.frame(result, stringsAsFactors = FALSE) + if (!is.null(rownames(result))) { + df <- cbind(row_name = rownames(result), df, row.names = NULL) + } + } else { + df <- data.frame(msg = "No valid table available") + } + + write.csv(df, file = path, row.names = FALSE, fileEncoding = "UTF-8") +} + +download_handler( + id = "dlp_chart_table", + fun = dlp_chart_table, + fn = function() paste0("table_", Sys.Date()), + type = "csv", + caption = i18n$t("Save chart-generated table") +) + +## ==================== 报告 / 截图 ==================== +chart_report <- function() {} +observeEvent(input$chart_report, chart_report()) +observeEvent(input$chart_screenshot, radiant_screenshot_modal("modal_chart_screenshot")) +observeEvent(input$modal_chart_screenshot, { chart_report(); removeModal() }) diff --git a/radiant.quickgen/inst/app/tools/analysis/quickgen_chat_ui.R b/radiant.quickgen/inst/app/tools/analysis/quickgen_chat_ui.R index 2504f5c586e4edfda7ba74b2661fb2823171f701..5ebdf9324266ec3a216737457b4993844dfd4ef9 100644 --- a/radiant.quickgen/inst/app/tools/analysis/quickgen_chat_ui.R +++ b/radiant.quickgen/inst/app/tools/analysis/quickgen_chat_ui.R @@ -6,7 +6,7 @@ output$quickgen_chat <- renderUI({ tagList( useShinyjs(), stat_tab_panel( - menu = i18n$t("One-click generation > AI chat guidance"), + menu = i18n$t("Oneclick generation > AI assistance"), tool = i18n$t("AI chat guidance"), tool_ui = "chat_main_ui", output_panels = tabPanel( diff --git a/radiant.quickgen/inst/app/tools/analysis/quickgen_metrics_ui.R b/radiant.quickgen/inst/app/tools/analysis/quickgen_metrics_ui.R new file mode 100644 index 0000000000000000000000000000000000000000..bdbfb4143d9c8b9acaefbc3b11162d8b1bd9eeda --- /dev/null +++ b/radiant.quickgen/inst/app/tools/analysis/quickgen_metrics_ui.R @@ -0,0 +1,419 @@ +# quickgen_metrics_ui.R +library(shinyjs) +library(shinyAce) + +# 新增:统计结果文本格式化函数 +format_stat_text <- function(result, dataset_name) { + # 1. 处理“无法计算”的情况 + if (is.character(result) && grepl("无法计算", result)) { + return(result) + } + + # 2. 单样本t检验(htest类) + if (inherits(result, "htest") && grepl("One Sample t-test", result$method)) { + # 提取关键指标 + var_name <- gsub("^x = df\\$|^df\\$", "", as.character(result$data.name)) + mean_val <- round(mean(result$data, na.rm = TRUE), 3) + n_val <- length(na.omit(result$data)) + n_missing <- sum(is.na(result$data)) + sd_val <- round(sd(result$data, na.rm = TRUE), 3) + se_val <- round(result$stderr, 3) + me_val <- round(se_val * qt(0.975, df = result$parameter), 3) # 边际误差 + diff_val <- round(result$estimate, 3) + t_val <- round(result$statistic, 3) + p_val <- if (result$p.value < 0.001) "< .001" else round(result$p.value, 4) + df_val <- result$parameter + ci_lower <- round(result$conf.int[1], 3) + ci_upper <- round(result$conf.int[2], 3) + conf_level <- round(attr(result$conf.int, "conf.level") * 100, 1) + # 显著性标记 + signif <- if (p_val == "< .001") "***" else if (p_val <= 0.001) "***" else if (p_val <= 0.01) "**" else if (p_val <= 0.05) "*" else if (p_val <= 0.1) "." else " " + + # 组织文本(完全匹配示例格式) + text <- sprintf(paste0( + "Single mean test\n", + "Data : %s \n", + "Variable : %s \n", + "Confidence: %.1f%% \n", + "Null hyp. : the mean of %s = %.1f \n", + "Alt. hyp. : the mean of %s is not equal to %.1f \n", + " mean n n_missing sd se me\n", + " %6.3f %5s %d %6.3f %5.3f %5.3f\n", + " diff se t.value p.value df 2.5%% 97.5%% \n", + " %6.3f %5.3f %6.3f %8s %5.0f %6.3f %6.3f %s\n", + "Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1" + ), + dataset_name, var_name, conf_level, var_name, result$null.value, + var_name, result$null.value, mean_val, format(n_val, big.mark = ","), + n_missing, sd_val, se_val, me_val, diff_val, se_val, t_val, p_val, + df_val, ci_lower, ci_upper, signif + ) + return(text) + } + + # 3. 独立样本t检验(htest类) + if (inherits(result, "htest") && grepl("Welch Two Sample t-test|Two Sample t-test", result$method)) { + # 提取分组变量和数值变量 + data_parts <- strsplit(result$data.name, " ~ ")[[1]] + var_name <- data_parts[1] + group_var <- data_parts[2] + group_vals <- levels(factor(df[[group_var]])) + # 分组统计 + group1_data <- df[[var_name]][df[[group_var]] == group_vals[1]] + group2_data <- df[[var_name]][df[[group_var]] == group_vals[2]] + mean1 <- round(mean(group1_data, na.rm = TRUE), 3) + mean2 <- round(mean(group2_data, na.rm = TRUE), 3) + n1 <- length(na.omit(group1_data)) + n2 <- length(na.omit(group2_data)) + n_missing1 <- sum(is.na(group1_data)) + n_missing2 <- sum(is.na(group2_data)) + sd1 <- round(sd(group1_data, na.rm = TRUE), 3) + sd2 <- round(sd(group2_data, na.rm = TRUE), 3) + se1 <- round(sd1 / sqrt(n1), 3) + se2 <- round(sd2 / sqrt(n2), 3) + me1 <- round(se1 * qt(0.975, df = n1 - 1), 3) + me2 <- round(se2 * qt(0.975, df = n2 - 1), 3) + # 检验结果 + diff_val <- round(result$estimate[1] - result$estimate[2], 3) + t_val <- round(result$statistic, 3) + p_val <- if (result$p.value < 0.001) "< .001" else round(result$p.value, 4) + df_val <- round(result$parameter, 0) + ci_lower <- round(result$conf.int[1], 3) + ci_upper <- round(result$conf.int[2], 3) + conf_level <- round(attr(result$conf.int, "conf.level") * 100, 1) + signif <- if (p_val == "< .001") "***" else if (p_val <= 0.001) "***" else if (p_val <= 0.01) "**" else if (p_val <= 0.05) "*" else if (p_val <= 0.1) "." else " " + + # 组织文本 + text <- sprintf(paste0( + "Pairwise mean comparisons (t-test)\n", + "Data : %s \n", + "Variables : %s, %s \n", + "Samples : independent \n", + "Confidence: %.1f%% \n", + "Adjustment: None \n", + " mean n n_missing sd se me\n", + " %6s %6.3f %5s %d %6.3f %5.3f %5.3f\n", + " %6s %6.3f %5s %d %6.3f %5.3f %5.3f\n", + " Null hyp. Alt. hyp. diff p.value \n", + " %s = %s %s not equal to %s %6.3f %8s %s\n", + "Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1" + ), + dataset_name, group_var, var_name, conf_level, + group_vals[1], mean1, format(n1, big.mark = ","), n_missing1, sd1, se1, me1, + group_vals[2], mean2, format(n2, big.mark = ","), n_missing2, sd2, se2, me2, + group_vals[1], group_vals[2], group_vals[1], group_vals[2], diff_val, p_val, signif + ) + return(text) + } + + # 4. 线性回归(lm类) + if (inherits(result, "lm")) { + # 提取模型信息 + model_formula <- as.character(result$call$formula) + var_dep <- model_formula[2] + vars_indep <- gsub("^ ~ ", "", model_formula[1]) + # 系数表 + coef_sum <- summary(result)$coefficients + coef_text <- " Estimate Std.Error t.value p.value Signif.\n" + for (i in 1:nrow(coef_sum)) { + term <- rownames(coef_sum)[i] + est <- round(coef_sum[i, 1], 4) + se <- round(coef_sum[i, 2], 4) + t_val <- round(coef_sum[i, 3], 3) + p_val <- if (coef_sum[i, 4] < 0.001) "< .001" else round(coef_sum[i, 4], 4) + signif <- if (p_val == "< .001") "***" else if (p_val <= 0.001) "***" else if (p_val <= 0.01) "**" else if (p_val <= 0.05) "*" else if (p_val <= 0.1) "." else " " + coef_text <- paste0(coef_text, sprintf(" %12s %8.4f %8.4f %6.3f %8s %3s\n", term, est, se, t_val, p_val, signif)) + } + # 模型拟合度 + r2 <- round(summary(result)$r.squared, 4) + r2_adj <- round(summary(result)$adj.r.squared, 4) + n_val <- nrow(result$model) + n_missing <- nrow(df) - n_val + + # 组织文本 + text <- sprintf(paste0( + "Linear Regression Model\n", + "Data : %s \n", + "Formula : %s ~ %s \n", + "Dependent : %s \n", + "Independent: %s \n", + "Sample : n = %s, n_missing = %d \n", + "Fit : R² = %.4f, Adjusted R² = %.4f \n", + "%s", + "Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1" + ), + dataset_name, var_dep, vars_indep, var_dep, vars_indep, + format(n_val, big.mark = ","), n_missing, r2, r2_adj, coef_text + ) + return(text) + } + + # 5. 其他统计方法(卡方检验、方差分析等,按示例风格扩展) + if (inherits(result, "htest") && grepl("Chi-squared test", result$method)) { + # 卡方检验文本格式化(类似逻辑,提取列联表、卡方值、p值等) + data_parts <- strsplit(result$data.name, " ~ ")[[1]] + var1 <- data_parts[1] + var2 <- data_parts[2] + contingency <- table(df[[var1]], df[[var2]], useNA = "no") + chi_val <- round(result$statistic, 3) + df_val <- result$parameter + p_val <- if (result$p.value < 0.001) "< .001" else round(result$p.value, 4) + signif <- if (p_val == "< .001") "***" else if (p_val <= 0.001) "***" else if (p_val <= 0.01) "**" else if (p_val <= 0.05) "*" else if (p_val <= 0.1) "." else " " + + text <- sprintf(paste0( + "Chi-squared Test of Independence\n", + "Data : %s \n", + "Variables : %s (row), %s (column) \n", + "Contingency Table:\n%s\n", + "Test Statistic: Chi-squared = %.3f, df = %.0f, p-value = %s %s\n", + "Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1" + ), + dataset_name, var1, var2, capture.output(print(contingency)), + chi_val, df_val, p_val, signif + ) + return(text) + } + + # 6. 直接输出原始结果 + return(capture.output(print(result))) +} + +## ==================== 右下角浮框 ==================== +ui_metrics_progress <- tags$div( + id = "metrics_progress_box", + style = "display:none; + position:fixed; + bottom:15px; right:15px; + width:220px; z-index:9999; + background:#f5f5f5; color:#333; + border:1px solid #337ab7; border-radius:4px; + padding:10px 15px; box-shadow:0 2px 8px rgba(0,0,0,.25);", + tags$strong(i18n$t("AI calculating...")), + tags$div(class = "progress", + tags$div(class = "progress-bar progress-bar-striped active", + style = "width:100%")) +) +## ======== 警告弹窗======== +ui_metrics_warn <- tags$div( + id = "metrics_warn_box", + style = "display:none; + position:fixed; + bottom:15px; right:15px; + width:220px; z-index:9999; + background:#fff3cd; color:#856404; + border:1px solid #ffeaa7; border-radius:4px; + padding:10px 15px; box-shadow:0 2px 8px rgba(0,0,0,.25);", + tags$strong(i18n$t("Warning:Please enter a request related to scientific research statistical calculation.")) +) +## ==================== 统一入口 ==================== +output$quickgen_metrics <- renderUI({ + stat_tab_panel( + menu = i18n$t("Oneclick generation > AI assistance"), + tool = i18n$t("AI generates descriptive statistics(metrics)"), + tool_ui = "metrics_main_ui", + output_panels = tabPanel( + title = i18n$t("Metrics Assistant"), + value = "metrics_panel", + uiOutput("metrics_result_area") + ) + ) +}) +## ==================== 右侧 Metrics 面板 ==================== +output$metrics_main_ui <- renderUI({ + tagList( + useShinyjs(), + ui_metrics_progress, + ui_metrics_warn, + wellPanel( + i18n$t("Describe your analysis request:"), + returnTextAreaInput("metrics_prompt", + label = NULL, + placeholder = i18n$t("e. g. 1. Single mean test for age (null mean=35) in insurance; 2. Chi-squared test between sex and smoker; 3. Linear regression of charges on bmi+age"), + rows = 4, + value = state_init("metrics_prompt", "")), + fluidRow( + column(6, uiOutput("ui_metrics_submit")), + column(6, uiOutput("metrics_loading")) + ) + ), + + wellPanel( + i18n$t("Generated R code"), + uiOutput("metrics_r_code_block"), + fluidRow( + column(6, actionButton("metrics_run_code", i18n$t("Run code"), icon = icon("play"), class = "btn-success")), + column(6, actionButton("metrics_edit_code", i18n$t("Edit code"), icon = icon("edit"), class = "btn-default")) + ) + ), + + help_and_report( + modal_title = i18n$t("AI generates descriptive statistics(metrics)"), + fun_name = "quickgen_metrics", + help_file = inclMD(file.path(getOption("radiant.path.quickgen"), "app/tools/help/quickgen_metrics.md")), + lic = "by-sa" + ) + ) +}) +## ==================== 控件渲染 ==================== +output$ui_metrics_submit <- renderUI({ + req(input$dataset) + actionButton("metrics_submit", i18n$t("Send"), icon = icon("magic"), class = "btn-primary") +}) +output$metrics_loading <- renderUI({ + if (isTRUE(r_values$metrics_loading)) + tags$div(class = "progress", + tags$div(class = "progress-bar progress-bar-striped active", + style = "width:100%", + i18n$t("Calling metrics calculation model..."))) +}) +## ==================== reactiveValues ==================== +r_values <- reactiveValues( + metrics_r_code = "", + metrics_result_type = "text", # 仅保留text/plot/error + metrics_result_ready = FALSE, + metrics_loading = FALSE +) +## ==================== 生成代码 ==================== +observeEvent(input$metrics_submit, { + if (is.empty(input$metrics_prompt)) + return(showNotification(i18n$t("Please enter a statistical calculation request"), type = "error")) + + r_values$metrics_loading <- TRUE + shinyjs::show("metrics_progress_box") # 显示右下角进度框 + on.exit({ + r_values$metrics_loading <- FALSE + shinyjs::hide("metrics_progress_box") # 无论成功失败都隐藏 + }) + + res <- try(do.call(metrics_generate, + list(prompt = input$metrics_prompt, + dataset = input$dataset, + envir = r_data)), + silent = TRUE) + if (inherits(res, "try-error")) { + showNotification(paste(i18n$t("Metrics API error:"), res), type = "error") + return() + } + + r_values$metrics_r_code <- res$r_code + r_values$metrics_result_type <- res$type + r_values$metrics_result_ready <- FALSE + r_values$auto_run <- res$auto_run + + if (res$type == "empty") { + shinyjs::show("metrics_warn_box") + shinyjs::delay(3000, shinyjs::hide("metrics_warn_box")) + return() + } + + if (isTRUE(r_values$auto_run)) + shinyjs::click("metrics_run_code") +}) +## ==================== 显示 R 代码 ==================== +output$metrics_r_code_block <- renderUI({ + codes <- r_values$metrics_r_code + tags$pre(codes, style = "background:#f5f5f5; padding:10px; border-radius:4px; + font-family:monospace; white-space:pre-wrap; min-height:100px;") +}) +## ==================== 运行代码 ==================== +observeEvent(input$metrics_run_code, { + shinyjs::hide("metrics_progress_box") + if (is.empty(r_values$metrics_r_code)) return() + + if (trimws(r_values$metrics_r_code) == "" || identical(r_values$metrics_result_type, "empty")) { + shinyjs::show("metrics_warn_box") + shinyjs::delay(3000, shinyjs::hide("metrics_warn_box")) + return() + } + + tryCatch({ + # 执行代码并获取原始结果 + result <- do.call(metrics_run_code, + list(r_code = r_values$metrics_r_code, envir = r_data)) + r_data$metrics_temp_result <- result + dataset_name <- input$dataset # 获取当前数据集名称 + + # 分支1:屏蔽图表输出 + if (inherits(result, "gg") || inherits(result, "ggplot") || inherits(result, "lattice")) { + r_values$metrics_result_type <- "text" + output$metrics_result_text <- renderText(i18n$t("This tool only supports statistical metrics calculation, not chart generation")) + } + # 分支2:所有统计结果转为结构化文本 + else { + r_values$metrics_result_type <- "text" + # 调用格式化函数,生成示例风格的文本 + formatted_text <- format_stat_text(result, dataset_name) + # 输出文本(保留换行和空格对齐) + output$metrics_result_text <- renderText(paste(formatted_text, collapse = "\n")) + } + + r_values$metrics_result_ready <- TRUE + }, error = function(e) { + r_values$metrics_result_type <- "error" + # 错误文本格式化 + err_msg <- if (grepl("object .* not found", e$message)) { + paste0(i18n$t("Error: Target column does not exist - "), e$message) + } else if (grepl("non-numeric argument", e$message)) { + paste0(i18n$t("Error: Variable type mismatch (e.g., t-test requires numeric variables) - "), e$message) + } else { + paste0(i18n$t("Error: "), e$message) + } + output$metrics_result_error <- renderText(err_msg) + r_values$metrics_result_ready <- TRUE + showNotification(err_msg, type = "error", duration = NULL) + }) +}, ignoreInit = TRUE) +## ======== 结果展示区(仅文本/错误输出)======== +output$metrics_result_area <- renderUI({ + req(r_values$metrics_result_ready) + tagList( + # 所有结果均用文本框展示(含图表屏蔽提示、统计结果、错误) + conditionalPanel( + condition = "output.metrics_result_type == 'text' || output.metrics_result_type == 'error'", + verbatimTextOutput("metrics_result_text", placeholder = TRUE) + ) + ) +}) +output$metrics_result_type <- reactive({ + r_values$metrics_result_type +}) +outputOptions(output, "metrics_result_type", suspendWhenHidden = FALSE) +## ==================== 编辑代码模态框 ==================== +observeEvent(input$metrics_edit_code, { + showModal( + modalDialog( + title = i18n$t("Edit R Code"), + size = "l", + footer = tagList( + actionButton("metrics_save_code", i18n$t("Save Changes"), class = "btn-primary"), + modalButton(i18n$t("Cancel")) + ), + aceEditor( + "metrics_code_editor", + mode = "r", + theme = getOption("radiant.ace_theme", "tomorrow"), + wordWrap = TRUE, + value = r_values$metrics_r_code, + placeholder = i18n$t("Edit the generated R code here..."), + vimKeyBinding = getOption("radiant.ace_vim.keys", FALSE), + tabSize = getOption("radiant.ace_tabSize", 2), + useSoftTabs = getOption("radiant.ace_useSoftTabs", TRUE), + showInvisibles = getOption("radiant.ace_showInvisibles", FALSE), + autoScrollEditorIntoView = TRUE, + minLines = 15, + maxLines = 30 + ) + ) + ) +}) +## ==================== 保存代码 ==================== +observeEvent(input$metrics_save_code, { + r_values$metrics_r_code <- input$metrics_code_editor + r_values$auto_run <- FALSE + removeModal() +}) +## ==================== 报告 / 截图 ==================== +metrics_report <- function() {} +observeEvent(input$metrics_report, metrics_report()) +observeEvent(input$metrics_screenshot, radiant_screenshot_modal("modal_metrics_screenshot")) +observeEvent(input$modal_metrics_screenshot, { metrics_report(); removeModal() }) diff --git a/radiant.quickgen/inst/app/tools/help/quickgen_ai.md b/radiant.quickgen/inst/app/tools/help/quickgen_ai.md deleted file mode 100644 index 983dea5822d7e7d5fed161d45abb9016e31d809a..0000000000000000000000000000000000000000 --- a/radiant.quickgen/inst/app/tools/help/quickgen_ai.md +++ /dev/null @@ -1,27 +0,0 @@ -> 大模型生成描述性统计 - -## 使用方法 - -以下是 `大模型生成描述性统计`的使用方法。 - -1.`数据对象`必须要有,且必须和数据集中的名字一致(大小写也一致) - -2.`图像类型`必须要有,比如分布图、散点图等。可以要求模型返回多张图表,需向模型明确。 - -3.`生成代码`如果有误,或者想要修改,可以点击`编辑`按钮对R代码进行修改,保存后点击`运行`按钮即可。 -## 示例 - -**1. 散点图** -请用diamonds画一个散点图,X轴是carat,Y轴是price,用color来区分颜色,并加上theme_bw()。 -**2. 箱线图** -请用diamonds画箱线图,把price按cut分组,看看不同切工的价格分布。 -**3. 直方图** -请用diamonds画carat的直方图,分面按clarity排布,bin宽度取0.1。 -**4. 柱状图** -请用diamonds统计各color等级的数量,画一个柱状图,颜色按实际颜色填充。 -**5. 密度图** -请用diamonds画出0.5~2克拉范围内,不同color的carat密度曲线,要求半透明重叠。 -**6. 分组均值表** -请用diamonds按cut分组,计算每组price与carat的平均值、标准差,输出成表格。 -**7. 价格对数-克拉线性拟合图** -请用diamonds画log(price)和carat的散点图,并加上回归直线,颜色按clarity区分,用theme_minimal()。 \ No newline at end of file diff --git a/radiant.quickgen/inst/app/tools/help/quickgen_chart.md b/radiant.quickgen/inst/app/tools/help/quickgen_chart.md new file mode 100644 index 0000000000000000000000000000000000000000..ca5a6eef99bed1bf6bbf71c33e1b51236a9a9904 --- /dev/null +++ b/radiant.quickgen/inst/app/tools/help/quickgen_chart.md @@ -0,0 +1,52 @@ +> 大模型生成描述性统计(图表) + +## 使用方法 + +以下是 `大模型生成描述性统计`的使用方法。 + +1.`数据对象`必须要有,且必须和数据集中的名字一致(大小写也一致) + +2.`图像类型`必须要有,比如分布图、散点图等。可以要求模型返回多张图表,需向模型明确。 + +3.`生成代码`如果有误,或者想要修改,可以点击`编辑`按钮对R代码进行修改,保存后点击`运行`按钮即可。 +## 示例 + +**1. 散点图** + +请用该数据集画一个散点图,X 轴是 bmi(身体质量指数),Y 轴是 charges(年度医疗费用),用 smoker(吸烟状态)来区分颜色。 + +**2. 箱线图** + +请用该数据集画箱线图,把 charges 按 smoker 分组,看看吸烟 / 不吸烟人群的医疗费用分布。 + +**3. 直方图** + +请用该数据集画 age(年龄)的直方图,分面按 sex(性别)排布,bin 宽度取 2(年龄区间)。 + +**4. 柱状图** + +请用该数据集统计各 region(居住区域)的样本数量,画一个柱状图,颜色按 region 实际类别填充。 + +**5. 密度图** + +请用该数据集画出 bmi 在 18~35 范围内,不同 sex 的 bmi 密度曲线,要求半透明重叠展示。 + +**6. 分组均值表** + +请用该数据集按 sex 分组,计算每组 age、bmi、charges 的平均值、标准差,输出成结构化表格。 + +**7. 费用 - 年龄线性拟合图** + +请用该数据集画 charges 和 age 的散点图,并加上回归直线,颜色按 smoker 区分。 + +**8. 交叉频数表** + +请用该数据集统计 sex 与 smoker 的交叉频数(即 “男性吸烟 / 不吸烟人数、女性吸烟 / 不吸烟人数”),输出二维汇总表格。 + +**9. 儿童数量分布柱状图** + +请用该数据集统计 children(受抚养者数量)的不同取值对应的样本数,画一个柱状图展示各数量的分布。 + +**10. 区域 - 费用箱线图** + +请用该数据集画箱线图,把 charges 按 region 分组,对比不同区域的医疗费用差异,并用不同颜色标注。 \ No newline at end of file diff --git a/radiant.quickgen/inst/app/tools/help/quickgen_chat.md b/radiant.quickgen/inst/app/tools/help/quickgen_chat.md index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..12c42ea4f947579b45ba227804fcd65d275b7eee 100644 --- a/radiant.quickgen/inst/app/tools/help/quickgen_chat.md +++ b/radiant.quickgen/inst/app/tools/help/quickgen_chat.md @@ -0,0 +1,44 @@ +> 大模型对话引导助手 + +### 1. 界面概述 + +本工具是 **“一键生成” 模块下的 R 语言科研辅助助手 **,专为数据集的科研分析设计,可自动结合数据集字段信息,为你提供字段解读、分析方法建议、统计结果解读等科研支持。 + +### 2. 使用步骤 + +1. **确认数据集**:进入工具后,,字段信息会自动加载至智能体; + +2. 发起对话 + - 方式 1:点击预设问题按钮,快速发起提问; + - 方式 2:在底部输入框中自定义科研问题,点击右侧发送按钮提交; + +3. **获取回复**:AI 会结合传入的字段信息,生成科研场景下的专业回复; + +4. **重置对话**:若需切换分析主题,点击 “开启新对话” 清空历史即可。 + +### 3. 常见操作示例 + +#### 示例 1:字段解读(预设问题 1) + +- 操作:点击 “这个数据集中的字段是什么意思?有什么科研分析用途?” 按钮 +- 效果:AI 会解释`insurance`中`age`(年龄)、`smoker`(吸烟状态)、`charges`(医疗费用)等字段的含义,并说明各字段的科研分析场景(如`smoker`可用于分析吸烟对医疗费用的影响)。 + +#### 示例 2:分析方法建议(预设问题 2) + +- 操作:点击 “基于当前数据集的字段信息,我该选择什么科研分析方法?” 按钮 +- 效果:AI 会根据`insurance`的字段类型(如分类变量`sex`、数值变量`charges`),推荐适配的统计方法(如箱线图分析分组费用差异、线性回归分析年龄对费用的影响)。 + +#### 示例 3:统计结果解读(预设问题 3) + +- 操作:点击 “我得到的科研结果(比如模型参数、统计指标)该怎么解读?” 按钮 +- 效果:若你提供具体结果(如 “`smoker`对`charges`的回归系数是 20000”),AI 会解读该指标的科研意义(如 “吸烟人群的年度医疗费用平均比非吸烟人群高 20000 单位”)。 + +#### 示例 4:自定义科研问题 + +- 输入:“帮我说明用`insurance`数据集中`bmi`和`charges`做散点图的科研意义是什么?” +- 效果:AI 会结合两个字段的含义,解释散点图可用于观察身体质量指数与医疗费用的相关性,为后续回归分析提供可视化依据。 + +### 4. 注意事项 + +1. 字段信息会**自动传递给 AI**,无需手动输入数据集字段内容; +2. “开启新对话” 会清空当前历史,若需保留对话记录,请勿点击该按钮。 \ No newline at end of file diff --git a/radiant.quickgen/inst/app/tools/help/quickgen_metrics.md b/radiant.quickgen/inst/app/tools/help/quickgen_metrics.md new file mode 100644 index 0000000000000000000000000000000000000000..544f2ae3b0d41b263f80359e4a4b3c2e254b6744 --- /dev/null +++ b/radiant.quickgen/inst/app/tools/help/quickgen_metrics.md @@ -0,0 +1 @@ +xxxxxx \ No newline at end of file