diff --git a/Dockerfile b/Dockerfile index 5c1ced96f982366e3ed8cbd1f118df3a5c1400cf..6f51ae6569c637e2e7c6eec61a10a6ef91ae3e97 100644 --- a/Dockerfile +++ b/Dockerfile @@ -4,6 +4,7 @@ RUN apt-get update && apt-get install -y \ libxml2-dev libssl-dev libcurl4-openssl-dev \ libharfbuzz-dev libfribidi-dev libfreetype6-dev \ libpng-dev libtiff5-dev libjpeg-dev \ + fonts-noto-cjk fonts-noto-cjk-extra \ && rm -rf /var/lib/apt/lists/* RUN R -e "install.packages(c('shiny', 'shinydashboard', 'remotes','readxl'), repos='https://cran.rstudio.com/',dependencies=TRUE)" @@ -34,7 +35,4 @@ CMD ["R", "-e", "radiant::radiant(host='0.0.0.0', port=3838)"] #docker build -t radiant:latest . 构建镜像 #cd /home/wuzekai/shinyproxy -#sh manage.sh restart 重启shinyproxy - -#sudo systemctl restart shinyproxy 重启proxy -#sudo vim /etc/shinyproxy/application.yml 修改配置文件 \ No newline at end of file +#sh manage.sh restart 重启shinyproxy \ No newline at end of file diff --git a/radiant.data/NAMESPACE b/radiant.data/NAMESPACE index aa1b27829c9df45e4085d70d3ad043aebcad3384..32d5842961608a9605644537c89a8e4f3a3bad35 100644 --- a/radiant.data/NAMESPACE +++ b/radiant.data/NAMESPACE @@ -42,6 +42,7 @@ export(choose_dir) export(choose_files) export(ci_label) export(ci_perc) +export(cjk_font_family) export(combine_data) export(combinedata) export(copy_all) diff --git a/radiant.data/R/radiant.R b/radiant.data/R/radiant.R index f15d919998bd06b2fdd8fc8a362c8e1c10bcfe54..8e2c7c944202ac63d850b919fb31d49572aa3ceb 100644 --- a/radiant.data/R/radiant.R +++ b/radiant.data/R/radiant.R @@ -1615,3 +1615,45 @@ read_files <- function(path, pdir = "", type = "rmd", to = "", clipboard = TRUE, return(invisible(cmd)) } } + +#' Detect a font family that supports CJK (Chinese) characters +#' +#' @details Returns the name of a font family that can render Chinese characters, +#' or "" if none is available. On Windows the Microsoft YaHei font is registered +#' with the \code{windowsFonts()} mechanism if it is present on the system. +#' On Linux and macOS the \code{systemfonts} package is used to look for common +#' CJK fonts (e.g., Noto Sans CJK, WenQuanYi, Source Han Sans). +#' +#' @return Character string with the name of a CJK-capable font family, or "" if none found +#' @examples +#' cjk_font_family() +#' @export +cjk_font_family <- function() { + os <- Sys.info()["sysname"] + + if (os == "Windows") { + ## register Microsoft YaHei if available + if (!"YaHei" %in% names(windowsFonts())) { + try(windowsFonts(YaHei = windowsFont("Microsoft YaHei")), silent = TRUE) + } + if ("YaHei" %in% names(windowsFonts())) { + return("YaHei") + } + return("") + } + + if (requireNamespace("systemfonts", quietly = TRUE)) { + sf <- try(systemfonts::system_fonts(), silent = TRUE) + if (!inherits(sf, "try-error") && nrow(sf) > 0) { + cjk_fonts <- unique(sf$family[grepl( + "Noto Sans CJK|WenQuanYi|Source Han|AR PL|Droid Sans Fallback|PingFang SC|Hiragino Sans GB", + sf$family, + ignore.case = TRUE + )]) + if (length(cjk_fonts) > 0) { + return(cjk_fonts[1]) + } + } + } + "" +} diff --git a/radiant.data/R/visualize.R b/radiant.data/R/visualize.R index 8475dfb64095fa96da0f49fcf37b0d1c46be36ff..1c186b4ed0b37d14af425f569be438e7e9ae68d6 100644 --- a/radiant.data/R/visualize.R +++ b/radiant.data/R/visualize.R @@ -747,9 +747,10 @@ visualize <- function(dataset, xvar, yvar = "", comby = FALSE, combx = FALSE, } ## setting theme + fml <- if (is.empty(base_family)) cjk_font_family() else base_family for (i in 1:length(plot_list)) { plot_list[[i]] <- plot_list[[i]] + - get(theme)(base_size = ifelse(is.na(base_size), 11, base_size), base_family = base_family) + get(theme)(base_size = ifelse(is.na(base_size), 11, base_size), base_family = fml) } if (custom) { diff --git a/radiant.data/inst/app/tools/data/ init_load_data.R b/radiant.data/inst/app/tools/data/ init_load_data.R index a9f4d6fccc97818ee51cab7dd6864f5ce40c8f20..c2c3bdb69de757d89531727d7debafe9d2e3a0d8 100644 --- a/radiant.data/inst/app/tools/data/ init_load_data.R +++ b/radiant.data/inst/app/tools/data/ init_load_data.R @@ -7,7 +7,7 @@ library(glue) download_handler_cric <- function(base_url, id, token, dest_file) { # 注意：这里假设 base_url 结尾没有 /，且 target 开头有 / target_url <- glue::glue("{base_url}/research-project/generate-project-dataset/{id}") - + response <- httr::POST( url = target_url, httr::add_headers(authentication = paste(token)), @@ -23,10 +23,10 @@ download_handler_cric <- function(base_url, id, token, dest_file) { download_handler_disease_batch <- function(base_url, id, token, dest_file) { # URL 拼接：base_url + /disease-data/... target_url <- glue::glue("{base_url}/disease-data/export/patient/list") - + # 参数预处理：逗号分隔字符串转向量 id_list <- strsplit(id, ",")[[1]] - + response <- httr::POST( url = target_url, httr::add_headers(Authorization = paste('Bearer ', token)), # 注意空格 @@ -40,7 +40,7 @@ download_handler_disease_batch <- function(base_url, id, token, dest_file) { # 场景 2: 申请单导出 (Case) download_handler_disease_apply <- function(base_url, id, token, dest_file) { target_url <- glue::glue("{base_url}/disease-data/data/export/apply/apply/case") - + response <- httr::POST( url = target_url, query = list(applyId = id), # 自动拼接到 URL ?applyId=xxx @@ -55,24 +55,21 @@ download_handler_disease_apply <- function(base_url, id, token, dest_file) { # ------------------------------------------------------------------------- SYSTEM_REGISTRY <- list( "cric" = list( - # api_base = "https://ds.cixincloud.com/data-search-api", - api_base = "http://10.120.120.34:8300/data-search-api", + api_base = "https://ds.cixincloud.com/data-search-api", handler = download_handler_cric, file_ext = ".xlsx", sys_description = "大数据检索系统" ), - + "disease_batch" = list( - # api_base = "https://ds.cixincloud.com/disease-api", - api_base = "http://10.120.120.34:8300/disease-api", + api_base = "https://ds.cixincloud.com/disease-api", handler = download_handler_disease_batch, file_ext = ".xls",# 注意这里是 xls sys_description = "专病库系统" ), - + "disease_apply" = list( - # api_base = "https://ds.cixincloud.com/disease-api", - api_base = "http://10.120.120.34:8300/disease-api", + api_base = "https://ds.cixincloud.com/disease-api", handler = download_handler_disease_apply, file_ext = ".xlsx", sys_description = "专病库系统" @@ -85,43 +82,43 @@ SYSTEM_REGISTRY <- list( observe({ # 1. 解析 URL 参数 query <- parseQueryString(session$clientData$url_search) - + dataset_id <- query[['datasetId']] token <- query[['token']] sys_name <- query[['system']] - + # 初始化已加载列表 if (is.null(session$userData$loaded_datasets)) { session$userData$loaded_datasets <- c() } - + # 2. 校验必要参数 if (!is.null(dataset_id) && !is.null(token) && !is.null(sys_name)) { - + # 3. 防止重复加载 if (!(dataset_id %in% session$userData$loaded_datasets)) { - + # 4. 获取系统配置 sys_config <- SYSTEM_REGISTRY[[sys_name]] - + if (is.null(sys_config)) { showNotification(paste0("配置错误：未知的系统类型 [", sys_config$sys_description, "]"), type = "error", duration = 10) return() } - + withProgress(message = paste0('正在连接 [', sys_config$sys_description, ']...'), value = 0.1, { - + tryCatch({ # 5. 准备临时文件 # 获取带点的后缀 (如 .xlsx) file_suffix <- ifelse(is.null(sys_config$file_ext), ".xlsx", sys_config$file_ext) tmp_file <- tempfile(fileext = file_suffix) - + # [修复点 1] 提前计算不带点的后缀变量 clean_ext，供后续使用 clean_ext <- gsub("\\.", "", file_suffix) - + incProgress(0.3, detail = "执行下载策略...") - + # 6. 调用 Handler 下载 response <- sys_config$handler( base_url = sys_config$api_base, @@ -129,7 +126,7 @@ observe({ token = token, dest_file = tmp_file ) - + # 7. 检查状态码 if (httr::status_code(response) != 200) { err_msg <- tryCatch( @@ -138,9 +135,9 @@ observe({ ) stop(paste0("下载失败 (HTTP ", httr::status_code(response), "): ", err_msg)) } - + incProgress(0.7, detail = "正在导入 Radiant...") - + # 8. 调用 Radiant 加载函数 load_user_data( fname = paste0("data_", dataset_id, file_suffix), @@ -149,32 +146,32 @@ observe({ xlsx_header = TRUE, man_str_as_factor = TRUE ) - + # 9. 界面联动：自动选中最后一个 Sheet if (clean_ext %in% c("xlsx", "xls")) { - + # 读取 Sheet 名 -> 清洗 -> 取最后一个 # 使用 try 包裹 readxl 以防空文件报错 raw_sheets <- try(readxl::excel_sheets(tmp_file), silent = TRUE) - + if (!inherits(raw_sheets, "try-error") && length(raw_sheets) > 0) { target_sheet <- head(make.names(raw_sheets), 1) message(target_sheet) - + # 更新下拉框 updateSelectInput(session, "dataset", choices = names(r_data), selected = target_sheet) - + # 切换页面 updateTabsetPanel(session, "nav_radiant", selected = "Data") updateTabsetPanel(session, "tabs_data", selected = "View") - + # showNotification(paste0("已选中: ", target_sheet), type = "message") } } - + # 10. 标记为已加载 session$userData$loaded_datasets <- c(session$userData$loaded_datasets, dataset_id) - + }, error = function(e) { showNotification(paste("同步失败:", e$message), type = "error", duration = 15) print(e) # 在控制台打印详细错误堆栈 diff --git a/radiant.data/inst/app/tools/data/init_load_data.R b/radiant.data/inst/app/tools/data/init_load_data.R new file mode 100644 index 0000000000000000000000000000000000000000..a9f4d6fccc97818ee51cab7dd6864f5ce40c8f20 --- /dev/null +++ b/radiant.data/inst/app/tools/data/init_load_data.R @@ -0,0 +1,185 @@ +library(httr) +library(glue) + +# ------------------------------------------------------------------------- +# 1. CRIC 系统处理函数 +# ------------------------------------------------------------------------- +download_handler_cric <- function(base_url, id, token, dest_file) { + # 注意：这里假设 base_url 结尾没有 /，且 target 开头有 / + target_url <- glue::glue("{base_url}/research-project/generate-project-dataset/{id}") + + response <- httr::POST( + url = target_url, + httr::add_headers(authentication = paste(token)), + httr::write_disk(dest_file, overwrite = TRUE) + ) + return(response) +} + +# ------------------------------------------------------------------------- +# 2. 专病库系统 处理函数 +# ------------------------------------------------------------------------- +# 场景 1: 批量导出患者 (List) +download_handler_disease_batch <- function(base_url, id, token, dest_file) { + # URL 拼接：base_url + /disease-data/... + target_url <- glue::glue("{base_url}/disease-data/export/patient/list") + + # 参数预处理：逗号分隔字符串转向量 + id_list <- strsplit(id, ",")[[1]] + + response <- httr::POST( + url = target_url, + httr::add_headers(Authorization = paste('Bearer ', token)), # 注意空格 + body = id_list, + encode = "json", # 自动将向量转为 JSON 数组 ["id1", "id2"] + httr::write_disk(dest_file, overwrite = TRUE) + ) + return(response) +} + +# 场景 2: 申请单导出 (Case) +download_handler_disease_apply <- function(base_url, id, token, dest_file) { + target_url <- glue::glue("{base_url}/disease-data/data/export/apply/apply/case") + + response <- httr::POST( + url = target_url, + query = list(applyId = id), # 自动拼接到 URL ?applyId=xxx + httr::add_headers(Authorization = paste('Bearer ', token)), + httr::write_disk(dest_file, overwrite = TRUE) + ) + return(response) +} + +# ------------------------------------------------------------------------- +# 系统注册表 +# ------------------------------------------------------------------------- +SYSTEM_REGISTRY <- list( + "cric" = list( + # api_base = "https://ds.cixincloud.com/data-search-api", + api_base = "http://10.120.120.34:8300/data-search-api", + handler = download_handler_cric, + file_ext = ".xlsx", + sys_description = "大数据检索系统" + ), + + "disease_batch" = list( + # api_base = "https://ds.cixincloud.com/disease-api", + api_base = "http://10.120.120.34:8300/disease-api", + handler = download_handler_disease_batch, + file_ext = ".xls",# 注意这里是 xls + sys_description = "专病库系统" + ), + + "disease_apply" = list( + # api_base = "https://ds.cixincloud.com/disease-api", + api_base = "http://10.120.120.34:8300/disease-api", + handler = download_handler_disease_apply, + file_ext = ".xlsx", + sys_description = "专病库系统" + ) +) + +# ------------------------------------------------------------------------- +# 主逻辑 (Observer) +# ------------------------------------------------------------------------- +observe({ + # 1. 解析 URL 参数 + query <- parseQueryString(session$clientData$url_search) + + dataset_id <- query[['datasetId']] + token <- query[['token']] + sys_name <- query[['system']] + + # 初始化已加载列表 + if (is.null(session$userData$loaded_datasets)) { + session$userData$loaded_datasets <- c() + } + + # 2. 校验必要参数 + if (!is.null(dataset_id) && !is.null(token) && !is.null(sys_name)) { + + # 3. 防止重复加载 + if (!(dataset_id %in% session$userData$loaded_datasets)) { + + # 4. 获取系统配置 + sys_config <- SYSTEM_REGISTRY[[sys_name]] + + if (is.null(sys_config)) { + showNotification(paste0("配置错误：未知的系统类型 [", sys_config$sys_description, "]"), type = "error", duration = 10) + return() + } + + withProgress(message = paste0('正在连接 [', sys_config$sys_description, ']...'), value = 0.1, { + + tryCatch({ + # 5. 准备临时文件 + # 获取带点的后缀 (如 .xlsx) + file_suffix <- ifelse(is.null(sys_config$file_ext), ".xlsx", sys_config$file_ext) + tmp_file <- tempfile(fileext = file_suffix) + + # [修复点 1] 提前计算不带点的后缀变量 clean_ext，供后续使用 + clean_ext <- gsub("\\.", "", file_suffix) + + incProgress(0.3, detail = "执行下载策略...") + + # 6. 调用 Handler 下载 + response <- sys_config$handler( + base_url = sys_config$api_base, + id = dataset_id, + token = token, + dest_file = tmp_file + ) + + # 7. 检查状态码 + if (httr::status_code(response) != 200) { + err_msg <- tryCatch( + httr::content(response, "text", encoding = "UTF-8"), + error = function(e) "无详细错误信息" + ) + stop(paste0("下载失败 (HTTP ", httr::status_code(response), "): ", err_msg)) + } + + incProgress(0.7, detail = "正在导入 Radiant...") + + # 8. 调用 Radiant 加载函数 + load_user_data( + fname = paste0("data_", dataset_id, file_suffix), + uFile = tmp_file, + ext = clean_ext, # [修复点 2] 使用定义好的变量 + xlsx_header = TRUE, + man_str_as_factor = TRUE + ) + + # 9. 界面联动：自动选中最后一个 Sheet + if (clean_ext %in% c("xlsx", "xls")) { + + # 读取 Sheet 名 -> 清洗 -> 取最后一个 + # 使用 try 包裹 readxl 以防空文件报错 + raw_sheets <- try(readxl::excel_sheets(tmp_file), silent = TRUE) + + if (!inherits(raw_sheets, "try-error") && length(raw_sheets) > 0) { + target_sheet <- head(make.names(raw_sheets), 1) + message(target_sheet) + + # 更新下拉框 + updateSelectInput(session, "dataset", choices = names(r_data), selected = target_sheet) + + # 切换页面 + updateTabsetPanel(session, "nav_radiant", selected = "Data") + updateTabsetPanel(session, "tabs_data", selected = "View") + + # showNotification(paste0("已选中: ", target_sheet), type = "message") + } + } + + # 10. 标记为已加载 + session$userData$loaded_datasets <- c(session$userData$loaded_datasets, dataset_id) + + }, error = function(e) { + showNotification(paste("同步失败:", e$message), type = "error", duration = 15) + print(e) # 在控制台打印详细错误堆栈 + }) + }) + } + } +}) diff --git a/radiant.data/inst/app/tools/data/manage.R b/radiant.data/inst/app/tools/data/manage.R index 3cfea63a86b874323ede512fedc7ad55c02c8bfe..f0ff79f80d8bd9dc357ff305ecaf9b573920910c 100644 --- a/radiant.data/inst/app/tools/data/manage.R +++ b/radiant.data/inst/app/tools/data/manage.R @@ -55,9 +55,29 @@ load_csv <- function(file, delim = ",", col_names = TRUE, dec = ".", } } +## 智能类型识别：将"看起来像数值"的字符列转为 numeric， +## 避免数值列（含空串/混入少量文本）被 to_fct 误转为 factor +smart_type_convert <- function(df) { + if (nrow(df) == 0) return(df) + for (col in names(df)) { + x <- df[[col]] + if (is.character(x)) { + test <- x[!is.na(x) & trimws(x) != ""] + if (length(test) > 0) { + num <- suppressWarnings(as.numeric(test)) + if (mean(!is.na(num)) >= 0.95) { + df[[col]] <- suppressWarnings(as.numeric(x)) + } + } + } + } + df +} + load_user_data <- function(fname, uFile, ext, header = TRUE, man_str_as_factor = TRUE, sep = ",", dec = ".", n_max = Inf, xlsx_sheet = 1, xlsx_header = TRUE) { + filename <- basename(fname) fext <- tools::file_ext(filename) %>% tolower() @@ -180,6 +200,8 @@ load_user_data <- function(fname, uFile, ext, header = TRUE, try({ # 清洗列名 colnames(raw_data) <- radiant.data::fix_names(colnames(raw_data)) + # 智能识别数值字段（避免数值列被 to_fct 误转为 factor） + raw_data <- smart_type_convert(raw_data) # 转换因子 if (man_str_as_factor) raw_data <- radiant.data::to_fct(raw_data) }, silent = TRUE) @@ -193,6 +215,7 @@ load_user_data <- function(fname, uFile, ext, header = TRUE, {clean_name} <- readxl::read_excel("{uFile}", sheet = "{sheet_name}", col_names = {xlsx_header}) %>% as.data.frame(stringsAsFactors = FALSE) %>% fix_names() + {clean_name} <- smart_type_convert({clean_name}) {if (man_str_as_factor) paste0(clean_name, " <- radiant.data::to_fct(", clean_name, ")") else ""} register("{clean_name}") ') diff --git a/radiant.data/inst/app/tools/data/visualize_ui.R b/radiant.data/inst/app/tools/data/visualize_ui.R index f593bd8dca7d65dcd02eb257bb6531faa5679ac9..0dba7e1f8d2699ca0495194a3f581806fa1b9073 100644 --- a/radiant.data/inst/app/tools/data/visualize_ui.R +++ b/radiant.data/inst/app/tools/data/visualize_ui.R @@ -27,6 +27,10 @@ viz_theme <- c( os_type <- Sys.info()["sysname"] if (os_type == "Windows") { + ## register Chinese fonts so they appear in the font dropdown + if (!"YaHei" %in% names(windowsFonts())) { + try(windowsFonts(YaHei = windowsFont("Microsoft YaHei")), silent = TRUE) + } fnt <- names(windowsFonts()) names(fnt) <- tools::toTitleCase(fnt) viz_base_family <- c("Theme default" = "", fnt) diff --git a/radiant.data/man/cjk_font_family.Rd b/radiant.data/man/cjk_font_family.Rd new file mode 100644 index 0000000000000000000000000000000000000000..c1f18c1c1334fa946a1df8b347dfd67a061780e4 --- /dev/null +++ b/radiant.data/man/cjk_font_family.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/radiant.R +\name{cjk_font_family} +\alias{cjk_font_family} +\title{Detect a font family that supports CJK (Chinese) characters} +\usage{ +cjk_font_family() +} +\value{ +Character string with the name of a CJK-capable font family, or "" if none found +} +\description{ +Detect a font family that supports CJK (Chinese) characters +} +\details{ +Returns the name of a font family that can render Chinese characters, + or "" if none is available. On Windows the Microsoft YaHei font is registered + with the \code{windowsFonts()} mechanism if it is present on the system. + On Linux and macOS the \code{systemfonts} package is used to look for common + CJK fonts (e.g., Noto Sans CJK, WenQuanYi, Source Han Sans). +} +\examples{ +cjk_font_family() +} diff --git a/radiant.quickgen/R/quickgen_basic.R b/radiant.quickgen/R/quickgen_basic.R index da304f79797ebfc7a2ae11781b59bd9124df562a..68d95f7d16b9b33e7ef1a5ac2de797609e9970cb 100644 --- a/radiant.quickgen/R/quickgen_basic.R +++ b/radiant.quickgen/R/quickgen_basic.R @@ -1119,9 +1119,10 @@ visualize <- function(dataset, xvar, yvar = "", comby = FALSE, combx = FALSE, } ## setting theme + fml <- if (is.empty(base_family)) radiant.data::cjk_font_family() else base_family for (i in 1:length(plot_list)) { plot_list[[i]] <- plot_list[[i]] + - get(theme)(base_size = ifelse(is.na(base_size), 11, base_size), base_family = base_family) + get(theme)(base_size = ifelse(is.na(base_size), 11, base_size), base_family = fml) } if (custom) { diff --git a/radiant.quickgen/R/quickgen_chart.R b/radiant.quickgen/R/quickgen_chart.R index d4bf7003eb3bbd53c21331f8a9983f042dce6890..ac8c8753e534f549f48d3401a8ae210bce286b4f 100644 --- a/radiant.quickgen/R/quickgen_chart.R +++ b/radiant.quickgen/R/quickgen_chart.R @@ -71,6 +71,7 @@ chart_completion <- function(user_prompt) { # === 构造发给模型的 Prompt === #' @export build_chart_prompt <- function(user_prompt, data_call) { + sys_theme_font <- radiant.data::cjk_font_family() sprintf( "你是 R 语言专家，必须严格遵守以下规则： 〓 输出格式 〓 @@ -89,8 +90,9 @@ build_chart_prompt <- function(user_prompt, data_call) { 2. 主题函数带括号：theme_minimal()、theme_bw() ... 3. 多张图用 patchwork 拼页。 4. 包函数写全名，不得省略括号。 +5. 生成的 ggplot 必须支持中文字符：若列名/标签含中文，统一在 theme_*() 中加 text = element_text(family = '%s')，或使用 scale_*_continuous/labs 时保证中文标签正常渲染。 用户请求：%s", - data_call, user_prompt + data_call, sys_theme_font, user_prompt ) } 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 ee5ceea089fcf193e704c359007356d1eecf8455..a50c357648551f79a19b5d190016702edc2b5f25 100644 --- a/radiant.quickgen/inst/app/tools/analysis/quickgen_basic_ui.R +++ b/radiant.quickgen/inst/app/tools/analysis/quickgen_basic_ui.R @@ -61,6 +61,10 @@ qib_theme <- c( os_type <- Sys.info()["sysname"] if (os_type == "Windows") { + ## register Chinese fonts so they appear in the font dropdown + if (!"YaHei" %in% names(windowsFonts())) { + try(windowsFonts(YaHei = windowsFont("Microsoft YaHei")), silent = TRUE) + } fnt <- names(windowsFonts()) names(fnt) <- tools::toTitleCase(fnt) qib_base_family <- c("Theme default" = "", fnt)