Skip to content

R
Radiant
Commit 4935b39a authored by wuzekai's avatar wuzekai
Browse files
Options

update: 添加中文字体支持并调整数据加载API配置

parent 73878daa
Hide whitespace changes
Inline Side-by-side
Showing with 323 additions and 41 deletions
Dockerfile
View file @ 4935b39a
......@@ -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
radiant.data/NAMESPACE
View file @ 4935b39a
......@@ -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)
......
radiant.data/R/radiant.R
View file @ 4935b39a
......@@ -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])
}
}
}
""
}
radiant.data/R/visualize.R
View file @ 4935b39a
......@@ -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) {
......
radiant.data/inst/app/tools/data/ init_load_data.R
View file @ 4935b39a
......@@ -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) # 在控制台打印详细错误堆栈
......
radiant.data/inst/app/tools/data/init_load_data.R 0 → 100644
View file @ 4935b39a
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) # 在控制台打印详细错误堆栈
})
})
}
}
})
radiant.data/inst/app/tools/data/manage.R
View file @ 4935b39a
......@@ -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}")
')
......
radiant.data/inst/app/tools/data/visualize_ui.R
View file @ 4935b39a
......@@ -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)
......
radiant.data/man/cjk_font_family.Rd 0 → 100644
View file @ 4935b39a
% 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()
}
radiant.quickgen/R/quickgen_basic.R
View file @ 4935b39a
......@@ -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) {
......
radiant.quickgen/R/quickgen_chart.R
View file @ 4935b39a
......@@ -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
)
}
......
radiant.quickgen/inst/app/tools/analysis/quickgen_basic_ui.R
View file @ 4935b39a
......@@ -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)
......
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