Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
R
Radiant
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Boards
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
wuzekai
Radiant
Commits
5ef043d9
Commit
5ef043d9
authored
Dec 24, 2025
by
gaozhaochen
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
feature(data):
1、自动下载读取excel数据支持专病库系统 2、数据查看默认展示前15行
parent
be466d32
Changes
2
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
141 additions
and
53 deletions
+141
-53
init_load_data.R
radiant.data/inst/app/tools/data/init_load_data.R
+140
-52
view_ui.R
radiant.data/inst/app/tools/data/view_ui.R
+1
-1
No files found.
radiant.data/inst/app/tools/data/init_load_data.R
View file @
5ef043d9
# ============================================================
# [新增功能] 企业级集成:Token鉴权 + 环境变量 + 自动加载
# ============================================================
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"
,
handler
=
download_handler_cric
,
file_ext
=
".xlsx"
,
sys_description
=
"大数据检索系统"
),
"disease_batch"
=
list
(
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"
,
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'
]]
# 初始化
一个 session 级别的变量来记录已加载的 ID,防止刷新时的重复请求
# 初始化
已加载列表
if
(
is.null
(
session
$
userData
$
loaded_datasets
))
{
session
$
userData
$
loaded_datasets
<-
c
()
}
# 2.
仅当 ID 和 Token 均存在时执行
if
(
!
is.null
(
dataset_id
)
&&
!
is.null
(
token
))
{
# 2.
校验必要参数
if
(
!
is.null
(
dataset_id
)
&&
!
is.null
(
token
)
&&
!
is.null
(
sys_name
)
)
{
# 3. [修改点] 检查 ID 是否已在本次会话中加载过
# 因为现在数据集名称是动态的 Sheet 名,下载前无法预知,所以改为判断 ID
# 3. 防止重复加载
if
(
!
(
dataset_id
%in%
session
$
userData
$
loaded_datasets
))
{
withProgress
(
message
=
'正在从业务系统同步数据...'
,
value
=
0.2
,
{
# 4. 获取环境变量
api_base
<-
Sys.getenv
(
"HOST_API_BASE"
,
"https://ds.cixincloud.com/data-search-api"
)
# 4. 获取系统配置
sys_config
<-
SYSTEM_REGISTRY
[[
sys_name
]]
# 5. 拼接完整 API 路径
target_url
<-
paste0
(
api_base
,
"/research-project/generate-project-dataset/"
,
dataset_id
)
if
(
is.null
(
sys_config
))
{
showNotification
(
paste0
(
"配置错误:未知的系统类型 ["
,
sys_config
$
sys_description
,
"]"
),
type
=
"error"
,
duration
=
10
)
return
()
}
# 6. 创建临时文件
tmp_file
<-
tempfile
(
fileext
=
".xlsx"
)
withProgress
(
message
=
paste0
(
'正在连接 ['
,
sys_config
$
sys_description
,
']...'
),
value
=
0.1
,
{
tryCatch
({
incProgress
(
0.3
,
detail
=
"正在鉴权并下载..."
)
# 7. HTTP 请求
response
<-
httr
::
POST
(
url
=
target_url
,
httr
::
add_headers
(
authentication
=
paste
(
token
)),
httr
::
write_disk
(
tmp_file
,
overwrite
=
TRUE
)
# 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
)
message
(
"=== Request Log ==="
)
print
(
response
$
request
)
message
(
"==================="
)
# 7. 检查状态码
if
(
httr
::
status_code
(
response
)
!=
200
)
{
stop
(
paste
(
"下载失败,HTTP状态码:"
,
httr
::
status_code
(
response
)))
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..."
)
incProgress
(
0.7
,
detail
=
"
正在
导入 Radiant..."
)
# 8. 调用核心加载函数
# 注意:这里的 fname 仅用于扩展名识别,实际数据集名称由 Sheet 名决定
# 8. 调用 Radiant 加载函数
load_user_data
(
fname
=
"downloaded_data.xlsx"
,
fname
=
paste0
(
"data_"
,
dataset_id
,
file_suffix
)
,
uFile
=
tmp_file
,
ext
=
"xlsx"
,
ext
=
clean_ext
,
# [修复点 2] 使用定义好的变量
xlsx_header
=
TRUE
,
man_str_as_factor
=
TRUE
)
# 9. 界面联动:获取刚才加载的 Sheet 名称并选中第一个
# 必须再次读取 Sheet 列表并做 make.names 处理,才能匹配到 r_data 中的 Key
loaded_sheets
<-
try
(
readxl
::
excel_sheets
(
tmp_file
),
silent
=
TRUE
)
# 9. 界面联动:自动选中最后一个 Sheet
if
(
clean_ext
%in%
c
(
"xlsx"
,
"xls"
))
{
if
(
!
inherits
(
loaded_sheets
,
"try-error"
)
&&
length
(
loaded_sheets
)
>
0
)
{
# 读取 Sheet 名 -> 清洗 -> 取最后一个
# 使用 try 包裹 readxl 以防空文件报错
raw_sheets
<-
try
(
readxl
::
excel_sheets
(
tmp_file
),
silent
=
TRUE
)
# 必须和 load_user_data 里的逻辑一致,使用 make.names 清洗
valid_names
<-
make.names
(
loaded_sheets
)
first_sheet_name
<-
valid_names
[
1
]
# 默认选第一个
if
(
!
inherits
(
raw_sheets
,
"try-error"
)
&&
length
(
raw_sheets
)
>
0
)
{
target_sheet
<-
head
(
make.names
(
raw_sheets
),
1
)
message
(
target_sheet
)
# 标记为已加载
session
$
userData
$
loaded_datasets
<-
c
(
session
$
userData
$
loaded_datasets
,
dataset_id
)
# 更新下拉框
updateSelectInput
(
session
,
"dataset"
,
choices
=
names
(
r_data
),
selected
=
target_sheet
)
# 更新下拉框并选中第一个 Sheet
updateSelectInput
(
session
,
"dataset"
,
selected
=
first_sheet_name
)
# 切换页面
updateTabsetPanel
(
session
,
"nav_radiant"
,
selected
=
"Data"
)
updateTabsetPanel
(
session
,
"tabs_data"
,
selected
=
"View"
)
showNotification
(
paste0
(
"成功加载 "
,
length
(
valid_names
),
" 个数据集 (ID: "
,
dataset_id
,
")"
),
type
=
"message"
)
}
else
{
showNotification
(
"文件下载成功,但未发现有效的 Sheet"
,
type
=
"warning"
)
# 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
=
10
)
showNotification
(
paste
(
"同步失败:"
,
e
$
message
),
type
=
"error"
,
duration
=
15
)
print
(
e
)
# 在控制台打印详细错误堆栈
})
})
}
}
})
# ============================================================
radiant.data/inst/app/tools/data/view_ui.R
View file @
5ef043d9
...
...
@@ -15,7 +15,7 @@ output$ui_view_vars <- renderUI({
selectInput
(
"view_vars"
,
i
18
n
$
t
(
"Select variables to show:"
),
choices
=
vars
,
selected
=
state_multiple
(
"view_vars"
,
vars
,
vars
),
selected
=
state_multiple
(
"view_vars"
,
vars
,
head
(
vars
,
15
)),
# 默认查看前15行
multiple
=
TRUE
,
selectize
=
FALSE
,
size
=
min
(
15
,
length
(
vars
))
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment