Initial commit

Dockerfile

@@ -6,21 +6,26 @@ RUN apt-get update && apt-get install -y \
     libpng-dev libtiff5-dev libjpeg-dev \
     && rm -rf /var/lib/apt/lists/*
 
-
-RUN R -e "install.packages(c('shiny', 'shinydashboard', 'remotes'), repos='https://cran.rstudio.com/')"
+RUN R -e "install.packages(c('shiny', 'shinydashboard', 'remotes','readxl'), repos='https://cran.rstudio.com/',dependencies=TRUE)"
+RUN echo 'options(radiant.shinyFiles = FALSE)' >> /usr/local/lib/R/etc/Rprofile.site
 COPY . /srv/shiny-server/
 COPY set_path.R /usr/local/lib/R/etc/Rprofile.site.d/00-radiant-path.R
 
 # 安装所有子模块
-RUN R -e "remotes::install_local('/srv/shiny-server/radiant.data', type='source', upgrade='never')"
-RUN R -e "remotes::install_local('/srv/shiny-server/radiant.basics', type='source', upgrade='never')"
-RUN R -e "remotes::install_local('/srv/shiny-server/radiant.model', type='source', upgrade='never')"
-RUN R -e "remotes::install_local('/srv/shiny-server/radiant.multivariate', type='source', upgrade='never')"
-RUN R -e "remotes::install_local('/srv/shiny-server/radiant.design', type='source', upgrade='never')"
-RUN R -e "remotes::install_local('/srv/shiny-server/radiant.quickgen', type='source', upgrade='never')"
+RUN R -e "remotes::install_local('/srv/shiny-server/radiant.data',dependencies=TRUE, type='source', upgrade='never')"
+RUN R -e "remotes::install_local('/srv/shiny-server/radiant.basics',dependencies=TRUE, type='source', upgrade='never')"
+RUN R -e "remotes::install_local('/srv/shiny-server/radiant.model',dependencies=TRUE, type='source', upgrade='never')"
+RUN R -e "remotes::install_local('/srv/shiny-server/radiant.multivariate',dependencies=TRUE, type='source', upgrade='never')"
+RUN R -e "remotes::install_local('/srv/shiny-server/radiant.design',dependencies=TRUE, type='source', upgrade='never')"
+RUN R -e "remotes::install_local('/srv/shiny-server/radiant.quickgen',dependencies=TRUE, type='source', upgrade='never')"
 
 # 安装主 radiant 应用
-RUN R -e "remotes::install_local('/srv/shiny-server/radiant-master', type='source', upgrade='never')"
+RUN R -e "remotes::install_local('/srv/shiny-server/radiant-master',dependencies=TRUE, type='source', upgrade='never')"
 
 WORKDIR /data
 CMD ["R", "-e", "radiant::radiant(host='0.0.0.0', port=3838)"]
+
+#docker images | grep radiant 查看镜像
+#sudo systemctl restart shinyproxy  重启proxy
+#sudo vim /etc/shinyproxy/application.yml 修改配置文件
+#docker build -t radiant:latest .   构建镜像
\ No newline at end of file

radiant-master/DESCRIPTION

@@ -14,7 +14,8 @@ Depends:
     radiant.design (>= 1.6.6),
     radiant.basics (>= 1.6.6),
     radiant.model (>= 1.6.6),
-    radiant.multivariate (>= 1.6.6)
+    radiant.multivariate (>= 1.6.6),
+    radiant.quickgen
 Imports:
     shiny (>= 1.8.1),
     import (>= 1.1.0),

radiant-master/inst/app/global.R

@@ -42,7 +42,6 @@ source(file.path(getOption("radiant.path.design"), "app/init.R"), encoding = get
 source(file.path(getOption("radiant.path.basics"), "app/init.R"), encoding = getOption("radiant.encoding"), local = TRUE)
 source(file.path(getOption("radiant.path.model"), "app/init.R"), encoding = getOption("radiant.encoding"), local = TRUE)
 source(file.path(getOption("radiant.path.multivariate"), "app/init.R"), encoding = getOption("radiant.encoding"), local = TRUE)
-# 添加quickgen模块的init.R
 source(file.path(getOption("radiant.path.quickgen"), "app/init.R"), encoding = getOption("radiant.encoding"), local = TRUE)
 
 options(radiant.url.patterns = make_url_patterns())

radiant.quickgen/DESCRIPTION

@@ -2,3 +2,21 @@ Package: radiant.quickgen
 Version: 0.0.1
 Title: Quick Generator table and chart for Radiant
 Description: Provides a simple data generator for the Radiant interface.
+Depends:
+    R (>= 4.3.0),
+    radiant.data (>= 1.6.6)
+Imports:
+    shiny (>= 1.8.1),
+    shiny.i18n,
+    httr2 (>= 1.0.0),
+    shinyjs,
+    shinyAce,
+    shinyWidgets(>= 0.8.0),
+    patchwork
+Suggests:
+    testthat (>= 2.0.0),
+    pkgdown (>= 1.1.0),
+    markdown (>= 1.3)
+Encoding: UTF-8
+Language: en-US
+RoxygenNote: 7.3.2

radiant.quickgen/NAMESPACE

+# Generated by roxygen2: do not edit by hand
+
+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(cv)
+export(does_vary)
+export(empty_level)
+export(explore)
+export(flip)
+export(ln)
+export(me)
+export(meprop)
+export(modal)
+export(n_missing)
+export(n_obs)
+export(p01)
+export(p025)
+export(p05)
+export(p10)
+export(p25)
+export(p75)
+export(p90)
+export(p95)
+export(p975)
+export(p99)
+export(prop)
+export(qscatter)
+export(sdpop)
+export(sdprop)
+export(se)
+export(seprop)
+export(varpop)
+export(varprop)
+export(visualize)

radiant.quickgen/R/quickgen_ai.R

-#' 一键生成模块服务器逻辑
+# === 配置 ===
+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
-quickgen_server <- function(input, output, session, r_data, r_info, r_state) {
-  # 为模块创建命名空间
-  ns <- session$ns
+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

radiant.quickgen/R/quickgen_basic.R

-
+#' @export
 explore <- function(dataset, vars = "", byvar = "", fun = c("mean", "sd"),
                     top = "fun", tabfilt = "", tabsort = "", tabslice = "",
                     nr = Inf, data_filter = "", arr = "", rows = NULL,
@@ -171,7 +171,7 @@ explore <- function(dataset, vars = "", byvar = "", fun = c("mean", "sd"),
   ) %>% add_class("explore")
 }
 
-
+#' @export
 summary.explore <- function(object, dec = 3, ...) {
   cat("Explore\n")
   cat("Data        :", object$df_name, "\n")
@@ -209,7 +209,7 @@ summary.explore <- function(object, dec = 3, ...) {
   invisible()
 }
 
-
+#' @export
 store.explore <- function(dataset, object, name, ...) {
   if (missing(name)) {
     object$tab
@@ -225,7 +225,7 @@ store.explore <- function(dataset, object, name, ...) {
   }
 }
 
-
+#' @export
 flip <- function(expl, top = "fun") {
   cvars <- expl$byvar %>%
     (function(x) if (is.empty(x[1])) character(0) else x)
@@ -245,7 +245,7 @@ flip <- function(expl, top = "fun") {
   expl$tab
 }
 
-
+#' @export
 dtab.explore <- function(object, dec = 3, searchCols = NULL,
                          order = NULL, pageLength = NULL,
                          caption = NULL, ...) {
@@ -330,31 +330,31 @@ dtab.explore <- function(object, dec = 3, searchCols = NULL,
 ## turn functions below into functional ...
 ###########################################
 
-
+#' @export
 n_obs <- function(x, ...) length(x)
-
+#' @export
 n_missing <- function(x, ...) sum(is.na(x))
-
+#' @export
 p01 <- function(x, na.rm = TRUE) quantile(x, .01, na.rm = na.rm)
-
+#' @export
 p025 <- function(x, na.rm = TRUE) quantile(x, .025, na.rm = na.rm)
-
+#' @export
 p05 <- function(x, na.rm = TRUE) quantile(x, .05, na.rm = na.rm)
-
+#' @export
 p10 <- function(x, na.rm = TRUE) quantile(x, .1, na.rm = na.rm)
-
+#' @export
 p25 <- function(x, na.rm = TRUE) quantile(x, .25, na.rm = na.rm)
-
+#' @export
 p75 <- function(x, na.rm = TRUE) quantile(x, .75, na.rm = na.rm)
-
+#' @export
 p90 <- function(x, na.rm = TRUE) quantile(x, .90, na.rm = na.rm)
-
+#' @export
 p95 <- function(x, na.rm = TRUE) quantile(x, .95, na.rm = na.rm)
-
+#' @export
 p975 <- function(x, na.rm = TRUE) quantile(x, .975, na.rm = na.rm)
-
+#' @export
 p99 <- function(x, na.rm = TRUE) quantile(x, .99, na.rm = na.rm)
-
+#' @export
 cv <- function(x, na.rm = TRUE) {
   m <- mean(x, na.rm = na.rm)
   if (m == 0) {
@@ -364,17 +364,17 @@ cv <- function(x, na.rm = TRUE) {
     sd(x, na.rm = na.rm) / m
   }
 }
-
+#' @export
 se <- function(x, na.rm = TRUE) {
   if (na.rm) x <- na.omit(x)
   sd(x) / sqrt(length(x))
 }
-
+#' @export
 me <- function(x, conf_lev = 0.95, na.rm = TRUE) {
   if (na.rm) x <- na.omit(x)
   se(x) * qt(conf_lev / 2 + .5, length(x) - 1, lower.tail = TRUE)
 }
-
+#' @export
 prop <- function(x, na.rm = TRUE) {
   if (na.rm) x <- na.omit(x)
   if (is.numeric(x)) {
@@ -387,36 +387,36 @@ prop <- function(x, na.rm = TRUE) {
     NA
   }
 }
-
+#' @export
 varprop <- function(x, na.rm = TRUE) {
   p <- prop(x, na.rm = na.rm)
   p * (1 - p)
 }
-
+#' @export
 sdprop <- function(x, na.rm = TRUE) sqrt(varprop(x, na.rm = na.rm))
-
+#' @export
 seprop <- function(x, na.rm = TRUE) {
   if (na.rm) x <- na.omit(x)
   sqrt(varprop(x, na.rm = FALSE) / length(x))
 }
-
+#' @export
 meprop <- function(x, conf_lev = 0.95, na.rm = TRUE) {
   if (na.rm) x <- na.omit(x)
   seprop(x) * qnorm(conf_lev / 2 + .5, lower.tail = TRUE)
 }
-
+#' @export
 varpop <- function(x, na.rm = TRUE) {
   if (na.rm) x <- na.omit(x)
   n <- length(x)
   var(x) * ((n - 1) / n)
 }
-
+#' @export
 sdpop <- function(x, na.rm = TRUE) sqrt(varpop(x, na.rm = na.rm))
-
+#' @export
 ln <- function(x, na.rm = TRUE) {
   if (na.rm) log(na.omit(x)) else log(x)
 }
-
+#' @export
 does_vary <- function(x, na.rm = TRUE) {
   ## based on http://stackoverflow.com/questions/4752275/test-for-equality-among-all-elements-of-a-single-vector
   if (length(x) == 1L) {
@@ -429,7 +429,7 @@ does_vary <- function(x, na.rm = TRUE) {
     }
   }
 }
-
+#' @export
 empty_level <- function(x) {
   if (!is.factor(x)) x <- as.factor(x)
   levs <- levels(x)
@@ -443,7 +443,7 @@ empty_level <- function(x) {
   }
   x
 }
-
+#' @export
 modal <- function(x, na.rm = TRUE) {
   if (na.rm) x <- na.omit(x)
   unv <- unique(x)
@@ -451,7 +451,7 @@ modal <- function(x, na.rm = TRUE) {
 }
 
 #—————————————————————————————————————————————————绘图部分———————————————————————————————————————————
-
+#' @export
 visualize <- function(dataset, xvar, yvar = "", comby = FALSE, combx = FALSE,
                       type = ifelse(is.empty(yvar), "dist", "scatter"), nrobs = -1,
                       facet_row = ".", facet_col = ".", color = "none", fill = "none",
@@ -1131,7 +1131,7 @@ visualize <- function(dataset, xvar, yvar = "", comby = FALSE, combx = FALSE,
       (function(x) if (isTRUE(shiny)) x else print(x))
   }
 }
-
+#' @export
 qscatter <- function(dataset, xvar, yvar, lev = "", fun = "mean", bins = 20) {
   if (is.character(dataset[[yvar]])) {
     dataset <- mutate_at(dataset, .vars = yvar, .funs = as.factor)

radiant.quickgen/inst/app/init.R

@@ -15,7 +15,7 @@ options(
           tags$script(src = "www_quickgen/js/run_return.js")
         ),
         tabPanel(i18n$t("Generate descriptive statistics with one click"), uiOutput("quickgen_basic")),
-        tabPanel(i18n$t("LLM generates descriptive statistics"), uiOutput("quickgen_ai"))
+        tabPanel(i18n$t("AI generates descriptive statistics"), uiOutput("quickgen_ai"))
       )
     )
 )
\ No newline at end of file

radiant.quickgen/inst/app/tools/help/quickgen_ai.md

+> 大模型生成描述性统计
+
+## 使用方法
+
+以下是 `大模型生成描述性统计`的使用方法。
+
+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

set_path.R

-# 创建文件 /home/wuzekai/radiant/set_path.R
 cat <<'EOF' | sudo tee /home/wuzekai/radiant/set_path.R
 options(radiant.launch_dir = "/data")
 options(radiant.project_dir = "/data")