Nab-iak's Blog

[PIN] RNA-seq Analysis Service from University of Tsukuba

Mon, 18 Apr 3025 00:00:00 GMT

Cover Pic by @Rafa

This RNA-seq analysis services as a part of the Open Facility Program, University of Tsukuba.
If you wish to proceed with the request below, please contact to us. The person in charge will respond with the shipping address and other instructions.
Note: Samples will not be returned. Thank you for your understanding.

</br> <center><h4>Shipping Address</h4></center>

Sport Medicine Laboratory Room 060, Medical Sciences Building, University of Tsukubaa 1-1-1 Tennodai, Tsukuba, Ibaraki 305-8577, Japan
Email: rnaseq.sugasawalab.tsukuba ※ gmail.com
(please replace ※ with @)

<center>Plan 1: from Extraction and Purification to Data Analysis</center>

<center><h4>- 44,300 yen/sample -</h4></center> <center><h4>- or 311.13 dollar/sample (2025.4.17) -</h4></center>

Sample

Please submit either tissue or a homogenized solution (e.g., processed with TRIZOL, QIAZOL, or ISOGEN)

<center>Plan 2: from Purified RNA to Data Analysis</center>

<center><h4>- 37,150 yen/sample -</h4></center> <center><h4>- or 260.91 dollar/sample (2025.4.17) -</h4></center>

Sample

The submitted total RNA solution must meet the following criteria:
- A260/230 ratio ≥ 1.6
- A260/280 ratio ≥ 1.8
A total of 1.5–3 μg of RNA at a concentration of 50–100 ng/μL is required for each sample.

Note

Please submit at least 3–4 μg of total RNA if possible. If the amount is less than 3 μg, library preparation may not be feasible.
If your sample does not meet the above requirements, please contact us. We may be able to accommodate samples with low concentration or poor quality.

<center>Plan 3: from Quality-checked RNA to Data Analysis</center>

<center><h4>- 25,020 yen/sample -</h4></center> <center><h4>- or 175.72 dollar/sample (2025.4.17) -</h4></center>

Sample

The submitted total RNA solution after purification must meet the following criteria:
- A260/230 ratio ≥ 1.6
- A260/280 ratio ≥ 1.8
Confirm that RNA degradation is absent or minimal in all samples using either standard gel electrophoresis (agarose gel for DNA in TAE buffer) or a Bioanalyzer.
- For gel electrophoresis, a 28S/18S ratio of 1.6–1.8 with no smearing is ideal.
- For Bioanalyzer, RIN ≥ 7 is recommended.
Adjust RNA concentration to 100 ng/μL and ensure a total yield of 3-4 ng/μL of RNA remains.
A total yield of at least 30 μL is required for each sample.

Note

Even if the total yield of RNA is lower than specified, request is still possible, but please note that it increases the risk of library preparation failure. Feel free to contact us for support, including guidance for gel electrophoresis.
If you require frequent support for data analysis, we may propose proceeding as a collaborative research project with the Department of Sports Medicine Analytics. Final decisions will be made based on your preferences.

<center>Plan 4: from Quality-checked RNA to FASTQ Delivery</center>

<center><h4>- 20,940 yen/sample -</h4></center> <center><h4>- or 147.07 dollar/sample (2025.4.17) -</h4></center>

Sample

The submitted total RNA solution after purification must meet the following criteria:
- A260/230 ratio ≥ 1.6
- A260/280 ratio ≥ 1.8
Confirm that RNA degradation is absent or minimal in all samples using either standard gel electrophoresis (agarose gel for DNA in TAE buffer) or a Bioanalyzer.
- For gel electrophoresis, a 28S/18S ratio of 1.6–1.8 with no smearing is ideal.
- For Bioanalyzer, RIN ≥ 7 is recommended.
Adjust RNA concentration to 100 ng/μL and ensure a total yield of 3-4 ng/μL of RNA remains.
A total yield of at least 30 μL is required for each sample.

Note

Even if the total yield of RNA is lower than specified, request is still possible, but please note that it increases the risk of library preparation failure. Feel free to contact us for support, including guidance for gel electrophoresis.
If you require frequent support for data analysis, we may propose proceeding as a collaborative research project with the Department of Sports Medicine Analytics. Final decisions will be made based on your preferences.

<center>Bioinformatics Analysis Support</center>

<center><h4>- 4,010 yen/sample -</h4></center> <center><h4>- or 28.16 dollar/sample (2025.4.17) -</h4></center>

Our department provides bioinformatics analysis support using data obtained from next-generation sequencing. Based on a hearing with the requester, we conduct tailored analyses and prepare figures and tables accordingly.
Please note that we may be unable to perform analyses that exceed the technical capacity of our department. For users of our RNA-seq service, please use this request form if you wish to request re-analysis more than one month after data delivery.
Supported analyses: RNA-seq, ChIP-seq, and genomic DNA-seq (regularly updated).
Accepted data formats: FASTQ, expression quantification data (TPM, RPKM, read count data, etc.).
Supported species: Mammals such as human, mouse, and rat, as well as bacteria.
Tools/software used: CLC Genomics Workbench, R, Python, GeneMANIA, Metascape, DAVID, GSEA, and others (continually updated).
Available visualizations: Expression quantification, hierarchical clustering, heatmaps, pathways, Gene Ontology (GO), scatter plots, volcano plots, and mutation identification.

倾向得分匹配（PSM）

Wed, 10 Sep 2025 00:00:00 GMT

Cover Pic by @BISQQQUE

参考

傾向スコア解析(1)：ロジスティック回帰モデルで傾向スコア（propensity score）を推定する [R]
傾向スコア解析(2)：傾向スコアを使った逆確率重み付け法（IPW）で交絡を調整する [R]
傾向スコア解析(3)：傾向スコアマッチング（PSM）を使って交絡を調整する [R]

(IDE中途从vscode换成了positron了，输出没有了html格式)

使用倾向得分调整混淆变量的方法

匹配
分层
以倾向得分为变量的回归模型
逆概率加权法

示例数据

加载R包和数据

library(tidyverse) # Basic tidy R style
library(tableone) # Group comparision
library(PSAgraphics) # Dataset
library(MatchIt) # PSM

data("lindner")

变量调整：增加death，表示是否死亡

dt <- lindner %>% 
	mutate(death = if_else(lifepres==0,1,0))
head(dt)

<table class="dataframe"> <caption>A data.frame: 6 x 11</caption> <thead> <tr><th></th><th scope=col>lifepres</th><th scope=col>cardbill</th><th scope=col>abcix</th><th scope=col>stent</th><th scope=col>height</th><th scope=col>female</th><th scope=col>diabetic</th><th scope=col>acutemi</th><th scope=col>ejecfrac</th><th scope=col>ves1proc</th><th scope=col>death</th></tr> <tr><th></th><th scope=col><dbl></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><th scope=row>1</th><td> 0.0</td><td>14301</td><td>1</td><td>0</td><td>163</td><td>1</td><td>1</td><td>0</td><td>56</td><td>1</td><td>1</td></tr> <tr><th scope=row>2</th><td>11.6</td><td> 3563</td><td>1</td><td>0</td><td>168</td><td>0</td><td>0</td><td>0</td><td>56</td><td>1</td><td>0</td></tr> <tr><th scope=row>3</th><td>11.6</td><td> 4694</td><td>1</td><td>0</td><td>188</td><td>0</td><td>0</td><td>0</td><td>50</td><td>1</td><td>0</td></tr> <tr><th scope=row>4</th><td>11.6</td><td> 7366</td><td>1</td><td>0</td><td>175</td><td>0</td><td>1</td><td>0</td><td>50</td><td>1</td><td>0</td></tr> <tr><th scope=row>5</th><td>11.6</td><td> 8247</td><td>1</td><td>0</td><td>168</td><td>1</td><td>0</td><td>0</td><td>55</td><td>1</td><td>0</td></tr> <tr><th scope=row>6</th><td>11.6</td><td> 8319</td><td>1</td><td>0</td><td>178</td><td>0</td><td>0</td><td>0</td><td>50</td><td>1</td><td>0</td></tr> </tbody> </table>

death：经皮冠状动脉介入治疗（PCI）后6个月的预后（0=生存, 1=死亡）
abcix：有无使用abciximab（0=PCI, 1=PCI+abciximab）
stent：有无留置冠动脉支架（0=无, 1=有）
height：身長（cm）
female：性別（0=男性, 1=女性）
diabetic：有无糖尿病（0=无, 1=有）
acutemi：7天以内有无急性心肌梗塞（0=无, 1=有）
ejecfrac：左心室收缩率（%）
ves1proc：病变血管数量
查看组间的差异

table_crude <- CreateTableOne(
	vars = c(
		"stent", "height", "female", 
        "diabetic", "acutemi", "ejecfrac", 
        "ves1proc","death"
	),
	   factorVars = c(
		   "stent", "female", "diabetic", 
		   "acutemi","death"
	   ),
	   strata = "abcix",
	   data = dt,
	   test = FALSE,
	   smd = TRUE)
print(table_crude, smd = TRUE)

Stratified by abcix
                       0              1              SMD   
  n                       298            698               
  stent = 1 (%)           174 (58.4)     492 (70.5)   0.255
  height (mean (SD))   171.45 (10.59) 171.44 (10.69) <0.001
  female = 1 (%)          115 (38.6)     231 (33.1)   0.115
  diabetic = 1 (%)         80 (26.8)     143 (20.5)   0.150
  acutemi = 1 (%)          18 ( 6.0)     125 (17.9)   0.372
  ejecfrac (mean (SD))  52.29 (10.30)  50.40 (10.42)  0.182
  ves1proc (mean (SD))   1.20 (0.48)    1.46 (0.71)   0.427
  death = 1 (%)            15 ( 5.0)      11 ( 1.6)   0.194

使用逻辑回归估计倾向得分

逻辑回归估计

过程很简单，就是先建立逻辑回归模型，
再用模型重新预测元数据集得到样本的预测结果及预测概率

ps_model <- glm(
	abcix ~ stent + height + female + 
		diabetic + acutemi + ejecfrac + ves1proc, 
	data = dt, 
	family = binomial(link="logit")
)

dt <- dt %>%
	mutate(
		ps_logit = predict(ps_model, type = "link"),
		ps = predict(ps_model, type = "response")
)

head(dt)

<table class="dataframe"> <caption>A data.frame: 6 x 13</caption> <thead> <tr><th></th><th scope=col>lifepres</th><th scope=col>cardbill</th><th scope=col>abcix</th><th scope=col>stent</th><th scope=col>height</th><th scope=col>female</th><th scope=col>diabetic</th><th scope=col>acutemi</th><th scope=col>ejecfrac</th><th scope=col>ves1proc</th><th scope=col>death</th><th scope=col>ps_logit</th><th scope=col>ps</th></tr> <tr><th></th><th scope=col><dbl></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><th scope=row>1</th><td> 0.0</td><td>14301</td><td>1</td><td>0</td><td>163</td><td>1</td><td>1</td><td>0</td><td>56</td><td>1</td><td>1</td><td>-0.37258319</td><td>0.4079170</td></tr> <tr><th scope=row>2</th><td>11.6</td><td> 3563</td><td>1</td><td>0</td><td>168</td><td>0</td><td>0</td><td>0</td><td>56</td><td>1</td><td>0</td><td> 0.31645572</td><td>0.5784602</td></tr> <tr><th scope=row>3</th><td>11.6</td><td> 4694</td><td>1</td><td>0</td><td>188</td><td>0</td><td>0</td><td>0</td><td>50</td><td>1</td><td>0</td><td> 0.09786545</td><td>0.5244469</td></tr> <tr><th scope=row>4</th><td>11.6</td><td> 7366</td><td>1</td><td>0</td><td>175</td><td>0</td><td>1</td><td>0</td><td>50</td><td>1</td><td>0</td><td>-0.10918387</td><td>0.4727311</td></tr> <tr><th scope=row>5</th><td>11.6</td><td> 8247</td><td>1</td><td>0</td><td>168</td><td>1</td><td>0</td><td>0</td><td>55</td><td>1</td><td>0</td><td>-0.02781550</td><td>0.4930466</td></tr> <tr><th scope=row>6</th><td>11.6</td><td> 8319</td><td>1</td><td>0</td><td>178</td><td>0</td><td>0</td><td>0</td><td>50</td><td>1</td><td>0</td><td> 0.25152728</td><td>0.5625524</td></tr> </tbody> </table>

ps为倾向得分
ps_logit为倾向得分的logit变换值
通过对两组的可视化也可以看出，接受治疗的组的倾向得分更高

ggplot(aes(x = ps, fill = factor(abcix)), data=dt) +
	geom_density(alpha=.25) +
	theme_bw()

ROC曲线

做ROC曲线看拟合程度

library(pROC)
roc_ps <- roc(abcix ~ ps_logit, data = dt, ci = TRUE)
ggroc(
	roc_ps,
	size = 1,
	legacy.axes = TRUE
) +
	geom_abline(color="dark grey", size=0.5) +
	theme_bw()

查看ROC-AUC

roc_ps

Call:
roc.formula(formula = abcix ~ ps_logit, data = dt, ci = TRUE)

Data: ps_logit in 298 controls (abcix 0) < 698 cases (abcix 1).
Area under the curve: 0.6807
95% CI: 0.6457-0.7156 (DeLong)

AUC
- AUC过低表明预测能力不足
- AUC过高则显示其中一组更容易预测，
  会导致再另一组中难以匹配到对应个体
- 0.6–0.8的范围内比较合适

Hosmer-Lemeshow检验

检验模型拟合程度的方法
$H_0$：预测值与观测值是一致的

library(ResourceSelection)
hoslem.test(
	dt$abcix,
	fitted(ps_model),
	g=10
)


	Hosmer and Lemeshow goodness of fit (GOF) test

data:  dt$abcix, fitted(ps_model)
X-squared = 8.7059, df = 8, p-value = 0.3677

本事例中 p = 0.3677 > 0.05，
可以认为模型拟合得没有问题

使用倾向得分的逆概率加权法（IPW）

权重的计算

Average Treatment Effect (ATE)
$$w_i = \frac{Z_i}{p_{1i}} + \frac{1-Z_i}{1-p_{1i}}$$
Average Treatment Effect on the Treated (ATT)
$$w_i = Z_i + (1-Z_i)\frac{p_{1i}}{1-p_{1i}}$$
使用ATE计算权重

dt <- dt %>%
  mutate(wt = if_else(abcix==1,1/ps,1/(1-ps)))

极端权重值的对应方法

方法
- 重新考虑是否使用倾向得分模型
- 使用倾向得分进行其他的分析
- 权重截断（weight truncation）
- 稳定权重（stabilized weight）
权重截断
- 这里将0.99以上的权重值改为0.99

dt <- dt %>%
	mutate(
		wt_trun = if_else(
			wt > quantile(wt, prob = 0.99),
			quantile(wt, prob = 0.99),
			wt
		)
	)

稳定权重
- 在ATE的基础上分别乘以概率的均值
  $$w_i = c_1 \frac{Z_i}{p_{1i}} + c_0 \frac{1-Z_i}{1-p_{1i}}$$

dt <- dt %>%
  mutate(c1 = mean(ps), 
         c0 = mean(1-ps),
         wt_stab = if_else(abcix==1,wt*c1,wt*c0))

对3种加权方式的比较

res <- dt %>% 
	pivot_longer(
		cols=c(wt,wt_trun,wt_stab),
		names_to = "wt_type", 
		values_to = "weight") %>%
	group_by(wt_type) %>%
	do(
		plots = 
			ggplot(data=., aes(x=weight)) +
				geom_density(aes(colour=factor(abcix))) +
				scale_x_continuous(limits = c(0,10)) + 
				ggtitle(.$wt_type) + 
				theme_bw()
	)
res[[2]]

`WeightIt`包的一步到位

weightit()

library(WeightIt)
wt_out <- weightit(
	abcix ~ stent + height + female + diabetic + acutemi + ejecfrac + ves1proc,
	data = dt, 
	estimand = "ATE", 
	method = "ps",
	stabilize = FALSE
)

结果出存在wt_out$weights中
summary()可以查看汇总信息
- 权重范围
- 按分组给出5个极端权重值
- 权重统计值
  - Coef of Var：变异系数，
    衡量权重的相对离散程度；
    值越大，说明权重差异越大
  - MAD：平均绝对离差，
    衡量权重偏离其均值的平均距离
  - Entropy：熵，
    衡量权重分布的均匀性；
    熵值越小，说明权重分布越不均匀
- 有效样本量（ESS）
  - $$ESS = \frac{(\sum w_i)^2}{\sum w_i^2}$$

summary(wt_out)

[4mSummary of weights[24m

- [3mWeight ranges[23m:

           Min                                   Max
treated 1.0204 |-|                            3.2033
control 1.3027  |--------------------------| 23.9979

- [3mUnits with the 5 most extreme weights by group[23m:
                                                
              34      80      93      72      22
 treated  2.4968  2.5399  2.6684   2.673  3.2033
             988     995     978     993     979
 control 14.8467 15.1977 15.6449 18.0062 23.9979

- [3mWeight statistics[23m:

        Coef of Var   MAD Entropy # Zeros
treated       0.200 0.154   0.019       0
control       0.703 0.368   0.153       0

- [3mEffective Sample Sizes[23m:

           Control Treated
Unweighted  298.    698.  
Weighted    199.68  671.09

`cobalt`包检查权重平衡

由于上面的summary()结果只关注权重本身，
还需要使用 cobalt 包来检查加权后协变量是否真的达到了平衡
- "m"：標準化平均差；
  对于连续变量，这是两组的均值之差；
  对于二元变量，这是两组的比例之差
- "V"：分散比；
  计算处理组和控制组协变量的方差之比，只对连续变量有意义
- binary = "std": 这个参数指定了如何处理二元变量（Binary variables）；
  "std" 表示计算标准化的均值差异（ SMD）；
  这是目前最推荐和最常用的做法

library(cobalt)
bal.tab(
	wt_out, 
	stats = c("m","v"), 
	binary = "std"
)

[4mBalance Measures[24m
               Type Diff.Adj V.Ratio.Adj
prop.score Distance  -0.0192      0.9373
stent        Binary   0.0062           .
height      Contin.  -0.0120      0.8409
female       Binary   0.0217           .
diabetic     Binary  -0.0517           .
acutemi      Binary  -0.0032           .
ejecfrac    Contin.  -0.0005      0.9475
ves1proc    Contin.  -0.0736      0.9061

[4mEffective sample sizes[24m
           Control Treated
Unadjusted  298.    698.  
Adjusted    199.68  671.09

`MatchIt`包检查权重平衡

MatchIt包多用于PSM，
也可以通过设置method = NULL及s.weights来检查权重平衡
summary()之后可以获得评估结果
- Means Treated与Means Control：
  加权后，处理组和控制组中各个协变量的均值
- Std. Mean Diff.：SMD
- Var. Ratio：方差比
- eCDF Mean / eCDF Max：
  经验累积分布函数（Empirical Cumulative Distribution Function）
  的均值差异和最大差异
  - 越接近0越好
- Matched / Unmatched / Discarded:
  因为没有执行任何匹配操作，
  所以所有数据都被认为是匹配的，没有未匹配或丢弃的数据

library(MatchIt)

wt_tab <- matchit(
	abcix ~ stent + height + female + diabetic + acutemi + ejecfrac + ves1proc,
        data = dt, 
        method = NULL, 
        s.weights = wt_out$weights
)

summary(wt_tab)


Call:
matchit(formula = abcix ~ stent + height + female + diabetic + 
    acutemi + ejecfrac + ves1proc, data = dt, method = NULL, 
    s.weights = wt_out$weights)

Summary of Balance for All Data:
         Means Treated Means Control Std. Mean Diff. Var. Ratio eCDF Mean
distance        0.4981        0.4964          0.0865     0.9000    0.0187
stent           0.6702        0.6673          0.0063          .    0.0029
height        171.4044      171.5317         -0.0120     0.8409    0.0087
female          0.3438        0.3334          0.0219          .    0.0104
diabetic        0.2228        0.2447         -0.0526          .    0.0219
acutemi         0.1433        0.1443         -0.0029          .    0.0010
ejecfrac       50.9431       50.9481         -0.0005     0.9475    0.0133
ves1proc        1.3840        1.4284         -0.0670     0.9061    0.0078
         eCDF Max
distance   0.0492
stent      0.0029
height     0.0376
female     0.0104
diabetic   0.0219
acutemi    0.0010
ejecfrac   0.0422
ves1proc   0.0280

Sample Sizes:
              Control Treated
All (ESS)      199.68  671.09
All            298.    698.  
Matched (ESS)  199.68  671.09
Matched        298.    698.  
Unmatched        0.      0.  
Discarded        0.      0.

估计治疗效果

使用survey包中的svyglm()函数来执行带权重的稳健标准误差估计广义线性回归

library(survey)

dsgn_wt <- svydesign(~1, weights = wt_out$weights, data = dt)

fit <- svyglm(
	death ~ abcix, 
	design = dsgn_wt,
	# 使用quasibinomial避免关于非整数成功次数的警告
	family = quasibinomial(link = "logit")
)
              
summary(fit)

Call:
svyglm(formula = death ~ abcix, design = dsgn_wt, family = quasibinomial(link = "logit"))

Survey design:
svydesign(~1, weights = wt_out$weights, data = dt)

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  -2.4250     0.3918  -6.190  8.8e-10 ***
abcix        -1.7471     0.5031  -3.472 0.000538 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for quasibinomial family taken to be 1.001005)

Number of Fisher Scoring iterations: 7

`MatchIt`包进行倾向得分匹配

确定协变量的平衡性

内容和之前的MatchIt包检查权重平衡相似
- 只是没有指定s.weights参数

library(MatchIt)

unmatched <- matchit(
	abcix ~ stent + height + female + diabetic + acutemi + ejecfrac + ves1proc,
	data = dt, 
	method = NULL
)

summary(unmatched)

Call:
matchit(formula = abcix ~ stent + height + female + diabetic + 
    acutemi + ejecfrac + ves1proc, data = dt, method = NULL)

Summary of Balance for All Data:
         Means Treated Means Control Std. Mean Diff. Var. Ratio eCDF Mean
distance        0.7265        0.6406          0.6609     1.1161    0.1714
stent           0.7049        0.5839          0.2652          .    0.1210
height        171.4427      171.4463         -0.0003     1.0201    0.0079
female          0.3309        0.3859         -0.1168          .    0.0550
diabetic        0.2049        0.2685         -0.1575          .    0.0636
acutemi         0.1791        0.0604          0.3095          .    0.1187
ejecfrac       50.4026       52.2886         -0.1810     1.0238    0.0356
ves1proc        1.4628        1.2047          0.3654     2.1614    0.0433
         eCDF Max
distance   0.2760
stent      0.1210
height     0.0250
female     0.0550
diabetic   0.0636
acutemi    0.1187
ejecfrac   0.1138
ves1proc   0.1884

Sample Sizes:
          Control Treated
All           298     698
Matched       298     698
Unmatched       0       0
Discarded       0       0

构建倾向得分匹配过的队列

matchit()函数
- method：匹配方法
  - "nearest"：最近邻匹配
- distance：观测间得分距离
  - "mahalanobis"：马哈拉诺比斯距离 / 马氏距离
- estimand：估计方法
  - "ATT"：对于那些接受了abcix治疗的患者，这个治疗到底有多大效果
- replace：是否允许重复匹配
- ratio：匹配比例，1为一对一匹配
- caliper：
  匹配观测间距离的SD阈值；
  小于改阈值的观测将被匹配；
  例如设置为0.2的情况时，距离小于0.2个SD的观测被匹配

matched_1 <- matchit(
	abcix ~ stent + height + female + diabetic + acutemi + ejecfrac + ves1proc,
	data = dt,
	method = "nearest",
	distance = "glm",
	link = "logit",
	estimand = "ATT",
	replace = FALSE,
	ratio = 1,
	seed = 42
)

summary(matched_1)

Warning message:
"Fewer control units than treated units; not all treated units will get
a match."


Call:
matchit(formula = abcix ~ stent + height + female + diabetic + 
    acutemi + ejecfrac + ves1proc, data = dt, method = "nearest", 
    distance = "glm", link = "logit", estimand = "ATT", replace = FALSE, 
    ratio = 1, seed = 42)

Summary of Balance for All Data:
         Means Treated Means Control Std. Mean Diff. Var. Ratio eCDF Mean
distance        0.7265        0.6406          0.6609     1.1161    0.1714
stent           0.7049        0.5839          0.2652          .    0.1210
height        171.4427      171.4463         -0.0003     1.0201    0.0079
female          0.3309        0.3859         -0.1168          .    0.0550
diabetic        0.2049        0.2685         -0.1575          .    0.0636
acutemi         0.1791        0.0604          0.3095          .    0.1187
ejecfrac       50.4026       52.2886         -0.1810     1.0238    0.0356
ves1proc        1.4628        1.2047          0.3654     2.1614    0.0433
         eCDF Max
distance   0.2760
stent      0.1210
height     0.0250
female     0.0550
diabetic   0.0636
acutemi    0.1187
ejecfrac   0.1138
ves1proc   0.1884

Summary of Balance for Matched Data:
         Means Treated Means Control Std. Mean Diff. Var. Ratio eCDF Mean
distance        0.8517        0.6406          1.6242     0.2455    0.4407
stent           0.7852        0.5839          0.4414          .    0.2013
height        171.4295      171.4463         -0.0016     1.1500    0.0109
female          0.2919        0.3859         -0.1997          .    0.0940
diabetic        0.1644        0.2685         -0.2577          .    0.1040
acutemi         0.4128        0.0604          0.9190          .    0.3523
ejecfrac       47.7953       52.2886         -0.4313     1.2340    0.0800
ves1proc        1.9228        1.2047          1.0170     2.7619    0.1197
         eCDF Max Std. Pair Dist.
distance   0.8289          1.6242
stent      0.2013          0.9123
height     0.0403          1.0803
female     0.0940          0.8986
diabetic   0.1040          0.7400
acutemi    0.3523          1.0065
ejecfrac   0.2315          1.0980
ves1proc   0.5134          1.1405

Sample Sizes:
          Control Treated
All           298     698
Matched       298     298
Unmatched       0     400
Discarded       0       0

查看匹配后的协变量平衡性

在上面summary()后的结果中
- Summary of Balance for All Data：
  匹配前的数据平衡性
- Summary of Balance for Matched Data：
  匹配后的数据平衡性
- Percent Balance Improvement：
  匹配前后数据平衡性的各指标改善百分比
- Sample Sizes：
  匹配的队列中选择的观测数

可视化匹配结果

散点图

plot(matched_1, type = "jitter")

密度分布图

plot(matched_1, type = "density")

QQ图（仅对连续变量）

plot(
	matched_1, 
	type = "qq", 
	which.xs = c("height", "ejecfrac", "ves1proc")
)

eCDF图（仅对连续变量）

plot(
	matched_1, 
	type = "ecdf", 
	which.xs = c("height", "ejecfrac", "ves1proc")
)

使用cobalt包可以对SMD进行可视化

library(cobalt)
love.plot(matched_1, threshold = 0.15, abs = TRUE, stars = "raw")

估计治疗效果

match.data()能够将匹配后的各种参数合并到原数据集中
- distance：与倾向得分ps相同，用于匹配
- weights: 匹配权重（这里全为1，表示1:1匹配）
- subclass：匹配后的配对编号

m.out_1 <- match.data(matched_1)
head(m.out_1)

lifepres cardbill abcix stent height female diabetic acutemi ejecfrac ves1proc death ps_logit        ps       wt
367      0.0    14990     1     1    157      1        1       0       45        2     1 1.215812 0.7713257 1.296469
369      0.0    96741     1     1    171      0        0       0       29        1     1 1.242675 0.7760293 1.288611
370     11.6     7616     1     1    168      1        0       0       51        2     0 1.364860 0.7965484 1.255416
371     11.6     7664     1     0    173      0        0       1       55        1     0 1.453961 0.8106073 1.233643
374     11.6     8321     1     0    180      0        0       1       60        1     0 1.272454 0.7811625 1.280143
375     11.6     8389     1     0    170      1        0       1       55        1     0 1.141000 0.7578631 1.319499
     wt_trun        c1        c0   wt_stab  distance weights subclass
367 1.296469 0.7008032 0.2991968 0.9085698 0.7713257       1        1
369 1.288611 0.7008032 0.2991968 0.9030628 0.7760293       1        2
370 1.255416 0.7008032 0.2991968 0.8797999 0.7965484       1        3
371 1.233643 0.7008032 0.2991968 0.8645409 0.8106073       1        4
374 1.280143 0.7008032 0.2991968 0.8971286 0.7811625       1        5
375 1.319499 0.7008032 0.2991968 0.9247094 0.7578631       1        6

使用上面match.data()过后的m.out_1直接进行glm(),
就能过获得估计后的治疗效果

fit <- glm(death ~ abcix, data = m.out_1,
           family = binomial(link = "logit"),
           # 添加权重即可
           weights = weights)
summary(fit)

Call:
glm(formula = death ~ abcix, family = binomial(link = "logit"), 
    data = m.out_1, weights = weights)

Coefficients:
            Estimate Std. Error z value Pr(>|z|)    
(Intercept)  -2.9374     0.2650 -11.086   <2e-16 ***
abcix        -0.7900     0.4653  -1.698   0.0895 .  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 188.34  on 595  degrees of freedom
Residual deviance: 185.25  on 594  degrees of freedom
AIC: 189.25

Number of Fisher Scoring iterations: 6

为了进行更好的估计，推荐使用稳健方差估计来修正结果

library(lmtest)
library(sandwich)

coeftest(fit, vcov. = vcovCL, cluster = ~subclass)

z test of coefficients:

            Estimate Std. Error  z value Pr(>|z|)    
(Intercept) -2.93740    0.26540 -11.0679  < 2e-16 ***
abcix       -0.79002    0.45153  -1.7497  0.08018 .  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

使用logit变换的倾向得分

如果使用倾向得分的logit变换值，
需要在distance指定

# 先逻辑回归
ps_model <- glm(
	abcix ~ stent + height + female + diabetic + acutemi + ejecfrac + ves1proc, 
	data = dt, 
	family = binomial(link="logit")
)

# 获得预测的link与response值，
# link值就是logit变换值
dt <- dt %>%
	mutate(
		ps_logit = predict(ps_model, type = "link"),
		ps = predict(ps_model, type = "response")
	)

# 其他都一样，仅修改distance
matched_2 <- matchit(
	abcix ~ stent + height + female + diabetic + acutemi + ejecfrac + ves1proc,
	data = dt,
	method = "nearest",
	# 指定为ps_logit而不是glm
	distance = dt$ps_logit,
	caliper = 0.2,
	std.caliper = TRUE,
	ratio = 1,
	replace = F,
	seed = 42
	)

summary(matched_2)

Call:
matchit(formula = abcix ~ stent + height + female + diabetic + 
    acutemi + ejecfrac + ves1proc, data = dt, method = "nearest", 
    distance = dt$ps_logit, replace = F, caliper = 0.2, std.caliper = TRUE, 
    ratio = 1, seed = 42)

Summary of Balance for All Data:
         Means Treated Means Control Std. Mean Diff. Var. Ratio eCDF Mean
distance        1.1148        0.6333          0.6048     1.6720    0.1714
stent           0.7049        0.5839          0.2652          .    0.1210
height        171.4427      171.4463         -0.0003     1.0201    0.0079
female          0.3309        0.3859         -0.1168          .    0.0550
diabetic        0.2049        0.2685         -0.1575          .    0.0636
acutemi         0.1791        0.0604          0.3095          .    0.1187
ejecfrac       50.4026       52.2886         -0.1810     1.0238    0.0356
ves1proc        1.4628        1.2047          0.3654     2.1614    0.0433
         eCDF Max
distance   0.2760
stent      0.1210
height     0.0250
female     0.0550
diabetic   0.0636
acutemi    0.1187
ejecfrac   0.1138
ves1proc   0.1884

Summary of Balance for Matched Data:
         Means Treated Means Control Std. Mean Diff. Var. Ratio eCDF Mean
distance        0.7978        0.6554          0.1788     1.0395    0.0616
stent           0.6438        0.5959          0.1051          .    0.0479
height        170.7671      171.5925         -0.0772     0.9794    0.0154
female          0.3562        0.3733         -0.0364          .    0.0171
diabetic        0.1918        0.2603         -0.1697          .    0.0685
acutemi         0.0719        0.0616          0.0268          .    0.0103
ejecfrac       51.5240       52.1301         -0.0582     0.9932    0.0222
ves1proc        1.2740        1.2123          0.0873     1.2880    0.0137
         eCDF Max Std. Pair Dist.
distance   0.1747          0.1798
stent      0.0479          0.6157
height     0.0616          1.0218
female     0.0171          0.7933
diabetic   0.0685          0.5940
acutemi    0.0103          0.2233
ejecfrac   0.0822          0.8556
ves1proc   0.0651          0.3589

Sample Sizes:
          Control Treated
All           298     698
Matched       292     292
Unmatched       6     406
Discarded       0       0

快速变量编码转换函数

Mon, 11 Aug 2025 00:00:00 GMT

Cover Pic by @MOJE末杰

简介

对于一些问卷调查的结果，大概率原始的编码给的都不是你想要的样子
- 比如有无的1/0编码可能被弄成1/2
- 有序变量的顺序也可能与实际分析的顺序相反
本函数通过传递一个转换规则矩阵，可以实现一键变量编码转换

`autoTx`：一键转换变量编码

函数功能：一键转换变量编码
函数参数：
- x：待转换的数据集
- t：转换规则矩阵
- var：x中需要转换的变量的列名
- valOld：变量的旧编码
- valNew：变量转换后的新编码
函数返回值：转换后的数据集
原始函数

autoTx <- function(x, t, var, valOld, valNew) {
  require(dplyr)
  require(tidyr)
  require(tibble)
  require(rlang)

  var_sym <- sym(var)
  valOld_sym <- sym(valOld)
  valNew_sym <- sym(valNew)

  tt <- t %>% fill(!!var_sym, .direction = 'down')

  for (v in unique(tt[[var]])) {
    recode_map <- tt %>%
      filter(!!var_sym == v) %>%
      select(!!valOld_sym, !!valNew_sym) %>%
      deframe()

    if (length(recode_map) == 0) {
      warning(glue::glue("No mapping found for variable '{v}', skipping."))
      next
    }

    if (!(v %in% names(x))) {
      warning(glue::glue("Variable '{v}' not in x, skipping."))
      next
    }

    x[[v]] <- recode(x[[v]], !!!recode_map)
  }

  return(x)
}

示例

x是待转换的数据
trans是转换规则矩阵

x <- data.frame(
    a = c(1, 2, 1, 2, 1, 3, 0),
    b = c(10, 20, 5, 10, 100, 20, 10)
)

trans <- data.frame(
    vars = c("a", NA, "b", NA, NA),
    val_old = c(1, 2, 5, 10 ,20),
    val_new = c(1, 0, 1 ,2, 3)
)

x; trans

<table class="dataframe"> <caption>A data.frame: 7 x 2</caption> <thead> <tr><th scope=col>a</th><th scope=col>b</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>1</td><td> 10</td></tr> <tr><td>2</td><td> 20</td></tr> <tr><td>1</td><td> 5</td></tr> <tr><td>2</td><td> 10</td></tr> <tr><td>1</td><td>100</td></tr> <tr><td>3</td><td> 20</td></tr> <tr><td>0</td><td> 10</td></tr> </tbody> </table>

<table class="dataframe"> <caption>A data.frame: 5 x 3</caption> <thead> <tr><th scope=col>vars</th><th scope=col>val_old</th><th scope=col>val_new</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>a </td><td> 1</td><td>1</td></tr> <tr><td>NA</td><td> 2</td><td>0</td></tr> <tr><td>b </td><td> 5</td><td>1</td></tr> <tr><td>NA</td><td>10</td><td>2</td></tr> <tr><td>NA</td><td>20</td><td>3</td></tr> </tbody> </table>

autoTx(
    x, 
    trans, 
    var = "vars", 
    valOld = "val_old", 
    valNew = "val_new"
)

<table class="dataframe"> <caption>A data.frame: 7 x 2</caption> <thead> <tr><th scope=col>a</th><th scope=col>b</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>1</td><td> 2</td></tr> <tr><td>0</td><td> 3</td></tr> <tr><td>1</td><td> 1</td></tr> <tr><td>0</td><td> 2</td></tr> <tr><td>1</td><td>100</td></tr> <tr><td>3</td><td> 3</td></tr> <tr><td>0</td><td> 2</td></tr> </tbody> </table>

在规则转换矩阵里的变量以及旧编码会被转换，
不存在的会直接保留原样

公共卫生PhD技能清单

Mon, 04 Aug 2025 00:00:00 GMT

Cover Pic by @Rafa

英文原文：Defining methodologic and other core competencies for PhD-level training in epidemiology
中文翻译：流行病学与卫生统计学专业硕士/博士生训练应具备的方法学知识和能力

描述人群健康状况，包括比较不同人群的健康状况

1.1 提出优质问题

区分描述性、预测性和病因学研究问题；
能够定义研究问题 / 阐明估计目标；对于因果问题，相关框架可能包括：
- PICOT（人群、干预措施、对照、结局、时间）
- FINER 标准（可行、有趣、新颖、符合伦理、相关）
基本因果概念：
- 传统 / 历史方法（例如布拉德福德・希尔准则）
- 现代方法（如充分病因和组分病因、反事实理论）

1.2 人、地点、时间

描述性流行病学
- 数据汇总和描述性统计
- 相关性
- 图表类型（直方图、箱线图、条形图、散点图）
- 分布度量
- 均值、中位数
- 方差、标准差
- Z 分数
人口调查
年龄、时期、队列效应
寿命表方法
目标人群
人群类型
- 封闭和开放人群
- 稳态
- 源人群
- 研究人群
抽样方法
- 简单随机抽样
- 系统抽样
- 整群 / 多阶段抽样
- 非概率抽样
普遍性、代表性、可推广性

1.3 疾病监测

疾病传播动力学
地方性流行、流行病、大流行
暴发调查（现场流行病学）
发病率、续发率
社区保护（群体免疫）
疾病监测项目
主动监测
被动监测
症状监测
哨点健康事件
国家和国际疾病监测项目

1.4 数据收集和数据来源

原始数据与二手数据
大数据来源
电子健康记录
行政数据
记录链接
健康索赔数据库
人口调查数据
不同类型暴露、结局、协变量的测量
疾病分类系统（如国际疾病分类第十版）
测量人群健康的挑战
问卷设计

1.5 发生的测量指标

发病率
发病密度
人年计算
累积发病率
病死率
疾病特异性死亡率
比例死亡率比（Proportionate mortality ratio）
时点患病率，时期患病率
发病率与患病率的关系

1.6 关联和影响的测量指标（包括计算与解释）

相对测量指标
Risk ratio
Rate ratio
Odds ratio
不可折叠性
绝对测量指标
Risk difference
Rate difference
Number needed to treat or harm
归因风险，归因分数
人群归因风险（Population attributable risk，PAR%）
指标间的概念差异
标准化
直接标准化
间接标准化

1.7 生物统计学

概率分布
正态分布
二项分布
泊松分布
离散和连续随机变量
随机变量的期望与方差
随机变异
目标参数（estimand）和估计量（estimator）
一致/相合估计量
超总体（super-populations）
维度灾难
标准误
假设检验
P值的理解和解释
参数检验/非参数检验
频率学派/贝叶斯视角
置信区间
检验效能和样本量
精确度
信度的测量
评分者间信度、评分者内信度
内部一致性
重测信度
一致性的测量（统计、图形、表格方法）
效度的测量
内容效度
效标效度
结构效度
ROC曲线
灵敏度、特异度、阳性预测值、阴性预测值
似然比

1.8 研究设计

实验性研究/观察性研究
随机对照试验
临床均势（equipoise）
安慰剂对照
阳性对照
优效性，等效性，非劣效性试验
可行性，伦理
随机化类型
分层
区组
群（cluster）
分配隐藏
盲法类型
依从性
效力 vs. 效果
意向性分析，符合方案分析，实际接受治疗的分析
期中分析与停止规则，数据安全监查委员会（DSMB）
整群随机对照试验
社区干预试验
非劣效试验
横断面研究
队列研究（前瞻性、回顾性、双向）
病例-对照研究（累积，病例队列，发病密度抽样）
病例-队列研究
病例-交叉研究
单纯病例研究
生态学研究
病例报告-病例系列
准实验研究
断点回归设计
双重差分
干预时间序列
合成控制设计
对于各个研究设计
理解其适用场景的的合理依据
优势与局限性

1.9 偏倚概述

概念性介绍
选择偏倚
混杂偏倚
测量偏倚（信息偏倚）
各类偏倚的预防
缺失数据（完全随机缺失，随机缺失，非随机缺失）

1.10 评价效应异质性

同质性与异质性概念
相加尺度/相乘尺度
交互的连续性
定量和定性分析
效应修饰
分层
评价
交互
生物学交互vs.统计学交互
联合效应框架
协同作用与拮抗作用
交互作用相对超额风险
与效应修饰的区别
公共卫生相关性
单调性

1.11 诊断，预后和筛查研究

临床和亚临床疾病
慢性疾病与传染性疾病
潜隐期和潜伏期
疾病自然史
诊断与预后
检验准确性
灵敏度、特异度、阳性预测值、阴性预测值
筛查研究
人群疾病筛查
筛查伦理学
成本效益比

分析流行病学

2.1 因果推断框架

因果效应类型
个体因果效应
平均因果效应
因果估计目标
因果vs.相关
因果响应类型
反事实理论和记号
可识别假定
可交换性
因果一致性&无干扰&SUTVA
正定性
无测量误差
因果模型误设

2.2 因果图

因果有向无环图（DAGs）
DAG术语（如弧、节点、祖先、后代、父、子、对撞子）
D-分离规则
忠实性
偏倚的结构方法
单世界干预图（SWIGs）

2.3 目标试验框架

问一个因果问题
模拟目标试验
撰写目标试验方案（计划书）
纳排标准
干预（治疗策略）
结局
随访的开始和结束
因果比较（估计目标）

2.4 混杂偏倚

混杂的结构
后门路径和前门路径
使用因果有向无环图进行定义
条件独立性
混杂选择的原理
通过研究设计进行控制
随机化
限制
匹配
通过分析方法控制
分层（包括回归调整）
标准化
针对未观测混杂因素的敏感性分析，如E-value
残余混杂
未观测混杂
过度调整（如，调整了一个中介变量）

2.5 选择偏倚

概念聚焦（从更大人群中抽样）
无偏倚的选择
偏倚的大小和方向
混杂和选择偏倚的区别
选择偏倚的结构
使用因果DAGs进行定义
有/没有碰撞节点变量的选择偏倚
零假设与非零假设下的选择偏倚
纳入样本的选择（例如，幸存者偏倚、不恰当的对照选择）
从样本中排除的选择（例如，失访）
外推性和可迁移性

2.6 测量偏倚

测量误差 vs 错误分类
使用因果DAGs进行定义
基于测量误差结构的偏倚强度和方向（差异错分/非差异错分，相关/独立）
暴露、结局、混杂、对撞节点变量的测量错误

2.7 数据分析基础

统计软件知识（SAS，R，Stata，etc）
数据结构（宽格式、长格式）
总结与描述数据（数据列表、Table 1）
编码
分类变量
虚拟变量
不相交类别编码
嵌套编码
连续型变量
重新缩放
中心化
变换
ANOVA
最大似然
最小二乘
2.8 回归模型
回归分析导论
什么是统计模型？
函数形式
包括概率在内的预测值
饱和模型/非饱和模型
粗/未校正模型，校正模型
广义线性和其他回归模型基础
线性回归
分位数回归
Logistic回归
Poisson回归
Binomial回归
解释回归模型输出，包括未校正和校正模型的结果
回归模型的后估计
预测概率
边际效应
多项式回归模型
有序回归
多项回归
回归系数的合理解释，P值，置信区间
剂量反应和趋势分析
单调性
机器学习的概念介绍，以及它和参数模型的异同之处

2.9 模型构建和拟合优度

模型构建的不同方法
先验法/基于因果DAG的方法
逐步回归，以及为何应该避免使用该法
不同方法的优势和局限
自变量建模的灵活方法/平滑方法
样条
分式多项式
模型拟合优度
似然比检验
信息标准（如AIC、BIC等）
偏倚——方差的权衡

复杂流行病学分析方法

3.1 纵向和多水平数据分析

变化的分析
时间固定和时间依赖的暴露因素和协变量
集群/相关数据
重复测量
多水平
边际模型
广义估计方程
协方差结构
混合效应/层次模型
随机效应和固定效应

3.2 生存分析

定义起点
时间尺度
离散（如人-时数据集）/连续时间数据结构
删失和截断
区间删失，左删失，右删失
生存曲线和其他描述指标（风险/累积风险/累积发生率函数）
非参数，半参数，参数生存模型
Log-rank检验
Cox比例风险回归
离散时间风险模型（如，pooled Logistic回归）
加速失效时间模型
Poisson回归
风险比的风险
竞争风险

3.3 时依性暴露

暴露评估方法
暴露负担
累积暴露
治疗策略
总是治疗/从不治疗
确定性治疗策略和随机治疗策略
动态治疗策略
序贯可交换性
时依性混杂，包括受先前暴露影响的时依性混杂/治疗混杂反馈

3.4 调整混杂因素的高级方法

边缘结构模型
G方法
g-估计/参数g-公式
逆概率加权
标准化 vs 未标准化权重
截断方法
加权诊断（图方法，数值方法）
G-估计
倾向性评分
PS分层
PS匹配
工具变量（包括孟德尔随机化）

3.5 定量偏倚分析方法

验证研究（内部验证/外部验证）
偏倚参数
确定性偏倚分析
概率偏倚分析
多重偏倚分析
未观测混杂、信息偏倚和选择偏倚的偏倚分析

3.6 变量选择和预测，特别是在高维数据背景下

变量选择技术
压缩
子集
LASSO
岭回归
维度缩减技术
交叉验证
过拟合
机器学习技术
双稳健机器学习估计量

3.7 中介分析

中介分析的传统方法
差值方法
乘积方法
因果中介分析
混杂假设
直接和间接效应
受控效应和自然效应
暴露——中介——交互
中介变量的类型
二分类
连续
多重中介
中介解释的百分比
消除比例
效应分解

流行病学研究的解释与应用，流行病学实践

4.1 研究的实际实施

公共卫生数据来源
数据管理
清理数据集
合并，追加数据集
创建变量
工作流和文档记录的最佳实践
跨数据集协调

4.2 研究伦理

历史视角与研究伦理的必要性
国际伦理准则和监管框架
机构审查委员会提交（材料）
知情同意
特殊人群（儿童、囚犯、无法提供同意的成年人）

4.3 开展与政策相关的研究

循证医学框架
证据级别
比较效果研究
政策评估
与政策相关的结果
符合条件（暴露）的人群
预期和非预期后果
CDC公共卫生评估框架
政策相关的因果推断方法
卫生技术评估

4.4 批判性评价与同行评审

如何对草稿进行批判性评价
同行评审的目的和原则
一篇写得好的批判性评价和同行评审的组成部分
如何撰写同行评审意见
Equator网络，研究报告指南

4.5 证据综合

进行文献检索
检索策略
数据库
文献管理软件
识别趋势、模式和不一致性
识别知识空白
综述的类型
叙述性综述
定性与定量综合
系统评价
meta分析
个体患者数据meta分析
网络meta分析
发表偏倚
数据综合
图形方法
异质性评价
拉贝图
合并
固定和随机效应
Dersimonian和Laird模型
亚组分析
Meta回归
解释结果
PRISMA指南
GRADE指南

4.6 基金申请书撰写：研究目的

开发研究目的
假设
基本原理
背景

4.7 基金申请书撰写：研究方法

研究人群
招募
数据来源
预试验数据
数据来源
模拟研究
测量
分析计划
样本量计算
时间安排
严谨性和可重复性
性别作为生物学变量
潜在问题和替代策略
预算编制

4.7 基金申请书撰写：描述潜在影响

创新性
意义和价值
知识转化计划

4.8 科学交流

撰写草稿（引言、方法、结果、结论）
给利益相关方的报告（如社区合作伙伴、资助方）
会议摘要
口头报告
海报展示
数据可视化
其他科学传播形式（如社交媒体、播客等）
面向非专业受众的传播

MacOS使用7zip

Mon, 28 Jul 2025 00:00:00 GMT

Cover Pic by @Pero

下载

直接官网下载，然后解压到喜欢的路径即可

https://www.7-zip.org/download.html

tar -xvf 7z2500-mac.tar.xz

写入环境变量

vim编辑环境变量配置文件（我用的.bash_profile）

vim ~/.bash_profile

按I键进入编辑模式，
把下面复制进去就行（注意替换YOURPATH为文件夹路径），
然后esc关闭编辑模式，
直接输入:wq回车保存

export PATH=$PATH:YOURPATH/7z2500-mac/:$

使用前source环境变量配置文件

source ~/.bash_profile

使用

压缩文件

# 单个文件
7zz a archive.7z a.txt

# 多个文件
7zz a archive.7z a.txt b.txt c.txt

# 递归压缩
7zz a -r archive.7z a.txt b.txt c.txt FolderA/ FolderB/

加密压缩

# 密码123

# 单个文件
7zz a -p123 archive.7z a.txt

# 多个文件
7zz a -p123 archive.7z a.txt b.txt c.txt

# 递归压缩
7zz a -p123 -r archive.7z a.txt b.txt c.txt FolderA/ FolderB/

ZIP压缩

# 单个文件
7zz a -tZip archive.7z a.txt

# 多个文件
7zz a -tZip archive.7z a.txt b.txt c.txt

# 递归压缩
7zz a -tZip -r archive.7z a.txt b.txt c.txt FolderA/ FolderB/

解压文件

# 正常解压
7z x archive.7z
7z x archive.zip

# 解压到指定目录
7z x -o/xxx archive.7z
7z x -o/xxx archive.zip

# 有密码的情况
# 正常解压，之后对话框输入密码123
7z x archive.7z 
# 直接解压
7z x -p123 archive.7z

使用missRanger插补

Fri, 25 Jul 2025 00:00:00 GMT

Cover Pic by @千机

简介

missRanger是一种基于随机森林的多元插补算法
该算法会不断迭代，直到森林的平均袋外（OOB）误差不再改善
缺失值将由最佳迭代的袋外预测值填充
- 速度很快
- 允许进行样本外应用
- 使用语法很直观：
  - missRanger(data, . ~ 1)对所有变量进行单变量插补
  - missRanger(data, Species ~ Sepal.Width)
    使用Sepal.Width来插补Species
- 适用于多种数据类型
- 将随机森林插补与预测均值匹配相结合
  - 避免了在0 - 1编码变量中出现像0.3334这样的新值，
    并有助于提高插补的方差

用法

数据准备

library(missRanger)
set.seed(42)

# 随机对iris数据集产生10%的NA值
iris_NA <- generateNA(iris, p = 0.1)

# 查看带有NA的iris数据集
head(iris_NA)

<table class="dataframe"> <caption>A data.frame: 6 x 5</caption> <thead> <tr><th></th><th scope=col>Sepal.Length</th><th scope=col>Sepal.Width</th><th scope=col>Petal.Length</th><th scope=col>Petal.Width</th><th scope=col>Species</th></tr> <tr><th></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><fct></th></tr> </thead> <tbody> <tr><th scope=row>1</th><td>5.1</td><td>3.5</td><td>1.4</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>2</th><td>4.9</td><td>3.0</td><td>1.4</td><td> NA</td><td>setosa</td></tr> <tr><th scope=row>3</th><td>4.7</td><td> NA</td><td> NA</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>4</th><td>4.6</td><td>3.1</td><td> NA</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>5</th><td>5.0</td><td> NA</td><td>1.4</td><td> NA</td><td>setosa</td></tr> <tr><th scope=row>6</th><td>5.4</td><td>3.9</td><td> NA</td><td>0.4</td><td>setosa</td></tr> </tbody> </table>

预测均值匹配

set.seed(42)
imp <- missRanger(iris_NA, num.trees = 100)
head(imp)

Missing value imputation by random forests


Variables to impute:  Sepal.Length, Sepal.Width, Petal.Length, Petal.Width, Species
Variables used to impute: Sepal.Length, Sepal.Width, Petal.Length, Petal.Width, Species

iter 1 
  |======================================================================| 100%
iter 2 
  |======================================================================| 100%
iter 3 
  |======================================================================| 100%
iter 4 
  |======================================================================| 100%

<table class="dataframe"> <caption>A data.frame: 6 x 5</caption> <thead> <tr><th></th><th scope=col>Sepal.Length</th><th scope=col>Sepal.Width</th><th scope=col>Petal.Length</th><th scope=col>Petal.Width</th><th scope=col>Species</th></tr> <tr><th></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><fct></th></tr> </thead> <tbody> <tr><th scope=row>1</th><td>5.1</td><td>3.500000</td><td>1.400000</td><td>0.2000000</td><td>setosa</td></tr> <tr><th scope=row>2</th><td>4.9</td><td>3.000000</td><td>1.400000</td><td>0.1623667</td><td>setosa</td></tr> <tr><th scope=row>3</th><td>4.7</td><td>3.222188</td><td>1.543517</td><td>0.2000000</td><td>setosa</td></tr> <tr><th scope=row>4</th><td>4.6</td><td>3.100000</td><td>1.336512</td><td>0.2000000</td><td>setosa</td></tr> <tr><th scope=row>5</th><td>5.0</td><td>3.229943</td><td>1.400000</td><td>0.2169167</td><td>setosa</td></tr> <tr><th scope=row>6</th><td>5.4</td><td>3.900000</td><td>1.485592</td><td>0.4000000</td><td>setosa</td></tr> </tbody> </table>

预测均值匹配

为了避免插补值过于精确（原本才小数点后1位数），
可以在袋外预测中添加预测均值匹配（predictive mean matching，PMM）
- pmm.k：
  在插补过程中，会为每个缺失值找到 5 个与预测均值最接近的样本，
  然后从这 5 个样本中随机选一个值来填补缺失，
  这样可以避免直接使用模型预测的精确值，
  让插补结果更贴近实际数据分布，同时增加插补的方差

set.seed(42)
imp <- missRanger(
 iris_NA, 
 pmm.k = 5, # 在预测均值匹配步骤中，用于抽样的候选非缺失值数量
 num.trees = 100, 
 verbose = 0 # 控制输出的详细程度，值为0，1，2
)
head(imp)

<table class="dataframe"> <caption>A data.frame: 6 x 5</caption> <thead> <tr><th></th><th scope=col>Sepal.Length</th><th scope=col>Sepal.Width</th><th scope=col>Petal.Length</th><th scope=col>Petal.Width</th><th scope=col>Species</th></tr> <tr><th></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><fct></th></tr> </thead> <tbody> <tr><th scope=row>1</th><td>5.1</td><td>3.5</td><td>1.4</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>2</th><td>4.9</td><td>3.0</td><td>1.4</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>3</th><td>4.7</td><td>3.2</td><td>1.5</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>4</th><td>4.6</td><td>3.1</td><td>1.3</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>5</th><td>5.0</td><td>2.8</td><td>1.4</td><td>0.5</td><td>setosa</td></tr> <tr><th scope=row>6</th><td>5.4</td><td>3.9</td><td>1.5</td><td>0.4</td><td>setosa</td></tr> </tbody> </table>

随机森林的控制

可以对随机森林的算法自行控制

set.seed(42)
imp <- missRanger(
 iris_NA, 
 pmm.k = 5, # 在预测均值匹配步骤中，用于抽样的候选非缺失值数量
 num.trees = 200, # 树改成200
 mtry = 1, # 每次仅分割一个特征
 verbose = 0 # 控制输出的详细程度，值为0，1，2
)
head(imp)

<table class="dataframe"> <caption>A data.frame: 6 x 5</caption> <thead> <tr><th></th><th scope=col>Sepal.Length</th><th scope=col>Sepal.Width</th><th scope=col>Petal.Length</th><th scope=col>Petal.Width</th><th scope=col>Species</th></tr> <tr><th></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><fct></th></tr> </thead> <tbody> <tr><th scope=row>1</th><td>5.1</td><td>3.5</td><td>1.4</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>2</th><td>4.9</td><td>3.0</td><td>1.4</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>3</th><td>4.7</td><td>3.0</td><td>1.6</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>4</th><td>4.6</td><td>3.1</td><td>1.3</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>5</th><td>5.0</td><td>3.2</td><td>1.4</td><td>0.1</td><td>setosa</td></tr> <tr><th scope=row>6</th><td>5.4</td><td>3.9</td><td>1.5</td><td>0.4</td><td>setosa</td></tr> </tbody> </table>

扩展输出

将data_only = FALSE（或keep_forests = TRUE）设置为返回一个“missRanger”对象
使用keep_forests = TRUE，这允许进行样本外应用

set.seed(42)
imp <- missRanger(
 iris_NA, 
 pmm.k = 5, 
 num.trees = 100, 
 verbose = 0,
 keep_forests = TRUE
)

imp

missRanger object. Extract imputed data via $data
- best iteration: 4 
- best average OOB imputation error: 0.1456677

summary(imp)

missRanger object. Extract imputed data via $data
- best iteration: 4 
- best average OOB imputation error: 0.1456677 

Sequence of OOB prediction errors:

     Sepal.Length Sepal.Width Petal.Length Petal.Width    Species
[1,]    1.0000000   1.1300328   0.25109911  0.13967576 0.06666667
[2,]    0.2045336   0.4627131   0.02291660  0.05595659 0.05925926
[3,]    0.1990785   0.4006927   0.02354877  0.05329063 0.06666667
[4,]    0.1717736   0.4393524   0.02212563  0.05064235 0.04444444
[5,]    0.1780753   0.4114935   0.02547026  0.06026729 0.05925926

Mean performance per iteration:
[1] 0.5174949 0.1610758 0.1486555 0.1456677 0.1469131

First rows of imputed data:

  Sepal.Length Sepal.Width Petal.Length Petal.Width Species
1          5.1         3.5          1.4         0.2  setosa
2          4.9         3.0          1.4         0.2  setosa
3          4.7         3.2          1.5         0.2  setosa

predict(imp, head(iris_NA))

<table class="dataframe"> <caption>A data.frame: 6 x 5</caption> <thead> <tr><th></th><th scope=col>Sepal.Length</th><th scope=col>Sepal.Width</th><th scope=col>Petal.Length</th><th scope=col>Petal.Width</th><th scope=col>Species</th></tr> <tr><th></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><fct></th></tr> </thead> <tbody> <tr><th scope=row>1</th><td>5.1</td><td>3.5</td><td>1.4</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>2</th><td>4.9</td><td>3.0</td><td>1.4</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>3</th><td>4.7</td><td>3.2</td><td>1.3</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>4</th><td>4.6</td><td>3.1</td><td>1.1</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>5</th><td>5.0</td><td>4.2</td><td>1.4</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>6</th><td>5.4</td><td>3.9</td><td>1.4</td><td>0.4</td><td>setosa</td></tr> </tbody> </table>

公式

默认情况下，missRanger() 使用所有列来插补所有存在缺失值的列
可以通过传递一个公式来修改：
公式左侧指定要进行插补的变量，右侧列出用于插补的变量

# 用所有变量对所有变量进行插补
set.seed(42)
m1 <- missRanger(
 iris_NA, 
 formula = . ~ ., 
 pmm.k = 5, 
 num.trees = 100, 
 verbose = 0
)

# 用除了Species以外的变量对所有变量插补
set.seed(42)
m2 <- missRanger(
 iris_NA, 
 . ~ . - Species, 
 pmm.k = 5, 
 num.trees = 100, 
 verbose = 0
)

# 仅用Species对Sepal.Length插补
set.seed(42)
m3 <- missRanger(
 iris_NA, 
 Sepal.Length ~ Species, 
 pmm.k = 5, 
 num.trees = 100,
 verbose = 0
)

head(m1)
head(m2)
head(m3)

<table class="dataframe"> <caption>A data.frame: 6 x 5</caption> <thead> <tr><th></th><th scope=col>Sepal.Length</th><th scope=col>Sepal.Width</th><th scope=col>Petal.Length</th><th scope=col>Petal.Width</th><th scope=col>Species</th></tr> <tr><th></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><fct></th></tr> </thead> <tbody> <tr><th scope=row>1</th><td>5.1</td><td>3.5</td><td>1.4</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>2</th><td>4.9</td><td>3.0</td><td>1.4</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>3</th><td>4.7</td><td>3.2</td><td>1.5</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>4</th><td>4.6</td><td>3.1</td><td>1.3</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>5</th><td>5.0</td><td>2.8</td><td>1.4</td><td>0.5</td><td>setosa</td></tr> <tr><th scope=row>6</th><td>5.4</td><td>3.9</td><td>1.5</td><td>0.4</td><td>setosa</td></tr> </tbody> </table>

<table class="dataframe"> <caption>A data.frame: 6 x 5</caption> <thead> <tr><th></th><th scope=col>Sepal.Length</th><th scope=col>Sepal.Width</th><th scope=col>Petal.Length</th><th scope=col>Petal.Width</th><th scope=col>Species</th></tr> <tr><th></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><fct></th></tr> </thead> <tbody> <tr><th scope=row>1</th><td>5.1</td><td>3.5</td><td>1.4</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>2</th><td>4.9</td><td>3.0</td><td>1.4</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>3</th><td>4.7</td><td>3.3</td><td>1.6</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>4</th><td>4.6</td><td>3.1</td><td>1.1</td><td>0.2</td><td>setosa</td></tr> <tr><th scope=row>5</th><td>5.0</td><td>3.1</td><td>1.4</td><td>0.4</td><td>setosa</td></tr> <tr><th scope=row>6</th><td>5.4</td><td>3.9</td><td>1.5</td><td>0.4</td><td>setosa</td></tr> </tbody> </table>

加速插补时间

missRanger() 会针对每个变量和每次迭代拟合一个随机森林
- 因此，插补可能需要较长时间
减少时间的方法：
- 使用更少的树，例如，num.trees = 100
- 使用较小的树深度，例如，max.depth = 6
- 使用较大的叶节点，例如，min.node.size = 100
- 使用较小的自助抽样样本，例如，sample.fraction = 0.2
- 使用更少的迭代次数，例如，max.iter = 3
前三项还有助于大幅减小模型的规模，
这在设置 keep_forests = TRUE 的样本外应用中可能会很重要

使用`case.weights`减少缺失值较多的行的影响

使用 case.weights 参数，
可以将案例权重传递给插补模型
- 这可以减少缺失值较多的行的影响：

m <- missRanger(
 iris_NA,
 num.trees = 100,
 pmm.k = 5,
 case.weights = rowSums(!is.na(iris_NA))
)

【mlr3】1.基础用法

Tue, 22 Jul 2025 00:00:00 GMT

Cover Pic by @抠肉肚脐

Applied Machine Learning Using mlr3 in R

`mlr3`框架生态

机器学习流程

将数据集拆分为训练集与测试集
选择学习器，用训练集构建模型
使用构建的模型对测试集进行预测
基于预测的结果对模型用不同的评估器进行评估
基于评估结果评价模型的性能

预设字典

预设的Task列表

mlr_tasks

<DictionaryTask> with 11 stored values
Keys: breast_cancer, california_housing, german_credit, iris, mtcars,
  penguins, pima, sonar, spam, wine, zoo

预设学习器列表

mlr_learners

<DictionaryLearner> with 27 stored values
Keys: classif.cv_glmnet, classif.debug, classif.featureless,
  classif.glmnet, classif.kknn, classif.lda, classif.log_reg,
  classif.multinom, classif.naive_bayes, classif.nnet, classif.qda,
  classif.ranger, classif.rpart, classif.svm, classif.xgboost,
  regr.cv_glmnet, regr.debug, regr.featureless, regr.glmnet, regr.kknn,
  regr.km, regr.lm, regr.nnet, regr.ranger, regr.rpart, regr.svm,
  regr.xgboost

预设的评估器列表

# 1
mlr_measures
# 2
msr()

<DictionaryMeasure> with 62 stored values
Keys: aic, bic, classif.acc, classif.auc, classif.bacc, classif.bbrier,
  classif.ce, classif.costs, classif.dor, classif.fbeta, classif.fdr,
  classif.fn, classif.fnr, classif.fomr, classif.fp, classif.fpr,
  classif.logloss, classif.mauc_au1p, classif.mauc_au1u,
  classif.mauc_aunp, classif.mauc_aunu, classif.mauc_mu,
  classif.mbrier, classif.mcc, classif.npv, classif.ppv, classif.prauc,
  classif.precision, classif.recall, classif.sensitivity,
  classif.specificity, classif.tn, classif.tnr, classif.tp,
  classif.tpr, debug_classif, internal_valid_score, oob_error,
  regr.bias, regr.ktau, regr.mae, regr.mape, regr.maxae, regr.medae,
  regr.medse, regr.mse, regr.msle, regr.pbias, regr.pinball, regr.rmse,
  regr.rmsle, regr.rsq, regr.sae, regr.smape, regr.srho, regr.sse,
  selected_features, sim.jaccard, sim.phi, time_both, time_predict,
  time_train

msr() %>% as.data.table()

<table class='dataframe'> <caption>A data.table: <thead> <tr><th scope=col>k <tr><th scope=col>& </thead> <tbody> <tr><td>aic <tr><td>bic <tr><td>classif.acc <tr><td>classif.auc <tr><td>classif.bacc <tr><td>classif.bbrier <tr><td>classif.ce <tr><td>classif.costs <tr><td>classif.dor <tr><td>classif.fbeta <tr><td>classif.fdr <tr><td>classif.fn <tr><td>classif.fnr <tr><td>classif.fomr <tr><td>classif.fp <tr><td>classif.fpr <tr><td>classif.logloss <tr><td>classif.mauc_au1p <tr><td>classif.mauc_au1u <tr><td>classif.mauc_aunp <tr><td>classif.mauc_aunu <tr><td>classif.mauc_mu <tr><td>classif.mbrier <tr><td>classif.mcc <tr><td>classif.npv <tr><td>classif.ppv <tr><td>classif.prauc <tr><td>classif.precision <tr><td>classif.recall <tr><td>classif.sen <tr><td>...</td& <tr><td>classif.tnr <tr><td>classif.tp <tr><td>classif.tpr <tr><td>debug_classif <tr><td>internal_va <tr><td>oob_error <tr><td>regr.bias <tr><td>regr.ktau <tr><td>regr.mae <tr><td>regr.mape <tr><td>regr.maxae <tr><td>regr.medae <tr><td>regr.medse <tr><td>regr.mse <tr><td>regr.msle <tr><td>regr.pbias <tr><td>regr.pinball <tr><td>regr.rmse <tr><td>regr.rmsle <tr><td>regr.rsq <tr><td>regr.sae <tr><td>regr.smape <tr><td>regr.srho <tr><td>regr.sse <tr><td>selected_features <tr><td>sim.jaccard <tr><td>sim.phi <tr><td>time_both <tr><td>time_predict <tr><td>time_train </tbody> </table> 62 x 7</caption> ey</th><th scope=col>label</th><th scope=col>task_type</th><th scope=col>packages</th><th scope=col>predict_type</th><th scope=col>properties</th><th scope=col>task_properties</th></tr> lt;chr></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><list></th><th scope=col><chr></th><th scope=col><list></th><th scope=col><list></th></tr> </td><td>Akaike Information Criterion </td><td>NA </td><td>mlr3</td><td>NA </td><td>na_score , requires_learner , requires_model , requires_no_prediction</td><td></td></tr> </td><td>Bayesian Information Criterion </td><td>NA </td><td>mlr3</td><td>NA </td><td>na_score , requires_learner , requires_model , requires_no_prediction</td><td></td></tr> </td><td>Classification Accuracy </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td>weights</td><td></td></tr> </td><td>Area Under the ROC Curve </td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob </td><td></td><td>twoclass</td></tr> </td><td>Balanced Accuracy </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td>weights</td><td></td></tr> </td><td>Binary Brier Score </td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob </td><td>weights</td><td>twoclass</td></tr> </td><td>Classification Error </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td>weights</td><td></td></tr> </td><td>Cost-sensitive Classification </td><td>classif</td><td>mlr3</td><td>response</td><td>weights</td><td></td></tr> </td><td>Diagnostic Odds Ratio </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td></td><td>twoclass</td></tr> </td><td>F-beta score </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td></td><td>twoclass</td></tr> </td><td>False Discovery Rate </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td></td><td>twoclass</td></tr> </td><td>False Negatives </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td></td><td>twoclass</td></tr> </td><td>False Negative Rate </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td></td><td>twoclass</td></tr> </td><td>False Omission Rate </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td></td><td>twoclass</td></tr> </td><td>False Positives </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td></td><td>twoclass</td></tr> </td><td>False Positive Rate </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td></td><td>twoclass</td></tr> </td><td>Log Loss </td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob </td><td>weights</td><td></td></tr> </td><td>Weighted average 1 vs. 1 multiclass AUC </td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob </td><td></td><td></td></tr> </td><td>Average 1 vs. 1 multiclass AUC </td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob </td><td></td><td></td></tr> </td><td>Weighted average 1 vs. rest multiclass AUC</td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob </td><td></td><td></td></tr> </td><td>Average 1 vs. rest multiclass AUC </td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob </td><td></td><td></td></tr> </td><td>Multiclass mu AUC </td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob </td><td></td><td></td></tr> </td><td>Multiclass Brier Score </td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob </td><td></td><td></td></tr> </td><td>Matthews Correlation Coefficient </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td></td><td></td></tr> </td><td>Negative Predictive Value </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td></td><td>twoclass</td></tr> </td><td>Positive Predictive Value </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td></td><td>twoclass</td></tr> </td><td>Precision-Recall Curve </td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob </td><td></td><td>twoclass</td></tr> </td><td>Precision </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td></td><td>twoclass</td></tr> </td><td>Recall </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td></td><td>twoclass</td></tr> sitivity</td><td>Sensitivity </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response</td><td></td><td>twoclass</td></tr> gt;<td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td></tr> </td><td>True Negative Rate </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response </td><td></td><td>twoclass</td></tr> </td><td>True Positives </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response </td><td></td><td>twoclass</td></tr> </td><td>True Positive Rate </td><td>classif</td><td>mlr3 , mlr3measures</td><td>response </td><td></td><td>twoclass</td></tr> </td><td>Debug Classification Measure </td><td>NA </td><td>mlr3</td><td>response </td><td>na_score</td><td></td></tr> lid_score</td><td>Internal Validation Score </td><td>NA </td><td>mlr3</td><td>NA </td><td>na_score , requires_learner , requires_no_prediction</td><td></td></tr> </td><td>Out-of-bag Error </td><td>NA </td><td>mlr3</td><td>NA </td><td>na_score , requires_learner , requires_no_prediction</td><td></td></tr> </td><td>Bias </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td>weights</td><td></td></tr> </td><td>Kendall's tau </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td></td><td></td></tr> </td><td>Mean Absolute Error </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td>weights</td><td></td></tr> </td><td>Mean Absolute Percent Error </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td>weights</td><td></td></tr> </td><td>Max Absolute Error </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td></td><td></td></tr> </td><td>Median Absolute Error </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td></td><td></td></tr> </td><td>Median Squared Error </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td></td><td></td></tr> </td><td>Mean Squared Error </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td>weights</td><td></td></tr> </td><td>Mean Squared Log Error </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td>weights</td><td></td></tr> </td><td>Percent Bias </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td>weights</td><td></td></tr> </td><td>NA </td><td>regr </td><td>mlr3</td><td>quantiles</td><td></td><td></td></tr> </td><td>Root Mean Squared Error </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td>weights</td><td></td></tr> </td><td>Root Mean Squared Log Error </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td>weights</td><td></td></tr> </td><td>NA </td><td>regr </td><td>mlr3</td><td>response </td><td>weights</td><td></td></tr> </td><td>Sum of Absolute Errors </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td></td><td></td></tr> </td><td>Symmetric Mean Absolute Percent Error </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td></td><td></td></tr> </td><td>Spearman's rho </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td></td><td></td></tr> </td><td>Sum of Squared Errors </td><td>regr </td><td>mlr3 , mlr3measures</td><td>response </td><td></td><td></td></tr> </td><td>Absolute or Relative Frequency of Selected Features</td><td>NA </td><td>mlr3</td><td>NA </td><td>requires_task , requires_learner , requires_model , requires_no_prediction</td><td></td></tr> </td><td>Jaccard Similarity Index </td><td>NA </td><td>mlr3 , mlr3measures</td><td>NA </td><td>requires_model , requires_no_prediction</td><td></td></tr> </td><td>Phi Coefficient Similarity </td><td>NA </td><td>mlr3 , mlr3measures</td><td>NA </td><td>requires_model , requires_no_prediction</td><td></td></tr> </td><td>Elapsed Time </td><td>NA </td><td>mlr3</td><td>NA </td><td>requires_learner , requires_no_prediction</td><td></td></tr> </td><td>Elapsed Time </td><td>NA </td><td>mlr3</td><td>NA </td><td>requires_learner , requires_no_prediction</td><td></td></tr> </td><td>Elapsed Time </td><td>NA </td><td>mlr3</td><td>NA </td><td>requires_learner , requires_no_prediction</td><td></td></tr>

调取详情

mlr_tasks$get('california_housing')
mlr_learners$get('classif.xgboost')
mlr_measures$get('regr.mse')

[36m--[39m [1m[34m<TaskRegr>[39m (20640x10): California House Value[22m [36m-------------------------------[39m
* Target: median_house_value
* Properties: -
* Features (9):
  * dbl (8): households, housing_median_age, latitude, longitude,
  median_income, population, total_bedrooms, total_rooms
  * fct (1): ocean_proximity



[36m--[39m [1m[34m<LearnerClassifXgboost>[39m (classif.xgboost): Extreme Gradient Boosting[22m [36m--------[39m
* Model: -
* Parameters: nrounds=1000, nthread=1, verbose=0
* Validate: [34m<NULL>[39m
* Packages: [34mmlr3[39m, [34mmlr3learners[39m, and [34mxgboost[39m
* Predict Types: [response] and prob
* Feature Types: logical, integer, and numeric
* Encapsulation: none (fallback: -)
* Properties: hotstart_forward, importance, internal_tuning, missings,
multiclass, offset, twoclass, validation, and weights
* Other settings: use_weights = 'use'



[36m--[39m [1m[34m<MeasureRegrSimple>[39m (regr.mse): Mean Squared Error[22m [36m--------------------------[39m
* Packages: [34mmlr3[39m and [34mmlr3measures[39m
* Range: [0, Inf]
* Minimize: [34mTRUE[39m
* Average: macro
* Parameters: list()
* Properties: weights
* Predict type: response
* Predict sets: test
* Aggregator: mean()

简单的回归的流程

任务化

创建任务

as_task_*()
- target：outcome
- id：任务名称
这里就用as_task_regr()代替下

dt.tskR <- as_task_regr(dt, target = 'outcome')

对outcome与特征值的图形化概括
- 特征值过多不建议，又慢又看不清

library(mlr3viz)
autoplot(dt.tskR, type = 'pairs')

数据检索及数据处理

可以通过$探索任务里的各种信息
对于导入的原始数据而言
- dt.tskR$nrow
- dt.tskR$ncol
- dt.tskR$feature_names
- dt.tskR$target_names
- dt.tskR$row_ids
- dt.tskR$col_info
- ......
有些是函数
- dt.tskR$clone()
- dt.tskR$data()
- dt.tskR$cbind()
- dt.tskR$rbind()
- dt.tskR$filter()
- dt.tskR$select()
- dt.tskR$head()
- ......
这两个虽然结果一样，
但是第一个是先调取整个data再筛选，
第二个则是直接充task里调取第二行

housing.tskR$data()[2]
housing.tskR$data(rows = housing.tskR$row_ids[2])

函数的用法和平时的类似，只是集成到了Task里面而已

数据处理的实例

注意，dt.tskR$func()是对dt.tsk的就地修改，
不需要保存到新的变量里

# 克隆一个一模一样的任务
dt.tskR2 <- dt.tskR$clone()
# 选择第1–2行
dt.tskR2$filter(1:2)

# 添加列
dt.tskR$cbind( 
  data.frame(x = c(150, 160))
)
# 添加行
dt.tskR_small$rbind( 
  data.frame(x1 = 23, x2 = 5, x3 = 170)
)
dt.tskR_small$data()

学习器

mlr-org: Learners

学习器的类型是Learner

包的分类

mlr3：仅包含一些基础的学习器
mlr3learners：比mlr3包更丰富且常用的学习器
mlr3proba：生存学习器
mlr3cluster：聚类学习器
mlr3extralearners：一些不稳定或者CRAN上不可用的学习器
mlr3torch：神经网络相关学习器

查看学习器

lrn()可以调取对应学习器的信息，并且包含下列数据
- $feature_types：学习器可以处理的特征类型
- $packages：使用该学习器需要安装的软件包
- $properties：学习器的属性；例如，'missings' 属性表示模型可以处理缺失数据，而 'importance' 表示它可以计算每个特征的相对重要性
- $predict_types：模型能够做出的预测类型
- $param_set：可用超参数集

lrn('regr.rpart')

[36m--[39m [1m[34m<LearnerRegrRpart>[39m (regr.rpart): Regression Tree[22m [36m----------------------------[39m
* Model: -
* Parameters: xval=0
* Packages: [34mmlr3[39m and [34mrpart[39m
* Predict Types: [response]
* Feature Types: logical, integer, numeric, factor, and ordered
* Encapsulation: none (fallback: -)
* Properties: importance, missings, selected_features, and weights
* Other settings: use_weights = 'use'

传递多个学习器

lrn()的复数形lrns()可以调取多个学习器
其他的类似的还有tsks()和后续出现的msrs()，rsmps()

dt.lrnR.rpart_lm <- lrns(c('regr.rpart', 'regr.lm'))
dt.lrnR.rpart_lm

分割训练集和测试集

partition()中ratio为训练集占整个数据集比例

dt.tskR.splits <- partition(dt.tsk, ratio = 0.7)
dt.tskR.splits

训练模型

Learner作用于Task

dt.lrnR.rpart <- lrn('regr.rpart')
dt.lrnR.rpart$train(dt.tsk)

拟合的模型储存在Learner$model中

dt.lrnR.rpart$model

通过指定参数row_ids分配训练集

dt.lrnR.rpart$train(dt.tskR, row_ids = dt.tskR.splits$train)

也可以指定预测类型
- regr.rpart不能选择response以外的类型
- 这里选择用 regr.lm来预测标准误差

dt.lrnR.lm <- lrn('regr.lm', predict_type = 'se')

可以随便看看区别
- 在指定了se后output里Predict Types的框框给到了[se]

lrn('regr.lm')
lrn('regr.lm', predict_type = 'se')


[36m--[39m [1m[34m<LearnerRegrLM>[39m (regr.lm): Linear Model[22m [36m-------------------------------------[39m
* Model: -
* Parameters: use_pred_offset=TRUE
* Packages: [34mmlr3[39m, [34mmlr3learners[39m, and [34mstats[39m
* Predict Types: [response] and se
* Feature Types: logical, integer, numeric, character, and factor
* Encapsulation: none (fallback: -)
* Properties: offset and weights
* Other settings: use_weights = 'use'


[36m--[39m [1m[34m<LearnerRegrLM>[39m (regr.lm): Linear Model[22m [36m-------------------------------------[39m
* Model: -
* Parameters: use_pred_offset=TRUE
* Packages: [34mmlr3[39m, [34mmlr3learners[39m, and [34mstats[39m
* Predict Types: response and [se]
* Feature Types: logical, integer, numeric, character, and factor
* Encapsulation: none (fallback: -)
* Properties: offset and weights
* Other settings: use_weights = 'use'

预测数据

由于Learner$predict()会返回一个新的对象，所以需要另外保存

dt.lrnR.rpart.pred <- dt.lrnR.rpart$predict(dt.tskR, row_ids = dt.tskR.splits$test)

可以简单看看这些对象的类别

dt.tskR %>% class()
dt.lrnR.rpart %>% class()
dt.lrnR.rpart.pred %>% class()

'TaskRegr''TaskSupervised''Task''R6'
'LearnerRegrRpart''LearnerRegr''Learner''R6'
'PredictionRegr''Prediction''R6'

dt.lrnR.rpart.pred：返回一个预测结果的文本输出
dt.lrnR.rpart.pred$truth：返回真实值向量
dt.lrnR.rpart.pred$responese：返回预测响应值向量

对真实值-预测值进行绘图

autoplot(dt.lrnR.rpart.pred)

超参数

训练模型前需要预先指定的参数

获取超参数

# 1
dt.lrnR.rpart$param_set
# 2
lrn('regr.rpart')$param_set

<ParamSet(10)>
                id    class lower upper nlevels        default  value
            <char>   <char> <num> <num>   <num>         <list> <list>
 1:             cp ParamDbl     0     1     Inf           0.01 [NULL]
 2:     keep_model ParamLgl    NA    NA       2          FALSE [NULL]
 3:     maxcompete ParamInt     0   Inf     Inf              4 [NULL]
 4:       maxdepth ParamInt     1    30      30             30 [NULL]
 5:   maxsurrogate ParamInt     0   Inf     Inf              5 [NULL]
 6:      minbucket ParamInt     1   Inf     Inf <NoDefault[0]> [NULL]
 7:       minsplit ParamInt     1   Inf     Inf             20 [NULL]
 8: surrogatestyle ParamInt     0     1       2              0 [NULL]
 9:   usesurrogate ParamInt     0     2       3              2 [NULL]
10:           xval ParamInt     0   Inf     Inf             10      0

其中
- id：超参数名
- class：类别
- lower：最小可设定值
- upper：最大可设定值
- nlevels：可设定值的种类数目
- default：原函数的默认取值
- value：当前取值，[NULL]时使用default的值
当cp设置为0.5后，可以看到output中cp的value变成了0.5

lrn('regr.rpart', cp = 0.5)$param_set

<ParamSet(10)>
                id    class lower upper nlevels        default  value
            <char>   <char> <num> <num>   <num>         <list> <list>
 1:             cp ParamDbl     0     1     Inf           0.01    0.5
 2:     keep_model ParamLgl    NA    NA       2          FALSE [NULL]
 3:     maxcompete ParamInt     0   Inf     Inf              4 [NULL]
 4:       maxdepth ParamInt     1    30      30             30 [NULL]
 5:   maxsurrogate ParamInt     0   Inf     Inf              5 [NULL]
 6:      minbucket ParamInt     1   Inf     Inf <NoDefault[0]> [NULL]
 7:       minsplit ParamInt     1   Inf     Inf             20 [NULL]
 8: surrogatestyle ParamInt     0     1       2              0 [NULL]
 9:   usesurrogate ParamInt     0     2       3              2 [NULL]
10:           xval ParamInt     0   Inf     Inf             10      0

查看当前模型的超参数设定情况

dt.lrnR.rpart$param_set$values

对查看当前模型的超参数设定就地修改

dt.lrnR.rpart$param_set$set_values(cp = 0.02，minsplit = 10)

超参数依赖关系

支持向量机中的超参数更加复杂

lrn('regr.svm')$param_set

<ParamSet(14)>
Key: <id>
           id    class lower upper nlevels        default parents  value
       <char>   <char> <num> <num>   <num>         <list>  <list> <list>
 1: cachesize ParamDbl  -Inf   Inf     Inf             40  [NULL] [NULL]
 2:     coef0 ParamDbl  -Inf   Inf     Inf              0  kernel [NULL]
 3:      cost ParamDbl     0   Inf     Inf              1    type [NULL]
 4:     cross ParamInt     0   Inf     Inf              0  [NULL] [NULL]
 5:    degree ParamInt     1   Inf     Inf              3  kernel [NULL]
 6:   epsilon ParamDbl     0   Inf     Inf            0.1    type [NULL]
 7:    fitted ParamLgl    NA    NA       2           TRUE  [NULL] [NULL]
 8:     gamma ParamDbl     0   Inf     Inf <NoDefault[0]>  kernel [NULL]
 9:    kernel ParamFct    NA    NA       4         radial  [NULL] [NULL]
10:        nu ParamDbl  -Inf   Inf     Inf            0.5    type [NULL]
11:     scale ParamUty    NA    NA     Inf           TRUE  [NULL] [NULL]
12: shrinking ParamLgl    NA    NA       2           TRUE  [NULL] [NULL]
13: tolerance ParamDbl     0   Inf     Inf          0.001  [NULL] [NULL]
14:      type ParamFct    NA    NA       2 eps-regression  [NULL] [NULL]

可以从Learner$param_set$deps中获得超参数之间的依赖关系总结

lrn('regr.svm')$param_set$deps

<table class='dataframe'> <caption>A data.table: 6 x 3</caption> <thead> <tr><th scope=col>id</th><th scope=col>on</th><th scope=col>cond</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td>coef0 </td><td>kernel</td><td>polynomial , sigmoid , %s %%in%% {%s}</td></tr> <tr><td>cost </td><td>type </td><td>eps-regression, nu-regression , %s %%in%% {%s}</td></tr> <tr><td>degree </td><td>kernel</td><td>polynomial, %s == %s </td></tr> <tr><td>epsilon</td><td>type </td><td>eps-regression, %s == %s </td></tr> <tr><td>gamma </td><td>kernel</td><td>polynomial , radial , sigmoid , %s %%in%% {%s}</td></tr> <tr><td>nu </td><td>type </td><td>nu-regression, %s == %s </td></tr> </tbody> </table>

查看一下设置的条件

for (i in 1:6){
 print(lrn('regr.svm')$param_set$deps[[i, 'cond']])
}

CondAnyOf: x %in% {polynomial, sigmoid}
CondAnyOf: x %in% {eps-regression, nu-regression}
CondEqual: x == polynomial
CondEqual: x == eps-regression
CondAnyOf: x %in% {polynomial, radial, sigmoid}
CondEqual: x == nu-regression

输出中x是on的指代，
当被依赖的超参数on的设置满足某条件时，
id中的超参数才能被设置
如果on超参数不满足条件，设置id超参数会报错

基准学习器

regr.featureless
- 它总是将新值预测为训练数据中目标的均值
- 如果 robust 超参数设置为 TRUE，则为中位数
用于
- 模型比较
- 回退学习器

lrn('regr.featureless')

模型评估

msr()用于单个评估器的评估
msrs()可以输入使用多个评估器名称的向量

# 1
msrR.mse_mae <- msrs(c('regr.mse', 'regr.mae'))
housing.lrnR.rpart.pred$score(msrR.mse_mae)
# 2
housing.lrnR.rpart.pred$score(msrs(c('regr.mse', 'regr.mae')))

mlr3还有一些其他非质量评价的评估指标
- msr('time_train')：训练模型所花费的时间
- msr('time_predict')：模型进行预测所需的时间
- msr('time_both')：训练模型然后进行预测所花费的总时间
- msr('selected_features')：
  模型选择的特征数量，仅当模型具有selected_features属性时才可使用
Measure$properties提供了评估器的属性

msr('regr.mse')$properties
msr('time_train')$properties

'weights'
'requires_learner''requires_no_prediction'

评估器的超参数
- 可以注意到time_train的Parameters是list()，
  这代表是空的
- selected_features的Parameters有normalize=FALSE，
  说明可以提前设置

msr('time_train')
msr('selected_features')

[36m--[39m [1m[34m<MeasureElapsedTime>[39m (time_train): Elapsed Time[22m [36m-----------------------------[39m
* Packages: [34mmlr3[39m
* Range: [0, Inf]
* Minimize: [34mTRUE[39m
* Average: macro
* Parameters: list()
* Properties: requires_learner and requires_no_prediction
* Predict type: NA
* Predict sets:
* Aggregator: mean()


[36m--[39m [1m[34m<MeasureSelectedFeatures>[39m (selected_features): Absolute or Relative Frequency[22m
* Packages: [34mmlr3[39m
* Range: [0, Inf]
* Minimize: [34mTRUE[39m
* Average: macro
* Parameters: normalize=FALSE
* Properties: requires_task, requires_learner, requires_model, and
requires_no_prediction
* Predict type: NA
* Predict sets:
* Aggregator: mean()

访问评估器的超参数也是用$param_set

msr.sf <- msr('selected_features')
msr.sf$param_set

<ParamSet(1)>
          id    class lower upper nlevels        default  value
      <char>   <char> <num> <num>   <num>         <list> <list>
1: normalize ParamLgl    NA    NA       2 <NoDefault[0]>  FALSE

修改

# 1
msr.sf$param_set$set_values(normalize = TRUE)
# 2
msr.sf$param_set$normalize <- TRUE

简单的分类的流程

与回归的流程相同，
只是基础对象分别继承自 TaskClassif、LearnerClassif 和 MeasureClassif
分类有二元分类和多元分类两种

任务化

这里就直接调取预设的任务进行练习

mlr_tasks %>% as.data.table()

<table class='dataframe'> <caption>A data.table: 11 x 14</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>task_type</th><th scope=col>nrow</th><th scope=col>ncol</th><th scope=col>properties</th><th scope=col>lgl</th><th scope=col>int</th><th scope=col>dbl</th><th scope=col>chr</th><th scope=col>fct</th><th scope=col>ord</th><th scope=col>pxc</th><th scope=col>dte</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><int></th><th scope=col><int></th><th scope=col><list></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th></tr> </thead> <tbody> <tr><td>breast_cancer </td><td>Wisconsin Breast Cancer</td><td>classif</td><td> 683</td><td>10</td><td>twoclass</td><td> 0</td><td>0</td><td> 0</td><td>0</td><td> 0</td><td>9</td><td>0</td><td>0</td></tr> <tr><td>california_housing</td><td>California House Value </td><td>regr </td><td>20640</td><td>10</td><td></td><td> 0</td><td>0</td><td> 8</td><td>0</td><td> 1</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>german_credit </td><td>German Credit </td><td>classif</td><td> 1000</td><td>21</td><td>twoclass</td><td> 0</td><td>3</td><td> 0</td><td>0</td><td>14</td><td>3</td><td>0</td><td>0</td></tr> <tr><td>iris </td><td>Iris Flowers </td><td>classif</td><td> 150</td><td> 5</td><td>multiclass</td><td> 0</td><td>0</td><td> 4</td><td>0</td><td> 0</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>mtcars </td><td>Motor Trends </td><td>regr </td><td> 32</td><td>11</td><td></td><td> 0</td><td>0</td><td>10</td><td>0</td><td> 0</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>penguins </td><td>Palmer Penguins </td><td>classif</td><td> 344</td><td> 8</td><td>multiclass</td><td> 0</td><td>3</td><td> 2</td><td>0</td><td> 2</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>pima </td><td>Pima Indian Diabetes </td><td>classif</td><td> 768</td><td> 9</td><td>twoclass</td><td> 0</td><td>0</td><td> 8</td><td>0</td><td> 0</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>sonar </td><td>Sonar: Mines vs. Rocks </td><td>classif</td><td> 208</td><td>61</td><td>twoclass</td><td> 0</td><td>0</td><td>60</td><td>0</td><td> 0</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>spam </td><td>HP Spam Detection </td><td>classif</td><td> 4601</td><td>58</td><td>twoclass</td><td> 0</td><td>0</td><td>57</td><td>0</td><td> 0</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>wine </td><td>Wine Regions </td><td>classif</td><td> 178</td><td>14</td><td>multiclass</td><td> 0</td><td>2</td><td>11</td><td>0</td><td> 0</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>zoo </td><td>Zoo Animals </td><td>classif</td><td> 101</td><td>17</td><td>multiclass</td><td>15</td><td>1</td><td> 0</td><td>0</td><td> 0</td><td>0</td><td>0</td><td>0</td></tr> </tbody> </table>

分别用german_credit和penguins作为二元分类和多元分类的例子

gc.tskC <- tsk('german_credit')
peng.tskC <- tsk('penguins')

gc.tskC
peng.tskC

[36m--[39m [1m[34m<TaskClassif>[39m (1000x21): German Credit[22m [36m--------------------------------------[39m
* Target: credit_risk
* Target classes: good (positive class, 70%), bad (30%)
* Properties: twoclass
* Features (20):
  * fct (14): credit_history, employment_duration, foreign_worker, housing,
  job, other_debtors, other_installment_plans, people_liable,
  personal_status_sex, property, purpose, savings, status, telephone
  * int (3): age, amount, duration
  * ord (3): installment_rate, number_credits, present_residence


[36m--[39m [1m[34m<TaskClassif>[39m (344x8): Palmer Penguins[22m [36m--------------------------------------[39m
* Target: species
* Target classes: Adelie (44%), Gentoo (36%), Chinstrap (20%)
* Properties: multiclass
* Features (7):
  * int (3): body_mass, flipper_length, year
  * dbl (2): bill_depth, bill_length
  * fct (2): island, sex

二元分类

Outcome的分类

gc.tskC$class_names
gc.tskC$properties

'good''bad'
'twoclass'

定义正类

gc.tskC$positive <- 'good'

如果不设置，默认第一个级别是正类

对真实值-预测值进行绘图

autoplot(gc.tskC, type = 'duo') +
  theme(strip.text.y = element_text(angle = -45, size = 8))

预测结果

predict_type可以选择预测响应类别'response'或者概率'prob'
- 选择概率也会给出response的结果
- 所以对于分类问题，用概率会更好

lrn('classif.rpart') # 'response'是默认
lrn('classif.rpart', predict_type = 'prob')

# gc.tskC.splits <- partition(gc.tskC,ratio = 0.7) # 事先设定好

gc.lrnC.rpart <- lrn('classif.rpart', predict_type = 'response')
gc.lrnC.rpart$train(gc.tskC, gc.tskC.splits$train)
gc.lrnC.rpart.pred <- gc.lrnC.rpart$predict(gc.tskC, gc.tskC.splits$test)
gc.lrnC.rpart.pred

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m300[39m observations:[22m [36m-----------------------------------[39m
 row_ids truth response
       6  good     good
       8  good      bad
      10   bad      bad
     ---   ---      ---
     992  good     good
     995  good     good
    1000  good      bad

# gc.tskC.splits <- partition(gc.tskC,ratio = 0.7) # 事先设定好

gc.lrnC.rpart <- lrn('classif.rpart', predict_type = 'prob')
gc.lrnC.rpart$train(gc.tskC, gc.tskC.splits$train)
gc.lrnC.rpart.pred <- gc.lrnC.rpart$predict(gc.tskC, gc.tskC.splits$test)
gc.lrnC.rpart.pred

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m300[39m observations:[22m [36m-----------------------------------[39m
 row_ids truth response  prob.good  prob.bad
       6  good     good 0.85667752 0.1433225
       8  good      bad 0.21739130 0.7826087
      10   bad      bad 0.29411765 0.7058824
     ---   ---      ---        ---       ---
     992  good     good 0.85667752 0.1433225
     995  good     good 0.85667752 0.1433225
    1000  good      bad 0.07692308 0.9230769

模型评估

不同种类的评估器对于response和prob的适用性是不同的，
需要找到合适的评估器
寻找支持分类并用于评估概率的评估器

as.data.table(msr())[
    task_type == 'classif' & predict_type == 'prob']

<table class='dataframe'> <caption>A data.table: 7 x 7</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>task_type</th><th scope=col>packages</th><th scope=col>predict_type</th><th scope=col>properties</th><th scope=col>task_properties</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><list></th><th scope=col><chr></th><th scope=col><list></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td>classif.logloss </td><td>Log Loss </td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob</td><td>weights</td><td></td></tr> <tr><td>classif.mauc_au1p</td><td>Weighted average 1 vs. 1 multiclass AUC </td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob</td><td></td><td></td></tr> <tr><td>classif.mauc_au1u</td><td>Average 1 vs. 1 multiclass AUC </td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob</td><td></td><td></td></tr> <tr><td>classif.mauc_aunp</td><td>Weighted average 1 vs. rest multiclass AUC</td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob</td><td></td><td></td></tr> <tr><td>classif.mauc_aunu</td><td>Average 1 vs. rest multiclass AUC </td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob</td><td></td><td></td></tr> <tr><td>classif.mauc_mu </td><td>Multiclass mu AUC </td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob</td><td></td><td></td></tr> <tr><td>classif.mbrier </td><td>Multiclass Brier Score </td><td>classif</td><td>mlr3 , mlr3measures</td><td>prob</td><td></td><td></td></tr> </tbody> </table>

这里使用了3种评估器
- classif.mbrier：用预测概率与真实值之间的平方差评估prob的预测结果
- classif.logloss：用真实类别的预测概率的负对数评估prob的预测结果
- classif.acc：评估response的预测分类结果

gc.lrnC.rpart.pred$score(msrs(c('classif.mbrier', 'classif.logloss', 'classif.acc')))

混淆矩阵

Prediction$confution查看混淆矩阵

gc.lrnC.rpart.pred$confusion

        truth
response good bad
    good  177  45
    bad    41  37

通过autoplot(Prediction)可视化混淆矩阵

autoplot(gc.lrnC.rpart.pred)

阈值设定

Prediction$set_threshold()设定阈值
- 阈值是判断为正类的阈值，因此需要正确设置正类

gc.lrnC.rpart.pred$set_threshold(YourThreshold)

多元分类

Outcome的分类

peng.tskC$class_names
peng.tskC$properties

'Adelie''Chinstrap''Gentoo'
'multiclass'

没有定义正类

定义了反而会报错的

peng.tskC$positive <- 'Adelie'

Error in (function (rhs) : Setting the positive class is only feasible for binary classification

对真实值-预测值进行绘图

autoplot(peng.tskC, type = 'duo') +
  theme(strip.text.y = element_text(angle = -45, size = 8))

预测结果

# peng.tskC.splits <- partition(peng.tskC,ratio = 0.7) # 事先设定好

peng.lrnC.rpart <- lrn('classif.rpart', predict_type = 'response')
peng.lrnC.rpart$train(peng.tskC, peng.tskC.splits$train)
peng.lrnC.rpart.pred <- peng.lrnC.rpart$predict(peng.tskC, peng.lrnC.splits$test)
peng.lrnC.rpart.pred

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m103[39m observations:[22m [36m-----------------------------------[39m
 row_ids     truth  response
      11    Adelie    Adelie
      13    Adelie    Adelie
      14    Adelie    Adelie
     ---       ---       ---
     326 Chinstrap Chinstrap
     331 Chinstrap    Adelie
     338 Chinstrap Chinstrap

# peng.tskC.splits <- partition(peng.tskC,ratio = 0.7) # 事先设定好

peng.lrnC.rpart <- lrn('classif.rpart', predict_type = 'prob')
peng.lrnC.rpart$train(peng.tskC, peng.tskC.splits$train)
peng.lrnC.rpart.pred <- peng.lrnC.rpart$predict(peng.tskC, peng.lrnC.splits$test)
peng.lrnC.rpart.pred

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m103[39m observations:[22m [36m-----------------------------------[39m
 row_ids     truth  response prob.Adelie prob.Chinstrap prob.Gentoo
      11    Adelie    Adelie   0.9537037     0.01851852  0.02777778
      13    Adelie    Adelie   0.9537037     0.01851852  0.02777778
      14    Adelie    Adelie   0.9537037     0.01851852  0.02777778
     ---       ---       ---         ---            ---         ---
     326 Chinstrap Chinstrap   0.0000000     1.00000000  0.00000000
     331 Chinstrap    Adelie   0.9537037     0.01851852  0.02777778
     338 Chinstrap Chinstrap   0.0000000     1.00000000  0.00000000

模型评估

寻找支持多元分类并用于评估概率的评估器

as.data.table(msr())[
    task_type == 'classif' & predict_type == 'prob' &
    !sapply(task_properties, function(x) return('twoclass' %in% x))]

peng.lrnC.rpart.pred$score(msrs(c('classif.mbrier', 'classif.logloss', 'classif.acc')))

混淆矩阵

Prediction$confution查看混淆矩阵

gc.lrnC.rpart.pred$confusion

        truth
response good bad
    good  177  45
    bad    41  37

通过autoplot(Prediction)可视化混淆矩阵

autoplot(gc.lrnC.rpart.pred)

阈值设定

Prediction$set_threshold()设定阈值
- 与二元分类不同的是，多元分类需要给每一个分类单独设置一个阈值
在多分类问题中阈值化的工作原理
- 首先为 n 个类别中的每个类别分配一个阈值，
  将每个类别的预测概率除以这些阈值，
  以返回 n 个比率，然后选择比率最高的类别
  （这里的阈值其实就是权重了，阈值越小，权重越高）
通过传递一个命名向量进行更改

# 随便设置
peng.lrnC.rpart.pred$set_threshold(c(
 'Adelie' = 0.8,
 'Chinstrap' = 0.5,
 'Gentoo' = 0.2
))

逆加权设定阈值
- 将新阈值设置为训练集中每个类别的比例
- 在选择比率最高的标签之前，用预测概率除以这些类别比例

# 逆加权法设置
peng.lrnC.rpart.pred$set_threshold(
 peng.tskC$truth(peng.tskC.splits$train) %>% 
  table() %>% 
  proportions()
)

定义数据role

Task$col_roles能显示所有的role

peng.tskC$col_roles

$feature
'bill_depth''bill_length''flipper_length''island''sex''year''body_mass'
$target
'species'
$name
$order
$stratum
$group
$offset
$weights_learner
$weights_measure

通过Task$set_col_roles('col', roles = 'role')来重新定义

set_col_roles('body_mass', roles = 'feature')

留出法与评估

留出法就是partition()的简单划分方法
评估Prediction$score是用来估计最终模型的泛化能力

重采样

简介

k折交叉验证（k-fold cross-validation, CV）
- 将数据集拆分为k折，其中k-1折用于模型训练，剩下1折用于测试数据
- 过程重复进行，直到每一折都被作为测试集使用一次
- 将k个模型的性估计值汇总，通常取平均值
留一法交叉验证（leave-one-out cross-validation, LOO-CV）
- CV的变体，用于测试集的数据不是一折而是一个样本
子采样（subsampling）
- 按一定比例无放回地抽取数据用作训练集，剩余的样本作为测试集
- 与CV不同的是，每次抽取都是随机的，意味着有的样本会被重复抽取
- 平均而言，在自助采样过程中，
  $1-e^{-1} \simeq 63.2%$ 的数据点将包含在训练集中，
  这些数据点被称为 “袋内” 样本（另外36.8% 被称为 “袋外” 样本）
自助采样（bootstrapping）
- 类似于子采样，但是抽取样本是有放回的
- 自助法已经不太常用，
  因为训练数据中的重复观测在某些机器学习设置中会导致问题，
  特别是与模型选择方法和嵌套重采样结合时
  （因为在嵌套方案中，重复观测可能会同时出现在训练集和测试集中）

三重交叉验证示意图

构建重采样策略

查看所有重采样策略

mlr_resamplings %>% as.data.table()

<table class='dataframe'> <caption>A data.table: 9 x 4</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>params</th><th scope=col>iters</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><list></th><th scope=col><int></th></tr> </thead> <tbody> <tr><td>bootstrap </td><td>Bootstrap </td><td>ratio , repeats</td><td> 30</td></tr> <tr><td>custom </td><td>Custom Splits </td><td></td><td> NA</td></tr> <tr><td>custom_cv </td><td>Custom Split Cross-Validation</td><td></td><td> NA</td></tr> <tr><td>cv </td><td>Cross-Validation </td><td>folds</td><td> 10</td></tr> <tr><td>holdout </td><td>Holdout </td><td>ratio</td><td> 1</td></tr> <tr><td>insample </td><td>Insample Resampling </td><td></td><td> 1</td></tr> <tr><td>loo </td><td>Leave-One-Out </td><td></td><td> NA</td></tr> <tr><td>repeated_cv</td><td>Repeated Cross-Validation </td><td>folds , repeats</td><td>100</td></tr> <tr><td>subsampling</td><td>Subsampling </td><td>ratio , repeats</td><td> 30</td></tr> </tbody> </table>

创建Resampling对象

rsmp('cv', folds = 5)

[36m--[39m [1m[34m<ResamplingCV>[39m : Cross-Validation[22m [36m-------------------------------------------[39m
* Iterations: [34m5[39m
* Instantiated: [34mFALSE[39m
* Parameters: folds=5

Resampling对象也有参数可以设定
- 可以用Resampling$param_set查看
- 也能用rsmp.cv$param_set$set_values()重新设定参数

rsmp.cv <- rsmp('cv')
rsmp.cv$param_set

<ParamSet(1)>
       id    class lower upper nlevels        default  value
   <char>   <char> <int> <num>   <num>         <list> <list>
1:  folds ParamInt     2   Inf     Inf <NoDefault[0]>     10

rsmp.cv$param_set$set_values(folds = 5)
rsmp.cv$param_set

<ParamSet(1)>
       id    class lower upper nlevels        default  value
   <char>   <char> <int> <num>   <num>         <list> <list>
1:  folds ParamInt     2   Inf     Inf <NoDefault[0]>      5

Resampling$instantiate(Task)可以手动构建重采样策略，
生成所有的训练集-测试集拆分

rsmp.cv <- rsmp('cv', folds = 5)
rsmp.cv$instantiate(peng.tskC)

# 第一个训练集中前五个样本
rsmp.cv$train_set(1)[1:5]
# 第三个测试集中前五个样本
rsmp.cv$test_set(3)[1:5]

执行重采样

使用resample()执行重采样，参数依次为Task，Learner，Resampling
- 注意，这里的Learner

peng.lrnC.rpart.rr <- resample(peng.tskC, peng.lrnC.rpart, rsmp.cv)
peng.lrnC.rpart.rr


[36m--[39m [1m[34m<ResampleResult>[39m with [34m5[39m resampling iterations[22m [36m-------------------------------[39m
  task_id    learner_id resampling_id iteration     prediction_test warnings
 penguins classif.rpart            cv         1 <PredictionClassif>        0
 penguins classif.rpart            cv         2 <PredictionClassif>        0
 penguins classif.rpart            cv         3 <PredictionClassif>        0
 penguins classif.rpart            cv         4 <PredictionClassif>        0
 penguins classif.rpart            cv         5 <PredictionClassif>        0
 errors
      0
      0
      0
      0
      0

默认是不储存所有训练出来的模型的，
如果要储存，则需要指定参数store_models = TRUE

peng.lrnC.rpart.rr <- resample(peng.tskC, peng.lrnC.rpart, rsmp.cv, store_models = TRUE)

查看精准度评估结果

# 分开的结果
peng.lrnC.rpart.rr$score(msr('classif.acc'))
# 整合结果
peng.lrnC.rpart.rr$aggregate(msr('classif.acc'))

<table class='dataframe'> <caption>A rr_score: 5 x 9</caption> <thead> <tr><th scope=col>task</th><th scope=col>task_id</th><th scope=col>learner</th><th scope=col>learner_id</th><th scope=col>resampling</th><th scope=col>resampling_id</th><th scope=col>iteration</th><th scope=col>prediction_test</th><th scope=col>classif.acc</th></tr> <tr><th scope=col><list></th><th scope=col><chr></th><th scope=col><list></th><th scope=col><chr></th><th scope=col><list></th><th scope=col><chr></th><th scope=col><int></th><th scope=col><list></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td><environment: 0x10a09dc58></td><td>penguins</td><td><environment: 0x10c5640f0></td><td>classif.rpart</td><td><environment: 0x118978278></td><td>cv</td><td>1</td><td><environment: 0x11964f5b8></td><td>0.9130435</td></tr> <tr><td><environment: 0x10a09dc58></td><td>penguins</td><td><environment: 0x139a15978></td><td>classif.rpart</td><td><environment: 0x118978278></td><td>cv</td><td>2</td><td><environment: 0x119767f20></td><td>0.9130435</td></tr> <tr><td><environment: 0x10a09dc58></td><td>penguins</td><td><environment: 0x1395c69e0></td><td>classif.rpart</td><td><environment: 0x118978278></td><td>cv</td><td>3</td><td><environment: 0x1099dbc90></td><td>0.9710145</td></tr> <tr><td><environment: 0x10a09dc58></td><td>penguins</td><td><environment: 0x1391f6740></td><td>classif.rpart</td><td><environment: 0x118978278></td><td>cv</td><td>4</td><td><environment: 0x11a3bea58></td><td>0.9710145</td></tr> <tr><td><environment: 0x10a09dc58></td><td>penguins</td><td><environment: 0x1380535f0></td><td>classif.rpart</td><td><environment: 0x118978278></td><td>cv</td><td>5</td><td><environment: 0x10d1c6e00></td><td>0.9411765</td></tr> </tbody> </table>

classif.acc: 0.941858482523444

默认的整合方式是使用平均值，这里也可以指定其他方式
- 这里用的是微平均（micro average）
  - 把重采样迭代中的预测结果合并到一个 Prediction 对象中，
    然后直接在此对象上计算指标
- 默认的聚合方法类型可以通过查询Measure对象的$average字段来找到

peng.lrnC.rpart.rr$aggregate(msr('classif.acc', average = 'micro'))

classif.acc: 0.941860465116279

msr('classif.ce')$average

'macro'

宏平均和微平均的详细

# macro
mean(mean(c(3, 5, 9)), mean(c(1, 5)))

# micro
mean(c(3, 5, 9, 1, 5))

$score() 与 $aggregate() 之间差异的示例：前者在每次重采样迭代中将预测结果聚合为单个分数，而后者则在所有重采样迭代中聚合分数

可以用autoplot.ResampleResult()生成重采样的结果

autoplot(peng.lrnC.rpart.rr, type = 'boxplot')
autoplot(peng.lrnC.rpart.rr, type = 'histogram')

重采样结果对象

ResampleResult$$prediction()打印单个模型的预测结果，
这个结果是整合了全部模型预测的结果
- 组合后的预测对象可用于手动计算微平均性能估计值
ResampleResult$$predictions()分别打印所有模型的预测结果

peng.lrnC.rpart.rr$prediction()
peng.lrnC.rpart.rr$predictions()

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m344[39m observations:[22m [36m-----------------------------------[39m
 row_ids     truth  response prob.Adelie prob.Chinstrap prob.Gentoo
       7    Adelie    Adelie  0.98290598     0.01709402  0.00000000
       9    Adelie    Adelie  0.98290598     0.01709402  0.00000000
      16    Adelie    Adelie  0.98290598     0.01709402  0.00000000
     ---       ---       ---         ---            ---         ---
     320 Chinstrap Chinstrap  0.05454545     0.92727273  0.01818182
     338 Chinstrap Chinstrap  0.05454545     0.92727273  0.01818182
     344 Chinstrap Chinstrap  0.05454545     0.92727273  0.01818182

[[1]]

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m69[39m observations:[22m [36m------------------------------------[39m
 row_ids     truth  response prob.Adelie prob.Chinstrap prob.Gentoo
       7    Adelie    Adelie  0.98290598     0.01709402  0.00000000
       9    Adelie    Adelie  0.98290598     0.01709402  0.00000000
      16    Adelie    Adelie  0.98290598     0.01709402  0.00000000
     ---       ---       ---         ---            ---         ---
     315 Chinstrap Chinstrap  0.05882353     0.92156863  0.01960784
     317 Chinstrap Chinstrap  0.28571429     0.57142857  0.14285714
     335 Chinstrap Chinstrap  0.05882353     0.92156863  0.01960784

[[2]]

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m69[39m observations:[22m [36m------------------------------------[39m
 row_ids     truth  response prob.Adelie prob.Chinstrap prob.Gentoo
       4    Adelie    Adelie  0.97580645     0.02419355    0.000000
      12    Adelie    Adelie  0.97580645     0.02419355    0.000000
      25    Adelie    Adelie  0.97580645     0.02419355    0.000000
     ---       ---       ---         ---            ---         ---
     334 Chinstrap Chinstrap  0.08000000     0.92000000    0.000000
     340 Chinstrap    Gentoo  0.00990099     0.02970297    0.960396
     343 Chinstrap    Gentoo  0.00990099     0.02970297    0.960396

[[3]]

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m69[39m observations:[22m [36m------------------------------------[39m
 row_ids     truth  response prob.Adelie prob.Chinstrap prob.Gentoo
       5    Adelie    Adelie   0.9669421     0.03305785  0.00000000
      10    Adelie    Adelie   0.9669421     0.03305785  0.00000000
      14    Adelie    Adelie   0.9669421     0.03305785  0.00000000
     ---       ---       ---         ---            ---         ---
     322 Chinstrap Chinstrap   0.0754717     0.90566038  0.01886792
     337 Chinstrap Chinstrap   0.2500000     0.50000000  0.25000000
     339 Chinstrap Chinstrap   0.0754717     0.90566038  0.01886792

[[4]]

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m69[39m observations:[22m [36m------------------------------------[39m
 row_ids     truth  response prob.Adelie prob.Chinstrap prob.Gentoo
       8    Adelie    Adelie  0.96124031     0.03875969   0.0000000
      21    Adelie    Adelie  0.96124031     0.03875969   0.0000000
      22    Adelie    Adelie  0.96124031     0.03875969   0.0000000
     ---       ---       ---         ---            ---         ---
     336 Chinstrap Chinstrap  0.06382979     0.91489362   0.0212766
     341 Chinstrap    Adelie  0.96124031     0.03875969   0.0000000
     342 Chinstrap Chinstrap  0.06382979     0.91489362   0.0212766

[[5]]

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m68[39m observations:[22m [36m------------------------------------[39m
 row_ids     truth  response prob.Adelie prob.Chinstrap prob.Gentoo
       1    Adelie    Adelie  0.96363636     0.03636364  0.00000000
       2    Adelie    Adelie  0.96363636     0.03636364  0.00000000
       3    Adelie    Adelie  0.96363636     0.03636364  0.00000000
     ---       ---       ---         ---            ---         ---
     320 Chinstrap Chinstrap  0.05454545     0.92727273  0.01818182
     338 Chinstrap Chinstrap  0.05454545     0.92727273  0.01818182
     344 Chinstrap Chinstrap  0.05454545     0.92727273  0.01818182

如果在重采样时指定了 store_models = TRUE，
也可以同理调出学习器
ResampleResult$learner并不是聚合后的学习器，
而是最终选择出来的模型

peng.lrnC.rpart.rr$learner
peng.lrnC.rpart.rr$learners

[36m--[39m [1m[34m<LearnerClassifRpart>[39m (classif.rpart): Classification Tree[22m [36m------------------[39m
* Model: -
* Parameters: xval=0
* Packages: [34mmlr3[39m and [34mrpart[39m
* Predict Types: response and [prob]
* Feature Types: logical, integer, numeric, factor, and ordered
* Encapsulation: none (fallback: -)
* Properties: importance, missings, multiclass, selected_features, twoclass,
and weights
* Other settings: use_weights = 'use'

[[1]]

[36m--[39m [1m[34m<LearnerClassifRpart>[39m (classif.rpart): Classification Tree[22m [36m------------------[39m
* Model: rpart
* Parameters: xval=0
* Packages: [34mmlr3[39m and [34mrpart[39m
* Predict Types: response and [prob]
* Feature Types: logical, integer, numeric, factor, and ordered
* Encapsulation: none (fallback: -)
* Properties: importance, missings, multiclass, selected_features, twoclass,
and weights
* Other settings: use_weights = 'use'

[[2]]

[36m--[39m [1m[34m<LearnerClassifRpart>[39m (classif.rpart): Classification Tree[22m [36m------------------[39m
* Model: rpart
* Parameters: xval=0
* Packages: [34mmlr3[39m and [34mrpart[39m
* Predict Types: response and [prob]
* Feature Types: logical, integer, numeric, factor, and ordered
* Encapsulation: none (fallback: -)
* Properties: importance, missings, multiclass, selected_features, twoclass,
and weights
* Other settings: use_weights = 'use'

[[3]]

[36m--[39m [1m[34m<LearnerClassifRpart>[39m (classif.rpart): Classification Tree[22m [36m------------------[39m
* Model: rpart
* Parameters: xval=0
* Packages: [34mmlr3[39m and [34mrpart[39m
* Predict Types: response and [prob]
* Feature Types: logical, integer, numeric, factor, and ordered
* Encapsulation: none (fallback: -)
* Properties: importance, missings, multiclass, selected_features, twoclass,
and weights
* Other settings: use_weights = 'use'

[[4]]

[36m--[39m [1m[34m<LearnerClassifRpart>[39m (classif.rpart): Classification Tree[22m [36m------------------[39m
* Model: rpart
* Parameters: xval=0
* Packages: [34mmlr3[39m and [34mrpart[39m
* Predict Types: response and [prob]
* Feature Types: logical, integer, numeric, factor, and ordered
* Encapsulation: none (fallback: -)
* Properties: importance, missings, multiclass, selected_features, twoclass,
and weights
* Other settings: use_weights = 'use'

[[5]]

[36m--[39m [1m[34m<LearnerClassifRpart>[39m (classif.rpart): Classification Tree[22m [36m------------------[39m
* Model: rpart
* Parameters: xval=0
* Packages: [34mmlr3[39m and [34mrpart[39m
* Predict Types: response and [prob]
* Feature Types: logical, integer, numeric, factor, and ordered
* Encapsulation: none (fallback: -)
* Properties: importance, missings, multiclass, selected_features, twoclass,
and weights
* Other settings: use_weights = 'use'

可以用lapply()查看每个模型中变量重要度

# 查看全部
lapply(
 peng.lrnC.rpart.rr$learners[2:3], 
 function(x) return(x$model$variable.importance)
)

# 选择子集
lapply(
 peng.lrnC.rpart.rr$learners[2:3], 
 function(x) return(x$model$variable.importance)
)

自定义重采样

rsmp('custom')用于构建留出重采样
- 留出重采样需要手动构建样本ID

peng.rs.ho <- rsmp('custom')
peng.rs.ho.trainSets <- c(1:5, 153:158, 277:280)
peng.rs.ho$instantiate(
 peng.tskC,
 train = list(peng.rs.ho.trainSets, peng.rs.ho.trainSets + 5),
 test = list(peng.rs.ho.trainSets + 15, peng.rs.ho.trainSets + 25)
)
resample(peng.tskC, peng.lrnC.rpart, peng.rr.ho)$prediction()

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m30[39m observations:[22m [36m------------------------------------[39m
 row_ids     truth response prob.Adelie prob.Chinstrap prob.Gentoo
      16    Adelie   Gentoo   0.3333333      0.2666667         0.4
      17    Adelie   Gentoo   0.3333333      0.2666667         0.4
      18    Adelie   Gentoo   0.3333333      0.2666667         0.4
     ---       ---      ---         ---            ---         ---
     303 Chinstrap   Gentoo   0.3333333      0.2666667         0.4
     304 Chinstrap   Gentoo   0.3333333      0.2666667         0.4
     305 Chinstrap   Gentoo   0.3333333      0.2666667         0.4

rsmp('custom_cv')用于构建CV重采样

# 仅选用4个样本，分别是第1，100，200，300行
peng.tskC_small <- peng.tskC$filter(c(1, 100, 200, 300))
peng.rs.ccv <- rsmp('custom_cv')
# 第1，3行为训练集，2，4行为测试集
peng.rs.ccv.folds <- as.factor(c(1, 2, 1, 2))
peng.rs.ccv$instantiate(tskC_small, f = peng.rs.ccv.folds)
resample(peng.tskC_small, peng.lrnC.rpart, peng.rs.ccv)$predictions()

Error in frame$yval2[where, 1L + nclass + 1L:nclass, drop = FALSE]: subscript out of bounds

由于上面莫名其妙地报错，所以用了个新的

# `$filter`是就地修改，如果改了的话运行：
# peng.tskC <- tsk('penguins')
peng.tskC2 <- peng.tskC$clone()
peng.rs.ccv <- rsmp('custom_cv')
peng.rs.ccv.folds <- as.factor(c(rep(1,244),rep(2,100)))
peng.rs.ccv$instantiate(peng.tskC2, f = peng.rs.ccv.folds)
resample(peng.tskC2, peng.lrnC.rpart, peng.rs.ccv)$predictions()

[[1]]

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m244[39m observations:[22m [36m-----------------------------------[39m
 row_ids  truth  response prob.Adelie prob.Chinstrap prob.Gentoo
       1 Adelie Chinstrap           0              1           0
       2 Adelie Chinstrap           0              1           0
       3 Adelie Chinstrap           0              1           0
     ---    ---       ---         ---            ---         ---
     242 Gentoo    Gentoo           0              0           1
     243 Gentoo    Gentoo           0              0           1
     244 Gentoo    Gentoo           0              0           1

[[2]]

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m100[39m observations:[22m [36m-----------------------------------[39m
 row_ids     truth response prob.Adelie prob.Chinstrap prob.Gentoo
     245    Gentoo   Gentoo   0.0212766              0   0.9787234
     246    Gentoo   Gentoo   0.0212766              0   0.9787234
     247    Gentoo   Gentoo   0.0212766              0   0.9787234
     ---       ---      ---         ---            ---         ---
     342 Chinstrap   Adelie   1.0000000              0   0.0000000
     343 Chinstrap   Gentoo   0.0212766              0   0.9787234
     344 Chinstrap   Adelie   1.0000000              0   0.0000000

重采样中的分组与分层

分组重采样

在一些特定的情形下，分组是至关重要的：
- 纵向研究中，对同一个个体进行多个时间点测量，
  如果不分组，可能会高估模型的泛化，
  因为同一个个体的观测值可能同时出现在训练集和测试集中

peng.tskC <-  tsk('penguins')
peng.tskC$set_col_roles('year', 'group')

peng.rs.loo <- rsmp('loo')
peng.rs.loo$instantiate(peng.tskC)

table(peng.tskC$data(rows = peng.rs.loo$train_set(1), cols = 'year'))
table(peng.tskC$data(rows = peng.rs.loo$test_set(1), cols = 'year'))

用CV试了下

peng.tskC <-  tsk('penguins')
peng.tskC$set_col_roles('year', 'group')

peng.rs.cv <- rsmp('cv')
peng.rs.cv$instantiate(peng.tskC)

table(peng.tskC$data(rows = peng.rs.cv$train_set(1), cols = 'year'))
table(peng.tskC$data(rows = peng.rs.cv$test_set(1), cols = 'year'))

上面可以看得出，
2008，2009年的数据分配到了训练集，
而2007的数据分配到了测试集
- 所以factor的第一级会分配到测试集中

分层重采样

分层能够确保在训练集与测试集中样本的特征分布是相同的，
以保证泛化能力较小的偏差
当不平衡情况严重时，少数类可能根本不会出现在训练集中
- 因此，这些重采样迭代中的中间模型将永远不会预测缺失的类，
  从而导致对任何没有分层的重采样策略的性能估计产生误导
依然用Task$set_col_roles()指定

peng.tskC <-  tsk('penguins')
peng.tskC$set_col_roles('species', c('target', 'stratum'))

peng.rs.cv <- rsmp('cv', folds = 10)
peng.rs.cv$instantiate(peng.tskC)

fold1 = prop.table(table(peng.tskC$data(rows = peng.rs.cv$test_set(1),
  cols = 'species')))
fold2 = prop.table(table(peng.tskC$data(rows = peng.rs.cv$test_set(2),
  cols = 'species')))

rbind('Fold 1' = fold1, 'Fold 2' = fold2)

<table class='dataframe'> <caption>A matrix: 2 x 3 of type dbl</caption> <thead> <tr><th></th><th scope=col>Adelie</th><th scope=col>Chinstrap</th><th scope=col>Gentoo</th></tr> </thead> <tbody> <tr><th scope=row>Fold 1</th><td>0.4444444</td><td>0.1944444</td><td>0.3611111</td></tr> <tr><th scope=row>Fold 2</th><td>0.4444444</td><td>0.1944444</td><td>0.3611111</td></tr> </tbody> </table>

基准测试

`benchmark()`

benchmark()可以执行在每个Task和Learner上的重采样resample()，
然后手机它们的结果
首先调用benchmark_grid()函数构建一个
不同Task，Learner，和Resampling的策略组合
（懒得改变量名了，就用教程给的）

# 这里`tasks`是一个`list`
# 使用本地文件可以先`as_task_*()`构建好任务，再用`list()`列表化
tasks <- tsks(c('german_credit', 'sonar')) 
learners <- lrns(c('classif.rpart', 'classif.ranger',
  'classif.featureless'), predict_type = 'prob')
rsmp_cv5 <- rsmp('cv', folds = 5)

design <- benchmark_grid(tasks, learners, rsmp_cv5)

本来用head()可以看的，但是在VS code的 jupyter 里好像用不了，
所以换了种print()的方式

design %>% head()

<table class='dataframe'> <caption>A benchmark_grid: 6 x 3</caption> <thead> <tr><th scope=col>task</th><th scope=col>learner</th><th scope=col>resampling</th></tr> <tr><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td><environment: 0x14a4fe818></td><td><environment: 0x13ad80320></td><td><environment: 0x10b13e698></td></tr> <tr><td><environment: 0x14a4fe818></td><td><environment: 0x139489040></td><td><environment: 0x10b13e698></td></tr> <tr><td><environment: 0x14a4fe818></td><td><environment: 0x10df71690></td><td><environment: 0x10b13e698></td></tr> <tr><td><environment: 0x14c562668></td><td><environment: 0x13ad80320></td><td><environment: 0x10fe429c0></td></tr> <tr><td><environment: 0x14c562668></td><td><environment: 0x139489040></td><td><environment: 0x10fe429c0></td></tr> <tr><td><environment: 0x14c562668></td><td><environment: 0x10df71690></td><td><environment: 0x10fe429c0></td></tr> </tbody> </table>

print(design, cols =ncol(design))

            task             learner resampling
          <char>              <char>     <char>
1: german_credit       classif.rpart         cv
2: german_credit      classif.ranger         cv
3: german_credit classif.featureless         cv
4:         sonar       classif.rpart         cv
5:         sonar      classif.ranger         cv
6:         sonar classif.featureless         cv

这里可以看到design就是一个data.table，
生成的原理也类似于expand_grid()
内容也可以手动进行修改
默认情况下，benchmark_grid() 会在任务上实例化重采样，
这意味着会生成具体的训练 - 测试分割
- 由于此过程是随机的，因此有必要在调用 benchmark_grid() 之前
  设置随机种子，以确保数据分割的可重复性
在benchmark_grid()创建基准测试设计后，
将设计表格传递给benchmark()

bmr <- benchmark(design)
bmr

[36m--[39m [1m[34m<BenchmarkResult>[39m of [34m30[39m rows with [34m6[39m resampling run[22m [36m--------------------------[39m
 nr       task_id          learner_id resampling_id iters warnings errors
  1 german_credit       classif.rpart            cv     5        0      0
  2 german_credit      classif.ranger            cv     5        0      0
  3 german_credit classif.featureless            cv     5        0      0
  4         sonar       classif.rpart            cv     5        0      0
  5         sonar      classif.ranger            cv     5        0      0
  6         sonar classif.featureless            cv     5        0      0

可以用BenchmarkResult$score()查看每个学习器/任务/重采样组合的每一折的结果，
用BenchmarkResult$aggregate()查看每个学习器/任务/重采样组合的每一折的结果
注意，这里的x.[rowVector,.(var1,var2,...)]用法是data.table的独有用法

bmr$score()[c(1, 7, 13), .(iteration, task_id, learner_id, classif.ce)]

<table class='dataframe'> <caption>A bmr_score: 3 x 4</caption> <thead> <tr><th scope=col>iteration</th><th scope=col>task_id</th><th scope=col>learner_id</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><int></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>1</td><td>german_credit</td><td>classif.rpart </td><td>0.29</td></tr> <tr><td>2</td><td>german_credit</td><td>classif.ranger </td><td>0.25</td></tr> <tr><td>3</td><td>german_credit</td><td>classif.featureless</td><td>0.31</td></tr> </tbody> </table>

bmr$aggregate()[, .(task_id, learner_id, classif.ce)]

<table class='dataframe'> <caption>A bmr_aggregate: 6 x 3</caption> <thead> <tr><th scope=col>task_id</th><th scope=col>learner_id</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>german_credit</td><td>classif.rpart </td><td>0.2720000</td></tr> <tr><td>german_credit</td><td>classif.ranger </td><td>0.2420000</td></tr> <tr><td>german_credit</td><td>classif.featureless</td><td>0.3000000</td></tr> <tr><td>sonar </td><td>classif.rpart </td><td>0.2792102</td></tr> <tr><td>sonar </td><td>classif.ranger </td><td>0.1782811</td></tr> <tr><td>sonar </td><td>classif.featureless</td><td>0.4670151</td></tr> </tbody> </table>

这里也可以改成其他的评估器

bmr$aggregate(msr('classif.acc'))[, .(task_id, learner_id, classif.acc)]

<table class='dataframe'> <caption>A bmr_aggregate: 6 x 3</caption> <thead> <tr><th scope=col>task_id</th><th scope=col>learner_id</th><th scope=col>classif.acc</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>german_credit</td><td>classif.rpart </td><td>0.7280000</td></tr> <tr><td>german_credit</td><td>classif.ranger </td><td>0.7580000</td></tr> <tr><td>german_credit</td><td>classif.featureless</td><td>0.7000000</td></tr> <tr><td>sonar </td><td>classif.rpart </td><td>0.7207898</td></tr> <tr><td>sonar </td><td>classif.ranger </td><td>0.8217189</td></tr> <tr><td>sonar </td><td>classif.featureless</td><td>0.5329849</td></tr> </tbody> </table>

`BenchmarkResult`对象

BenchmarkResult对象其实就是多个ResampleResult对象的集合

bmrdt <- as.data.table(bmr)
bmrdt[1:2, .(task, learner, resampling, iteration)]

<table class='dataframe'> <caption>A data.table: 2 x 4</caption> <thead> <tr><th scope=col>task</th><th scope=col>learner</th><th scope=col>resampling</th><th scope=col>iteration</th></tr> <tr><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th><th scope=col><int></th></tr> </thead> <tbody> <tr><td><environment: 0x164aae688></td><td><environment: 0x14c201600></td><td><environment: 0x13ff88320></td><td>1</td></tr> <tr><td><environment: 0x164aae688></td><td><environment: 0x14a63e1b8></td><td><environment: 0x13ff88320></td><td>2</td></tr> </tbody> </table>

存储的 ResampleResult 可以通过 ResampleResult$resample_result(i) 方法提取
- i是执行的重采样实验的索引

rr1 <- bmr$resample_result(1)
rr2 <- bmr$resample_result(2)

rr1
rr2

[36m--[39m [1m[34m<ResampleResult>[39m with [34m5[39m resampling iterations[22m [36m-------------------------------[39m
       task_id    learner_id resampling_id iteration     prediction_test
 german_credit classif.rpart            cv         1 <PredictionClassif>
 german_credit classif.rpart            cv         2 <PredictionClassif>
 german_credit classif.rpart            cv         3 <PredictionClassif>
 german_credit classif.rpart            cv         4 <PredictionClassif>
 german_credit classif.rpart            cv         5 <PredictionClassif>
 warnings errors
        0      0
        0      0
        0      0
        0      0
        0      0


[36m--[39m [1m[34m<ResampleResult>[39m with [34m5[39m resampling iterations[22m [36m-------------------------------[39m
       task_id     learner_id resampling_id iteration     prediction_test
 german_credit classif.ranger            cv         1 <PredictionClassif>
 german_credit classif.ranger            cv         2 <PredictionClassif>
 german_credit classif.ranger            cv         3 <PredictionClassif>
 german_credit classif.ranger            cv         4 <PredictionClassif>
 german_credit classif.ranger            cv         5 <PredictionClassif>
 warnings errors
        0      0
        0      0
        0      0
        0      0
        0      0

ResampleResult$resample_results()也可以打印所有的重采样

bmr$resample_results

<table class='dataframe'> <caption>A data.table: 6 x 3</caption> <thead> <tr><th scope=col>uhash</th><th scope=col>nr</th><th scope=col>resample_result</th></tr> <tr><th scope=col><chr></th><th scope=col><int></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td>e3e12f28-dbeb-491f-9053-bf542a1a6eb7</td><td>1</td><td><environment: 0x13ae1b7c0></td></tr> <tr><td>01b8d3a8-9d06-4520-b3d9-a43dfe6eb620</td><td>2</td><td><environment: 0x13ae79ba0></td></tr> <tr><td>f859c5f2-80ba-4b18-8074-9fa3007c8e16</td><td>3</td><td><environment: 0x13ab7e918></td></tr> <tr><td>c844f002-4add-428c-9bc0-6f1cd7439ffb</td><td>4</td><td><environment: 0x148f66558></td></tr> <tr><td>bba8375a-f30e-4b44-8caa-c7b572d5b151</td><td>5</td><td><environment: 0x148ff9b30></td></tr> <tr><td>78cfe007-fbfd-4f2d-bcd2-3fba990295b5</td><td>6</td><td><environment: 0x13a9f3368></td></tr> </tbody> </table>

as_benchmark_result() 可用于将对象从 ResampleResult 转换为 BenchmarkResult
c() 方法可用于合并多个 BenchmarkResult 对象
- 这在多台机器上进行实验时可能会很有用

bmr1 <- as_benchmark_result(rr1)
bmr2 <- as_benchmark_result(rr2)

c(bmr1, bmr2)

[36m--[39m [1m[34m<BenchmarkResult>[39m of [34m10[39m rows with [34m2[39m resampling run[22m [36m--------------------------[39m
 nr       task_id     learner_id resampling_id iters warnings errors
  1 german_credit  classif.rpart            cv     5        0      0
  2 german_credit classif.ranger            cv     5        0      0

可视化`BenchmarkResult`的评估结果

autoplot(bmr, measure = msr('classif.acc'))

二元分类器的评估

混淆矩阵（Confusion Matrix）

基于混淆矩阵，可以计算以下指标
- True Positive Rate (TPR), Sensitivity or Recall
- True Negative Rate (TNR) or Specificity
- False Positive Rate (FPR), or 1- Specificity
- Positive Predictive Value (PPV) or Precision
- Negative Predictive Value (NPV)
- Accuracy (ACC)
- F1-score $$2 \times \frac{Precision \times Recall}{Precision + Recall}$$

mlr3measures::confusion_matrix()可以生成混淆矩阵

# 准备一下数据
gc.tskC <- tsk('german_credit')
gc.tskC.splits <- partition(gc.tskC)
gc.lrnC.ranger <- lrn('classif.ranger', predict_type = 'prob')
gc.lrnC.ranger$train(gc.tskC, row_ids = gc.tskC.splits$train)
gc.lrnC.ranger.pred <- gc.lrnC.ranger$predict(gc.tskC, row_ids = gc.tskC.splits$test)

# 混淆矩阵
gc.cm.ranger <- mlr3measures::confusion_matrix(
    truth = gc.lrnC.ranger.pred$truth,
    response = gc.lrnC.ranger.pred$response, 
    positive = gc.tskC$positive
)
gc.cm.ranger

        truth
response good bad
    good  207  60
    bad    26  37
acc :  0.7394; ce  :  0.2606; dor :  4.9096; f1  :  0.8280 
fdr :  0.2247; fnr :  0.1116; fomr:  0.4127; fpr :  0.6186 
mcc :  0.3128; npv :  0.5873; ppv :  0.7753; tnr :  0.3814 
tpr :  0.8884

受试者工作特征曲线（ROC curve）分析

对于二元分类问题最常用的评估器
由不同阈值进行分类截断时的FPR与TPR构成的一条曲线
ROC曲线可以由autoplot(Prediction)生成
- 注意：Learner <- lrn('classif.*', predict_type = 'prob')
  必须指定预测的类型为'prob'

autoplot(gc.lrnC.ranger.pred, type = 'roc')

使用msr('classif.auc')调用评估器AUC分析

gc.lrnC.ranger.pred$score(msr('classif.auc'))

classif.auc: 0.772628921745402

精确率 - 召回率曲线（PRC）

PRC能够可视化阳性预测值/精确率与真阳性率/召回率的关系
PRC忽略了真阴性的数量，这在不平衡总体中很有用，
因为阳性类别总是少见的，因此具有高真阳性率的分类器可能仍然提供的信息不多

autoplot(gc.lrnC.ranger.pred, type = 'prc')

使用msr('classif.prauc')调用评估器PRC AUC分析

gc.lrnC.ranger.pred$score(msr('classif.prauc'))

classif.prauc: 0.891557073290125

其他的可视化

可视化其他性能指标随阈值变化的关系
- 这里是误报率（FPR）和准确率为例

autoplot(gc.lrnC.ranger.pred, type = 'threshold', measure = msr('classif.fpr'))
autoplot(gc.lrnC.ranger.pred, type = 'threshold', measure = msr('classif.acc'))

上述的可视化方法同样适用于ResampleResult对象

【mlr3】2.调优

Mon, 21 Jul 2025 00:00:00 GMT

Cover Pic by @晕欧欧

Applied Machine Learning Using mlr3 in R

基本调优方法

调优的整体流程

模型调优（Model Tuning）

搜索空间（search space）/调优空间（tuning space）
- 可供调整的超参数集合
不可调超参数
- 少数模型的训练函数提供了和训练模型不相干的超参数
- 例如lrn('classif.ranger') 中的 verbose 控制训练期间向用户显示多少信息
对于数值型的超参数，需要指定调整的范围
使用to_tune()来构建调整范围的下限与上限

learner <- lrn('classif.svm',
  type  = 'C-classification',
  kernel = 'radial',
  cost  = to_tune(1e-1, 1e5),
  gamma = to_tune(1e-1, 1)
)
learner

如果对用to_tune()标记了超参数的学习器调用Learner$train()的话会抛出错误

终止器（Terminator）

~~终结者~~
mlr_terminators存储了所有终止器的种类，
使用 trm() 创建终止器

Terminator <br>终止器	Function call and default parameters <br>函数调用和默认参数
Clock Time <br>时钟时间	`trm('clock_time')`
Combo <br>组合	`trm('combo', any = TRUE)`
None <br>无	`trm('none')`
Number of Evaluations <br>评估次数	`trm('evals', n_evals = 100, k = 0)`
Performance Level <br>性能水平	`trm('perf_reached', level = 0.1)`
Run Time <br>运行时间	`trm('run_time', secs = 30)`
Stagnation <br>停滞	`trm('stagnation', iters = 10, threshold = 0)`

mlr_terminators %>% as.data.table()

<table class='dataframe'> <caption>A data.table: 9 x 4</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>properties</th><th scope=col>unit</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><list></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><td>clock_time </td><td>Clock Time </td><td>single-crit, multi-crit </td><td>seconds </td></tr> <tr><td>combo </td><td>Combination </td><td>single-crit, multi-crit </td><td>percent </td></tr> <tr><td>evals </td><td>Number of Evaluation </td><td>single-crit, multi-crit </td><td>evaluations</td></tr> <tr><td>none </td><td>None </td><td>single-crit, multi-crit </td><td>percent </td></tr> <tr><td>perf_reached </td><td>Performance Level </td><td>single-crit</td><td>percent </td></tr> <tr><td>run_time </td><td>Run Time </td><td>single-crit, multi-crit </td><td>seconds </td></tr> <tr><td>stagnation </td><td>Stagnation </td><td>single-crit</td><td>percent </td></tr> <tr><td>stagnation_batch </td><td>Stagnation Batch </td><td>single-crit</td><td>percent </td></tr> <tr><td>stagnation_hypervolume</td><td>Stagnation Hypervolume</td><td>multi-crit</td><td>percent </td></tr> </tbody> </table>

最常用的终止条件是在特定时间（trm('run_time'），
或给定评估次数（trm('evals')）后停止调优
- 选择运行时间通常基于实际考虑和直觉
  - 在计算集群上，使用时间限制可能很重要，
    因为可能需要为计算任务指定最长运行时间
- trm('perf_reached')在达到指定性能水平时停止调优
  - 如果某个性能水平被认为足以满足模型的实际应用，这会很有帮助
  - 但是，如果设置得过于乐观，调优可能永远不会终止
trm('stagnation')在设定数量的iterations中没有取得大于threshold的进展时停止
- 对于复杂的搜索空间，阈值可能很难选择
- 因为尽管仍有（可能很大的）改进空间，但优化可能会过早停止
trm('none')用于自行控制终止的调谐器，因此此终止条件不起作用
这些终止条件中的任何一个都可以通过使用trm('combo')自由组合，
可用于指定超参数优化在任何终止条件触发时完成（any = TRUE），
或者在所有终止条件触发时完成（any = FALSE）

使用`ti()`进行实例调优（Tuning Instance）

这里用ti()创建了一个单目标调优的TuningInstanceBatchSingleCrit对象
所谓的实例，就是将Task，Learner，Resampling，Measure，和Terminator这些要素打包在一起，提供给Tuner进行调优
调优的结果也会储存在Instance里面

# 调取预设任务`'sonar'`
tsk_sonar <-  tsk('sonar')
# 构建学习器
learner <-  lrn('classif.svm',
 # 指定调优的超参数`cose`和`gamma`
 cost  = to_tune(1e-1, 1e5),
 gamma = to_tune(1e-1, 1),
 # 设置其他的超参数
 kernel = 'radial',
 type = 'C-classification'
)
# 进行实例调优
instance <-  ti(
 task = tsk_sonar,
 learner = learner,
 resampling = rsmp('cv', folds = 3),
 # 这里只有一个`Measure`，所以是单目标调优
 # 如果这里是`msrs(c('msr1','msr2'))`，那么就是多目标调优
 measures = msr('classif.ce'),
 # 遍历整个网格，不过早停止，因此不设定终止器
 terminator = trm('none')
)
# 查看实例
instance

<TuningInstanceBatchSingleCrit>
* State:  Not optimized
* Objective: <ObjectiveTuningBatch:classif.svm_on_sonar>
* Search Space:
       id    class lower upper nlevels
   <char>   <char> <num> <num>   <num>
1:   cost ParamDbl   0.1 1e+05     Inf
2:  gamma ParamDbl   0.1 1e+00     Inf
* Terminator: <TerminatorNone>

其实这里<TuningInstanceBatchSingleCrit>已经看得出是单目标调优对象了
可以随便看看instance的类

instance %>% class()

'TuningInstanceBatchSingleCrit''OptimInstanceBatchSingleCrit''OptimInstanceBatch''OptimInstance''R6'

调优器（Tuner）

调优器种类

下表给出了可用的Tuner

Tuner <br>调谐器	Function call <br>函数调用	Package <br>包
Random Search <br>随机搜索	`tnr('random_search')`	`mlr3tuning`
Grid Search <br>网格搜索	`tnr('grid_search')`	`mlr3tuning`
Bayesian Optimization <br>贝叶斯优化	`tnr('mbo')`	`mlr3mbo`
CMA-ES <br>协方差矩阵自适应进化策略	`tnr('cmaes')`	`adagio`
Iterated Racing <br>迭代竞赛	`tnr('irace')`	`irace`
Hyperband <br>超参数优化算法	`tnr('hyperband')`	`mlr3hyperband`
Generalized Simulated Annealing <br>广义模拟退火算法	`tnr('gensa')`	`GenSA`
Nonlinear Optimization <br>非线性优化	`tnr('nloptr')`	`nloptr`

使用tnr()来调用调优器

tnr('grid_search')

<TunerBatchGridSearch>: Grid Search
* Parameters: batch_size=1, resolution=10
* Parameter classes: ParamLgl, ParamInt, ParamDbl, ParamFct
* Properties: dependencies, single-crit, multi-crit
* Packages: mlr3tuning, bbotk

调优策略

搜索策略（Search strategies）
- 网格搜索和随机搜索是最基本的算法，在初始实验中通常首先被选用
- 网格搜索
  - 思路是详尽地评估给定超参数值的每一种可能组合
  - 分类超参数通常会在其所有可能取值上进行评估
  - 数值型和整型超参数值会根据给定的分辨率
    （即每个超参数要尝试的不同值的数量），
    在其边界约束（上限和下限）内等距分布
- 随机搜索
  - 从预先指定的分布（通常是均匀分布）中为每个超参数独立地随机选择值
- 这两种方法都不具备适应性，
  也就是说每次提出的配置都忽略了先前配置的性能
- 由于其简单性，
  网格搜索和随机搜索都可以处理混合搜索空间（即超参数可以是数值型、整型或分类型）以及分层搜索空间
自适应算法（Adaptive Algorithms）
- 自适应算法从先前评估的配置中学习，以快速找到良好的配置
- 贝叶斯优化（Bayesian Optimization）
  - 使用代理模型来近似待优化的未知函数
    - 在超参数优化中，这将是从超参数配置到估计的泛化性能的映射
  - 如果选择了合适的代理模型，例如随机森林，
    贝叶斯优化可以相当灵活，甚至可以处理混合和分层搜索空间
- 协方差矩阵自适应进化策略
  （Covariance Matrix Adaptation Evolution Strategy）
  - 在候选点上维持一个概率分布，该分布由一个均值向量和协方差矩阵表示
    通过从这个分布中采样生成一组新的候选点，每个候选点被选中的概率与其性能成正比
  - 协方差矩阵会随着时间进行调整，以反映性能态势
  - 通过miesmuschel包，在mlr3中还可使用更多进化策略
- 迭代竞赛算法（Iterated Racing）
  - 迭代舍弃那些经统计检验显示性能不佳的配置
  - 首先从参数化密度中随机采样的初始配置群体中进行 “竞赛”，
    然后利用竞赛中幸存的配置来随机更新后续竞赛的密度，
    以便聚焦于搜索空间中有前景的区域，
    依此类推
- 超带算法（Hyperband）/ 多保真度超参数优化（Multi-fidelity HPO）
  - 一种自适应方法，
    利用计算成本较低的低保真度评估的预测能力
    （即质量较差的预测例如那些由训练轮数较少的神经网络产生的预测）
    来提高整体优化效率

策略选择

搜索策略
- 如果搜索空间较小或结构不复杂，
  网格搜索或许能够在合理时间内详尽评估整个搜索空间
- 由于高纬度的搜索空间导致的的维度灾难以及对数值搜索空间的覆盖不足，
  通常不推荐使用网格搜索
  - 此时，随机搜索往往是更好的选择，
    因为可以考虑更多独特值
更优的算法
- 适用于高维度或结构更复杂的搜索空间
- 进化策略和贝叶斯优化间的选择
  - 根据函数评估的成本进行选择
  - 进化策略（evolutionary strategies）
    - 超参数配置能够快速评估时
  - 贝叶斯优化（Bayesian optimization）
    - 模型评估耗时且优化预算有限时
  - 通常推荐在超参数优化中使用贝叶斯优化
    - 虽然贝叶斯优化的优化成本相对较大
      （例如，在每次迭代中，都要训练代理模型并优化采集函数），
      但在诸如机器学习模型重采样等函数评估成本相对较高的情况下，
      这种影响较小
- 在超参数优化问题涉及有意义的保真度参数（例如，轮数、树的数量、提升轮数）
  且需要高效使用优化预算的情况下，
  像Hyperband这样的多保真度超参数优化算法可能值得考虑

调优器处理的类型

Learner$param_classes
- 提供可以处理哪些类别的超参数
Learner$param_classes
- 提供可以处理哪些特性

tnr('grid_search')$param_classes
tnr('grid_search')$properties

'ParamLgl''ParamInt''ParamDbl''ParamFct'
'dependencies''single-crit''multi-crit'

（重新回顾一下如何去看超参数类型）
- 这里的class就是了

lrn('classif.svm')$param_set

<ParamSet(16)>
Key: <id>
                 id    class lower upper nlevels          default parents
             <char>   <char> <num> <num>   <num>           <list>  <list>
 1:       cachesize ParamDbl  -Inf   Inf     Inf               40  [NULL]
 2:   class.weights ParamUty    NA    NA     Inf           [NULL]  [NULL]
 3:           coef0 ParamDbl  -Inf   Inf     Inf                0  kernel
 4:            cost ParamDbl     0   Inf     Inf                1    type
 5:           cross ParamInt     0   Inf     Inf                0  [NULL]
 6: decision.values ParamLgl    NA    NA       2            FALSE  [NULL]
 7:          degree ParamInt     1   Inf     Inf                3  kernel
 8:         epsilon ParamDbl     0   Inf     Inf              0.1  [NULL]
 9:          fitted ParamLgl    NA    NA       2             TRUE  [NULL]
10:           gamma ParamDbl     0   Inf     Inf   <NoDefault[0]>  kernel
11:          kernel ParamFct    NA    NA       4           radial  [NULL]
12:              nu ParamDbl  -Inf   Inf     Inf              0.5    type
13:           scale ParamUty    NA    NA     Inf             TRUE  [NULL]
14:       shrinking ParamLgl    NA    NA       2             TRUE  [NULL]
15:       tolerance ParamDbl     0   Inf     Inf            0.001  [NULL]
16:            type ParamFct    NA    NA       2 C-classification  [NULL]
     value
    <list>
 1: [NULL]
 2: [NULL]
 3: [NULL]
 4: [NULL]
 5: [NULL]
 6: [NULL]
 7: [NULL]
 8: [NULL]
 9: [NULL]
10: [NULL]
11: [NULL]
12: [NULL]
13: [NULL]
14: [NULL]
15: [NULL]
16: [NULL]

lrn('classif.svm')$param_set$deps

<table class='dataframe'> <caption>A data.table: 5 x 3</caption> <thead> <tr><th scope=col>id</th><th scope=col>on</th><th scope=col>cond</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td>coef0 </td><td>kernel</td><td>polynomial , sigmoid , %s %%in%% {%s}</td></tr> <tr><td>cost </td><td>type </td><td>C-classification, %s == %s </td></tr> <tr><td>degree</td><td>kernel</td><td>polynomial, %s == %s </td></tr> <tr><td>gamma </td><td>kernel</td><td>polynomial , radial , sigmoid , %s %%in%% {%s}</td></tr> <tr><td>nu </td><td>type </td><td>nu-classification, %s == %s </td></tr> </tbody> </table>

触发调优过程

这个是之前构建好的实例

tsk_sonar <-  tsk('sonar')
# 构建学习器
learner <-  lrn('classif.svm',
 # 指定调优的超参数`cose`和`gamma`
 cost  = to_tune(1e-1, 1e5),
 gamma = to_tune(1e-1, 1),
 # 设置其他的超参数
 kernel = 'radial',
 type = 'C-classification'
)
# 进行实例调优
instance <-  ti(
 task = tsk_sonar,
 learner = learner,
 resampling = rsmp('cv', folds = 3),
 measures = msr('classif.ce'),
 terminator = trm('none')
)

创建调优器
- resolution：控制网格搜索中每个超参数的候选值数量，决定搜索的细致程度
- batch_size：控制评估超参数组合时的分批规模，平衡计算资源与效率

tuner <- tnr('grid_search', resolution = 5, batch_size = 10)

接下来使用Tuner$optimize(TuningInstanceBatchSingleCrit)进行调优
- 结果返回了最佳的调优参数，并且储存在了
  TuningInstanceBatchSingleCrit$result中

tuner$optimize(instance)

<table class='dataframe'> <caption>A data.table: 1 x 5</caption> <thead> <tr><th scope=col>cost</th><th scope=col>gamma</th><th scope=col>learner_param_vals</th><th scope=col>x_domain</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><list></th><th scope=col><list></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>25000.08</td><td>0.1</td><td>radial , C-classification, 25000.075 , 0.1 </td><td>25000.08, 0.10</td><td>0.27902</td></tr> </tbody> </table>

instance$result
instance$result$learner_param_vals

$kernel
'radial'
$type
'C-classification'
$cost
25000.075
$gamma
0.1

对数变换

对于许多具有较大上界的非负超参数，
在对数尺度上进行调优可能比在线性尺度上更有效
对数变化之后可以让备选参数的范围更集中

cost <- runif(1000, log(1e-5), log(1e5))
exp_cost <- exp(cost)

# library(patchwork)
data.frame(x=cost) %>% ggplot(aes(x=x)) + geom_histogram() + theme_bw() & data.frame(x=exp_cost) %>% ggplot(aes(x=x)) + geom_histogram() + theme_bw()

左边是Tuner中采样的结果频数
右边
在调优时，只用将logscale = TRUE 传递给 to_tune() 即可

# 调取任务
tsk_sonar <-  tsk('sonar')
# 构建学习器
learner <-  lrn('classif.svm',
 # 指定调优的超参数`cose`和`gamma`
 # 选择将对数变换的结果传递给`Learner`
 cost  = to_tune(1e-1, 1e5, logscale = TRUE),
 gamma = to_tune(1e-1, 1e5, logscale = TRUE),
 # 设置其他的超参数
 kernel = 'radial',
 type = 'C-classification'
)
# 进行实例调优
instance <-  ti(
 task = tsk_sonar,
 learner = learner,
 resampling = rsmp('cv', folds = 3),
 measures = msr('classif.ce'),
 terminator = trm('none')
)
# 构建调优器
tuner <- tnr('grid_search', resolution = 5, batch_size = 10)
# 调优实例
tuner$optimize(instance)

<table class='dataframe'> <caption>A data.table: 1 x 5</caption> <thead> <tr><th scope=col>cost</th><th scope=col>gamma</th><th scope=col>learner_param_vals</th><th scope=col>x_domain</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><list></th><th scope=col><list></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>1.151293</td><td>-2.302585</td><td>radial , C-classification, 3.16227766016838, 0.1 </td><td>3.162278, 0.100000</td><td>0.2408558</td></tr> </tbody> </table>

cost和gamma是对数变换前的最优值，
而learner_param_vals和x_domain包含的是是对数变换后的

instance$result_learner_param_vals
instance$result$learner_param_vals

$kernel
'radial'
$type
'C-classification'
$cost
3.16227766016838
$gamma
0.1

instance$result_x_domain
instance$result$x_domain

$cost
3.16227766016838
$gamma
0.1

可以简单验算一下结果
- 结果和上方的结果完全一致

instance$result$cost
exp(instance$result$cost)

1.15129254649702
3.16227766016838

分析和使用结果

评估完的结果储存在Instance$archive里面
一共有25组，这是因为设定的Tuner的resulution是5，
所以可以得到$5^{2}= 25$

instance$archive

<table class='dataframe'> <caption>A data.table: 25 x 10</caption> <thead> <tr><th scope=col>cost</th><th scope=col>gamma</th><th scope=col>classif.ce</th><th scope=col>runtime_learners</th><th scope=col>timestamp</th><th scope=col>warnings</th><th scope=col>errors</th><th scope=col>x_domain</th><th scope=col>batch_nr</th><th scope=col>resample_result</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dttm></th><th scope=col><int></th><th scope=col><int></th><th scope=col><list></th><th scope=col><int></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td>-2.302585</td><td>11.512925</td><td>0.4665286</td><td>0.039</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>1e-01, 1e+05</td><td>1</td><td><environment: 0x1734a6650></td></tr> <tr><td> 1.151293</td><td>-2.302585</td><td>0.2408558</td><td>0.046</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3.162278, 0.100000</td><td>1</td><td><environment: 0x173467a08></td></tr> <tr><td> 1.151293</td><td> 1.151293</td><td>0.4665286</td><td>0.030</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3.162278, 3.162278</td><td>1</td><td><environment: 0x173430338></td></tr> <tr><td> 1.151293</td><td> 8.059048</td><td>0.4665286</td><td>0.026</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3.162278, 3162.277660</td><td>1</td><td><environment: 0x1733e7c38></td></tr> <tr><td> 1.151293</td><td>11.512925</td><td>0.4665286</td><td>0.030</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3.162278e+00, 1.000000e+05</td><td>1</td><td><environment: 0x1733b1f48></td></tr> <tr><td> 4.605170</td><td>-2.302585</td><td>0.2408558</td><td>0.100</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>100.0, 0.1</td><td>1</td><td><environment: 0x173087ad0></td></tr> <tr><td> 8.059048</td><td>-2.302585</td><td>0.2408558</td><td>0.030</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3162.278, 0.100</td><td>1</td><td><environment: 0x17361d128></td></tr> <tr><td> 8.059048</td><td>11.512925</td><td>0.4665286</td><td>0.027</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3162.278, 100000.000</td><td>1</td><td><environment: 0x173397c08></td></tr> <tr><td>11.512925</td><td>11.512925</td><td>0.4665286</td><td>0.030</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>1e+05, 1e+05</td><td>1</td><td><environment: 0x173350e78></td></tr> <tr><td>-2.302585</td><td>-2.302585</td><td>0.4665286</td><td>0.029</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>0.1, 0.1</td><td>2</td><td><environment: 0x173313660></td></tr> <tr><td>-2.302585</td><td> 8.059048</td><td>0.4665286</td><td>0.026</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>0.100, 3162.278</td><td>2</td><td><environment: 0x1732e5170></td></tr> <tr><td> 1.151293</td><td> 4.605170</td><td>0.4665286</td><td>0.025</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3.162278, 100.000000</td><td>2</td><td><environment: 0x1732b32b0></td></tr> <tr><td> 4.605170</td><td> 1.151293</td><td>0.4665286</td><td>0.038</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>100.000000, 3.162278</td><td>2</td><td><environment: 0x1732860c8></td></tr> <tr><td> 8.059048</td><td> 1.151293</td><td>0.4665286</td><td>0.030</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3162.277660, 3.162278</td><td>2</td><td><environment: 0x171620ab0></td></tr> <tr><td> 8.059048</td><td> 8.059048</td><td>0.4665286</td><td>0.031</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3162.278, 3162.278</td><td>2</td><td><environment: 0x1715e60b0></td></tr> <tr><td>11.512925</td><td> 1.151293</td><td>0.4665286</td><td>0.035</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>1.000000e+05, 3.162278e+00</td><td>2</td><td><environment: 0x173054958></td></tr> <tr><td>11.512925</td><td> 8.059048</td><td>0.4665286</td><td>0.029</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>100000.000, 3162.278</td><td>2</td><td><environment: 0x173214b00></td></tr> <tr><td>-2.302585</td><td> 1.151293</td><td>0.4665286</td><td>0.031</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>0.100000, 3.162278</td><td>3</td><td><environment: 0x1731baa20></td></tr> <tr><td>-2.302585</td><td> 4.605170</td><td>0.4665286</td><td>0.027</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>0.1, 100.0</td><td>3</td><td><environment: 0x173160e10></td></tr> <tr><td> 4.605170</td><td> 4.605170</td><td>0.4665286</td><td>0.026</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>100, 100</td><td>3</td><td><environment: 0x1730f8d98></td></tr> <tr><td> 4.605170</td><td> 8.059048</td><td>0.4665286</td><td>0.040</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>100.000, 3162.278</td><td>3</td><td><environment: 0x173064ba0></td></tr> <tr><td> 4.605170</td><td>11.512925</td><td>0.4665286</td><td>0.064</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>1e+02, 1e+05</td><td>3</td><td><environment: 0x13a1f7410></td></tr> <tr><td> 8.059048</td><td> 4.605170</td><td>0.4665286</td><td>0.033</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>3162.278, 100.000</td><td>3</td><td><environment: 0x176b02dd8></td></tr> <tr><td>11.512925</td><td>-2.302585</td><td>0.2408558</td><td>0.035</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>1e+05, 1e-01</td><td>3</td><td><environment: 0x176c46388></td></tr> <tr><td>11.512925</td><td> 4.605170</td><td>0.4665286</td><td>0.039</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>1e+05, 1e+02</td><td>3</td><td><environment: 0x176bf3e68></td></tr> </tbody> </table>

可以根据不同的性能指标对内部ResampleResult进行评分
- zhe l这里是考察漏报率、误报率以及分类错误

as.data.table(
 instance$archive,
 measures = msrs(c('classif.fpr', 'classif.fnr'))
)

<table class='dataframe'> <caption>A data.table: 25 x 12</caption> <thead> <tr><th scope=col>cost</th><th scope=col>gamma</th><th scope=col>classif.ce</th><th scope=col>classif.fpr</th><th scope=col>classif.fnr</th><th scope=col>runtime_learners</th><th scope=col>timestamp</th><th scope=col>warnings</th><th scope=col>errors</th><th scope=col>x_domain</th><th scope=col>batch_nr</th><th scope=col>resample_result</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dttm></th><th scope=col><int></th><th scope=col><int></th><th scope=col><list></th><th scope=col><int></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td>-2.302585</td><td>11.512925</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.039</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>1e-01, 1e+05</td><td>1</td><td><environment: 0x17b2d4438></td></tr> <tr><td> 1.151293</td><td>-2.302585</td><td>0.2408558</td><td>0.4606607</td><td>0.03397436</td><td>0.046</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3.162278, 0.100000</td><td>1</td><td><environment: 0x17b2bce48></td></tr> <tr><td> 1.151293</td><td> 1.151293</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.030</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3.162278, 3.162278</td><td>1</td><td><environment: 0x17b2a6070></td></tr> <tr><td> 1.151293</td><td> 8.059048</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.026</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3.162278, 3162.277660</td><td>1</td><td><environment: 0x17b288a58></td></tr> <tr><td> 1.151293</td><td>11.512925</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.030</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3.162278e+00, 1.000000e+05</td><td>1</td><td><environment: 0x17b2719e0></td></tr> <tr><td> 4.605170</td><td>-2.302585</td><td>0.2408558</td><td>0.4606607</td><td>0.03397436</td><td>0.100</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>100.0, 0.1</td><td>1</td><td><environment: 0x17b254208></td></tr> <tr><td> 8.059048</td><td>-2.302585</td><td>0.2408558</td><td>0.4606607</td><td>0.03397436</td><td>0.030</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3162.278, 0.100</td><td>1</td><td><environment: 0x17b23cb00></td></tr> <tr><td> 8.059048</td><td>11.512925</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.027</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3162.278, 100000.000</td><td>1</td><td><environment: 0x17b19f510></td></tr> <tr><td>11.512925</td><td>11.512925</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.030</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>1e+05, 1e+05</td><td>1</td><td><environment: 0x17b17e0e0></td></tr> <tr><td>-2.302585</td><td>-2.302585</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.029</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>0.1, 0.1</td><td>2</td><td><environment: 0x17b1639e0></td></tr> <tr><td>-2.302585</td><td> 8.059048</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.026</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>0.100, 3162.278</td><td>2</td><td><environment: 0x17b140828></td></tr> <tr><td> 1.151293</td><td> 4.605170</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.025</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3.162278, 100.000000</td><td>2</td><td><environment: 0x17b1184e0></td></tr> <tr><td> 4.605170</td><td> 1.151293</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.038</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>100.000000, 3.162278</td><td>2</td><td><environment: 0x17b0ffee8></td></tr> <tr><td> 8.059048</td><td> 1.151293</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.030</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3162.277660, 3.162278</td><td>2</td><td><environment: 0x17b0e54d8></td></tr> <tr><td> 8.059048</td><td> 8.059048</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.031</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>3162.278, 3162.278</td><td>2</td><td><environment: 0x17b0c9120></td></tr> <tr><td>11.512925</td><td> 1.151293</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.035</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>1.000000e+05, 3.162278e+00</td><td>2</td><td><environment: 0x17b0ae860></td></tr> <tr><td>11.512925</td><td> 8.059048</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.029</td><td>2025-06-17 14:29:56</td><td>0</td><td>0</td><td>100000.000, 3162.278</td><td>2</td><td><environment: 0x17b0978c8></td></tr> <tr><td>-2.302585</td><td> 1.151293</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.031</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>0.100000, 3.162278</td><td>3</td><td><environment: 0x17b07ce80></td></tr> <tr><td>-2.302585</td><td> 4.605170</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.027</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>0.1, 100.0</td><td>3</td><td><environment: 0x17b062f60></td></tr> <tr><td> 4.605170</td><td> 4.605170</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.026</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>100, 100</td><td>3</td><td><environment: 0x17b049820></td></tr> <tr><td> 4.605170</td><td> 8.059048</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.040</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>100.000, 3162.278</td><td>3</td><td><environment: 0x17b02c320></td></tr> <tr><td> 4.605170</td><td>11.512925</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.064</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>1e+02, 1e+05</td><td>3</td><td><environment: 0x17b015b30></td></tr> <tr><td> 8.059048</td><td> 4.605170</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.033</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>3162.278, 100.000</td><td>3</td><td><environment: 0x1797f0da0></td></tr> <tr><td>11.512925</td><td>-2.302585</td><td>0.2408558</td><td>0.4606607</td><td>0.03397436</td><td>0.035</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>1e+05, 1e-01</td><td>3</td><td><environment: 0x1797d1698></td></tr> <tr><td>11.512925</td><td> 4.605170</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td><td>0.039</td><td>2025-06-17 14:29:57</td><td>0</td><td>0</td><td>1e+05, 1e+02</td><td>3</td><td><environment: 0x1797b2a90></td></tr> </tbody> </table>

只挑前五个的一部分

as.data.table(
 instance$archive,
 measures = msrs(c('classif.fpr', 'classif.fnr'))
)[1:5 ,.(cost, gamma, classif.ce, classif.fpr, classif.fnr)]

<table class='dataframe'> <caption>A data.table: 5 x 5</caption> <thead> <tr><th scope=col>cost</th><th scope=col>gamma</th><th scope=col>classif.ce</th><th scope=col>classif.fpr</th><th scope=col>classif.fnr</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>-2.302585</td><td>11.512925</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td></tr> <tr><td> 1.151293</td><td>-2.302585</td><td>0.2408558</td><td>0.4606607</td><td>0.03397436</td></tr> <tr><td> 1.151293</td><td> 1.151293</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td></tr> <tr><td> 1.151293</td><td> 8.059048</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td></tr> <tr><td> 1.151293</td><td>11.512925</td><td>0.4665286</td><td>1.0000000</td><td>0.00000000</td></tr> </tbody> </table>

Instance$archive$benchmark_result中储存了所有的BenchmarkResult对象

{instance$archive$benchmark_result %>% as.data.table()}[1:5]

<table class='dataframe'> <caption>A data.table: 5 x 9</caption> <thead> <tr><th scope=col>uhash</th><th scope=col>task</th><th scope=col>learner</th><th scope=col>resampling</th><th scope=col>iteration</th><th scope=col>prediction</th><th scope=col>task_id</th><th scope=col>learner_id</th><th scope=col>resampling_id</th></tr> <tr><th scope=col><chr></th><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th><th scope=col><int></th><th scope=col><list></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><td>e31b69c6-41d4-4d7f-81c2-ed3b4bd3b75f</td><td><environment: 0x17cd32908></td><td><environment: 0x3064c38c0></td><td><environment: 0x17269e738></td><td>1</td><td><environment: 0x3202d2ac0></td><td>sonar</td><td>classif.svm</td><td>cv</td></tr> <tr><td>e31b69c6-41d4-4d7f-81c2-ed3b4bd3b75f</td><td><environment: 0x17cd32908></td><td><environment: 0x306425260></td><td><environment: 0x17269e738></td><td>2</td><td><environment: 0x32023dcf0></td><td>sonar</td><td>classif.svm</td><td>cv</td></tr> <tr><td>e31b69c6-41d4-4d7f-81c2-ed3b4bd3b75f</td><td><environment: 0x17cd32908></td><td><environment: 0x30a0e4660></td><td><environment: 0x17269e738></td><td>3</td><td><environment: 0x32019c9d0></td><td>sonar</td><td>classif.svm</td><td>cv</td></tr> <tr><td>5413c20f-f67c-4741-bc1e-6535ac83e266</td><td><environment: 0x17cd32908></td><td><environment: 0x300847120></td><td><environment: 0x17269e738></td><td>1</td><td><environment: 0x320379c40></td><td>sonar</td><td>classif.svm</td><td>cv</td></tr> <tr><td>5413c20f-f67c-4741-bc1e-6535ac83e266</td><td><environment: 0x17cd32908></td><td><environment: 0x31f42b8c0></td><td><environment: 0x17269e738></td><td>2</td><td><environment: 0x17ede9278></td><td>sonar</td><td>classif.svm</td><td>cv</td></tr> </tbody> </table>

可以将type = 'surface'传递给autoplot.TuningInstanceBatchSingleCrit来可视化实例调优的结果
- 蓝色的区域表示classif.ce评估器的较小结果，表明模型更优

autoplot(instance, type = 'surface')

训练优化模型

当确定好超参数后，将Instance中的超参数传递给新建学习器中

lrn_svm_tuned <- lrn('classif.svm')
lrn_svm_tuned$param_set$values <- instance$result_learner_param_vals

之后进行最基础的训练流程即可

lrn_svm_tuned$train(tsk_sonar)$model

Call:
svm.default(x = data, y = task$truth(), type = 'C-classification', 
    kernel = 'radial', gamma = 0.1, cost = 3.16227766016838, probability = (self$predict_type == 
        'prob'))


Parameters:
   SVM-Type:  C-classification 
 SVM-Kernel:  radial 
       cost:  3.162278 

Number of Support Vectors:  205

更便捷的调优方法

基本调优方法中用的是ti()创建调优实例，
之后用Tuner$optimize()进行调优

`tune()`

tune()可以在创建实例后直接进行调优，
省略手动先创建调优实例，后
下面的例子可以进行简单的对比

# 调取任务
tsk_sonar <-  tsk('sonar')

# ---------------之前的方法
# 构建学习器
learner <-  lrn('classif.svm',
 # 指定调优的超参数`cose`和`gamma`
 # 选择将对数变换的结果传递给`Learner`
 cost  = to_tune(1e-1, 1e5, logscale = TRUE),
 gamma = to_tune(1e-1, 1e5, logscale = TRUE),
 # 设置其他的超参数
 kernel = 'radial',
 type = 'C-classification'
)
# 进行实例调优
instance <-  ti(
 task = tsk_sonar,
 learner = learner,
 resampling = rsmp('cv', folds = 3),
 measures = msr('classif.ce'),
 terminator = trm('none')
)
# 构建调优器
tuner <- tnr('grid_search', resolution = 5, batch_size = 10)
# 调优实例
tuner$optimize(instance)

# ---------------`tune()`的方法
# 构建学习器
lrn_svm <- lrn('classif.svm',
  cost  = to_tune(1e-5, 1e5, logscale = TRUE),
  gamma = to_tune(1e-5, 1e5, logscale = TRUE),
  kernel = 'radial',
  type = 'C-classification'
)
# [构建调优器]
# 需要先构建调优器，之后传递到`tune()`中
tnr_grid_search <- tnr('grid_search', resolution = 5, batch_size = 5)
# 进行实例调优
instance <- tune(
 # [这里多了`tuner`参数]
 # 所以先构建的调优器，后传递到`tune()`中
 # 也可以直接输入`tnr('grid_search', resolution = 5, batch_size = 5)`
 tuner = tnr_grid_search,
 task = tsk_sonar,
 learner = lrn_svm,
 resampling = rsmp('cv', folds = 3),
 measures = msr('classif.ce')
)
instance$result

`auto_tune()`

auto_tune() 创建一个AutoTuner类的对象
AutoTuner继承自Learner类，并封装了调优所需的所有信息，
这意味着AutoTuner就是一个Learner
在底层，AutoTuner本质上是在调用Learner$train()时传递给模型的数据上运行tune()，然后将Learner$param_set参数设置为最优配置

# 调取任务
tsk_sonar <-  tsk('sonar')

# ---------------之前的方法
# 构建学习器
learner <-  lrn('classif.svm',
 # 指定调优的超参数`cose`和`gamma`
 # 选择将对数变换的结果传递给`Learner`
 cost  = to_tune(1e-1, 1e5, logscale = TRUE),
 gamma = to_tune(1e-1, 1e5, logscale = TRUE),
 # 设置其他的超参数
 kernel = 'radial',
 type = 'C-classification'
)
# 进行实例调优
instance <-  ti(
 task = tsk_sonar,
 learner = learner,
 resampling = rsmp('cv', folds = 3),
 measures = msr('classif.ce'),
 terminator = trm('none')
)
# 构建调优器
tuner <- tnr('grid_search', resolution = 5, batch_size = 10)
# 调优实例
tuner$optimize(instance)

# ---------------`auto_tune()`的方法
# 构建学习器
lrn_svm <- lrn('classif.svm',
 cost  = to_tune(1e-5, 1e5, logscale = TRUE),
 gamma = to_tune(1e-5, 1e5, logscale = TRUE),
 kernel = 'radial',
 type = 'C-classification'
)
# [构建调优器]
# 需要先构建调优器，之后传递到`auto_tune()`中
tnr_grid_search <- tnr('grid_search', resolution = 5, batch_size = 5)
# 创建`AutoTuner`
at <- auto_tuner(
 tuner = tnr_grid_search,
 learner = lrn_svm,
 resampling = rsmp('cv', folds = 3),
 measure = msr('classif.ce')
)
# 分割`Task`的数据
split <- partition(tsk_sonar) 
# 训练模型，在此过程中自动调优选择出最佳的超参数
at$train(tsk_sonar, row_ids = split$train) 
# 预测模型，获得评估结果
pred <- at$predict(tsk_sonar, row_ids = split$test)
pred$score()

classif.ce: 0.159420289855072

AutoTuner中还包含一个调优实例Intance
- 用法和前述一样

at$tuning_instance$result %>% as.data.table()

<table class='dataframe'> <caption>A data.table: 1 x 5</caption> <thead> <tr><th scope=col>cost</th><th scope=col>gamma</th><th scope=col>learner_param_vals</th><th scope=col>x_domain</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><list></th><th scope=col><list></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>11.51293</td><td>-5.756463</td><td>radial , C-classification , 1e+05 , 0.00316227766016838</td><td>1.000000e+05, 3.162278e-03</td><td>0.2008942</td></tr> </tbody> </table>

Illustration of an Auto-Tuner.

嵌套重采样（Nested Resampling）

简介

超参数优化在不进行额外的重采样时会产生训练误差导致的乐观偏差

嵌套重采样示意图大块代表用于模型评估的外部重采样的三折交叉验证，小块代表用于调优的内部重采样的四折交叉验证浅蓝色块为训练集，深蓝色块为测试集

看着挺挺复杂的，在本例中：
- 其实就是先对整个数据集进行3折交叉验证的切分，
  这个里面2/3的用于训练集，1/3的用于验证集
  （本质是测试集，不过一般测试集是纯用于测试的那种），这个部分叫外部重采样（outer resampling）
  - 对2/3训练集中再进行4折交叉验证的切分，
    这个部分叫内部重采样（inner resampling）
  - 内部重采样训练出来的N个模型用外部的验证集进行评估，
    选出最佳超参数，
    这个部分叫超参数优化（HPO）
    - N取决于超参数个数以及网格搜索分辨率，
      2个超参数，网格搜索分辨率为2就是$2^2=4$，
      2个超参数，网格搜索分辨率为3就是$3^2=9$，
      这个结果再乘以内部重采样的k值
    - 本例中假设内部重采样是4折，2个参数，2个网格，
      那么共产生 $4\times2^2=16$ 个模型
    - 这些模型不直接用于1/3数据的验证集，
      而是用内部重采样的小验证集进行性能评估，
      最终选出16个模型里在自己小验证集上表现最好的模型的超参数
  - 用选择的超参数在整个2/3数据的的训练集进行模型训练，
    再在1/3数据的测试集上进行模型评估
- 上述一轮的内外重采样结束后，再重复两轮
- 三次结束后，获得最终3个模型，
  最这三个模型进行综合评估并选择最佳参数建模，
  并最终用测试集评估最终性能
注意：嵌套重采样的计算成本很高
- 正如上所述，超参数的个数和网格数分辨率决定了训练模型的迭代次数；
  如果2超参数外3折内4折为5的分辨率，那么总共需要迭代 $3\times4\times5^{2}= 300$次
- 如果计算资源支持，可以通过并行化提高速度

使用`auto_tuner()`进行嵌套重采样

只需将 AutoTuner 传递给 resample()或 benchmark() 即可

# 调取任务
tsk_sonar <-  tsk('sonar')
# 构建学习器
lrn_svm <- lrn('classif.svm',
 cost  = to_tune(1e-5, 1e5, logscale = TRUE),
 gamma = to_tune(1e-5, 1e5, logscale = TRUE),
 kernel = 'radial',
 type = 'C-classification'
)
# 构建调优器
tnr_grid_search <- tnr('grid_search', resolution = 5, batch_size = 5)
# 构建`AutoTuner`
at <- auto_tuner(
 tuner = tnr_grid_search,
 learner = lrn_svm,
 # 构建内部`Resampling`
 resampling = rsmp('cv', folds = 4),
 measure = msr('classif.ce')
)
# 构建外部`Resampling`
rsmp_cv3 <- rsmp('cv', folds = 3)
# 将`AutoTuner`传递给`resample()`
# 这里的`store_models=TRUE`仅能储存外部重采样的3个模型
rr <- resample(tsk_sonar, at, rsmp_cv3, store_models = TRUE)
# 打印
rr

[36m--[39m [1m[34m<ResampleResult>[39m with [34m3[39m resampling iterations[22m [36m-------------------------------[39m
 task_id        learner_id resampling_id iteration     prediction_test warnings
   sonar classif.svm.tuned            cv         1 <PredictionClassif>        0
   sonar classif.svm.tuned            cv         2 <PredictionClassif>        0
   sonar classif.svm.tuned            cv         3 <PredictionClassif>        0
 errors
      0
      0
      0

查看最终模型的

rr$aggregate()

classif.ce: 0.163285024154589

extract_inner_tuning_results(ResampleResult) 返回外部重采样的全部结果
extract_inner_tuning_archives(ResampleResult) 返回内外部重采样的全部结果

extract_inner_tuning_results(rr)

<table class='dataframe'> <caption>A data.table: 3 x 9</caption> <thead> <tr><th scope=col>iteration</th><th scope=col>cost</th><th scope=col>gamma</th><th scope=col>classif.ce</th><th scope=col>learner_param_vals</th><th scope=col>x_domain</th><th scope=col>task_id</th><th scope=col>learner_id</th><th scope=col>resampling_id</th></tr> <tr><th scope=col><int></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><list></th><th scope=col><list></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><td>1</td><td>5.756463</td><td> -5.756463</td><td>0.1882353</td><td>radial , C-classification , 316.227766016838 , 0.00316227766016838</td><td>3.162278e+02, 3.162278e-03</td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>2</td><td>5.756463</td><td>-11.512925</td><td>0.2376050</td><td>radial , C-classification, 316.227766016838, 1e-05 </td><td>316.22777, 0.00001</td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td>5.756463</td><td> -5.756463</td><td>0.2006303</td><td>radial , C-classification , 316.227766016838 , 0.00316227766016838</td><td>3.162278e+02, 3.162278e-03</td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> </tbody> </table>

extract_inner_tuning_archives(rr)

<table class='dataframe'> <caption>A data.table: 75 x 15</caption> <thead> <tr><th scope=col>iteration</th><th scope=col>cost</th><th scope=col>gamma</th><th scope=col>classif.ce</th><th scope=col>x_domain_cost</th><th scope=col>x_domain_gamma</th><th scope=col>runtime_learners</th><th scope=col>timestamp</th><th scope=col>warnings</th><th scope=col>errors</th><th scope=col>batch_nr</th><th scope=col>resample_result</th><th scope=col>task_id</th><th scope=col>learner_id</th><th scope=col>resampling_id</th></tr> <tr><th scope=col><int></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dttm></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><list></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><td>1</td><td>-11.512925</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>0.4632353</td><td>1.000000e-05</td><td>3.162278e+02</td><td>0.088</td><td>2025-06-17 23:57:50</td><td>0</td><td>0</td><td>1</td><td><environment: 0x16ec87bc8></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td> -5.756463</td><td>0.2689076</td><td>1.000000e+00</td><td>3.162278e-03</td><td>0.042</td><td>2025-06-17 23:57:50</td><td>0</td><td>0</td><td>1</td><td><environment: 0x16ec63f78></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td><span style=white-space:pre-wrap> 0.000000</span></td><td>0.4632353</td><td>1.000000e+00</td><td>1.000000e+00</td><td>0.074</td><td>2025-06-17 23:57:50</td><td>0</td><td>0</td><td>1</td><td><environment: 0x16ec47d10></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>-11.512925</td><td>0.3126050</td><td>3.162278e+02</td><td>1.000000e-05</td><td>0.033</td><td>2025-06-17 23:57:50</td><td>0</td><td>0</td><td>1</td><td><environment: 0x16ec1b1c8></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td><span style=white-space:pre-wrap> 0.000000</span></td><td>0.4632353</td><td>3.162278e+02</td><td>1.000000e+00</td><td>0.035</td><td>2025-06-17 23:57:50</td><td>0</td><td>0</td><td>1</td><td><environment: 0x16ebf3920></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td> -5.756463</td><td> -5.756463</td><td>0.4632353</td><td>3.162278e-03</td><td>3.162278e-03</td><td>0.026</td><td>2025-06-17 23:57:50</td><td>0</td><td>0</td><td>2</td><td><environment: 0x16ebda1e0></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td> -5.756463</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td>0.4632353</td><td>3.162278e-03</td><td>1.000000e+00</td><td>0.029</td><td>2025-06-17 23:57:50</td><td>0</td><td>0</td><td>2</td><td><environment: 0x16eba3970></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td> -5.756463</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>0.4632353</td><td>3.162278e-03</td><td>3.162278e+02</td><td>0.037</td><td>2025-06-17 23:57:50</td><td>0</td><td>0</td><td>2</td><td><environment: 0x16eb76288></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td> 11.512925</td><td>0.4632353</td><td>1.000000e+00</td><td>1.000000e+05</td><td>0.028</td><td>2025-06-17 23:57:50</td><td>0</td><td>0</td><td>2</td><td><environment: 0x16eb1ca18></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td> 11.512925</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>0.4632353</td><td>1.000000e+05</td><td>3.162278e+02</td><td>0.034</td><td>2025-06-17 23:57:50</td><td>0</td><td>0</td><td>2</td><td><environment: 0x16eaf0358></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td>-11.512925</td><td> -5.756463</td><td>0.4632353</td><td>1.000000e-05</td><td>3.162278e-03</td><td>0.035</td><td>2025-06-17 23:57:51</td><td>0</td><td>0</td><td>3</td><td><environment: 0x16eac7780></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td>-11.512925</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td>0.4632353</td><td>1.000000e-05</td><td>1.000000e+00</td><td>0.029</td><td>2025-06-17 23:57:51</td><td>0</td><td>0</td><td>3</td><td><environment: 0x16e7cc3a0></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td>-11.512925</td><td> 11.512925</td><td>0.4632353</td><td>1.000000e-05</td><td>1.000000e+05</td><td>0.055</td><td>2025-06-17 23:57:51</td><td>0</td><td>0</td><td>3</td><td><environment: 0x134617800></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>0.4632353</td><td>1.000000e+00</td><td>3.162278e+02</td><td>0.044</td><td>2025-06-17 23:57:51</td><td>0</td><td>0</td><td>3</td><td><environment: 0x164f9f808></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td> 11.512925</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td>0.4632353</td><td>1.000000e+05</td><td>1.000000e+00</td><td>0.039</td><td>2025-06-17 23:57:51</td><td>0</td><td>0</td><td>3</td><td><environment: 0x164f80080></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td> -5.756463</td><td> 11.512925</td><td>0.4632353</td><td>3.162278e-03</td><td>1.000000e+05</td><td>0.029</td><td>2025-06-17 23:57:52</td><td>0</td><td>0</td><td>4</td><td><environment: 0x164f5c5f8></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td> -5.756463</td><td>0.1882353</td><td>3.162278e+02</td><td>3.162278e-03</td><td>0.025</td><td>2025-06-17 23:57:52</td><td>0</td><td>0</td><td>4</td><td><environment: 0x164f362f0></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td> 11.512925</td><td>0.4632353</td><td>3.162278e+02</td><td>1.000000e+05</td><td>0.050</td><td>2025-06-17 23:57:52</td><td>0</td><td>0</td><td>4</td><td><environment: 0x164f0c570></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td> 11.512925</td><td> -5.756463</td><td>0.1882353</td><td>1.000000e+05</td><td>3.162278e-03</td><td>0.024</td><td>2025-06-17 23:57:52</td><td>0</td><td>0</td><td>4</td><td><environment: 0x164eec7c8></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td> 11.512925</td><td> 11.512925</td><td>0.4632353</td><td>1.000000e+05</td><td>1.000000e+05</td><td>0.792</td><td>2025-06-17 23:57:52</td><td>0</td><td>0</td><td>4</td><td><environment: 0x164ec0b48></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td>-11.512925</td><td>-11.512925</td><td>0.4632353</td><td>1.000000e-05</td><td>1.000000e-05</td><td>0.030</td><td>2025-06-17 23:57:52</td><td>0</td><td>0</td><td>5</td><td><environment: 0x164e8ab88></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td> -5.756463</td><td>-11.512925</td><td>0.4632353</td><td>3.162278e-03</td><td>1.000000e-05</td><td>0.029</td><td>2025-06-17 23:57:52</td><td>0</td><td>0</td><td>5</td><td><environment: 0x164e5e2d0></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td>-11.512925</td><td>0.4632353</td><td>1.000000e+00</td><td>1.000000e-05</td><td>0.043</td><td>2025-06-17 23:57:52</td><td>0</td><td>0</td><td>5</td><td><environment: 0x164e34400></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>0.4632353</td><td>3.162278e+02</td><td>3.162278e+02</td><td>0.074</td><td>2025-06-17 23:57:52</td><td>0</td><td>0</td><td>5</td><td><environment: 0x164e02020></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>1</td><td> 11.512925</td><td>-11.512925</td><td>0.2542017</td><td>1.000000e+05</td><td>1.000000e-05</td><td>0.026</td><td>2025-06-17 23:57:52</td><td>0</td><td>0</td><td>5</td><td><environment: 0x164de4160></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>2</td><td> -5.756463</td><td>-11.512925</td><td>0.4672269</td><td>3.162278e-03</td><td>1.000000e-05</td><td>0.030</td><td>2025-06-17 23:57:53</td><td>0</td><td>0</td><td>1</td><td><environment: 0x16e41f860></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>2</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>0.4672269</td><td>1.000000e+00</td><td>3.162278e+02</td><td>0.050</td><td>2025-06-17 23:57:53</td><td>0</td><td>0</td><td>1</td><td><environment: 0x16e3e9f40></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>2</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>0.4672269</td><td>3.162278e+02</td><td>3.162278e+02</td><td>0.035</td><td>2025-06-17 23:57:53</td><td>0</td><td>0</td><td>1</td><td><environment: 0x16e3c77f8></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>2</td><td> 11.512925</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>0.4672269</td><td>1.000000e+05</td><td>3.162278e+02</td><td>0.032</td><td>2025-06-17 23:57:53</td><td>0</td><td>0</td><td>1</td><td><environment: 0x1345eef68></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>2</td><td> 11.512925</td><td> 11.512925</td><td>0.4672269</td><td>1.000000e+05</td><td>1.000000e+05</td><td>0.029</td><td>2025-06-17 23:57:53</td><td>0</td><td>0</td><td>1</td><td><environment: 0x1345c8a18></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td></tr> <tr><td>2</td><td>-11.512925</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>0.4672269</td><td>1.000000e-05</td><td>3.162278e+02</td><td>0.027</td><td>2025-06-17 23:57:54</td><td>0</td><td>0</td><td>5</td><td><environment: 0x164ca6460></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>2</td><td> -5.756463</td><td> -5.756463</td><td>0.4672269</td><td>3.162278e-03</td><td>3.162278e-03</td><td>0.029</td><td>2025-06-17 23:57:54</td><td>0</td><td>0</td><td>5</td><td><environment: 0x164c86108></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>2</td><td> -5.756463</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>0.4672269</td><td>3.162278e-03</td><td>3.162278e+02</td><td>0.023</td><td>2025-06-17 23:57:54</td><td>0</td><td>0</td><td>5</td><td><environment: 0x13452b258></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>2</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td><span style=white-space:pre-wrap> 0.000000</span></td><td>0.4672269</td><td>1.000000e+00</td><td>1.000000e+00</td><td>0.026</td><td>2025-06-17 23:57:54</td><td>0</td><td>0</td><td>5</td><td><environment: 0x1345010e8></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>2</td><td> 11.512925</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td>0.4672269</td><td>1.000000e+05</td><td>1.000000e+00</td><td>0.028</td><td>2025-06-17 23:57:54</td><td>0</td><td>0</td><td>5</td><td><environment: 0x1344dd2a8></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td>-11.512925</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td>0.4680672</td><td>1.000000e-05</td><td>1.000000e+00</td><td>0.033</td><td>2025-06-17 23:57:55</td><td>0</td><td>0</td><td>1</td><td><environment: 0x16e8c96d8></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td> -5.756463</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td>0.4680672</td><td>3.162278e-03</td><td>1.000000e+00</td><td>0.042</td><td>2025-06-17 23:57:55</td><td>0</td><td>0</td><td>1</td><td><environment: 0x16e8a5b28></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td> -5.756463</td><td>0.2518908</td><td>1.000000e+00</td><td>3.162278e-03</td><td>0.025</td><td>2025-06-17 23:57:55</td><td>0</td><td>0</td><td>1</td><td><environment: 0x16e87db78></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td><span style=white-space:pre-wrap> 0.000000</span></td><td>0.4680672</td><td>3.162278e+02</td><td>1.000000e+00</td><td>0.026</td><td>2025-06-17 23:57:55</td><td>0</td><td>0</td><td>1</td><td><environment: 0x164b0ec00></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td> 11.512925</td><td>-11.512925</td><td>0.2371849</td><td>1.000000e+05</td><td>1.000000e-05</td><td>0.051</td><td>2025-06-17 23:57:55</td><td>0</td><td>0</td><td>1</td><td><environment: 0x164aede90></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td>-11.512925</td><td> -5.756463</td><td>0.4680672</td><td>1.000000e-05</td><td>3.162278e-03</td><td>0.027</td><td>2025-06-17 23:57:55</td><td>0</td><td>0</td><td>2</td><td><environment: 0x164aadb78></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td>-11.512925</td><td> 11.512925</td><td>0.4680672</td><td>1.000000e-05</td><td>1.000000e+05</td><td>0.026</td><td>2025-06-17 23:57:55</td><td>0</td><td>0</td><td>2</td><td><environment: 0x164a8cee8></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td> -5.756463</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>0.4680672</td><td>3.162278e-03</td><td>3.162278e+02</td><td>0.024</td><td>2025-06-17 23:57:55</td><td>0</td><td>0</td><td>2</td><td><environment: 0x164a46ef8></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td> -5.756463</td><td>0.2006303</td><td>3.162278e+02</td><td>3.162278e-03</td><td>0.024</td><td>2025-06-17 23:57:55</td><td>0</td><td>0</td><td>2</td><td><environment: 0x164a275b0></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>0.4680672</td><td>3.162278e+02</td><td>3.162278e+02</td><td>0.025</td><td>2025-06-17 23:57:55</td><td>0</td><td>0</td><td>2</td><td><environment: 0x164a0a2e0></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td> -5.756463</td><td>-11.512925</td><td>0.4823529</td><td>3.162278e-03</td><td>1.000000e-05</td><td>0.025</td><td>2025-06-17 23:57:56</td><td>0</td><td>0</td><td>3</td><td><environment: 0x1649ea238></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td> -5.756463</td><td> -5.756463</td><td>0.4680672</td><td>3.162278e-03</td><td>3.162278e-03</td><td>0.030</td><td>2025-06-17 23:57:56</td><td>0</td><td>0</td><td>3</td><td><environment: 0x1649d0c80></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td> -5.756463</td><td> 11.512925</td><td>0.4680672</td><td>3.162278e-03</td><td>1.000000e+05</td><td>0.052</td><td>2025-06-17 23:57:56</td><td>0</td><td>0</td><td>3</td><td><environment: 0x1649b6c10></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td>-11.512925</td><td>0.4823529</td><td>1.000000e+00</td><td>1.000000e-05</td><td>0.029</td><td>2025-06-17 23:57:56</td><td>0</td><td>0</td><td>3</td><td><environment: 0x16e865190></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td> 11.512925</td><td>0.4680672</td><td>1.000000e+00</td><td>1.000000e+05</td><td>0.028</td><td>2025-06-17 23:57:56</td><td>0</td><td>0</td><td>3</td><td><environment: 0x16e84baf8></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td>-11.512925</td><td>-11.512925</td><td>0.4823529</td><td>1.000000e-05</td><td>1.000000e-05</td><td>0.037</td><td>2025-06-17 23:57:56</td><td>0</td><td>0</td><td>4</td><td><environment: 0x16e82a278></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td>-11.512925</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>0.4680672</td><td>1.000000e-05</td><td>3.162278e+02</td><td>0.025</td><td>2025-06-17 23:57:56</td><td>0</td><td>0</td><td>4</td><td><environment: 0x133ff9c88></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>-11.512925</td><td>0.2802521</td><td>3.162278e+02</td><td>1.000000e-05</td><td>0.025</td><td>2025-06-17 23:57:56</td><td>0</td><td>0</td><td>4</td><td><environment: 0x133fde710></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td> 11.512925</td><td>0.4680672</td><td>3.162278e+02</td><td>1.000000e+05</td><td>0.026</td><td>2025-06-17 23:57:56</td><td>0</td><td>0</td><td>4</td><td><environment: 0x133fc2fd0></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td> 11.512925</td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>0.4680672</td><td>1.000000e+05</td><td>3.162278e+02</td><td>0.027</td><td>2025-06-17 23:57:56</td><td>0</td><td>0</td><td>4</td><td><environment: 0x133f06cb0></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td><span style=white-space:pre-wrap> 0.000000</span></td><td>0.4680672</td><td>1.000000e+00</td><td>1.000000e+00</td><td>0.025</td><td>2025-06-17 23:57:56</td><td>0</td><td>0</td><td>5</td><td><environment: 0x133eca480></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td><span style=white-space:pre-wrap> 5.756463</span></td><td>0.4680672</td><td>1.000000e+00</td><td>3.162278e+02</td><td>0.024</td><td>2025-06-17 23:57:56</td><td>0</td><td>0</td><td>5</td><td><environment: 0x133e9dd28></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td> 11.512925</td><td> -5.756463</td><td>0.2006303</td><td>1.000000e+05</td><td>3.162278e-03</td><td>0.033</td><td>2025-06-17 23:57:56</td><td>0</td><td>0</td><td>5</td><td><environment: 0x133e7f238></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td> 11.512925</td><td><span style=white-space:pre-wrap> 0.000000</span></td><td>0.4680672</td><td>1.000000e+05</td><td>1.000000e+00</td><td>0.029</td><td>2025-06-17 23:57:56</td><td>0</td><td>0</td><td>5</td><td><environment: 0x16e33a6d8></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> <tr><td>3</td><td> 11.512925</td><td> 11.512925</td><td>0.4680672</td><td>1.000000e+05</td><td>1.000000e+05</td><td>0.027</td><td>2025-06-17 23:57:56</td><td>0</td><td>0</td><td>5</td><td><environment: 0x16e319e18></td><td>sonar</td><td>classif.svm.tuned</td><td>cv</td></tr> </tbody> </table>

评估性能的正确（与错误）方式

这里进行一个对比，看看为什么要用嵌套重采样而不是简单的无嵌套重采样

# ---------------准备数据
# 设置随机数种子
set.seed(5)
# 构建学习器
lrn_xgboost <- lrn(
 # 选择xgboost算法作为学习器
 'classif.xgboost',
 # 设置超参数的选择范围
 eta = to_tune(1e-4, 1, logscale = TRUE),
 max_depth = to_tune(1, 20),
 colsample_bytree  = to_tune(1e-1, 1),
 colsample_bylevel = to_tune(1e-1, 1),
 lambda = to_tune(1e-3, 1e3, logscale = TRUE),
 alpha = to_tune(1e-3, 1e3, logscale = TRUE),
 subsample = to_tune(1e-1, 1)
)
# 构建任务生成器，命名为'moons'
tsk_moons <- tgen('moons')
# 随机生成100个训练样本和1000000个测试样本
tsk_moons_train <- tsk_moons$generate(100)
tsk_moons_test <- tsk_moons$generate(1000000)
# 构建评估器
msr_ce <- msr('classif.ce')
# 调优器用随机搜索法
tnr_random <- tnr('random_search')
# 使用留出法重采样
rsmp_holdout <- rsmp('holdout')
# 设置终止器，使用次数限制法，随机搜索700次终止
trm_evals700 <- trm('evals', n_evals = 700)

# -------无嵌套重采样
# 使用`tune()`进行实例调优
instance <- tune(
 tuner = tnr_random,
 task = tsk_moons_train,
 learner = lrn_xgboost,
 resampling = rsmp_holdout,
 measures = msr_ce,
 terminator = trm_evals700
)
# 记录最优参数在调优集上的性能
insample <- instance$result_y

# -------嵌套重采样
# 使用`auto_tuner()`创建一个调优学习器`AutoTuner`
at <- auto_tuner(
 tuner = tnr_random,
 learner = lrn_xgboost,
 # 这里的留出法用于内部重采样
 resampling = rsmp_holdout,
 measure = msr_ce,
 terminator = trm_evals700
)
# 创建一个5折CV，用于后续的外部重采样
rsmp_cv5 <- rsmp('cv', folds = 5)
# 将`Task`，`AutoTuner`和外部重采样器`Resampling`传递给`resample()`
# `ResampleResult$aggregate()`给出整合结果
rr <- resample(tsk_moons_train, at, rsmp_cv5)
outsample <- rr$aggregate()

# ------用无嵌套重采样的超参数建模
# 创建xgboost的学习器
lrn_xgboost_tuned <- lrn('classif.xgboost')
# 将无嵌套重采样的实例调优得到的最佳超参数传递给xgboost学习器
lrn_xgboost_tuned$param_set$set_values(
 # `instance`是无嵌套重采样的调优实例
 .values = instance$result_learner_param_vals
)
# 训练模型 -> 测试模型 -> 评估
generalization <- lrn_xgboost_tuned$train(
 tsk_moons_train
)$
 predict(tsk_moons_test)$
 score()

# 汇总一下结果
round(
 c(
  # 用无嵌套重采样选择的最佳超参数构建的模型在测试集上的评估结果
  true_generalization = as.numeric(generalization),
  # 无嵌套重采样选择的最佳超参数构建的模型在内部训练的评估结果
  # 这里的内部是仅在训练集上生成的调优模型得到的结果
  without_nested_resampling = as.numeric(insample),
  # 嵌套重采样选择的最佳超参数构建的模型在内部训练的评估结果
  with_nested_resampling = as.numeric(outsample)
 ), 
 2
)

true_generalization 0.1 
without_nested_resampling 0.06 
with_nested_resampling 0.14

从上面得到什么结果？
- 无嵌套重采样的内部评估得到的交叉熵很低，与实际在测试集的评估结果差异很大
- 这可能表明对特定的内部留出划分存在元过拟合（meta-overfitting）
- 相比之下嵌套重采样得到的外部估计效果更稳健

更高级的搜索空间

标量参数调优（Scalar Parameter Tuning）

当在学习器中使用to_tune()时，会隐式地为调优搜索空间创建一个ParamSet

learner <- lrn('classif.svm',
  cost  = to_tune(1e-1, 1e5),
  kernel = to_tune(c('radial', 'linear')),
  shrinking = to_tune(),
  type = 'C-classification'
)

learner$param_set$search_space()

<ParamSet(3)>
          id    class lower upper nlevels        default  value
      <char>   <char> <num> <num>   <num>         <list> <list>
1:      cost ParamDbl   0.1 1e+05     Inf <NoDefault[0]> [NULL]
2:    kernel ParamFct    NA    NA       2 <NoDefault[0]> [NULL]
3: shrinking ParamLgl    NA    NA       2           TRUE [NULL]

可以看到
- kernel是因子，只需要传入想要调整的水平相对应的向量
- shrinking超参数是一个逻辑值，它只有两种可能的值，
  所以不需要向to_tune()传递任何内容，
  它会自动从learner$param_set中识别出这是一个逻辑值，
  并将这个细节传递给learner$param_set$search_space()
- 对于因子参数，如果想在所有可能的值上进行调整，
  也可以在不传递任何参数的情况下使用to_tune()
- 如果想在一小部分可能的值上离散化数值参数，
  可以使用to_tune()将数值参数视为因子
  - 例如，想找到随机森林中最优的树的数量，
    我们可能只考虑三种情况：100棵、200棵或400棵树

lrn('classif.ranger', num.trees = to_tune(c(100, 200, 400)))

将整数变做因子会导致超参数无序
- 因此，利用顺序信息的算法在忽略顺序时性能会变差
- 对于这些算法，
  使用自定义变换定义一个 ParamDbl 或 ParamInt更有意义（后续内容）

定义搜索空间

下列p_*()创建Param对象

Constructor 构造函数	Description 描述	Underlying Class 基础类
`p_dbl()`	Real valued parameter (“double”)	`ParamDbl`
`p_int()`	Integer parameter	`ParamInt`
`p_fct()`	Discrete valued parameter (“factor”)	`ParamFct`
`p_lgl()`	Logical / Boolean parameter	`ParamLgl`
`p_uty()`	Untyped parameter	`ParamUty`

使用ps()手动创造搜索空间，对象为ParamSet

search_space <- ps(
 cost  = p_dbl(lower = 1e-1, upper = 1e5),
 kernel = p_fct(c('radial', 'linear')),
 shrinking = p_lgl()
)

将搜索空间传递给ti()
- 官方文档写错了，他给的例子是ti() auto_tuner()应该传递了Tuner但是例子里没有Tuner

tsk_sonar <- tsk('sonar')
rsmp_cv3 <- rsmp('cv', folds = 3)
msr_ce <- msr('classif.ce')

ists <- ti(
    tsk_sonar, 
    lrn('classif.svm', type = 'C-classification'), 
    rsmp_cv3,
    msr_ce, 
    trm('none'), 
    # 将搜索空间传递到参数`search_space`
    search_space = search_space
)

ists

[36m--[39m [1m[34m<TuningInstanceBatchSingleCrit>[39m[22m [36m---------------------------------------------[39m
* State: Not optimized
* Objective: [34m<ObjectiveTuningBatch>[39m
* Search Space:
          id    class lower upper nlevels
      <char>   <char> <num> <num>   <num>
1:      cost ParamDbl   0.1 1e+05     Inf
2:    kernel ParamFct    NA    NA       2
3: shrinking ParamLgl    NA    NA       2
* Terminator: [34m<TerminatorNone>[39m

有界搜索空间
- 手动创建搜索空间时，对搜索空间中的所有超参数是否有边界保持谨慎
- 如果没有给p_dbl() 或 p_int() 传递下限和上限，
  几乎所有调谐器在调优过程中都会抛出错误
- 如果不确定，您可以在构造的 ParamSet （ps()创建的对象）上
  使用ParamSet$is_bounded查看是否设置了下限和上限

ps(cost = p_dbl(lower = 0.1, upper = 1))$is_bounded
ps(cost = p_dbl(lower = 0.1, upper = Inf))$is_bounded
search_space

cost: TRUE

cost: FALSE

cost TRUE 
kernel TRUE 
shrinking TRUE

向量上的变换与调优

使用`p_*()`的自定义变换

之前讨论过对数变换的用法
简单回顾一下之前用给lrn()传递用to_tune()创建的学习器的搜索空间

svm <- lrn(
 'classif.svm',
 cost = to_tune(1e-5,1e5, logscale = TRUE)
)
svm$param_set

<ParamSet(1)>
       id    class     lower    upper nlevels        default  value
   <char>   <char>     <num>    <num>   <num>         <list> <list>
1:   cost ParamDbl -11.51293 11.51293     Inf <NoDefault[0]> [NULL]
Trafo is set.

可以看到这里的lower和upper并非1e-5和1e5而是-11.5和11.5 　所以输入到学习器的范围其实是log(1e-5)和log(1e5)
手动创建对数变换
- trafo中传递的是对采样结果的操作函数
- 这里的输出结果和svm$param_set一致

ss <- ps(
 cost = p_dbl(
  # 注意：这里是log(1e-5)和log(1e5)
  log(1e-5), log(1e5),
  # 对结果做指数变换
  trafo = function(x) ruturn(exp(x))
 )
) 
ss

<ParamSet(1)>
       id    class     lower    upper nlevels        default  value
   <char>   <char>     <num>    <num>   <num>         <list> <list>
1:   cost ParamDbl -11.51293 11.51293     Inf <NoDefault[0]> [NULL]
Trafo is set.

虽然ParamSet给出了Trafo is set.的信息，
也可以通过ParamSet$trafo()手动输入信息来查看是否有转换
看看ParamSet$trafo()的转换
- 结果也是完全一致

svm$param_set$search_space()$trafo(list(cost = 1))
ss$trafo(list(cost = 1))

$cost = 2.71828182845905
$cost = 2.71828182845905

从上面的例子可以看出，to_tune(1e-5,1e5, logscale = TRUE)的原理是：
- 将下限与上限做对数变换
- 在对数变换后的上下限形成的区间做均匀取样
- 将均匀取样的结果进行指数变换，传递给Learner
to_tune()除了接受to_tune(1e-5, 1e5, logscale = TRUE)这样的格式外，
也接受Param对象
在下面例子中，取样在区间$[0,3]$均匀取样，将取样的结果$+2$传递到Learner中

lrn(
 'classif.svm',
 cost = to_tune(
  p_dbl(
   0, 3, 
   trafo = function(x) return(x + 2)
  )
 )
)

对于多个复杂变换，需要将函数传递到.extra_trafo中
- .extra_trafo接受一个带有参数x和param_set的函数
- 在调优过程中，
  x是一个包含正在测试的配置的列表，
  param_set是整个参数集
- 测试了一下，在这个例子里省略param_set也是可以的，
  但是不确定其他用法中能不能省，我觉得还是别省了

search_space <- ps(
 # `cost`在区间[-1,1]均匀取样，取样结果做指数转换
 cost = p_dbl(-1, 1, trafo = function(x) return(exp(x))),
 # `kernel`有'polynomial'和'radial'两种选择
 kernel = p_fct(c('polynomial', 'radial')),
 # 传递一个函数：当kernel == 'polynomial'时，
 # `cost`抽样后指数转换的最终结果+2；否则就保持最终结果
 .extra_trafo = function(x, param_set) {
     if (x$kernel == 'polynomial') {
       x$cost = x$cost + 2
  }
  return(x)
 }
)

search_space$trafo(list(cost = 1, kernel = 'polynomial'))
search_space$trafo(list(cost = 1, kernel = 'radial'))

$cost
4.71828182845904
$kernel
'polynomial'


$cost
2.71828182845905
$kernel
'radial'

向量变换

任何函数都可以传递给trafo和.extra_trafo，
这使得可以调整ParamUty类参数，
这些参数可以是向量、函数或任何非原子类
下例中，支持向量机（SVM）的class.weights参数接受一个类权重的命名向量，
每个目标类都有一个条目
- 为了调整这个参数，可以调整一个标量，然后将其转换为一个向量
- 下面的代码将采样一个介于0.1和0.9之间的值x，
  然后将结果转换为(x, 1 - x)，然后传递给Learner
先看看class.weights长什么样
- 它的类型是ParamUty，所以可以传递任何东西给它

{
    lrn('classif.svm')$param_set %>% 
        as.data.table()
} %>% 
    filter(id == 'class.weights')

<table class='dataframe'> <caption>A data.table: 1 x 11</caption> <thead> <tr><th scope=col>id</th><th scope=col>class</th><th scope=col>lower</th><th scope=col>upper</th><th scope=col>levels</th><th scope=col>nlevels</th><th scope=col>is_bounded</th><th scope=col>special_vals</th><th scope=col>default</th><th scope=col>storage_type</th><th scope=col>tags</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><list></th><th scope=col><dbl></th><th scope=col><lgl></th><th scope=col><list></th><th scope=col><list></th><th scope=col><chr></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td>class.weights</td><td>ParamUty</td><td>NA</td><td>NA</td><td>NULL</td><td>Inf</td><td>FALSE</td><td>NULL</td><td>NULL</td><td>list</td><td>train</td></tr> </tbody> </table>

对于ParamUty而言，要慎重确定它原本接受什么形式的输入
- class.weights接受一个命名向量，
  其中包含分类的level以及希望分配的权重（0–1之间）

search_space <- ps(
 class.weights = p_dbl(
  lower = 0.1, upper = 0.9,
  # 这里的M和R是`tsk_sonar`里的分类
  # M是Mines，R是Rocks
  trafo = function(x) return(c(M = x, R = 1 - x))
 )
)

有时候需要调节多个不存在学习器param_set里的伪参数
- 这些伪参数会被用于调整向量参数
下例中以lrn('surv.coxtime')为例
- num_nodes需要给每个层传递节点，
  如果有5个层，每个层生成4个节点，那么就要输入向量：
  num_nodes = c(4, 4, 4, 4, 4)，当然也可以这样传递：`num_nodes = rep(4, 5)
- 所以num_nodes实际依赖两个参数：
  - 层数
  - 每层节点数
- 因此可以自定义层数和每层节点数的两个伪参数，
  通过组合这两个伪函数来生成目标超参数num_nodes
num_nodes并不会在ParamSet的打印结果中出现，
因为我们并没有在ps()中直接定义它

search_space <- ps(
 num_layers = p_int(lower = 1, upper = 20),
 num_nodes_per_layer = p_int(4, 64),
 .extra_trafo = function(x, param_set) {
  x$num_nodes = rep(x$num_nodes_per_layer, x$num_layers)
  x$num_layers = NULL
  x$num_nodes_per_layer = NULL
  return(x)
  }
)

search_space

<ParamSet(2)>
                    id    class lower upper nlevels        default  value
                <char>   <char> <num> <num>   <num>         <list> <list>
1:          num_layers ParamInt     1    20      20 <NoDefault[0]> [NULL]
2: num_nodes_per_layer ParamInt     4    64      61 <NoDefault[0]> [NULL]
Trafo is set.

但是可以通过ParamSet$trafo()来验证
- 结果也是很清晰了，
  在实际的运算中要传递给Learner的是生成的num_nodes

search_space$trafo(list(num_layers = 4, num_nodes_per_layer = 12))

$num_nodes =
12 12 12 12

可以通过Learner$param_set$set_values()传递上述自定义的搜索空间

learner <- lrn('surv.coxtime')
learner$param_set$search_space()

learner$param_set$set_values(num_nodes = to_tune(search_space))
learner$param_set$search_space()

<ParamSet(0)>
Empty.


<ParamSet(2)>
                    id    class lower upper nlevels        default  value
                <char>   <char> <num> <num>   <num>         <list> <list>
1:          num_layers ParamInt     1    20      20 <NoDefault[0]> [NULL]
2: num_nodes_per_layer ParamInt     4    64      61 <NoDefault[0]> [NULL]
Trafo is set.

超参数依赖关系

例如，SVM中的degree参数仅在kernel为'polynomial'时才有效
- 在ps()函数中，使用depends参数来指定这种依赖关系，
  该参数接受一个命名参数，
  形式为<param> == value 或 <param> %in% <vector>
下面例子中，对3个超参数进行调优
先简单看看lrn('classif.svm')中的依赖关系
- degree和gamma都依赖于kernel

learner <- lrn('classif.svm')
learner$param_set$deps

使用depends参数来指定这种依赖关系
- 该参数接受一个命名参数，形式为<param> == value 或 <param> %in% <vector>

ps(
 kernel = p_fct(c('polynomial', 'radial')),
 degree = p_int(1, 3, depends = (kernel == 'polynomial')),
 gamma = p_dbl(
  1e-5, 1e5,
  depends = (kernel %in% c('polynomial', 'radial'))
 )
)

<ParamSet(3)>
Key: <id>
       id    class lower upper nlevels        default parents  value
   <char>   <char> <num> <num>   <num>         <list>  <list> <list>
1: degree ParamInt 1e+00 3e+00       3 <NoDefault[0]>  kernel [NULL]
2:  gamma ParamDbl 1e-05 1e+05     Inf <NoDefault[0]>  kernel [NULL]
3: kernel ParamFct    NA    NA       2 <NoDefault[0]>  [NULL] [NULL]

也可以直接传递到to_tune()函数

lrn(
 'classif.svm',
 kernel = to_tune(c('polynomial', 'radial')),
 degree = to_tune(
  p_int(
   1, 3, 
   depends = (kernel == 'polynomial')
  )
 ),
 gamma = to_tune(
  p_dbl(
   1e-5, 1e5,
   depends = (kernel %in% c('polynomial', 'radial'))
  )
 )
)$param_set$search_space()

<ParamSet(3)>
Key: <id>
       id    class lower upper nlevels        default       parents  value
   <char>   <char> <num> <num>   <num>         <list>        <list> <list>
1: degree ParamInt 1e+00 3e+00       3 <NoDefault[0]> kernel,kernel [NULL]
2:  gamma ParamDbl 1e-05 1e+05     Inf <NoDefault[0]> kernel,kernel [NULL]
3: kernel ParamFct    NA    NA       2 <NoDefault[0]>        [NULL] [NULL]

使用 `mlr3tuningspaces` 推荐的搜索空间

选定的搜索空间可能需要大量的背景知识或专业技能
mlr3tuningspaces 包为许多流行的机器学习算法提供已发布搜索空间的实现，
让超参数优化更容易上手
搜索空间存储在字典 mlr_tuning_spaces 中

# library(mlr3tuningspaces)
mlr_tuning_spaces

<table class='dataframe'> <caption>A data.table: 30 x 4</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>learner</th><th scope=col>n_values</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><int></th></tr> </thead> <tbody> <tr><td>classif.glmnet.default </td><td>Classification GLM with Default </td><td>classif.glmnet </td><td> 2</td></tr> <tr><td>classif.glmnet.rbv1 </td><td>Classification GLM with RandomBot </td><td>classif.glmnet </td><td> 2</td></tr> <tr><td>classif.glmnet.rbv2 </td><td>Classification GLM with RandomBot </td><td>classif.glmnet </td><td> 2</td></tr> <tr><td>classif.ranger.default </td><td>Classification Ranger with Default </td><td>classif.ranger </td><td> 4</td></tr> <tr><td>classif.ranger.rbv1 </td><td>Classification Ranger with RandomBot </td><td>classif.ranger </td><td> 6</td></tr> <tr><td>classif.ranger.rbv2 </td><td>Classification Ranger with RandomBot </td><td>classif.ranger </td><td> 8</td></tr> <tr><td>classif.rpart.default </td><td>Classification Rpart with Default </td><td>classif.rpart </td><td> 3</td></tr> <tr><td>classif.rpart.rbv1 </td><td>Classification Rpart with RandomBot </td><td>classif.rpart </td><td> 4</td></tr> <tr><td>classif.rpart.rbv2 </td><td>Classification Rpart with RandomBot </td><td>classif.rpart </td><td> 4</td></tr> <tr><td>classif.svm.default </td><td>Classification SVM with Default </td><td>classif.svm </td><td> 4</td></tr> <tr><td>classif.svm.rbv1 </td><td>Classification SVM with RandomBot </td><td>classif.svm </td><td> 4</td></tr> <tr><td>classif.svm.rbv2 </td><td>Classification SVM with RandomBot </td><td>classif.svm </td><td> 5</td></tr> <tr><td>classif.xgboost.default</td><td>Classification XGBoost with Default </td><td>classif.xgboost</td><td> 8</td></tr> <tr><td>classif.xgboost.rbv1 </td><td>Classification XGBoost with RandomBot</td><td>classif.xgboost</td><td>10</td></tr> <tr><td>classif.xgboost.rbv2 </td><td>Classification XGBoost with RandomBot</td><td>classif.xgboost</td><td>13</td></tr> <tr><td>regr.glmnet.default </td><td>Regression GLM with Default </td><td>regr.glmnet </td><td> 2</td></tr> <tr><td>regr.glmnet.rbv1 </td><td>Regression GLM with RandomBot </td><td>regr.glmnet </td><td> 2</td></tr> <tr><td>regr.glmnet.rbv2 </td><td>Regression GLM with RandomBot </td><td>regr.glmnet </td><td> 2</td></tr> <tr><td>regr.ranger.default </td><td>Regression Ranger with Default </td><td>regr.ranger </td><td> 4</td></tr> <tr><td>regr.ranger.rbv1 </td><td>Regression Ranger with RandomBot </td><td>regr.ranger </td><td> 6</td></tr> <tr><td>regr.ranger.rbv2 </td><td>Regression Ranger with RandomBot </td><td>regr.ranger </td><td> 7</td></tr> <tr><td>regr.rpart.default </td><td>Regression Rpart with Default </td><td>regr.rpart </td><td> 3</td></tr> <tr><td>regr.rpart.rbv1 </td><td>Regression Rpart with RandomBot </td><td>regr.rpart </td><td> 4</td></tr> <tr><td>regr.rpart.rbv2 </td><td>Regression Rpart with RandomBot </td><td>regr.rpart </td><td> 4</td></tr> <tr><td>regr.svm.default </td><td>Regression SVM with Default </td><td>regr.svm </td><td> 4</td></tr> <tr><td>regr.svm.rbv1 </td><td>Regression SVM with RandomBot </td><td>regr.svm </td><td> 4</td></tr> <tr><td>regr.svm.rbv2 </td><td>Regression SVM with RandomBot </td><td>regr.svm </td><td> 5</td></tr> <tr><td>regr.xgboost.default </td><td>Regression XGBoost with Default </td><td>regr.xgboost </td><td> 8</td></tr> <tr><td>regr.xgboost.rbv1 </td><td>Regression XGBoost with RandomBot </td><td>regr.xgboost </td><td>10</td></tr> <tr><td>regr.xgboost.rbv2 </td><td>Regression XGBoost with RandomBot </td><td>regr.xgboost </td><td>13</td></tr> </tbody> </table>

lts()（learner tuning space）可以快速调取推荐的搜索空间

lts_rpart <- lts('classif.rpart.default')
lts_rpart

[36m--[39m [1m[34m<TuningSpace>[39m (classif.rpart.default): Classification Rpart with Default[22m [36m----[39m
          id lower upper levels logscale
      <char> <num> <num> <list>   <lgcl>
1:  minsplit 2e+00 128.0 [NULL]     TRUE
2: minbucket 1e+00  64.0 [NULL]     TRUE
3:        cp 1e-04   0.1 [NULL]     TRUE

之后可以传递给ti()或auto_tuner()中的search_space参数，
也可以直接调取TuningSpace$values（TuneToken类）传递到Learner$param_set中

# `ti()`
instance <- ti(
 task = tsk_sonar,
 learner = lrn('classif.rpart'),
 resampling = rsmp('cv', folds = 3),
 measures = msr('classif.ce'),
 terminator = trm('evals', n_evals = 20),
 # 在这里
 search_space = lts_rpart
)

# `auto_tuner()`
at <- auto_tuner(
 learner = lrn('classif.rpart'),
 resampling = rsmp('cv', folds = 3),
 measures = msr('classif.ce'),
 terminator = trm('evals', n_evals = 20),
 # # 在这里
 search_space = lts_rpart
)

# 直接传递给`Learner`
learner <- lrn('classif.rpart')
learner$param_set$set_values(.values = lts_rpart$values)
learner$param_set

也可以直接将Learner传递给lts()来调用默认的搜索空间，
以及在lts()调用默认搜索空间的时候自定义更改超参数调优内容

lts(lrn('classif.rpart'))
lts('classif.rpart.rbv2', maxdepth = to_tune(1, 20))

错误处理与内存管理

封装与回退学习器

即使在简单的机器学习问题中，也有很大的出错可能性
- 例如，当学习器无法收敛、内存耗尽，
  或者由于底层数据的问题而出现错误并终止运行
作为一个常见问题：如果测试数据中存在训练数据中没有的因子水平，
学习器可能会失败，在这种情况下建模会失败，
因为没有针对这些新的因子水平训练权重/系数：

# 调取`Task`
tsk_pen <- tsk('penguins')
# 去除有缺损值的行
tsk_pen$filter(tsk_pen$row_ids[complete.cases(tsk_pen$data())])
# 创建一个custom方法的重采样器(ResamplingCustom类)：
# custom需要手动提供的索引将数据拆分为训练集和测试集
rsmp_custom <- rsmp('custom')
# 为了举例子，这里选择手动分配训练集和测试集：
# 不包含“Torgersen”和仅包含“Torgersen”的行的数据集
rsmp_custom$instantiate(
 task = tsk_pen,
 # 选择所有`island`不为'Torgersen'的行的数据集作为训练集
 train_sets = list(
  tsk_pen$
   row_ids[
    tsk_pen$
     data()$
     island != 'Torgersen'
   ]
 ),
 # 选择所有`island`为'Torgersen'的行的数据集作为测试集
 test_sets = list(
  tsk_pen$
   row_ids[
    tsk_pen$
     data()$
     island == 'Torgersen'
   ]
 )
)
# 这样分配完后，测试集中的`island`是没有'Torgersen'的（缺乏因子）
# 这种结果会导致后面的`tune()`失败

# 创建交叉熵评估器
msr_ce <- msr('classif.ce')
# 创建随机搜索调优器
tnr_random <- tnr('random_search')
# 创建lda学习器
learner <- lrn(
 'classif.lda', 
 method = 't', 
 nu = to_tune(3, 10)
)

# ----------由于训练集没有测试集的因子“Torgersen”
# ----------下面报错
# 进行实例调优
tune(
 tuner = tnr_random, 
 task = tsk_pen, 
 learner = learner, 
 resampling = rsmp_custom, 
 measure = msr_ce, 
 term_evals = 10)

Error in lda.default(x, grouping, ...): variable 6 appears to be constant within groups

封装（encapsulation）允许在不干扰调优过程的情况下隔离和处理错误
可以使用 $encapsulate() 方法让学习器封装错误
- 传递的method = 'evaluate'是告诉学习器在训练和预测阶段都设置封装

learner$encapsulate(
 method = 'evaluate', 
 fallback = lrn('classif.featureless')
)

在HPO过程中，学习器不收敛是比较常见的问题，
这导致进程无限期运行
- 可以通过在学习器中设置 timeout字段来避免这种情况发生
- 如果学习器运行了指定的时长（以秒为单位），
  该字段会向学习器发出停止信号
- 可以分别针对训练和预测进行设置

learner$timeout = c(train = 30, predict = 30)

如果出现错误，或者达到模型超时阈值，
那么学习者不会中断，而是在发现错误时不进行预测
- 对于出现错误的重采样迭代，结果将显示为NA
上述情况时，超参数优化将会失败
- 因为无法汇总不同重采样迭代的结果
- 通过使用备择学习器，可以解决这个问题
  - 常见的方法是使用无特征基线
    lrn('regr.featureless') 或
    lrn('classif.featureless')
  - lrn('classif.featureless')总是预测多数类（占比最高的分类）

instance <- tune(
 tuner = tnr_random, 
 task = tsk_pen, 
 learner = learner, 
 resampling = rsmp_custom, 
 measure = msr_ce,
 term_evals = 10
)

as.data.table(instance$archive)

<table class='dataframe'> <caption>A data.table: 10 x 9</caption> <thead> <tr><th scope=col>nu</th><th scope=col>classif.ce</th><th scope=col>runtime_learners</th><th scope=col>timestamp</th><th scope=col>warnings</th><th scope=col>errors</th><th scope=col>x_domain</th><th scope=col>batch_nr</th><th scope=col>resample_result</th></tr> <tr><th scope=col><int></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dttm></th><th scope=col><int></th><th scope=col><int></th><th scope=col><list></th><th scope=col><int></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td>8</td><td>1</td><td>NA</td><td>2025-06-20 18:42:40</td><td>0</td><td>1</td><td>8</td><td> 1</td><td><environment: 0x16642a5a8></td></tr> <tr><td>9</td><td>1</td><td>NA</td><td>2025-06-20 18:42:40</td><td>0</td><td>1</td><td>9</td><td> 2</td><td><environment: 0x165f622c8></td></tr> <tr><td>5</td><td>1</td><td>NA</td><td>2025-06-20 18:42:40</td><td>0</td><td>1</td><td>5</td><td> 3</td><td><environment: 0x165f7da40></td></tr> <tr><td>5</td><td>1</td><td>NA</td><td>2025-06-20 18:42:40</td><td>0</td><td>1</td><td>5</td><td> 4</td><td><environment: 0x165f9bbc8></td></tr> <tr><td>6</td><td>1</td><td>NA</td><td>2025-06-20 18:42:40</td><td>0</td><td>1</td><td>6</td><td> 5</td><td><environment: 0x165fbb758></td></tr> <tr><td>9</td><td>1</td><td>NA</td><td>2025-06-20 18:42:40</td><td>0</td><td>1</td><td>9</td><td> 6</td><td><environment: 0x165fd78a8></td></tr> <tr><td>5</td><td>1</td><td>NA</td><td>2025-06-20 18:42:40</td><td>0</td><td>1</td><td>5</td><td> 7</td><td><environment: 0x165fedbc8></td></tr> <tr><td>4</td><td>1</td><td>NA</td><td>2025-06-20 18:42:40</td><td>0</td><td>1</td><td>4</td><td> 8</td><td><environment: 0x16644c068></td></tr> <tr><td>8</td><td>1</td><td>NA</td><td>2025-06-20 18:42:40</td><td>0</td><td>1</td><td>8</td><td> 9</td><td><environment: 0x16646a458></td></tr> <tr><td>6</td><td>1</td><td>NA</td><td>2025-06-20 18:42:41</td><td>0</td><td>1</td><td>6</td><td>10</td><td><environment: 0x166ac1458></td></tr> </tbody> </table>

用Instance$archive$resample_result()调取重采样中发生的错误

instance$archive$resample_result(1)$errors

<table class='dataframe'> <caption>A data.table: 1 x 2</caption> <thead> <tr><th scope=col>iteration</th><th scope=col>msg</th></tr> <tr><th scope=col><int></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><td>1</td><td>variable 6 appears to be constant within groups</td></tr> </tbody> </table>

调优则是可以进行的，并且得到最终选择出来的超参数

instance$result

<table class='dataframe'> <caption>A data.table: 1 x 4</caption> <thead> <tr><th scope=col>nu</th><th scope=col>learner_param_vals</th><th scope=col>x_domain</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><int></th><th scope=col><list></th><th scope=col><list></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>8</td><td>t, 8</td><td>8</td><td>1</td></tr> </tbody> </table>

内存管理

ti()和auto_tuner()中的store_models参数
可以选择是否储存训练中生成的模型
ti() 和 auto_tuner()中的store_benchmark_result参数
可以选择是否储存重采样结果
- 但如果没有重采样结果，
  就无法再用其他指标对配置进行评分
当使用大量外部重采样迭代运行嵌套重采样时，
如果在 auto_tuner() 函数中设置 store_tuning_instance = FALSE，
则可以节省额外的内存
- 但是，
  extract_inner_tuning_results() 和
  extract_inner_tuning_archives() 函数将不再起作用
选项store_models = TRUE会将
store_benchmark_result和
store_tuning_instance设置为TRUE
- 因为模型存储在基准测试结果中，
  而基准测试结果又是实例的一部分
- 这也意味着store_benchmark_result = TRUE会将
  store_tuning_instance设置为TRUE
在 resample() 或 benchmark() 中设置 store_models = FALSE，
以在运行嵌套重采样时禁用自动调谐器的存储仍然可以通过ResampleResult$aggregate() 查看整合评估的结果，
但会丢失有关内部重采样的信息

多目标调优

更多时候，比起模型在单一评估指标上优秀，
在多个评估指标上都有较好的评估结果是我们想看到的
从定义上讲，对多个评估指标进行优化意味着这些指标之间会相互竞争
（否则我们只需优化其中一个指标）
- 因此一般来说，不存在一种能优化所有指标的单一评估器
帕累托最优（Pareto optimality）
- 假设要最小化分类误差$CE$和复杂度$CP$，
  配置A和配置B的分类误差分别为$CE_A$和$CE_B$，复杂度分别为$CP_A$和$CP_B$
- 若满足以下条件，则A帕累托支配B：
  - 1）CEA≤CEB且CPA<CPB；或者
    2）CEA<CEB且CPA≤CPB
  - 所有不被其他任何配置帕累托支配的配置称为
    帕累托有效配置（Pareto-efficient）
  - 所有这些配置的集合就是帕累托集（Pareto set）
  - 与帕累托集相对应的指标值称为帕累托前沿（Pareto front）
多目标超参数优化的目标是找到一组非支配解，
使其对应的指标值逼近帕累托前沿
下例中，对 tsk('sonar') 数据集上调整决策树来演示多目标超参数优化
- 其中分类误差作为模型性能的度量
- 所选特征的数量作为模型复杂度的度量

learner <- lrn(
 'classif.rpart', 
 cp = to_tune(1e-04, 1e-1),
 minsplit = to_tune(2, 64), 
 maxdepth = to_tune(1, 30)
)

measures <- msrs(c('classif.ce', 'selected_features'))

用ti()调优
- 由于是多评估指标调优，所以创建的不是
  TuningInstanceBatchSingleCrit，而是
  TuningInstanceBatchMultiCrit

# 创建调优实例
instance <- ti(
 task = tsk('sonar'),
 learner = learner,
 resampling = rsmp('cv', folds = 3),
 # 注意不是`measure`而是`measures`复数
 measures = measures,
 terminator = trm('evals', n_evals = 30),
 # 
 store_models = TRUE
)

# 创建调优器
tuner <- tnr('random_search')
# 调优
tuner$optimize(instance)

<table class='dataframe'> <caption>A data.table: 16 x 7</caption> <thead> <tr><th scope=col>cp</th><th scope=col>maxdepth</th><th scope=col>minsplit</th><th scope=col>learner_param_vals</th><th scope=col>x_domain</th><th scope=col>classif.ce</th><th scope=col>selected_features</th></tr> <tr><th scope=col><dbl></th><th scope=col><int></th><th scope=col><int></th><th scope=col><list></th><th scope=col><list></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>0.05426979</td><td> 2</td><td>28</td><td>0.00000000, 0.05426979, 2.00000000, 28.00000000</td><td>0.05426979, 2.00000000, 28.00000000</td><td>0.2739821</td><td>1.666667</td></tr> <tr><td>0.08910768</td><td>24</td><td>44</td><td>0.00000000, 0.08910768, 24.00000000, 44.00000000</td><td>0.08910768, 24.00000000, 44.00000000</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.08880381</td><td> 4</td><td> 9</td><td>0.00000000, 0.08880381, 4.00000000, 9.00000000</td><td>0.08880381, 4.00000000, 9.00000000</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.07884068</td><td> 4</td><td>36</td><td>0.00000000, 0.07884068, 4.00000000, 36.00000000</td><td>0.07884068, 4.00000000, 36.00000000</td><td>0.2787440</td><td>1.333333</td></tr> <tr><td>0.07125967</td><td> 8</td><td>16</td><td>0.00000000, 0.07125967, 8.00000000, 16.00000000</td><td>0.07125967, 8.00000000, 16.00000000</td><td>0.2692892</td><td>3.000000</td></tr> <tr><td>0.09373661</td><td>15</td><td>32</td><td>0.00000000, 0.09373661, 15.00000000, 32.00000000</td><td>0.09373661, 15.00000000, 32.00000000</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.09580900</td><td> 3</td><td>47</td><td>0.000000, 0.095809, 3.000000, 47.000000</td><td>0.095809, 3.000000, 47.000000</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.09714774</td><td> 6</td><td>57</td><td>0.00000000, 0.09714774, 6.00000000, 57.00000000</td><td>0.09714774, 6.00000000, 57.00000000</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.09435243</td><td>26</td><td>33</td><td>0.00000000, 0.09435243, 26.00000000, 33.00000000</td><td>0.09435243, 26.00000000, 33.00000000</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.01511812</td><td> 1</td><td>20</td><td>0.00000000, 0.01511812, 1.00000000, 20.00000000</td><td>0.01511812, 1.00000000, 20.00000000</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.06956784</td><td>18</td><td> 9</td><td>0.00000000, 0.06956784, 18.00000000, 9.00000000</td><td>0.06956784, 18.00000000, 9.00000000</td><td>0.2692892</td><td>3.000000</td></tr> <tr><td>0.05564576</td><td> 3</td><td>51</td><td>0.00000000, 0.05564576, 3.00000000, 51.00000000</td><td>0.05564576, 3.00000000, 51.00000000</td><td>0.2739821</td><td>1.666667</td></tr> <tr><td>0.08578581</td><td> 1</td><td>64</td><td>0.00000000, 0.08578581, 1.00000000, 64.00000000</td><td>0.08578581, 1.00000000, 64.00000000</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.07160058</td><td>24</td><td>12</td><td>0.00000000, 0.07160058, 24.00000000, 12.00000000</td><td>0.07160058, 24.00000000, 12.00000000</td><td>0.2692892</td><td>3.000000</td></tr> <tr><td>0.06709319</td><td>14</td><td>15</td><td>0.00000000, 0.06709319, 14.00000000, 15.00000000</td><td>0.06709319, 14.00000000, 15.00000000</td><td>0.2644582</td><td>3.333333</td></tr> <tr><td>0.06516315</td><td> 8</td><td>59</td><td>0.00000000, 0.06516315, 8.00000000, 59.00000000</td><td>0.06516315, 8.00000000, 59.00000000</td><td>0.2835749</td><td>1.000000</td></tr> </tbody> </table>

<table class='dataframe'> <caption>A data.table: 16 x 12</caption> <thead> <tr><th scope=col>cp</th><th scope=col>maxdepth</th><th scope=col>minsplit</th><th scope=col>classif.ce</th><th scope=col>selected_features</th><th scope=col>warnings</th><th scope=col>errors</th><th scope=col>runtime_learners</th><th scope=col>uhash</th><th scope=col>x_domain</th><th scope=col>timestamp</th><th scope=col>batch_nr</th></tr> <tr><th scope=col><dbl></th><th scope=col><int></th><th scope=col><int></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><int></th><th scope=col><int></th><th scope=col><dbl></th><th scope=col><chr></th><th scope=col><list></th><th scope=col><dttm></th><th scope=col><int></th></tr> </thead> <tbody> <tr><td>0.05426979</td><td> 2</td><td>28</td><td>0.2739821</td><td>1.666667</td><td>0</td><td>0</td><td>0.021</td><td>6be71e58-e259-4c8b-878b-e29817f2a6d8</td><td>0.05426979, 2.00000000, 28.00000000</td><td>2025-06-20 19:51:32</td><td> 2</td></tr> <tr><td>0.08910768</td><td>24</td><td>44</td><td>0.2835749</td><td>1.000000</td><td>0</td><td>0</td><td>0.025</td><td>9e2e9e87-1080-47a8-b919-76d94a86dda6</td><td>0.08910768, 24.00000000, 44.00000000</td><td>2025-06-20 19:51:32</td><td> 3</td></tr> <tr><td>0.08880381</td><td> 4</td><td> 9</td><td>0.2835749</td><td>1.000000</td><td>0</td><td>0</td><td>0.020</td><td>a97a1800-f583-43fa-9598-98e94f489fc3</td><td>0.08880381, 4.00000000, 9.00000000</td><td>2025-06-20 19:51:33</td><td> 4</td></tr> <tr><td>0.07884068</td><td> 4</td><td>36</td><td>0.2787440</td><td>1.333333</td><td>0</td><td>0</td><td>0.024</td><td>d068028d-b167-4a10-868c-0ad4dc41645e</td><td>0.07884068, 4.00000000, 36.00000000</td><td>2025-06-20 19:51:33</td><td> 5</td></tr> <tr><td>0.07125967</td><td> 8</td><td>16</td><td>0.2692892</td><td>3.000000</td><td>0</td><td>0</td><td>0.026</td><td>36f4c7a7-1d1f-4bc8-93ca-f3a4554e1ac0</td><td>0.07125967, 8.00000000, 16.00000000</td><td>2025-06-20 19:51:33</td><td> 6</td></tr> <tr><td>0.09373661</td><td>15</td><td>32</td><td>0.2835749</td><td>1.000000</td><td>0</td><td>0</td><td>0.019</td><td>556f9677-9b7f-4141-83a9-b60005fa7b13</td><td>0.09373661, 15.00000000, 32.00000000</td><td>2025-06-20 19:51:33</td><td> 8</td></tr> <tr><td>0.09580900</td><td> 3</td><td>47</td><td>0.2835749</td><td>1.000000</td><td>0</td><td>0</td><td>0.019</td><td>86f908bf-3e82-4520-af3a-44f79b6dc187</td><td>0.095809, 3.000000, 47.000000</td><td>2025-06-20 19:51:33</td><td> 9</td></tr> <tr><td>0.09714774</td><td> 6</td><td>57</td><td>0.2835749</td><td>1.000000</td><td>0</td><td>0</td><td>0.019</td><td>9e15d7b5-70ed-4ad5-a25c-1a977bbe7c02</td><td>0.09714774, 6.00000000, 57.00000000</td><td>2025-06-20 19:51:33</td><td>11</td></tr> <tr><td>0.09435243</td><td>26</td><td>33</td><td>0.2835749</td><td>1.000000</td><td>0</td><td>0</td><td>0.019</td><td>b6c82dee-e800-4ac2-92f4-3fed0ad3d7d7</td><td>0.09435243, 26.00000000, 33.00000000</td><td>2025-06-20 19:51:33</td><td>13</td></tr> <tr><td>0.01511812</td><td> 1</td><td>20</td><td>0.2835749</td><td>1.000000</td><td>0</td><td>0</td><td>0.020</td><td>9624b63b-5a6e-4e33-b3d6-3c7d3f019c11</td><td>0.01511812, 1.00000000, 20.00000000</td><td>2025-06-20 19:51:34</td><td>15</td></tr> <tr><td>0.06956784</td><td>18</td><td> 9</td><td>0.2692892</td><td>3.000000</td><td>0</td><td>0</td><td>0.022</td><td>42137ac1-5ae4-4b5e-b115-a6595affbb7c</td><td>0.06956784, 18.00000000, 9.00000000</td><td>2025-06-20 19:51:34</td><td>20</td></tr> <tr><td>0.05564576</td><td> 3</td><td>51</td><td>0.2739821</td><td>1.666667</td><td>0</td><td>0</td><td>0.018</td><td>9474b0f3-4b88-45dd-a47f-d74b270d4b42</td><td>0.05564576, 3.00000000, 51.00000000</td><td>2025-06-20 19:51:34</td><td>24</td></tr> <tr><td>0.08578581</td><td> 1</td><td>64</td><td>0.2835749</td><td>1.000000</td><td>0</td><td>0</td><td>0.017</td><td>d43220b1-93b9-44c7-84b4-7d3b59874a5e</td><td>0.08578581, 1.00000000, 64.00000000</td><td>2025-06-20 19:51:34</td><td>25</td></tr> <tr><td>0.07160058</td><td>24</td><td>12</td><td>0.2692892</td><td>3.000000</td><td>0</td><td>0</td><td>0.019</td><td>5bc304de-e3c7-4b7f-8e6a-34d8656effaf</td><td>0.07160058, 24.00000000, 12.00000000</td><td>2025-06-20 19:51:35</td><td>27</td></tr> <tr><td>0.06709319</td><td>14</td><td>15</td><td>0.2644582</td><td>3.333333</td><td>0</td><td>0</td><td>0.018</td><td>2f5dee32-6999-40cf-8587-0d3160c01c87</td><td>0.06709319, 14.00000000, 15.00000000</td><td>2025-06-20 19:51:35</td><td>29</td></tr> <tr><td>0.06516315</td><td> 8</td><td>59</td><td>0.2835749</td><td>1.000000</td><td>0</td><td>0</td><td>0.017</td><td>6227972f-90ad-4963-8fed-102fb71e697f</td><td>0.06516315, 8.00000000, 59.00000000</td><td>2025-06-20 19:51:35</td><td>30</td></tr> </tbody> </table>

使用Instance$archive$best()调用所有的可用配置
- 从帕累托前沿中确定部署哪种配置取决于个人偏好
  - 根据定义，不存在最优配置
- 例如，如果宁愿以较高错误率为代价来换取较低的复杂度，
  那么可以选择 selected_features = 1 的配置

instance$archive$best()[
 , 
 .(
  cp, minsplit, 
  maxdepth, 
  classif.ce,
  selected_features
 )
]

<table class='dataframe'> <caption>A data.table: 16 x 5</caption> <thead> <tr><th scope=col>cp</th><th scope=col>minsplit</th><th scope=col>maxdepth</th><th scope=col>classif.ce</th><th scope=col>selected_features</th></tr> <tr><th scope=col><dbl></th><th scope=col><int></th><th scope=col><int></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>0.05426979</td><td>28</td><td> 2</td><td>0.2739821</td><td>1.666667</td></tr> <tr><td>0.08910768</td><td>44</td><td>24</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.08880381</td><td> 9</td><td> 4</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.07884068</td><td>36</td><td> 4</td><td>0.2787440</td><td>1.333333</td></tr> <tr><td>0.07125967</td><td>16</td><td> 8</td><td>0.2692892</td><td>3.000000</td></tr> <tr><td>0.09373661</td><td>32</td><td>15</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.09580900</td><td>47</td><td> 3</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.09714774</td><td>57</td><td> 6</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.09435243</td><td>33</td><td>26</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.01511812</td><td>20</td><td> 1</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.06956784</td><td> 9</td><td>18</td><td>0.2692892</td><td>3.000000</td></tr> <tr><td>0.05564576</td><td>51</td><td> 3</td><td>0.2739821</td><td>1.666667</td></tr> <tr><td>0.08578581</td><td>64</td><td> 1</td><td>0.2835749</td><td>1.000000</td></tr> <tr><td>0.07160058</td><td>12</td><td>24</td><td>0.2692892</td><td>3.000000</td></tr> <tr><td>0.06709319</td><td>15</td><td>14</td><td>0.2644582</td><td>3.333333</td></tr> <tr><td>0.06516315</td><td>59</td><td> 8</td><td>0.2835749</td><td>1.000000</td></tr> </tbody> </table>

使用Instance$result_learner_param_vals传递给Learner`
- 例如这里选择第二项配置

learner <- lrn('classif.rpart')
learner$param_set$values <- instance$result_learner_param_vals[[2]]

因为多目标调优需要人为手动配置，
所以不能使用auto_tuner()

超带算法（Hyperband）进行多保真度（Fidelity）调优

简介

保真度：
核心指模型或算法在处理数据、进行预测或迁移时对原始信息的保留程度
对于超大的数据集和搜索空间，
调优的计算成本会非常高
类似于Hyperband的方法目的在于：
用低保真度模型的性能可以代替全保真度模型的性能
- 对于预期进行1000轮梯度提升算法实验时，
  1000轮的训练就是全保真，
  轮数越低保真度就越低
一些算法具有天然的保真度参数
- 神经网络：number of epochs
- 随机森林：number of trees

超带算法与连续减半算法（Successive Halving）

超带算法
- 对低保真度下随机采样的配置进行评估后，
  超带算法会迭代地将更多资源分配给有前景的配置，
  并尽早终止性能不佳的配置
- 基于Jamieson和Talwalkar提出的连续减半算法
  - 简介
    - 初始化时需要一些起始配置数量$m_0$，
      每个阶段丢弃配置的比例$η$，
      以及单次评估的最小预算（budget，= 保真度）$r_0$和
      最大预算$r_{max}$
    - 该算法首先对$m_0$个随机配置进行采样，并为它们分配最小预算$r_0$
    - 对这些配置进行评估，然后丢弃表现最差的$\frac{η-1}{η}$的配置
    - 剩余的配置进入下一阶段（bracket），并在更大的预算下进行评估；
      这个过程持续进行，直到一个或多个配置在最大预算$r_{max}$下进行评估，
      然后选择表现最佳的配置
    - 计算阶段总数，以便每个阶段消耗大致相同的总预算
    - 这种方法的一个很大缺点是，
      不清楚是从大量配置（较大的$r_0$）和较小预算开始，
      还是从较少配置（较小的$r_0$）但较大预算开始更好
  - 超带算法中对其的优化
    - 通过在不同的起始配置数量下运行连续减半法，
      每个起始配置数量对应不同的预算水平 $r_0$，
      解决上述问题
    - 使用相同的 $η$ 和 $r_{max}$ 参数进行初始化（但不是 $m_0$）
    - 每个bracket从不同的预算 $r_0$ 开始，
      较小的值意味着可以评估更多的配置，
      因此最具探索性的括号（即bracket最多的那个）被分配全局最小预算 $r_{min}$
    - 在每个括号中，起始预算以 $η$ 倍的因子增加，
      直到最后一个括号基本上使用完整预算 $r_{max}$ 进行随机搜索
    - 括号的总数 $s_{max} + 1$ 计算为 $s_{max}=log_η{\frac{r_max}{r_min}}$
    - 每个括号的起始配置数量 $m_0$ 经过计算，
      使得每个括号使用的预算大致相同
    - 每个括号中的最优超参数配置是最后阶段性能最佳的配置
    - 调优结束时的最优超参数配置是所有括号中性能最佳的配置
下表例子为：当$η=2$，$r_{min}=1$， $r_{max}=8$时，
每个bracket $s$ ，阶段 $i$ 的超带调度，
包含配置数量 $m_i$ 和资源量 $r_i$

	s=3		s=2		s=1		s=0
i	mi	ri	mi	ri	mi	ri	mi	ri
0	8	1	6	2	4	4	4	8
1	4	2	3	4	2	8
2	2	4	1	8
3	1	8

下表是商标中具体的超参数配置
- HPCs∗ 是bracket $s$ 中的最优超参数配置
- HPC∗ 是所有bracket中的最优超参数配置

	s=3	s=2	s=1	s=0
i=0	{1,2,3,4,5,6,7,8}	{9,10,11,12,13,14}	{15,16,17,18}	{19,20,21,22}
i=1	{1,2,7,8}	{9,14,15}	{20,21}
i=2	{1,8}	{15}
i=3	{1}
HPCs∗	{1}	{15}	{21}	{22}
HPC∗	{15}

`mlr3hyperband`包

调用的方法为
- tnr('successive_halving')
- tnr('hyperband')
下面的例子为使用超带算法

# 超带算法需要单独加载'mlr3hyperband'包
# library(mlr3hyperband)

# 构建学习器，这里是xgboost算法
learner <- lrn('classif.xgboost')
# 设置超级参数的调整范围
# 这里是先创建学习器，再设定参数
# 直接在`lrn()`中传递设置也行
learner$param_set$set_values(
 nrounds = to_tune(p_int(16, 128, tags = 'budget')),
 eta = to_tune(1e-4, 1, logscale = TRUE),
 max_depth = to_tune(1, 20),
 colsample_bytree = to_tune(1e-1, 1),
 colsample_bylevel = to_tune(1e-1, 1),
 lambda = to_tune(1e-3, 1e3, logscale = TRUE),
 alpha = to_tune(1e-3, 1e3, logscale = TRUE),
 subsample = to_tune(1e-1, 1)
)

构建超带算法调优器
- eta，$\eta$
- reprtitions，brackets评估的次数
  - 如果希望终止器基于运行时间等条件允许，
    可以设置为Inf

# 创建调优实例
instance <- ti(
 task = tsk('sonar'),
 learner = learner,
 resampling = rsmp('holdout'),
 measures = msr('classif.ce'),
 terminator = trm('none')
)

# 将调优器选择为'hyperband'
tuner <- tnr('hyperband', eta = 2, repetitions = 1)
# 显示给定保真度级别和预算增加因子的调度情况
hyperband_schedule(r_min = 16, r_max = 128, eta = 2)

<table class='dataframe'> <caption>A data.table: 10 x 4</caption> <thead> <tr><th scope=col>bracket</th><th scope=col>stage</th><th scope=col>budget</th><th scope=col>n</th></tr> <tr><th scope=col><int></th><th scope=col><int></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>3</td><td>0</td><td> 16</td><td>8</td></tr> <tr><td>3</td><td>1</td><td> 32</td><td>4</td></tr> <tr><td>3</td><td>2</td><td> 64</td><td>2</td></tr> <tr><td>3</td><td>3</td><td>128</td><td>1</td></tr> <tr><td>2</td><td>0</td><td> 32</td><td>6</td></tr> <tr><td>2</td><td>1</td><td> 64</td><td>3</td></tr> <tr><td>2</td><td>2</td><td>128</td><td>1</td></tr> <tr><td>1</td><td>0</td><td> 64</td><td>4</td></tr> <tr><td>1</td><td>1</td><td>128</td><td>2</td></tr> <tr><td>0</td><td>0</td><td>128</td><td>4</td></tr> </tbody> </table>

开调
- 超带算法运行生成的存档包含额外的 bracket和stage`可供查询

tuner$optimize(instance)

<table class='dataframe'> <caption>A data.table: 1 x 11</caption> <thead> <tr><th scope=col>alpha</th><th scope=col>colsample_bylevel</th><th scope=col>colsample_bytree</th><th scope=col>eta</th><th scope=col>lambda</th><th scope=col>max_depth</th><th scope=col>nrounds</th><th scope=col>subsample</th><th scope=col>learner_param_vals</th><th scope=col>x_domain</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><int></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><list></th><th scope=col><list></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>-6.172833</td><td>0.3635065</td><td>0.8039435</td><td>-2.811107</td><td>-2.935965</td><td>10</td><td>32</td><td>0.8351367</td><td>1.00000000, 0.00000000, 0.00208532, 0.36350653, 0.80394345, 0.06013836, 0.05307950, 10.00000000, 32.00000000, 0.83513674</td><td>0.00208532, 0.36350653, 0.80394345, 0.06013836, 0.05307950, 10.00000000, 32.00000000, 0.83513674</td><td>0.08695652</td></tr> </tbody> </table>

查看结果

instance$result[, .(classif.ce, nrounds)]

<table class='dataframe'> <caption>A data.table: 1 x 2</caption> <thead> <tr><th scope=col>classif.ce</th><th scope=col>nrounds</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>0.08695652</td><td>32</td></tr> </tbody> </table>

as.data.table(
 instance$
  archive
)[
 ,
 .(
  bracket, 
  stage, 
  classif.ce, 
  eta, 
  max_depth, 
  colsample_bytree
 )
]

<table class='dataframe'> <caption>A data.table: 35 x 6</caption> <thead> <tr><th scope=col>bracket</th><th scope=col>stage</th><th scope=col>classif.ce</th><th scope=col>eta</th><th scope=col>max_depth</th><th scope=col>colsample_bytree</th></tr> <tr><th scope=col><int></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><int></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>3</td><td>0</td><td>0.18840580</td><td>-8.4184092</td><td>14</td><td>0.1132001</td></tr> <tr><td>3</td><td>0</td><td>0.14492754</td><td>-2.8111074</td><td>10</td><td>0.8039435</td></tr> <tr><td>3</td><td>0</td><td>0.17391304</td><td>-8.9243113</td><td>12</td><td>0.4971439</td></tr> <tr><td>3</td><td>0</td><td>0.47826087</td><td>-3.6697481</td><td> 3</td><td>0.8741933</td></tr> <tr><td>3</td><td>0</td><td>0.43478261</td><td>-4.3152031</td><td>13</td><td>0.5225918</td></tr> <tr><td>3</td><td>0</td><td>0.36231884</td><td>-8.4627255</td><td>19</td><td>0.1774070</td></tr> <tr><td>3</td><td>0</td><td>0.17391304</td><td>-4.0383421</td><td> 5</td><td>0.6494958</td></tr> <tr><td>3</td><td>0</td><td>0.49275362</td><td>-6.6481889</td><td> 4</td><td>0.2036302</td></tr> <tr><td>2</td><td>0</td><td>0.36231884</td><td>-1.6321229</td><td>16</td><td>0.8125073</td></tr> <tr><td>2</td><td>0</td><td>0.59420290</td><td>-2.9741057</td><td>12</td><td>0.9270787</td></tr> <tr><td>2</td><td>0</td><td>0.21739130</td><td>-3.5983812</td><td>12</td><td>0.4030144</td></tr> <tr><td>2</td><td>0</td><td>0.20289855</td><td>-8.9486226</td><td> 2</td><td>0.5908226</td></tr> <tr><td>2</td><td>0</td><td>0.20289855</td><td>-5.9648847</td><td>13</td><td>0.3665838</td></tr> <tr><td>2</td><td>0</td><td>0.52173913</td><td>-1.2237877</td><td>10</td><td>0.2762483</td></tr> <tr><td>3</td><td>1</td><td>0.08695652</td><td>-2.8111074</td><td>10</td><td>0.8039435</td></tr> <tr><td>3</td><td>1</td><td>0.18840580</td><td>-8.9243113</td><td>12</td><td>0.4971439</td></tr> <tr><td>3</td><td>1</td><td>0.17391304</td><td>-4.0383421</td><td> 5</td><td>0.6494958</td></tr> <tr><td>3</td><td>1</td><td>0.23188406</td><td>-8.4184092</td><td>14</td><td>0.1132001</td></tr> <tr><td>1</td><td>0</td><td>0.13043478</td><td>-4.2164773</td><td> 6</td><td>0.9656635</td></tr> <tr><td>1</td><td>0</td><td>0.15942029</td><td>-2.6815217</td><td>14</td><td>0.2158201</td></tr> <tr><td>1</td><td>0</td><td>0.43478261</td><td>-0.2845524</td><td>14</td><td>0.2034910</td></tr> <tr><td>1</td><td>0</td><td>0.47826087</td><td>-8.0905822</td><td> 6</td><td>0.4738960</td></tr> <tr><td>3</td><td>2</td><td>0.11594203</td><td>-2.8111074</td><td>10</td><td>0.8039435</td></tr> <tr><td>3</td><td>2</td><td>0.18840580</td><td>-4.0383421</td><td> 5</td><td>0.6494958</td></tr> <tr><td>2</td><td>1</td><td>0.18840580</td><td>-8.9486226</td><td> 2</td><td>0.5908226</td></tr> <tr><td>2</td><td>1</td><td>0.15942029</td><td>-5.9648847</td><td>13</td><td>0.3665838</td></tr> <tr><td>2</td><td>1</td><td>0.17391304</td><td>-3.5983812</td><td>12</td><td>0.4030144</td></tr> <tr><td>0</td><td>0</td><td>0.52173913</td><td>-5.9619021</td><td>16</td><td>0.6184736</td></tr> <tr><td>0</td><td>0</td><td>0.17391304</td><td>-5.1422637</td><td>16</td><td>0.1687332</td></tr> <tr><td>0</td><td>0</td><td>0.15942029</td><td>-5.7223769</td><td> 9</td><td>0.6430624</td></tr> <tr><td>0</td><td>0</td><td>0.17391304</td><td>-6.1107773</td><td>19</td><td>0.7558739</td></tr> <tr><td>3</td><td>3</td><td>0.10144928</td><td>-2.8111074</td><td>10</td><td>0.8039435</td></tr> <tr><td>2</td><td>2</td><td>0.14492754</td><td>-5.9648847</td><td>13</td><td>0.3665838</td></tr> <tr><td>1</td><td>1</td><td>0.15942029</td><td>-4.2164773</td><td> 6</td><td>0.9656635</td></tr> <tr><td>1</td><td>1</td><td>0.13043478</td><td>-2.6815217</td><td>14</td><td>0.2158201</td></tr> </tbody> </table>

贝叶斯优化（Bayesian Optimization, BO）

简介

贝叶斯优化是基于模型的优化（Model Based Optimization）
黑盒优化
- 简单来说，虽然超参数的设定影响模型的性能，
  但我们无法判断什么样的超参数和带来什么样的性能
- 这种只能通过输入输出试错并且不能了解内部原理的优化过程，
  称作黑盒优化
贝叶斯优化
- 一类样本高效的迭代全局黑盒优化算法，
  这类算法依赖于在观测数据上训练的 代理模型 来对黑盒函数进行建模
  - 代理模型一般是一个非线性回归模型
  - 利用有限的观测数据来捕捉未知函数
- 每次迭代中，贝叶斯优化算法采用一个 采集函数（acquisition function’） 来确定下一个待评估的候选点
  - 采集函数基于代理模型的预测来衡量搜索空间内每个点的预期 效用（utility）
  - 算法选择具有最佳采集函数值的候选点，并在该点评估黑盒函数，进而更新代理模型
  - 这个迭代过程持续进行，直到满足终止条件
    - 例如达到预先指定的最大评估次数或实现所需的性能水平
- 贝叶斯优化是一种强大的方法，通常能产生良好的优化性能，
  特别是当黑盒评估成本高昂且优化预算紧张时
在后续中，以优化下方正弦函数$f$为示例；
该函数具有两个局部最小值和一个全局最小值 $$f:[0,1] \rightarrow \mathbb{R}, x \mapsto 2x \times sin(14x) $$

黑箱优化

bbotk是用于黑箱优化工具包，在mlr3生态环境中主力调用用于调优
- OptimInstanceBatchSingleCrit类和OptimInstanceBatchMultiCrit类
  - TuningInstanceBatchSingleCrit 和 TuningInstanceBatchMultiCrit
    分别继承于它们
  - 用于构建描述优化问题并且存储结果的优化实例
  - 依赖于目标函数类（Objective类）
    - 包含从定义域（所有可能的函数输入）到陪域（所有可能的函数输出）的实际映射
    - 目标函数可以通过不同的类来创建
    - 这些类都继承自Objective
    - 这些类提供了不同的方式来定义和评估目标函数；
      选择合适的类将减少类型转换开销
      - ObjectiveRFun：
        
        封装了一个函数，该函数将描述 单个配置 的列表作为输入，
        其中元素可以是任何类型
        
        当底层函数评估机制是通过一次评估单个配置来实现时，它很适用
      - ObjectiveRFunMany：
        
        封装了一个函数，该函数接受一个包含 多种配置 的列表作为输入，
        其中元素可以是任何类型，甚至是混合类型
        
        当对多种配置的函数求值可以并行化时，这很有用
      - ObjectiveRFunDt：
        
        封装了一个对 data.table 进行操作的函数
        
        它允许直接在 data.table 对象上进行高效的向量化或批处理评估，
        避免不必要的数据类型转换
- OptimizerBatch类
  - 用于构建和配置优化算法
创建ObjectiveRFun类，以单个配置作为输入
Objective需要指定要优化的函数及其定义域和值域
通过使用'minimize'或'maximize'标记值域来指定优化方向
下面的优化函数如何以一个名为x的单元素list作为输入

# library(bbotk)

# 创建上述的函数f
sinus_1D <- function(xs) 2 * xs$x * sin(14 * xs$x)

# 定义域
domain <- ps(x = p_dbl(lower = 0, upper = 1))
# 陪域
codomain <- ps(y = p_dbl(tags = 'minimize'))

# 创建一个
objective <- ObjectiveRFun$new(
 sinus_1D,
 domain = domain, 
 codomain = codomain
)

再定义域范围内将函数可视化

# 加载`ggplot2`包
# library(ggplot2)

# 生成1001个观测，范围在`domain`定义的定义域范围
xydt <- generate_design_grid(domain, resolution = 1001)$data
# `:=`是`data.table`类的特殊用法：
# 就地修改，将`objective$eval_dt(xydt)$y`赋值到`y`
xydt[, y := objective$eval_dt(xydt)$y]

# 这里是预先计算好的局部和全局最小值
# 用于作图
optima <- data.table(x = c(0, 0.3509406, 0.7918238))
optima[, y := objective$eval_dt(optima)$y]
optima[, type := c('local', 'local', 'global')]

# 作图
ggplot(aes(x = x, y = y), data = xydt) +
  geom_line() +
  geom_point(
   aes(pch = type), 
   color = 'black', 
   size = 4, 
   data = optima
  ) +
  theme_minimal() +
  theme(legend.position = 'none')

定义了目标函数后，可以使用OptimInstanceBatchSingleCrit类对其进行优化
- 这个类允许我们封装目标函数，并显式指定搜索空间
- 搜索空间定义了我们想要优化的输入值集合，
  它通常是定义域的一个子集或变换，
  尽管默认情况下整个定义域被用作搜索空间
- 在黑盒优化中，定义域以及因此的搜索空间通常具有有限的盒约束
- 与超参数优化类似，有时可以使用变换来更有效地搜索空间
接下来，使用简单随机搜索在整个域上优化正弦函数，并以常规方式检查instance的结果
- 使用oi()函数（optimization instance）构建一个优化实例
- 与Tuner类似，bbotk中的Optimizer存储在mlr_optimizers字典中，
  并且可以使用opt()进行构建
首先看看mlr_optimizers储存了哪些优化器（Optimizer类）

mlr_optimizers

<table class='dataframe'> <caption>A data.table: 15 x 5</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>param_classes</th><th scope=col>properties</th><th scope=col>packages</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td>async_design_points</td><td>Asynchronous Design Points </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct, ParamUty</td><td>dependencies, single-crit , multi-crit , async </td><td>bbotk, rush </td></tr> <tr><td>async_grid_search </td><td>Asynchronous Grid Search </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit , multi-crit , async </td><td>bbotk, rush </td></tr> <tr><td>async_random_search</td><td>Asynchronous Random Search </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit , multi-crit , async </td><td>bbotk, rush </td></tr> <tr><td>chain </td><td>Chain Multiple Optimizers Sequentially </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit , multi-crit </td><td>bbotk</td></tr> <tr><td>cmaes </td><td>Covariance Matrix Adaptation Evolution Strategy</td><td>ParamDbl</td><td>single-crit</td><td>bbotk , adagio</td></tr> <tr><td>design_points </td><td>Design Points </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct, ParamUty</td><td>dependencies, single-crit , multi-crit </td><td>bbotk</td></tr> <tr><td>focus_search </td><td>Focus Search </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit </td><td>bbotk</td></tr> <tr><td>gensa </td><td>Generalized Simulated Annealing </td><td>ParamDbl</td><td>single-crit</td><td>bbotk, GenSA</td></tr> <tr><td>grid_search </td><td>Grid Search </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit , multi-crit </td><td>bbotk</td></tr> <tr><td>hyperband </td><td>Hyperband </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit , multi-crit </td><td>bbotk , mlr3hyperband</td></tr> <tr><td>irace </td><td>Iterated Racing </td><td>ParamDbl, ParamInt, ParamFct, ParamLgl</td><td>dependencies, single-crit </td><td>bbotk, irace</td></tr> <tr><td>local_search </td><td>Local Search </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit </td><td>bbotk</td></tr> <tr><td>nloptr </td><td>Non-linear Optimization </td><td>ParamDbl</td><td>single-crit</td><td>bbotk , nloptr</td></tr> <tr><td>random_search </td><td>Random Search </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit , multi-crit </td><td>bbotk</td></tr> <tr><td>successive_halving </td><td>Successive Halving </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit , multi-crit </td><td>bbotk , mlr3hyperband</td></tr> </tbody> </table>

使用oi()构建优化实例并进行优化（类似于vi()）

# 构建优化实例
instance <- oi(
 objective,
 # 定义域传递到搜索空间
 search_space = domain,
 # 设定终止器，迭代20次后终止
 terminator = trm('evals', n_evals = 20)
)
# 构建优化器，算法为随机搜索
optimizer <- opt('random_search', batch_size = 20)
optimizer$optimize(instance)

<table class='dataframe'> <caption>A data.table: 1 x 3</caption> <thead> <tr><th scope=col>x</th><th scope=col>x_domain</th><th scope=col>y</th></tr> <tr><th scope=col><dbl></th><th scope=col><list></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>0.7732799</td><td>0.7732799</td><td>-1.524356</td></tr> </tbody> </table>

也可以使用bb_optimize进行实例优化（类似于tune()）

optimal <- bb_optimize(
 objective, 
 method = 'random_search',
 max_evals = 20
)
optimal$instance$result

<table class='dataframe'> <caption>A data.table: 1 x 3</caption> <thead> <tr><th scope=col>x</th><th scope=col>x_domain</th><th scope=col>y</th></tr> <tr><th scope=col><dbl></th><th scope=col><list></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>0.7530768</td><td>0.7530768</td><td>-1.35457</td></tr> </tbody> </table>

贝叶斯优化的构建模块（Building Blocks）

步骤：

生成并评估初始设计
循环：
在目前所做的所有观测数据存档上拟合一个代理模型，以对未知的黑箱函数进行建模
优化采集函数，以确定搜索空间中的哪些点是有前景的候选点，应在下一步进行评估
评估下一个候选对象，并更新到目前为止所做的所有观察记录档案
检查是否满足给定的终止条件，如果不满足，则返回步骤 (1)

采集函数（acquisition function）依赖于代理模型的均值和标准差预测，
无需对真实黑箱函数进行评估，因此优化成本相对较低
好的采集函数会在两方面取得平衡：
- 利用观察到性能良好且代理模型不确定性较低的区域的知识
- 探索尚未评估过的点且因此代理模型不确定性较高的区域

构建模块：OptimizerMbo类
- BO算法循环结构（loop_function）
- 代理模型（Surrogate）
- 采集函数（AcqFunction）
- 采集函数优化器（AcqOptimizer）
模块由mlr3mbo设计并反映

初步设计

在拟合代理模型之前评估的初始点集称为初始设计（Initial Design）
可以用mlr3mbo 手动构建初始设计，
也可以用 loop_function 为构建并评估初始设计
- 用mlr3mbo 手动构建初始设计可以对初始设计进行更多控制
构建初始设计的一种简单方法是使用 paradox 中的四个设计生成器之一
- generate_design_random()：随机均匀生成点
- generate_design_grid()：在大小均匀的网格中生成点
- generate_design_lhs()：拉丁超立方抽样（Latin hypercube sampling, LHS）
  - 将每个输入变量划分为大小相等的区间，
    并确保每个区间恰好由一个采样点表示，从而得到均匀的边缘分布
  - 在LHS设计中，两点之间的最小距离通常会最大化，从而实现对空间的空间填充覆盖
- generate_design_sobol()：Sobol序列（Sobol sequence）
  - 与LHS的工作方式类似，但在维度数量较大时，它能比LHS提供更好的覆盖
通常建议在贝叶斯优化（BO）中使用LHS或Sobol设计，
但与BO的其他设计选择相比，初始设计的影响通常较小

生成的Design对象是围绕data.table的包装器

sample_domain <- ps(x1 = p_dbl(0, 1), x2 = p_dbl(0, 1))
generate_design_random(sample_domain, n = 3)
generate_design_random(sample_domain, n = 3)$data

<Design> with 3 rows:
          x1        x2
       <num>     <num>
1: 0.5406415 0.3784440
2: 0.9641830 0.3064937
3: 0.2573565 0.7557893

<table class='dataframe'> <caption>A data.table: 3 x 2</caption> <thead> <tr><th scope=col>x1</th><th scope=col>x2</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>0.8539652</td><td>0.1333672</td></tr> <tr><td>0.8623679</td><td>0.1129187</td></tr> <tr><td>0.1020241</td><td>0.8403042</td></tr> </tbody> </table>

初始设计也可以通过自定义data.table完成
在构建初始设计后，进行优化前，
需要在OptimInstance上进行评估

# 构建目标函数的优化实例
instance <- OptimInstanceSingleCrit$new(
 objective,
 terminator = trm('evals', n_evals = 20)
)
# 构建一个`data.table`类的设计矩阵
design <- data.table(x = c(0.1, 0.34, 0.65, 1))
# 输入设计的矩阵
instance$eval_batch(design)

# 查看输入的定义域数值对应产生的陪域数值
instance$archive$data

INFO  [16:59:32.257] [bbotk] Evaluating 4 configuration(s)
INFO  [16:59:32.287] [bbotk] Result of batch 1:
INFO  [16:59:32.288] [bbotk]     x          y
INFO  [16:59:32.288] [bbotk]  0.10  0.1970899
INFO  [16:59:32.288] [bbotk]  0.34 -0.6792294
INFO  [16:59:32.288] [bbotk]  0.65  0.4148279
INFO  [16:59:32.288] [bbotk]  1.00  1.9812147

<table class='dataframe'> <caption>A data.table: 4 x 5</caption> <thead> <tr><th scope=col>x</th><th scope=col>y</th><th scope=col>x_domain</th><th scope=col>timestamp</th><th scope=col>batch_nr</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><list></th><th scope=col><dttm></th><th scope=col><int></th></tr> </thead> <tbody> <tr><td>0.10</td><td> 0.1970899</td><td>0.1</td><td>2025-06-23 16:59:32</td><td>1</td></tr> <tr><td>0.34</td><td>-0.6792294</td><td>0.34</td><td>2025-06-23 16:59:32</td><td>1</td></tr> <tr><td>0.65</td><td> 0.4148279</td><td>0.65</td><td>2025-06-23 16:59:32</td><td>1</td></tr> <tr><td>1.00</td><td> 1.9812147</td><td>1</td><td>2025-06-23 16:59:32</td><td>1</td></tr> </tbody> </table>

代理模型

在mlr3mbo中，SurrogateLearner是一个R6类
- 继承自基础Surrogate类
- 旨在构建和管理代理模型，包括自动构建TaskRegr
  - TaskRegr在每次BO循环的迭代中被训练
代理模型包装了一个回归学习器，
该学习器基于观测数据对未知的黑盒函数进行建模
- 回归学习器可以用任何mlr3中的回归学习器
- 大多数采集函数既依赖于代理模型的均值预测，
  也依赖于标准差预测，而后者要求支持predict_type = 'se'
代理模型的回归学习器的典型选择
- lrn('regr.km')：高斯过程（Gaussian processes）
  对于低到中等维度的数值搜索空间
- lrn('regr.ranger')：随机森林
  对于高维度混合（和/或分层）搜索空间
下面以高斯过程作为代理模型的算法为例

lrn_gp <- lrn(
 # 选择高斯过程为学习器
 'regr.km', 
 # 使用具有Matérn 5/2核的高斯过程
 covtype = 'matern5_2', 
 # 使用BFGS作为优化器来寻找最优核参数
 optim.method = 'BFGS',
 # 设置`trace = FALSE`以防止在拟合过程中产生过多输出
 control = list(trace = FALSE)
)

构建SurrogateLearner对象：srlrn()
- 需要传递LearnerRegr对象与Instance$archive

# 需要`mlr3mbo`包
# library(mlr3mbo)

# 构建`SurrogateLearner`对象
surrogate <- srlrn(
 lrn_gp, 
 archive = instance$archive
)

# 通过`SurrogateLearner$update()`的更新来拟合高斯过程
surrogate$update() 
# 访问拟合后的模型
surrogate$learner$model

Call:
DiceKriging::km(design = data, response = truth, covtype = 'matern5_2', 
    optim.method = 'BFGS', control = pv$control)

Trend  coeff.:
               Estimate
 (Intercept)     0.7899

Covar. type  : matern5_2 
Covar. coeff.:
               Estimate
    theta(x)     0.3014

Variance estimate: 1.069737

采集函数

采集函数依赖于代理模型的预测，
并量化搜索空间中每个点在下次迭代中进行评估时的预期 效用（utility）
以下方的 期望改善（expected improvement） 为例
- 在给定代理模型的性能预测的情况下，
  与目前观察到的最佳函数值（当前最优值）相比，
  可以期望一个候选点提升多少
- 下方公式中：
  - $Y(x)$：给定输入点 $x$ 的代理模型预测值
    （一个随机变量，在使用高斯过程时服从正态分布）
  - $f_{min}$ ：目前观测到的最佳函数值（假设为最小化问题）
- 计算期望提升需要模型给出均值和标准差预测

$$ \alpha_{\mathrm{EI}}(\mathbf{x}) = \mathbb{E} \left[ \max \left( f_{\mathrm{min}} - Y(\mathbf{x}), 0 \right) \right] $$

在 mlr3mbo 中，采集函数为AcqFunction类
- 存储在 mlr_acqfunctions 字典中，可以通过 acqf() 来构建
- 在本示例中，使用期望改善（acqf('ei')）来选择下一个待评估的候选对象
- 如之前示例一样，
  必须更新（AcqFunction$update()）AcqFunction 对当前最优解的看法，
  以确保它仍然使用目前观察到的最佳值

acq_function <- acqf('ei', surrogate = surrogate)
acq_function$update()
acq_function$y_best

使用 Objective$eval_dt() 对作为 data.table 给出的域评估采集函数
- 使用高斯过程预测均值和标准误差
- 在0到1区间的均匀点网格上评估期望改善

# 在0到1间生成1001个数据点
xydt <- generate_design_grid(domain, resolution = 1001)$data
# 用函数f生成x对应的真实y值
xydt[, y := objective$eval_dt(xydt)$y]
# 使用高斯过程计算期望改善
xydt[, ei :=  acq_function$eval_dt(xydt[, 'x'])]
# 使用代理函数预测x对应的y的均值及标准误差
xydt[, c('mean', 'se') :=  surrogate$predict(xydt[, 'x'])]
xydt[1:3]

通过作图可以发现：
在高斯过程的平均预测（灰色点线）较低或不确定性较高的区域，期望提升较高

ggplot(xydt, mapping = aes(x = x, y = y)) +
 geom_point(
  size = 2, 
  data = instance$archive$data
 ) +
 # 目标函数（黑色）
 geom_line() +
 # 代理模型预测均值（灰色点线）
 geom_line(
  aes(y = mean), 
  colour = 'gray', 
  linetype = 2
 ) +
 # 代理模型标准误差范围（灰色点线的条带）
 geom_ribbon(
  aes(min = mean - se, max = mean + se),
  fill = 'gray',
  alpha = 0.3
 ) +
 # 期待提升曲线（灰色实线）
 geom_line(
  aes(y = ei * 40), 
  linewidth = 1, 
  colour = 'darkgray'
 ) +
 scale_y_continuous(
  'y',
     sec.axis = sec_axis(
      ~ . * 0.025, 
      name = 'EI',
      breaks = c(0, 0.025, 0.05)
  )
 ) +
 theme_minimal()

采集函数优化器

大多数常用的采集函数具有非凸性
（顺着梯度方向走到底只能保证是局部最优，不能保证是全局最优），
因此通常采用全局优化技术来优化采集函数
优化采集函数的广泛使用方法包括无导数全局优化方法，如：
- 分支定界算法，如DIRECT算法
- 多起点局部优化方法，如
  多次从不同起点运行L - BFGS - B算法或进行局部搜索
因此，采集函数的优化问题本身可以作为一个黑盒优化问题来处理，
但它比原始问题的成本要低得多
AcqOptimizer类
- 用于在有限的计算资源内，通过高效搜索潜在候选空间来优化采集函数
- 用 acqo() 构建
  - 该函数将 Optimizer、Terminator和采集函数作为输入
  - 优化器存储在 mlr_optimizers 字典中，并且可以通过便捷函数 opt() 构建

mlr_optimizers %>% as.data.table()

<table class='dataframe'> <caption>A data.table: 18 x 5</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>param_classes</th><th scope=col>properties</th><th scope=col>packages</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td>adbo </td><td>Asynchronous Decentralized Bayesian Optimization</td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit </td><td>mlr3mbo, rush </td></tr> <tr><td>async_design_points</td><td>Asynchronous Design Points </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct, ParamUty</td><td>dependencies, single-crit , multi-crit , async </td><td>bbotk, rush </td></tr> <tr><td>async_grid_search </td><td>Asynchronous Grid Search </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit , multi-crit , async </td><td>bbotk, rush </td></tr> <tr><td>async_mbo </td><td>Asynchronous Model Based Optimization </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit </td><td>mlr3mbo, rush </td></tr> <tr><td>async_random_search</td><td>Asynchronous Random Search </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit , multi-crit , async </td><td>bbotk, rush </td></tr> <tr><td>chain </td><td>Chain Multiple Optimizers Sequentially </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit , multi-crit </td><td>bbotk</td></tr> <tr><td>cmaes </td><td>Covariance Matrix Adaptation Evolution Strategy </td><td>ParamDbl</td><td>single-crit</td><td>bbotk , adagio</td></tr> <tr><td>design_points </td><td>Design Points </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct, ParamUty</td><td>dependencies, single-crit , multi-crit </td><td>bbotk</td></tr> <tr><td>focus_search </td><td>Focus Search </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit </td><td>bbotk</td></tr> <tr><td>gensa </td><td>Generalized Simulated Annealing </td><td>ParamDbl</td><td>single-crit</td><td>bbotk, GenSA</td></tr> <tr><td>grid_search </td><td>Grid Search </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit , multi-crit </td><td>bbotk</td></tr> <tr><td>hyperband </td><td>Hyperband </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit , multi-crit </td><td>bbotk , mlr3hyperband</td></tr> <tr><td>irace </td><td>Iterated Racing </td><td>ParamDbl, ParamInt, ParamFct, ParamLgl</td><td>dependencies, single-crit </td><td>bbotk, irace</td></tr> <tr><td>local_search </td><td>Local Search </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit </td><td>bbotk</td></tr> <tr><td>mbo </td><td>Model Based Optimization </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit , multi-crit </td><td>mlr3mbo</td></tr> <tr><td>nloptr </td><td>Non-linear Optimization </td><td>ParamDbl</td><td>single-crit</td><td>bbotk , nloptr</td></tr> <tr><td>random_search </td><td>Random Search </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit , multi-crit </td><td>bbotk</td></tr> <tr><td>successive_halving </td><td>Successive Halving </td><td>ParamLgl, ParamInt, ParamDbl, ParamFct</td><td>dependencies, single-crit , multi-crit </td><td>bbotk , mlr3hyperband</td></tr> </tbody> </table>

acq_optimizer <- acqo(
 # 调优器是非线性调优
 # 算法是'NLOPT_GN_ORIG_DIRECT'
 optimizer = opt('nloptr', algorithm = 'NLOPT_GN_ORIG_DIRECT'),
 # 使用停滞超体积终止器，迭代100次，当提升小于1e-5时终止
 terminator = trm('stagnation', iters = 100, threshold = 1e-5),
 # 传递要调优的
 acq_function = acq_function
)

candidate <- acq_optimizer$optimize()
candidate

<table class='dataframe'> <caption>A data.table: 1 x 4</caption> <thead> <tr><th scope=col>x</th><th scope=col>acq_ei</th><th scope=col>x_domain</th><th scope=col>.already_evaluated</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><list></th><th scope=col><lgl></th></tr> </thead> <tbody> <tr><td>0.417289</td><td>0.06074387</td><td>0.417289</td><td>FALSE</td></tr> </tbody> </table>

使用和构建循环函数

使用loop_function可以在全局层面决定贝叶斯优化算法的行为
- 通过定义每次迭代时执行的子例程（subroutine），
  以生成新的待评估候选对象
loop_function储存在mlr_loop_functions字典中

as.data.table(mlr_loop_functions)[, .(key, label, instance)]

<table class='dataframe'> <caption>A data.table: 5 x 3</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>instance</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><td>bayesopt_ego </td><td>Efficient Global Optimization</td><td>single-crit</td></tr> <tr><td>bayesopt_emo </td><td>Multi-Objective EGO </td><td>multi-crit </td></tr> <tr><td>bayesopt_mpcl </td><td>Multipoint Constant Liar </td><td>single-crit</td></tr> <tr><td>bayesopt_parego</td><td>ParEGO </td><td>multi-crit </td></tr> <tr><td>bayesopt_smsego</td><td>SMS-EGO </td><td>multi-crit </td></tr> </tbody> </table>

可以使用上述的循环函数，也可以自行编写
下面使用 高效全局优化（Efficient Global Optimization, EGO） 进行循环全局优化
- 在设定好了贝叶斯优化组件后，循环执行：
  - 更新代理模型
  - 更新采集函数
  - 优化采集函数以生成新的候选解
  - 评估候选解并添加到存档archive中
- 如果在循环过程中出现错误，则会使用回退机制，
  即随机均匀地提出下一个候选解，
  确保即使存在潜在问题，该过程仍能继续进行
这里是手动构建一个简化版的EGO算法代码，
也可以用来回顾上方的流程

my_simple_ego <- function(
 # 设定了贝叶斯优化部件
 instance, # 实例
 surrogate, # 代理模型
 acq_function, # 采集函数
 acq_optimizer, # 采集函数调优器
 # 这里的初始设计是`generate_design_sobol()`的参数`n`
 init_design_size 
  ) {

 # 下面这段可以看清楚这几个部件之间的传递关系
 # 实例存档传递到代理模型存档
 surrogate$archive <- instance$archive 
 # 代理模型传递到采集函数
 acq_function$surrogate <- surrogate
 # 采集函数传递到采集函数调整器
 acq_optimizer$acq_function <- acq_function 
 # 调取搜索空间
 search_space <- instance$search_space

  # 初始设计
  design <- generate_design_sobol(
   search_space, 
   n = init_design_size
  )$data
  # 生成y
  instance$eval_batch(design)

  # 基于模型的优化（MBO）的循环
  repeat {
 candidate <- tryCatch({
  # 更新代理模型
  acq_function$surrogate$update()
  # 更新采集函数
  acq_function$update()
  # 采集函数调优器调优
  acq_optimizer$optimize()
 }, 
 # 当发生错误时，使用备选方法：随机搜索
 mbo_error = function(mbo_error_condition) {
      generate_design_random(search_space, n = 1L)$data
 }) # 1L 表示整数型的 1

    # 评估候选点并保存到存档中
    tryCatch({
      instance$eval_batch(candidate)
    }, 
    terminated_error = function(cond) {
      # 这里写终止条件（如达到最大评估次数）
      # ......
    })
    # 检查终止条件
    if (instance$is_terminated) break
  }

  return(instance)
}

使用OptimizerMbo实现贝叶斯优化自动化

上面是手动构建贝叶斯优化的流程
可以将上述构建模块封装到opt()构建的OptimizerMbo对象中执行自动化贝叶斯优化

# 构建循环函数
bayesopt_ego <- mlr_loop_functions$get('bayesopt_ego')
# 构建代理模型
surrogate <- srlrn(
 lrn(
  'regr.km', 
  covtype = 'matern5_2',
  optim.method = 'BFGS', 
  control = list(trace = FALSE)
 )
)
# 构建采集函数
acq_function <- acqf('ei')
# 构建采集函数模拟器优化器
acq_optimizer <- acqo(
 # 优化器算法
 opt(
  'nloptr', 
  algorithm = 'NLOPT_GN_ORIG_DIRECT'
 ),
 # 终止器算法
 terminator = trm(
  'stagnation', 
  iters = 100, 
  threshold = 1e-5
 )
)
# 用`opt()`进行自动化BO封装
optimizer <- opt(
 'mbo',
 loop_function = bayesopt_ego,
 surrogate = surrogate,
 acq_function = acq_function,
 acq_optimizer = acq_optimizer
)

构建优化实例

instance <- OptimInstanceBatchSingleCrit$new(
 objective,
 terminator = trm('evals', n_evals = 20)
)

design <- data.table(x = c(0.1, 0.34, 0.65, 1))
instance$eval_batch(design)
optimizer$optimize(instance)

<table class='dataframe'> <caption>A data.table: 1 x 3</caption> <thead> <tr><th scope=col>x</th><th scope=col>x_domain</th><th scope=col>y</th></tr> <tr><th scope=col><dbl></th><th scope=col><list></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>0.7921811</td><td>0.7921811</td><td>-1.577224</td></tr> </tbody> </table>

如果用Instance$archive做图的话可以得到下面这个：
- 贝叶斯优化算法的采样轨迹初始设计的点用黑色三角形表示；
  随着算法的推进，采样点用圆点表示，颜色从黑色逐渐变为白色
- 在第17轮迭代的时候，采样点就来到了全局最优值的地方
然而，即使在优化的后期阶段，该算法仍在探索新的区域
- 这表明期望提升采集函数确实如我们所要求的那样，
  在探索和利用之间取得了平衡

-　顺便看看Instance$archive 的结果

instance$archive %>% as.data.table()

<table class='dataframe'> <caption>A data.table: 20 x 7</caption> <thead> <tr><th scope=col>x</th><th scope=col>y</th><th scope=col>timestamp</th><th scope=col>batch_nr</th><th scope=col>acq_ei</th><th scope=col>.already_evaluated</th><th scope=col>x_domain_x</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dttm></th><th scope=col><int></th><th scope=col><dbl></th><th scope=col><lgl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>1.000000e-01</td><td> 1.970899e-01</td><td>2025-06-24 19:19:37</td><td> 1</td><td> NA</td><td> NA</td><td>1.000000e-01</td></tr> <tr><td>3.400000e-01</td><td>-6.792294e-01</td><td>2025-06-24 19:19:37</td><td> 1</td><td> NA</td><td> NA</td><td>3.400000e-01</td></tr> <tr><td>6.500000e-01</td><td> 4.148279e-01</td><td>2025-06-24 19:19:37</td><td> 1</td><td> NA</td><td> NA</td><td>6.500000e-01</td></tr> <tr><td>1.000000e+00</td><td> 1.981215e+00</td><td>2025-06-24 19:19:37</td><td> 1</td><td> NA</td><td> NA</td><td>1.000000e+00</td></tr> <tr><td>4.172890e-01</td><td>-3.563394e-01</td><td>2025-06-24 19:19:38</td><td> 2</td><td> 6.074387e-02</td><td>FALSE</td><td>4.172890e-01</td></tr> <tr><td>2.843317e-01</td><td>-4.230907e-01</td><td>2025-06-24 19:19:39</td><td> 3</td><td> 6.085101e-02</td><td>FALSE</td><td>2.843317e-01</td></tr> <tr><td>3.549510e-01</td><td>-6.866001e-01</td><td>2025-06-24 19:19:40</td><td> 4</td><td> 9.136180e-03</td><td>FALSE</td><td>3.549510e-01</td></tr> <tr><td>2.540263e-05</td><td> 1.806822e-08</td><td>2025-06-24 19:19:41</td><td> 5</td><td> 1.969525e-03</td><td>FALSE</td><td>2.540263e-05</td></tr> <tr><td>3.503277e-01</td><td>-6.877539e-01</td><td>2025-06-24 19:19:42</td><td> 6</td><td> 1.806029e-03</td><td>FALSE</td><td>3.503277e-01</td></tr> <tr><td>7.881166e-01</td><td>-1.575092e+00</td><td>2025-06-24 19:19:42</td><td> 7</td><td> 3.460028e-05</td><td>FALSE</td><td>7.881166e-01</td></tr> <tr><td>8.152467e-01</td><td>-1.490192e+00</td><td>2025-06-24 19:19:43</td><td> 8</td><td> 4.368291e-02</td><td>FALSE</td><td>8.152467e-01</td></tr> <tr><td>7.942641e-01</td><td>-1.576307e+00</td><td>2025-06-24 19:19:44</td><td> 9</td><td> 4.720211e-03</td><td>FALSE</td><td>7.942641e-01</td></tr> <tr><td>7.624092e-01</td><td>-1.446524e+00</td><td>2025-06-24 19:19:45</td><td>10</td><td> 6.985420e-09</td><td>FALSE</td><td>7.624092e-01</td></tr> <tr><td>7.921811e-01</td><td>-1.577224e+00</td><td>2025-06-24 19:19:47</td><td>11</td><td> 9.251675e-04</td><td>FALSE</td><td>7.921811e-01</td></tr> <tr><td>8.827160e-01</td><td>-3.651653e-01</td><td>2025-06-24 19:19:49</td><td>12</td><td> 7.987685e-20</td><td>FALSE</td><td>8.827160e-01</td></tr> <tr><td>5.246914e-01</td><td> 9.167112e-01</td><td>2025-06-24 19:19:50</td><td>13</td><td> 5.535251e-21</td><td>FALSE</td><td>5.246914e-01</td></tr> <tr><td>1.872428e-01</td><td> 1.861373e-01</td><td>2025-06-24 19:19:51</td><td>14</td><td> 1.408867e-24</td><td>FALSE</td><td>1.872428e-01</td></tr> <tr><td>7.222222e-01</td><td>-9.153515e-01</td><td>2025-06-24 19:19:53</td><td>15</td><td> 7.389664e-67</td><td>FALSE</td><td>7.222222e-01</td></tr> <tr><td>4.320988e-02</td><td> 4.914789e-02</td><td>2025-06-24 19:19:54</td><td>16</td><td>8.721303e-111</td><td>FALSE</td><td>4.320988e-02</td></tr> <tr><td>7.798354e-01</td><td>-1.554943e+00</td><td>2025-06-24 19:19:55</td><td>17</td><td>1.960345e-163</td><td>FALSE</td><td>7.798354e-01</td></tr> </tbody> </table>

如果将贝叶斯优化算法运行十次（采用随机初始设计和不同的随机种子），
并与随机搜索进行比较
- 可以看到，贝叶斯优化的性能更好，平均在大约15次函数评估后就能达到全局最优
- 正如预期的那样，初始设计规模的性能与随机搜索的性能相近

用于超参数优化的贝叶斯优化

使用mlr3mbo的TunerMbo类可以进行超参数优化
- TunerMbo类是OptimizerMbo的包装器
下面例子中，在tsk('sonar')上使用径向核，通过3折CV来调整
lrn('classif.svm') 的 cost 和 gamma 参数

# 构建调优器
tuner <- tnr(
 # 选择基于模型的调优
 'mbo',
 # 选择贝叶斯优化的EGO算法
 loop_function = bayesopt_ego,
 # 传递代理模型
 surrogate = surrogate,
 # 传递采集函数
 acq_function = acq_function,
 # 传递采集函数调优器
 acq_optimizer = acq_optimizer
)

# 构建学习器
lrn_svm <- lrn(
 # 选择支持向量机
 'classif.svm', 
 # 选择radial内核
 kernel = 'radial',
 # 选择分类问题
 type = 'C-classification',
 # 选择`cost`和`gamma`的调优范围
 cost  = to_tune(1e-5, 1e5, logscale = TRUE),
 gamma = to_tune(1e-5, 1e5, logscale = TRUE)
)

# 进行实例调优
instance <- tune(
 tuner, 
 tsk('sonar'), 
 lrn_svm, 
 # 使用3折CV进行重采样
 rsmp('cv', folds = 3),
 # 使用交叉熵评估器
 msr('classif.ce'), 
 # 迭代次数25次
 25
)

instance$result

<table class='dataframe'> <caption>A data.table: 1 x 5</caption> <thead> <tr><th scope=col>cost</th><th scope=col>gamma</th><th scope=col>learner_param_vals</th><th scope=col>x_domain</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><list></th><th scope=col><list></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>8.287107</td><td>-3.762188</td><td>radial , C-classification , 3972.32580037573 , 0.0232328628271241</td><td>3.972326e+03, 2.323286e-02</td><td>0.110628</td></tr> </tbody> </table>

接下来是多评估标准的例子
- 评估的标准是真阳性率（TPR），假阳性率（FPR）
  - 前者越大越好，后者越小越好

tuner <- tnr(
 'mbo',
 loop_function = bayesopt_parego,
 surrogate = surrogate,
 acq_function = acq_function,
 acq_optimizer = acq_optimizer
)

lrn_rpart <- lrn(
 'classif.rpart',
 cp = to_tune(1e-04, 1e-1),
 minsplit = to_tune(2, 64),
 maxdepth = to_tune(1, 30)
)

instance <- tune(
 tuner, 
 tsk('sonar'), 
 lrn_svm, 
 rsmp('cv', folds = 3),
 # 这里就是2个评估器：
 # 真阳性率（TPR），假阳性率（FPR）
 msrs(c('classif.tpr', 'classif.fpr')), 
 25
)

instance$result

<table class='dataframe'> <caption>A data.table: 4 x 6</caption> <thead> <tr><th scope=col>cost</th><th scope=col>gamma</th><th scope=col>learner_param_vals</th><th scope=col>x_domain</th><th scope=col>classif.tpr</th><th scope=col>classif.fpr</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><list></th><th scope=col><list></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>-2.078838</td><td>-4.156062</td><td>radial , C-classification , 0.125075520793627 , 0.0156691447439775</td><td>0.12507552, 0.01566914</td><td>1.0000000</td><td>0.7383860</td></tr> <tr><td> 3.126967</td><td>-4.221932</td><td>radial , C-classification , 22.8047172214673 , 0.0146702678401885</td><td>22.80471722, 0.01467027</td><td>0.9081787</td><td>0.1999920</td></tr> <tr><td> 3.411237</td><td>-4.264046</td><td>radial , C-classification , 30.302710828664 , 0.0140652724210524</td><td>30.30271083, 0.01406527</td><td>0.9081787</td><td>0.1999920</td></tr> <tr><td> 6.395485</td><td>-2.990097</td><td>radial , C-classification , 599.133704193403 , 0.0502825699974251</td><td>599.13370419, 0.05028257</td><td>0.9264098</td><td>0.2588602</td></tr> </tbody> </table>

含噪声贝叶斯优化

现实生活中模型是受到噪声影响的 -> 误差
- 在bbotk中，可以通过将'noisy'标签传递给properties参数，
  将Objective对象标记为有噪声的
  - 这使我们能够使用可以对这类目标进行不同处理的方法

# 定义一个受到误差干扰的目标函数
sinus_1D_noisy <- function(xs) {
  y <- 2 * xs$x * sin(14 * xs$x) + 
   # 这里以正态随机分布随机生成1个均值为0标准偏差为0.1的误差项为例
   rnorm(1, mean = 0, sd = 0.1)
  return(y)
}
# 定义域
domain <- ps(x = p_dbl(lower = 0, upper = 1))
# 陪域
codomain <- ps(y = p_dbl(tags = 'minimize'))
# 
objective_noisy <- ObjectiveRFun$new(
 sinus_1D_noisy,
 domain = domain, 
 codomain = codomain, 
 # 对目标函数标记有噪声
 properties = 'noisy'
)

对于带有噪声的目标函数，处理方法有：
- 使用代理模型来考虑噪声
- 使用一种考虑噪声的采集函数
- 优化后的最终最佳点（即实例的 Instance$result 字段）的选择方式
  可以反映噪声情况
如果使用代理模型来考虑噪声，
可以不用插值高斯过程（interpolating Gaussian process），
而是使用高斯过程回归（Gaussian process regression）
- 这将导致高斯过程无法完美地对训练数据进行插值，
  并且与训练数据相关的标准差预测将不为零
  - 这反映了由于测量误差导致的观测函数值的不确定性

srlrn(
 lrn(
  'regr.km', 
  # 设置`nugget.estim = TRUE`使用高斯过程回归
  nugget.estim = TRUE
 )
)

如果使用一种考虑噪声的采集函数，
可以使用增强期望提升（Augmented expected improvement）
- 本质上是对期望提升进行重新缩放，同时考虑了测量误差

acq_function <- acqf('aei')

最后，mlr3mbo 允许通过结果分配器（assigner）
明确指定优化后的最终结果如何分配给优化实例（即 Instance$result 中保存的内容）
- 可以在构建 OptimizerMbo 或 TunerMbo 时指定结果分配器
- ResultAssignerSurrogate 使用代理模型预测所有评估点的均值，
  然后选择均值预测最佳的点作为最终优化结果
- 默认方法 ResultAssignerArchive 仅根据 archive 中记录的评估结果选择最佳点
- 结果分配器存储在 mlr_result_assigners 字典中，
  可以使用 ras() 构建

opt(
 'mbo',
 loop_function = bayesopt_ego,
 surrogate = surrogate,
 acq_function = acq_function,
 acq_optimizer = acq_optimizer,
 result_assigner = ras('surrogate')
)

其实结果分配器就两种

mlr_result_assigners %>% as.data.table()

<table class='dataframe'> <caption>A data.table: 2 x 3</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>man</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><td>archive </td><td>Archive </td><td>mlr3mbo::mlr_result_assigners_archive </td></tr> <tr><td>surrogate</td><td>Mean Surrogate Prediction</td><td>mlr3mbo::mlr_result_assigners_surrogate</td></tr> </tbody> </table>

贝叶斯优化中的实际考量

mlr3mbo包在代理模型、采集函数、采集函数优化器甚至循环函数的选择上使用合理的默认值
- 例如在纯数值搜索空间的情况下，
  mlr3mbo 默认将使用高斯过程作为代理模型，
  并使用随机森林作为回退学习器，
  此外还封装了学习器
- 在不指定任何与默认值不同的情况下执行贝叶斯优化，并且仍然期望获得不错的优化性能
- mbo_defaults 的帮助页面给出了这些默认值

错误处理（Error Handling）

在贝叶斯优化的背景下，构建模块有很大的潜在失败空间，这可能会破坏整个过程
- 例如，如果训练数据中的两个点彼此过于接近，拟合高斯过程代理模型可能会失败
mlr3mbo 有几个内置的安全机制来捕获错误
- Surrogate 包含 catch_errors 配置控制参数，
  如果将其设置为 TRUE，则会捕获在代理模型训练或更新期间发生的所有错误
- AcqOptimizer 也有 catch_errors 配置控制参数，
  可用于捕获在采集函数优化期间发生的所有错误，
  无论是由于代理模型预测失败还是采集函数优化器出错
- 如果在这些步骤中的任何一步捕获到错误，
  任何 loop_function 的标准行为是触发回退学习器，
  即随机均匀地提出下一个候选解
- 注意：为 AcqOptimizer 设置 catch_errors = TRUE 时，
  通常无需也为 Surrogate 显式设置 catch_errors = TRUE
  - 不过这在调试时可能会有用
- 在最坏的情况下，如果所有迭代都出错，贝叶斯优化算法将直接进行随机搜索
- 理想情况下，还应使用回退学习器，在随机提出下一个候选解之前将采用该学习器
- 采集函数的值也始终记录在优化实例的存档中，
  因此检查该值是个好主意，以确保算法按预期运行

代理模型

在实践中，用户可能更喜欢一种更稳健的贝叶斯优化变体，
而不是一种可能性能更好但不稳定的变体
即使catch_errors参数已打开且从未触发，也不能保证BO算法按预期运行
- 例如，高斯过程对核函数及其参数的选择很敏感，
  这些参数通常通过最大似然估计来估算，
  次优的参数值可能会导致具有恒定均值和标准差预测的白噪声模型
- 在这种情况下，代理模型将无法提供有用的均值和标准差预测，
  从而导致BO算法的整体性能不佳
关于代理模型选择的另一个实际考虑因素可能是开销
- 拟合一个普通高斯过程的计算量与数据点的数量呈三次方关系，
  因此BO算法的开销会随着迭代次数的增加而增长
普通高斯过程本身无法处理分类输入变量或搜索空间中的依赖关系
（在超参数优化中，我们经常处理混合层次空间）
- 相比之下，随机森林（在SMAC中广泛用作代理模型）训练成本低，
  在某种意义上相当稳健
  - 因为它不像高斯过程那样对其超参数敏感
  - 并且可以轻松处理混合层次空间
- 不利的一面是，随机森林并非真正的贝叶斯模型（即不存在后验预测分布），
  并且在不确定性估计和外推方面表现不佳

热启动（Warmstarting）

热启动是优化中的一种技术
- 它利用先前的优化运行来提高新的相关优化运行的收敛速度和最终解决方案
在贝叶斯优化中，热启动可以通过在初始设计中
提供一组可能表现良好的配置来实现
- 这种方法特别有利，因为它允许代理模型在相关区域中利用优化空间的先验知识开始
在mlr3mbo中，通过指定自定义初始设计，热启动很简单
此外，mlr3mbo的一个便捷功能是，即使在优化运行终止后，
也能够以在线方式继续优化
- OptimizerMbo和TunerMbo都支持此功能，
  即使先前的优化被中断或终止，也能在给定实例上恢复优化

终止

常见的终止准则包括：
- 在固定次数的评估后停止
- 一旦达到给定的时间预算
- 当性能达到一定水平时
- 当性能提升停滞时
在贝叶斯优化的背景下，
如果最佳采集函数值降至某个阈值以下，停止优化也是合理的
- 例如，如果下一个候选解的预期改进可以忽略不计，
  终止优化可能是一种合理的方法
然而目前基于采集函数的终止器尚未实现

并行化

大多数贝叶斯优化算法的标准行为是
按顺序提出下一个应评估的单个候选方案
如果将贝叶斯优化用于超参数优化，那么最有效的方法是对嵌套重采样进行并行化
如果循环函数支持批量提出候选方案（例如bayesopt_parego()），
那么可以设置循环函数的 q 参数，
以便在每次迭代中提出 q 个候选方案
- 如果 Objective 实现得当，这些候选方案可以并行评估

【mlr3】3.特征选择

Sun, 20 Jul 2025 00:00:00 GMT

Cover Pic by @humugo

Applied Machine Learning Using mlr3 in R

特征选择

特征选择的目的
- 提高预测性能，因为我们减少了对无关特征的过拟合
- 不依赖噪声特征的稳健模型
- 更简单且易于解释的模型
- 更快的模型拟合，例如用于模型更新
- 无需收集可能成本高昂的特征

过滤器（Filter）

设置过滤器可以在训练模型前简单筛除一些无关特征变量，例如：
- 计算每个特征与数值型目标变量相关系数$\rho$，
  并选择$\rho > 2$的特征变量
一些更先进的方法，例如基于特征重要性的多变量过滤器通常表现更好
单变量过滤器的一个优点是，它们通常比更复杂的过滤或包装方法计算成本更低
过滤算法通过为每个特征分配数值分数来选择特征
- 例如，特征与目标变量之间的相关性，
  使用这些分数对特征进行排序，
  并根据排序选择特征子集，
  在后续建模步骤中，得分较低的特征将被忽略
所有过滤器（Filter类）均通过包 mlr3filters 实现
可以通过mlr_filters字典查询所有过滤器，
通过flt()函数来调取对应过滤器

mlr_filters %>% as.data.table()

<table class='dataframe'> <caption>A data.table: 23 x 7</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>task_types</th><th scope=col>task_properties</th><th scope=col>params</th><th scope=col>feature_types</th><th scope=col>packages</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td>anova </td><td>ANOVA F-Test </td><td>classif</td><td></td><td></td><td>integer, numeric</td><td>stats</td></tr> <tr><td>auc </td><td>Area Under the ROC Curve Score </td><td>classif</td><td>twoclass</td><td></td><td>integer, numeric</td><td>mlr3measures</td></tr> <tr><td>boruta </td><td>Burota </td><td>regr , classif</td><td></td><td>pValue , mcAdj , maxRuns , doTrace , holdHistory, getImp , keep , num.threads</td><td>integer, numeric</td><td>Boruta</td></tr> <tr><td>carscore </td><td>Correlation-Adjusted coRrelation Score </td><td>regr</td><td></td><td>lambda , diagonal, verbose </td><td>logical, integer, numeric</td><td>care</td></tr> <tr><td>carsurvscore </td><td>Correlation-Adjusted coRrelation Survival Score </td><td>surv</td><td></td><td>maxIPCweight, denom </td><td>integer, numeric</td><td>carSurv , mlr3proba</td></tr> <tr><td>cmim </td><td>Minimal Conditional Mutual Information Maximization </td><td>classif, regr </td><td></td><td>threads</td><td>integer, numeric, factor , ordered</td><td>praznik</td></tr> <tr><td>correlation </td><td>Correlation </td><td>regr</td><td></td><td>use , method</td><td>integer, numeric</td><td>stats</td></tr> <tr><td>disr </td><td>Double Input Symmetrical Relevance </td><td>classif, regr </td><td></td><td>threads</td><td>integer, numeric, factor , ordered</td><td>praznik</td></tr> <tr><td>find_correlation </td><td>Correlation-based Score </td><td>NA</td><td></td><td>use , method</td><td>integer, numeric</td><td>stats</td></tr> <tr><td>importance </td><td>Importance Score </td><td>classif</td><td></td><td>method</td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td>mlr3</td></tr> <tr><td>information_gain </td><td>Information Gain </td><td>classif, regr </td><td></td><td>type , equal , discIntegers, threads </td><td>integer, numeric, factor , ordered</td><td>FSelectorRcpp</td></tr> <tr><td>jmi </td><td>Joint Mutual Information </td><td>classif, regr </td><td></td><td>threads</td><td>integer, numeric, factor , ordered</td><td>praznik</td></tr> <tr><td>jmim </td><td>Minimal Joint Mutual Information Maximization </td><td>classif, regr </td><td></td><td>threads</td><td>integer, numeric, factor , ordered</td><td>praznik</td></tr> <tr><td>kruskal_test </td><td>Kruskal-Wallis Test </td><td>classif</td><td></td><td>na.action</td><td>integer, numeric</td><td>stats</td></tr> <tr><td>mim </td><td>Mutual Information Maximization </td><td>classif, regr </td><td></td><td>threads</td><td>integer, numeric, factor , ordered</td><td>praznik</td></tr> <tr><td>mrmr </td><td>Minimum Redundancy Maximal Relevancy </td><td>classif, regr </td><td></td><td>threads</td><td>integer, numeric, factor , ordered</td><td>praznik</td></tr> <tr><td>njmim </td><td>Minimal Normalised Joint Mutual Information Maximization</td><td>classif, regr </td><td></td><td>threads</td><td>integer, numeric, factor , ordered</td><td>praznik</td></tr> <tr><td>performance </td><td>Predictive Performance </td><td>classif</td><td></td><td>method</td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td>mlr3 , mlr3measures</td></tr> <tr><td>permutation </td><td>Permutation Score </td><td>classif</td><td></td><td>standardize, nmc </td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td>mlr3 , mlr3measures</td></tr> <tr><td>relief </td><td>RELIEF </td><td>classif, regr </td><td></td><td>neighboursCount, sampleSize </td><td>integer, numeric, factor , ordered</td><td>FSelectorRcpp</td></tr> <tr><td>selected_features</td><td>Embedded Feature Selection </td><td>classif</td><td></td><td>method</td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td>mlr3</td></tr> <tr><td>univariate_cox </td><td>Univariate Cox Survival Score </td><td>surv</td><td></td><td></td><td>integer, numeric, logical</td><td>survival</td></tr> <tr><td>variance </td><td>Variance </td><td>NA</td><td></td><td>na.rm</td><td>integer, numeric</td><td>stats</td></tr> </tbody> </table>

几种常用的过滤器：
- flt('correlation')：相关性，
  计算数值特征与数值目标之间的皮尔逊（Pearson）或
  斯皮尔曼（Spearman）相关性
- flt('information_gain')：信息增益，
  即特征与目标之间的互信息，
  或者由于某个特征导致目标不确定性的降低
- flt('jmim')：最小联合互信息最大化
- flt('permutation')：排列分数，
  它使用给定的学习器为每个特征计算排列特征重要性
- flt('auc')：分别为每个特征计算的ROC曲线下面积
大多数过滤方法都有一些局限性
例如，相关性过滤器只能用于具有数值特征的回归任务
- 建议不要依赖单一的过滤方法，
  如果可用的计算资源允许，尝试多种方法；
  如果只能使用一种过滤方法，
  建议使用基于随机森林排列重要性的特征重要性过滤器

计算过滤器值

每一个Filter类的对象都有一个Filter$calculate()的方法
- 本例用的是信息增益过滤器（其实就是stepwise法）

# 加载R包
# library(mlr3filters)

# 创建`Task`
tsk_pen <- tsk('penguins')
# 创建信息增益过滤器
flt_gain <- flt('information_gain')

# 将`Filter`作用于`Task`
flt_gain$calculate(tsk_pen)

# 获取结果
as.data.table(flt_gain)

<table class='dataframe'> <caption>A data.table: 7 x 2</caption> <thead> <tr><th scope=col>feature</th><th scope=col>score</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>flipper_length</td><td>0.581167901</td></tr> <tr><td>bill_length </td><td>0.544896584</td></tr> <tr><td>bill_depth </td><td>0.538718879</td></tr> <tr><td>island </td><td>0.520157171</td></tr> <tr><td>body_mass </td><td>0.442879511</td></tr> <tr><td>sex </td><td>0.007244168</td></tr> <tr><td>year </td><td>0.000000000</td></tr> </tbody> </table>

可以看到
- 结果保存在Filter中
- sex和year是最无关的变量
对于有参数的过滤器，也可以用Filter$param_set调取

# 创建相关性过滤器，方法选择'spearman相关性检验'
flt_cor <- flt('correlation', method = 'spearman')
flt_cor$param_set

<ParamSet(2)>
       id    class lower upper nlevels    default    value
   <char>   <char> <num> <num>   <num>     <list>   <list>
1:    use ParamFct    NA    NA       5 everything   [NULL]
2: method ParamFct    NA    NA       3    pearson spearman

特征重要性过滤器

要使用特征重要性过滤器，我们可以使用具有 Filter$importance() 方法的学习器
- 简单看看哪些Learner支持特征重要性计算

as.data.table(mlr_learners)[
 sapply(properties, function(x) 'importance' %in% x)
]

<table class='dataframe'> <caption>A data.table: 34 x 7</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>task_type</th><th scope=col>feature_types</th><th scope=col>packages</th><th scope=col>properties</th><th scope=col>predict_types</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td>classif.aorsf </td><td>Oblique Random Forest Classifier </td><td>classif</td><td>integer, numeric, factor , ordered</td><td>mlr3 , mlr3extralearners, aorsf </td><td>importance, multiclass, oob_error , twoclass , weights </td><td>response, prob </td></tr> <tr><td>classif.catboost </td><td>Gradient Boosting </td><td>classif</td><td>numeric, factor , ordered</td><td>mlr3 , mlr3extralearners, catboost </td><td>importance , internal_tuning, missings , multiclass , twoclass , validation , weights </td><td>response, prob </td></tr> <tr><td>classif.featureless </td><td>Featureless Classification Learner</td><td>classif</td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td>mlr3</td><td>featureless , importance , missings , multiclass , selected_features, twoclass , weights </td><td>response, prob </td></tr> <tr><td>classif.gbm </td><td>Gradient Boosting </td><td>classif</td><td>integer, numeric, factor , ordered</td><td>mlr3 , mlr3extralearners, gbm </td><td>importance, missings , twoclass , weights </td><td>response, prob </td></tr> <tr><td>classif.imbalanced_rfsrc</td><td>Imbalanced Random Forest </td><td>classif</td><td>logical, integer, numeric, factor , ordered</td><td>mlr3 , randomForestSRC</td><td>importance, missings , oob_error , twoclass , weights </td><td>response, prob </td></tr> <tr><td>classif.lightgbm </td><td>Gradient Boosting </td><td>classif</td><td>logical, integer, numeric, factor </td><td>mlr3 , mlr3extralearners, lightgbm </td><td>hotstart_forward, importance , internal_tuning , missings , multiclass , twoclass , validation , weights </td><td>response, prob </td></tr> <tr><td>classif.randomForest </td><td>Random Forest </td><td>classif</td><td>logical, integer, numeric, factor , ordered</td><td>mlr3 , mlr3extralearners, randomForest </td><td>importance, multiclass, oob_error , twoclass , weights </td><td>response, prob </td></tr> <tr><td>classif.ranger </td><td>Random Forest </td><td>classif</td><td>logical , integer , numeric , character, factor , ordered </td><td>mlr3 , mlr3learners, ranger </td><td>hotstart_backward, importance , missings , multiclass , oob_error , selected_features, twoclass , weights </td><td>response, prob </td></tr> <tr><td>classif.rfsrc </td><td>Random Forest </td><td>classif</td><td>logical, integer, numeric, factor </td><td>mlr3 , mlr3extralearners, randomForestSRC </td><td>importance, missings , multiclass, oob_error , twoclass , weights </td><td>response, prob </td></tr> <tr><td>classif.rpart </td><td>Classification Tree </td><td>classif</td><td>logical, integer, numeric, factor , ordered</td><td>mlr3 , rpart</td><td>importance , missings , multiclass , selected_features, twoclass , weights </td><td>response, prob </td></tr> <tr><td>classif.torch_model </td><td>Torch Model </td><td>classif</td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td>mlr3 , mlr3torch, torch </td><td>featureless , hotstart_backward, hotstart_forward , importance , internal_tuning , marshal , missings , multiclass , offset , oob_error , selected_features, twoclass , validation , weights </td><td>response, prob </td></tr> <tr><td>classif.xgboost </td><td>Extreme Gradient Boosting </td><td>classif</td><td>logical, integer, numeric</td><td>mlr3 , mlr3learners, xgboost </td><td>hotstart_forward, importance , internal_tuning , missings , multiclass , offset , twoclass , validation , weights </td><td>response, prob </td></tr> <tr><td>regr.aorsf </td><td>Oblique Random Forest Regressor </td><td>regr </td><td>logical, integer, numeric, factor , ordered</td><td>mlr3 , mlr3extralearners, aorsf </td><td>importance, oob_error , weights </td><td>response</td></tr> <tr><td>regr.catboost </td><td>Gradient Boosting </td><td>regr </td><td>numeric, factor , ordered</td><td>mlr3 , mlr3extralearners, catboost </td><td>importance , internal_tuning, missings , validation , weights </td><td>response</td></tr> <tr><td>regr.featureless </td><td>Featureless Regression Learner </td><td>regr </td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td>mlr3 , stats</td><td>featureless , importance , missings , selected_features, weights </td><td>response , se , quantiles</td></tr> <tr><td>regr.gbm </td><td>Gradient Boosting </td><td>regr </td><td>integer, numeric, factor , ordered</td><td>mlr3 , mlr3extralearners, gbm </td><td>importance, missings , weights </td><td>response , quantiles</td></tr> <tr><td>regr.lightgbm </td><td>Gradient Boosting </td><td>regr </td><td>logical, integer, numeric, factor </td><td>mlr3 , mlr3extralearners, lightgbm </td><td>hotstart_forward, importance , internal_tuning , missings , validation , weights </td><td>response</td></tr> <tr><td>regr.randomForest </td><td>Random Forest </td><td>regr </td><td>logical, integer, numeric, factor , ordered</td><td>mlr3 , mlr3extralearners, randomForest </td><td>importance, oob_error , weights </td><td>response</td></tr> <tr><td>regr.ranger </td><td>Random Forest </td><td>regr </td><td>logical , integer , numeric , character, factor , ordered </td><td>mlr3 , mlr3learners, ranger </td><td>hotstart_backward, importance , missings , oob_error , selected_features, weights </td><td>response , se , quantiles</td></tr> <tr><td>regr.rfsrc </td><td>Random Forest </td><td>regr </td><td>logical, integer, numeric, factor </td><td>mlr3 , mlr3extralearners, randomForestSRC </td><td>importance, missings , oob_error , weights </td><td>response</td></tr> <tr><td>regr.rpart </td><td>Regression Tree </td><td>regr </td><td>logical, integer, numeric, factor , ordered</td><td>mlr3 , rpart</td><td>importance , missings , selected_features, weights </td><td>response</td></tr> <tr><td>regr.torch_model </td><td>Torch Model </td><td>regr </td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td>mlr3 , mlr3torch, torch </td><td>featureless , hotstart_backward, hotstart_forward , importance , internal_tuning , marshal , missings , offset , oob_error , selected_features, validation , weights </td><td>response</td></tr> <tr><td>regr.xgboost </td><td>Extreme Gradient Boosting </td><td>regr </td><td>logical, integer, numeric</td><td>mlr3 , mlr3learners, xgboost </td><td>hotstart_forward, importance , internal_tuning , missings , offset , validation , weights </td><td>response</td></tr> <tr><td>surv.aorsf </td><td>Oblique Random Forest </td><td>surv </td><td>integer, numeric, factor , ordered</td><td>mlr3 , mlr3proba , mlr3extralearners, aorsf , pracma </td><td>importance, missings , oob_error , weights </td><td>crank , distr , response</td></tr> <tr><td>surv.bart </td><td>Bayesian Additive Regression Trees</td><td>surv </td><td>logical, integer, numeric</td><td>mlr3 , mlr3proba, BART </td><td>importance, missings </td><td>crank, distr</td></tr> <tr><td>surv.gamboost </td><td>Boosted Generalized Additive Model</td><td>surv </td><td>logical, integer, numeric, factor </td><td>mlr3 , mlr3proba , mlr3extralearners, mboost , pracma </td><td>importance , offset , selected_features, weights </td><td>crank, distr, lp </td></tr> <tr><td>surv.gbm </td><td>Gradient Boosting </td><td>surv </td><td>integer, numeric, factor , ordered</td><td>mlr3 , mlr3proba , mlr3extralearners, gbm </td><td>importance, missings , weights </td><td>crank, lp </td></tr> <tr><td>surv.glmboost </td><td>Boosted Generalized Linear Model </td><td>surv </td><td>logical, integer, numeric, factor </td><td>mlr3 , mlr3proba , mlr3extralearners, mboost , pracma </td><td>importance , offset , selected_features, weights </td><td>crank, distr, lp </td></tr> <tr><td>surv.mboost </td><td>Boosted Generalized Additive Model</td><td>surv </td><td>logical, integer, numeric, factor </td><td>mlr3 , mlr3proba , mlr3extralearners, mboost </td><td>importance , offset , selected_features, weights </td><td>crank, distr, lp </td></tr> <tr><td>surv.ranger </td><td>Random Forest </td><td>surv </td><td>logical , integer , numeric , character, factor , ordered </td><td>mlr3 , mlr3proba , mlr3extralearners, ranger </td><td>importance, oob_error , weights </td><td>crank, distr</td></tr> <tr><td>surv.rfsrc </td><td>Random Forest </td><td>surv </td><td>logical, integer, numeric, factor </td><td>mlr3 , mlr3proba , mlr3extralearners, randomForestSRC , pracma </td><td>importance, missings , oob_error , weights </td><td>crank, distr</td></tr> <tr><td>surv.rpart </td><td>Survival Tree </td><td>surv </td><td>logical , integer , numeric , character, factor , ordered </td><td>mlr3 , mlr3proba, rpart , distr6 , survival </td><td>importance , missings , selected_features, weights </td><td>crank</td></tr> <tr><td>surv.xgboost.aft </td><td>Extreme Gradient Boosting AFT </td><td>surv </td><td>integer, numeric</td><td>mlr3 , mlr3proba , mlr3extralearners, xgboost </td><td>importance , internal_tuning, missings , validation , weights </td><td>crank , lp , response</td></tr> <tr><td>surv.xgboost.cox </td><td>Extreme Gradient Boosting Cox </td><td>surv </td><td>integer, numeric</td><td>mlr3 , mlr3proba , mlr3extralearners, xgboost </td><td>importance , internal_tuning, marshal , missings , validation , weights </td><td>crank, distr, lp </td></tr> </tbody> </table>

对于一些学习器来说，需要将所需的过滤方法设置为一个超参数
- lrn('classif.ranger') 带有多种集成方法，
  可以在构建过程中进行选择
  - 要使用特征重要性方法 'impurity'，可在构建Learner时选择它
lrn('classif.ranger')的importance有哪些

lrn('classif.ranger')$param_set$levels$importance

选择用不纯度'impurity'做为特征重要性计算方法的lrn('classif.ranger')

lrn_ranger <- lrn('classif.ranger', importance = 'impurity')

由于lrn('classif.ranger')不具备处理缺失数据的'missing'属性，
所以先删除一下有缺失数据的行

# 创建`Task`
tsk_pen <- tsk('penguins')
# 删除缺失数据行
# 注意：运行`Task$filter()`后会就地修改数据
tsk_pen$filter(tsk_pen$row_ids[complete.cases(tsk_pen$data())])

之后就可以用flt('importance') 来计算重要性值了
- learner参数会调取传递的Learner的计算方式

# 创建特征重要性过滤器
# 并将指定计算方法为`'importance'`的`Learner`传递过去
flt_importance <- flt('importance', learner = lrn_ranger)
# 计算特征重要性
flt_importance$calculate(tsk_pen)
# 获取结果
as.data.table(flt_importance)

<table class='dataframe'> <caption>A data.table: 7 x 2</caption> <thead> <tr><th scope=col>feature</th><th scope=col>score</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>bill_length </td><td>77.391297</td></tr> <tr><td>flipper_length</td><td>48.663869</td></tr> <tr><td>bill_depth </td><td>32.345189</td></tr> <tr><td>island </td><td>27.669237</td></tr> <tr><td>body_mass </td><td>25.625846</td></tr> <tr><td>sex </td><td> 1.259613</td></tr> <tr><td>year </td><td> 1.146758</td></tr> </tbody> </table>

嵌入法（ Embedded Methods）

许多学习器会在内部选择一部分它们认为对预测有帮助的特征，而忽略其他特征
- 决策树可能永远不会选择某些特征进行分裂
这些子集可用于特征选择，称之为嵌入法，因为特征选择嵌入在学习器中

as.data.table(mlr_learners)[
 sapply(properties, function(x) 'selected_features' %in% x)
]

<table class='dataframe'> <caption>A data.table: 23 x 7</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>task_type</th><th scope=col>feature_types</th><th scope=col>packages</th><th scope=col>properties</th><th scope=col>predict_types</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td>classif.abess </td><td>Fast Best Subset Selection for Classification</td><td>classif</td><td>integer, numeric</td><td>mlr3 , abess</td><td>multiclass , selected_features, twoclass , weights </td><td>response, prob </td></tr> <tr><td>classif.cv_glmnet </td><td>GLM with Elastic Net Regularization </td><td>classif</td><td>logical, integer, numeric</td><td>mlr3 , mlr3learners, glmnet </td><td>multiclass , offset , selected_features, twoclass , weights </td><td>response, prob </td></tr> <tr><td>classif.featureless </td><td>Featureless Classification Learner </td><td>classif</td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td>mlr3</td><td>featureless , importance , missings , multiclass , selected_features, twoclass , weights </td><td>response, prob </td></tr> <tr><td>classif.priority_lasso</td><td>Priority Lasso </td><td>classif</td><td>logical, integer, numeric</td><td>mlr3 , prioritylasso</td><td>selected_features, twoclass , weights </td><td>response, prob </td></tr> <tr><td>classif.ranger </td><td>Random Forest </td><td>classif</td><td>logical , integer , numeric , character, factor , ordered </td><td>mlr3 , mlr3learners, ranger </td><td>hotstart_backward, importance , missings , multiclass , oob_error , selected_features, twoclass , weights </td><td>response, prob </td></tr> <tr><td>classif.rpart </td><td>Classification Tree </td><td>classif</td><td>logical, integer, numeric, factor , ordered</td><td>mlr3 , rpart</td><td>importance , missings , multiclass , selected_features, twoclass , weights </td><td>response, prob </td></tr> <tr><td>classif.torch_model </td><td>Torch Model </td><td>classif</td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td>mlr3 , mlr3torch, torch </td><td>featureless , hotstart_backward, hotstart_forward , importance , internal_tuning , marshal , missings , multiclass , offset , oob_error , selected_features, twoclass , validation , weights </td><td>response, prob </td></tr> <tr><td>regr.abess </td><td>Fast Best Subset Selection for Regression </td><td>regr </td><td>integer, numeric</td><td>mlr3 , abess</td><td>selected_features, weights </td><td>response</td></tr> <tr><td>regr.cv_glmnet </td><td>GLM with Elastic Net Regularization </td><td>regr </td><td>logical, integer, numeric</td><td>mlr3 , mlr3learners, glmnet </td><td>offset , selected_features, weights </td><td>response</td></tr> <tr><td>regr.featureless </td><td>Featureless Regression Learner </td><td>regr </td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td>mlr3 , stats</td><td>featureless , importance , missings , selected_features, weights </td><td>response , se , quantiles</td></tr> <tr><td>regr.priority_lasso </td><td>Priority Lasso </td><td>regr </td><td>logical, integer, numeric</td><td>mlr3 , prioritylasso</td><td>selected_features, weights </td><td>response</td></tr> <tr><td>regr.ranger </td><td>Random Forest </td><td>regr </td><td>logical , integer , numeric , character, factor , ordered </td><td>mlr3 , mlr3learners, ranger </td><td>hotstart_backward, importance , missings , oob_error , selected_features, weights </td><td>response , se , quantiles</td></tr> <tr><td>regr.rpart </td><td>Regression Tree </td><td>regr </td><td>logical, integer, numeric, factor , ordered</td><td>mlr3 , rpart</td><td>importance , missings , selected_features, weights </td><td>response</td></tr> <tr><td>regr.torch_model </td><td>Torch Model </td><td>regr </td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td>mlr3 , mlr3torch, torch </td><td>featureless , hotstart_backward, hotstart_forward , importance , internal_tuning , marshal , missings , offset , oob_error , selected_features, validation , weights </td><td>response</td></tr> <tr><td>surv.coxboost </td><td>Likelihood-based Boosting </td><td>surv </td><td>integer, numeric</td><td>mlr3 , mlr3proba , mlr3extralearners, CoxBoost , pracma </td><td>selected_features, weights </td><td>crank, distr, lp </td></tr> <tr><td>surv.cv_coxboost </td><td>Likelihood-based Boosting </td><td>surv </td><td>integer, numeric</td><td>mlr3 , mlr3proba , mlr3extralearners, CoxBoost , pracma </td><td>selected_features, weights </td><td>crank, distr, lp </td></tr> <tr><td>surv.cv_glmnet </td><td>Regularized Generalized Linear Model </td><td>surv </td><td>logical, integer, numeric</td><td>mlr3 , mlr3proba , mlr3extralearners, glmnet </td><td>offset , selected_features, weights </td><td>crank, distr, lp </td></tr> <tr><td>surv.gamboost </td><td>Boosted Generalized Additive Model </td><td>surv </td><td>logical, integer, numeric, factor </td><td>mlr3 , mlr3proba , mlr3extralearners, mboost , pracma </td><td>importance , offset , selected_features, weights </td><td>crank, distr, lp </td></tr> <tr><td>surv.glmboost </td><td>Boosted Generalized Linear Model </td><td>surv </td><td>logical, integer, numeric, factor </td><td>mlr3 , mlr3proba , mlr3extralearners, mboost , pracma </td><td>importance , offset , selected_features, weights </td><td>crank, distr, lp </td></tr> <tr><td>surv.glmnet </td><td>Regularized Generalized Linear Model </td><td>surv </td><td>logical, integer, numeric</td><td>mlr3 , mlr3proba , mlr3extralearners, glmnet </td><td>offset , selected_features, weights </td><td>crank, distr, lp </td></tr> <tr><td>surv.mboost </td><td>Boosted Generalized Additive Model </td><td>surv </td><td>logical, integer, numeric, factor </td><td>mlr3 , mlr3proba , mlr3extralearners, mboost </td><td>importance , offset , selected_features, weights </td><td>crank, distr, lp </td></tr> <tr><td>surv.priority_lasso </td><td>Priority Lasso </td><td>surv </td><td>logical, integer, numeric</td><td>mlr3 , mlr3proba , prioritylasso</td><td>selected_features, weights </td><td>crank, distr, lp </td></tr> <tr><td>surv.rpart </td><td>Survival Tree </td><td>surv </td><td>logical , integer , numeric , character, factor , ordered </td><td>mlr3 , mlr3proba, rpart , distr6 , survival </td><td>importance , missings , selected_features, weights </td><td>crank</td></tr> </tbody> </table>

对于嵌入式的过滤器，
首先要训练嵌入的学习器进行，
再调取选择的特征，
最后再用过滤器获取计算的结果

# 创建`Task`
tsk_pen <- tsk('penguins')
# 构建学习器
lrn_rpart <- lrn('classif.rpart')
# 训练模型
lrn_rpart$train(tsk_pen)
# 调取选择的特征
lrn_rpart$selected_features()

'flipper_length''bill_length''island'

这里计算得分算了个什么东西呢？
- 就是算了个选择的特征变量在不在模型里头而已，，，

# 构建
flt_selected <- flt('selected_features', learner = lrn_rpart)
# 计算得分
flt_selected$calculate(tsk_pen)
# 调取结果
as.data.table(flt_selected)

<table class='dataframe'> <caption>A data.table: 7 x 2</caption> <thead> <tr><th scope=col>feature</th><th scope=col>score</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>bill_length </td><td>1</td></tr> <tr><td>flipper_length</td><td>1</td></tr> <tr><td>island </td><td>1</td></tr> <tr><td>bill_depth </td><td>0</td></tr> <tr><td>year </td><td>0</td></tr> <tr><td>body_mass </td><td>0</td></tr> <tr><td>sex </td><td>0</td></tr> </tbody> </table>

基于过滤的特征选择（Filter-Based Feature Selection）

在为每个特征计算得分后，需要选择保留的特征或从后续建模步骤中剔除的特征

嵌入法的过滤

对于嵌入法而言，只需选择最后score为1的特征即可
先看看特征变量选择前的变量名

tsk_pen$feature_names

'bill_depth''bill_length''body_mass''flipper_length''island''sex''year'

进行特征变量筛选

# 计算得分
flt_selected$calculate(tsk_pen)
# 调取得分为`1`的特征变量
keep <- names(which(flt_selected$scores == 1))
# 进行选择
tsk_pen$select(keep)
# 查看选择后的特征变量名
tsk_pen$feature_names

'bill_length''flipper_length''island'

分配连续分数的过滤

两种方法
- 按排名为前$k$个特征
- 高于某阈值$\tau$的特征
$k$个特征

# 创建`Task`，`Filter`并计算得分
tsk_pen <- tsk('penguins')
flt_gain <- flt('information_gain')
flt_gain$calculate(tsk_pen)

# 设置k的个数
k = 3

# 筛选特征变量
keep <- names(head(flt_gain$scores, k))
tsk_pen$select(keep)
tsk_pen$feature_names

'bill_depth''bill_length''flipper_length'

$\tau > 0.5$ 的特征

# 创建`Task`，`Filter`并计算得分
tsk_pen <- tsk('penguins')
flt_gain <- flt('information_gain')
flt_gain$calculate(tsk_pen)

# 设置阈值r
tau = 0.5

# 筛选特征变量
keep <- names(which(flt_gain$scores > tau))
tsk_pen$select(keep)
tsk_pen$feature_names

'bill_depth''bill_length''flipper_length''island'

包装器方法（Wrapper Methods）

原理是在选定的特征子集上拟合模型并评估其性能
- 可以按顺序进行，例如在顺序前向选择中通过迭代向模型添加特征
- 或者以并行方式进行，例如在随机搜索中评估随机特征子集
下图表示具有四个特征的顺序前向选择的二进制表示
- 绿色表示已评估的特征集，深绿色表示每次迭代中的最佳特征集，白色表示未评估的特征集
- 从没有选择任何特征（所有特征均为“0”）的底部开始
- 在下一次迭代中，分别测试所有特征（每个特征分别为“1”），
  并选择最佳选项（第二行中颜色最深的）
- 选择第二个、第三个和第四个特征时继续此过程

上述基于包装器的特征选择与超参数优化中的黑盒优化方法非常相似
- 主要区别在于，我们搜索的是性能良好的特征子集，而非超参数配置
- 这种相似性不仅体现在基本概念和结构上，在 mlr3 类和API方面也是如此；
  API在很多地方几乎完全相同，我们可以使用相同的终止器，
  结果以与调优类似的方式记录到存档中，
  并且我们也可以通过类似的方式优化多个性能指标以创建帕累托最优解

简单前向选择示例

类似于tune()的用法，这里也是fselect()的用法也很类似，
约等于包装一个选择实例

# 加载R包
# library(mlr3fselect)

# 创建`Task`，并给予刚刚的选择结果进行特征筛选
tsk_pen <- tsk('penguins')
tsk_pen$select(
 c(
  'bill_depth', 
  'bill_length', 
  'body_mass', 
  'flipper_length'
 )
)

# 进行特征实例选择
instance <- fselect(
 # 类似于`tune()`，传递的不是`Tuner`而是`FSelector`
 fselector = fs('sequential'),
 # 和`tune()`一样，传递`Task`
 task =  tsk_pen,
 # 和`tune()`一样，传递`Learner`
 learner = lrn_rpart,
 # 和`tune()`一样，传递`Resampling`
 resampling = rsmp('cv', folds = 3),
 # # 和`tune()`一样，传递`Measure`
 measure = msr('classif.acc')
)

查看迭代的结果

dt <- as.data.table(instance$archive)
dt

<table class='dataframe'> <caption>A data.table: 10 x 13</caption> <thead> <tr><th scope=col>bill_depth</th><th scope=col>bill_length</th><th scope=col>body_mass</th><th scope=col>flipper_length</th><th scope=col>classif.acc</th><th scope=col>runtime_learners</th><th scope=col>timestamp</th><th scope=col>batch_nr</th><th scope=col>warnings</th><th scope=col>errors</th><th scope=col>features</th><th scope=col>n_features</th><th scope=col>resample_result</th></tr> <tr><th scope=col><lgl></th><th scope=col><lgl></th><th scope=col><lgl></th><th scope=col><lgl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dttm></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td> TRUE</td><td>FALSE</td><td>FALSE</td><td>FALSE</td><td>0.7355200</td><td>0.015</td><td>2025-06-25 15:04:09</td><td>1</td><td>0</td><td>0</td><td>bill_depth</td><td>1</td><td><environment: 0x301ed9928></td></tr> <tr><td>FALSE</td><td> TRUE</td><td>FALSE</td><td>FALSE</td><td>0.7674549</td><td>0.007</td><td>2025-06-25 15:04:09</td><td>1</td><td>0</td><td>0</td><td>bill_length</td><td>1</td><td><environment: 0x301efcbd0></td></tr> <tr><td>FALSE</td><td>FALSE</td><td> TRUE</td><td>FALSE</td><td>0.7150013</td><td>0.022</td><td>2025-06-25 15:04:09</td><td>1</td><td>0</td><td>0</td><td>body_mass</td><td>1</td><td><environment: 0x14a691150></td></tr> <tr><td>FALSE</td><td>FALSE</td><td>FALSE</td><td> TRUE</td><td>0.7935673</td><td>0.026</td><td>2025-06-25 15:04:09</td><td>1</td><td>0</td><td>0</td><td>flipper_length</td><td>1</td><td><environment: 0x16a7b79f0></td></tr> <tr><td> TRUE</td><td>FALSE</td><td>FALSE</td><td> TRUE</td><td>0.7819985</td><td>0.008</td><td>2025-06-25 15:04:10</td><td>2</td><td>0</td><td>0</td><td><span style=white-space:pre-wrap>bill_depth , flipper_length</span></td><td>2</td><td><environment: 0x301f245e8></td></tr> <tr><td>FALSE</td><td> TRUE</td><td>FALSE</td><td> TRUE</td><td>0.9360285</td><td>0.009</td><td>2025-06-25 15:04:10</td><td>2</td><td>0</td><td>0</td><td><span style=white-space:pre-wrap>bill_length , flipper_length</span></td><td>2</td><td><environment: 0x301f4d490></td></tr> <tr><td>FALSE</td><td>FALSE</td><td> TRUE</td><td> TRUE</td><td>0.7993644</td><td>0.008</td><td>2025-06-25 15:04:10</td><td>2</td><td>0</td><td>0</td><td><span style=white-space:pre-wrap>body_mass , flipper_length</span></td><td>2</td><td><environment: 0x301f9eef0></td></tr> <tr><td> TRUE</td><td> TRUE</td><td>FALSE</td><td> TRUE</td><td>0.9360285</td><td>0.010</td><td>2025-06-25 15:04:10</td><td>3</td><td>0</td><td>0</td><td><span style=white-space:pre-wrap>bill_depth , bill_length , flipper_length</span></td><td>3</td><td><environment: 0x301fcdfc8></td></tr> <tr><td>FALSE</td><td> TRUE</td><td> TRUE</td><td> TRUE</td><td>0.9360285</td><td>0.007</td><td>2025-06-25 15:04:10</td><td>3</td><td>0</td><td>0</td><td><span style=white-space:pre-wrap>bill_length , body_mass , flipper_length</span></td><td>3</td><td><environment: 0x17bdd2f38></td></tr> <tr><td> TRUE</td><td> TRUE</td><td> TRUE</td><td> TRUE</td><td>0.9360285</td><td>0.008</td><td>2025-06-25 15:04:10</td><td>4</td><td>0</td><td>0</td><td><span style=white-space:pre-wrap>bill_depth , bill_length , body_mass , flipper_length</span></td><td>4</td><td><environment: 0x17bdfaeb0></td></tr> </tbody> </table>

分别看1–3次迭代的结果
- 特征 flipper_length 在第一次迭代中实现了最高的预测性能，因此被选中
- 在第二次迭代中，bill_length加入后模型准确率高达93.6%
- 第三次开始模型改善不大，
  因此可选择一个稍差但只有两个特征的模型，以减小数据规模

dt[batch_nr == 1, 1:5]
dt[batch_nr == 2, 1:5]
dt[batch_nr == 3, 1:5]

<table class='dataframe'> <caption>A data.table: 4 x 5</caption> <thead> <tr><th scope=col>bill_depth</th><th scope=col>bill_length</th><th scope=col>body_mass</th><th scope=col>flipper_length</th><th scope=col>classif.acc</th></tr> <tr><th scope=col><lgl></th><th scope=col><lgl></th><th scope=col><lgl></th><th scope=col><lgl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td> TRUE</td><td>FALSE</td><td>FALSE</td><td>FALSE</td><td>0.7355200</td></tr> <tr><td>FALSE</td><td> TRUE</td><td>FALSE</td><td>FALSE</td><td>0.7674549</td></tr> <tr><td>FALSE</td><td>FALSE</td><td> TRUE</td><td>FALSE</td><td>0.7150013</td></tr> <tr><td>FALSE</td><td>FALSE</td><td>FALSE</td><td> TRUE</td><td>0.7935673</td></tr> </tbody> </table>

<table class='dataframe'> <caption>A data.table: 3 x 5</caption> <thead> <tr><th scope=col>bill_depth</th><th scope=col>bill_length</th><th scope=col>body_mass</th><th scope=col>flipper_length</th><th scope=col>classif.acc</th></tr> <tr><th scope=col><lgl></th><th scope=col><lgl></th><th scope=col><lgl></th><th scope=col><lgl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td> TRUE</td><td>FALSE</td><td>FALSE</td><td>TRUE</td><td>0.7819985</td></tr> <tr><td>FALSE</td><td> TRUE</td><td>FALSE</td><td>TRUE</td><td>0.9360285</td></tr> <tr><td>FALSE</td><td>FALSE</td><td> TRUE</td><td>TRUE</td><td>0.7993644</td></tr> </tbody> </table>

<table class='dataframe'> <caption>A data.table: 2 x 5</caption> <thead> <tr><th scope=col>bill_depth</th><th scope=col>bill_length</th><th scope=col>body_mass</th><th scope=col>flipper_length</th><th scope=col>classif.acc</th></tr> <tr><th scope=col><lgl></th><th scope=col><lgl></th><th scope=col><lgl></th><th scope=col><lgl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td> TRUE</td><td>TRUE</td><td>FALSE</td><td>TRUE</td><td>0.9360285</td></tr> <tr><td>FALSE</td><td>TRUE</td><td> TRUE</td><td>TRUE</td><td>0.9360285</td></tr> </tbody> </table>

可以将每次迭代的评估结果可视化来看

autoplot(instance, type = 'performance')

为了直接展示最佳特征集，
我们可以使用 Instance$result_feature_set
- 它会按字母顺序（而非选择顺序）返回特征

instance$result_feature_set

'bill_length''flipper_length'

在内部，fselect()函数会创建一个FSelectInstanceBatchSingleCrit对象，
并基于所选方法，使用FSelectorBatch对象执行特征选择
- 在本示例中是FSelectorBatchSequential对象
这与tune()函数中的情况类似
- 它使用提供的重采样和度量方法，
  在任务上评估由FSelectorBatch提供的所有特征子集

FSelectInstance类

我们使用简化函数 fsi() 创建一个 FSelectInstanceBatchSingleCrit 对象
- 正如fselect()类似于tune，
  fsi()类似于vi()

instance <- fsi(
 task = tsk_pen,
 learner = lrn_rpart,
 resampling = rsmp('cv', folds = 3),
 measure = msr('classif.acc'),
 terminator = trm('evals', n_evals = 20)
)

FSelector类

FSelectorBatch类是不同特征选择算法的基类
- fs()创建
- fs()类似于tnr()，调取一个特征选择的算法
目前在mlr3fselect中实现了以下算法：
- fs('random_search')：随机搜索
  尝试随机特征子集，直到终止
- fs('exhaustive_search')：穷举搜索
  尝试所有可能的特征子集
- fs('sequential')：顺序搜索
  即顺序向前或向后选择
- fs('rfe')：递归特征消除
  它使用学习器的重要性分数来迭代地删除特征重要性较低的特征
- fs('design_points')设计点
  尝试所有用户提供的特征集
- fs('genetic_search')：遗传搜索
  实现一种遗传算法，该算法将特征视为二进制序列，并尝试通过变异找到最佳子集
- fs('shadow_variable_search')：影子变量搜索
  即添加所有特征的排列副本（影子变量），执行前向选择，并在选择到影子变量时停止
下面使用简单的随机搜索算法

fselector <- fs('random_search')

开始特征选择

和tnr()创建Tuner，使用Tuner$optimize()一样，
fs()创建的Fselector可以使用 Fselector$optimize(Instance)进行特征选择
基于实例中的元素，特征选择的算法将如下执行：
- FSelectorBatch 会提出至少一个特征子集，
  也可能提出多个子集以便并行评估，
  这可以通过 batch_size 设置进行控制
- 对于每个特征子集，
  给定的学习器将使用提供的重采样方法在任务上进行拟合，
  并使用给定的度量进行评估
- 所有评估结果都存储在FSelectInstanceBatchSingleCrit对象的存档中
- 查询终止条件；
  如果未触发终止标准，则转到第一步
- 确定观察到的性能最佳的特征子集
- 将表现最佳的特征子集作为结果存储在实例对象中

fselector$optimize(instance)

<table class='dataframe'> <caption>A data.table: 1 x 7</caption> <thead> <tr><th scope=col>bill_depth</th><th scope=col>bill_length</th><th scope=col>body_mass</th><th scope=col>flipper_length</th><th scope=col>features</th><th scope=col>n_features</th><th scope=col>classif.acc</th></tr> <tr><th scope=col><lgl></th><th scope=col><lgl></th><th scope=col><lgl></th><th scope=col><lgl></th><th scope=col><list></th><th scope=col><int></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>TRUE</td><td>TRUE</td><td>TRUE</td><td>TRUE</td><td>bill_depth , bill_length , body_mass , flipper_length</td><td>4</td><td>0.941851</td></tr> </tbody> </table>

结果储存在Instance$result里面

as.data.table(instance$result)[, .(features, classif.acc)]

<table class='dataframe'> <caption>A data.table: 1 x 2</caption> <thead> <tr><th scope=col>features</th><th scope=col>classif.acc</th></tr> <tr><th scope=col><list></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>bill_depth , bill_length , body_mass , flipper_length</td><td>0.941851</td></tr> </tbody> </table>

也可以访问FSelectInstanceBatchSingleCrit$archive查看所有子集的评估结果

as.data.table(instance$archive)[
 1:5,
 .(bill_depth, bill_length, body_mass, flipper_length, classif.acc)
]

经过优化的特征子集可用于对任务进行子集划分，并在所有观测数据上拟合模型

# 创建任务
tsk_pen <- tsk('penguins')
# 使用过滤后的特征变量
tsk_pen$select(instance$result_feature_set)
# 训练模型
lrn_rpart$train(tsk_pen)

优化多项性能指标

FSelectInstanceBatchMultiCrit，不解释了，熟悉的味道

instance <- fsi(
 task = tsk('sonar'),
 learner = lrn_rpart,
 resampling = rsmp('holdout'),
 # 这里是传递`用msrs()`给`measure`
 measure = msrs(c('classif.tpr', 'classif.tnr')),
 terminator = trm('evals', n_evals = 20)
)

熟悉的味道

fselector <- fs('random_search')
fselector$optimize(instance)

熟悉的味道，，，

as.data.table(instance$result)[, .(features, classif.tpr, classif.tnr)]

<table class='dataframe'> <caption>A data.table: 9 x 3</caption> <thead> <tr><th scope=col>features</th><th scope=col>classif.tpr</th><th scope=col>classif.tnr</th></tr> <tr><th scope=col><list></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>V10, V11, V12, V14, V15, V16, V2 , V20, V24, V26, V27, V3 , V34, V39, V4 , V46, V5 , V50, V51, V54, V55, V57, V59, V9 </td><td>0.7428571</td><td>0.7647059</td></tr> <tr><td>V11, V13, V14, V16, V20, V21, V24, V25, V27, V28, V31, V32, V33, V35, V38, V41, V42, V43, V48, V49, V5 , V50, V51, V54, V55, V57, V58, V9 </td><td>0.8285714</td><td>0.7352941</td></tr> <tr><td>V1 , V10, V11, V12, V14, V15, V16, V17, V18, V2 , V20, V21, V25, V26, V27, V28, V29, V3 , V32, V33, V36, V38, V39, V4 , V41, V45, V49, V50, V51, V52, V53, V54, V55, V56, V57, V58, V59, V6 , V60, V7 , V8 , V9 </td><td>0.9714286</td><td>0.5000000</td></tr> <tr><td>V1 , V10, V11, V12, V13, V14, V15, V16, V17, V18, V19, V2 , V20, V21, V22, V23, V24, V25, V26, V27, V28, V29, V3 , V30, V31, V32, V33, V34, V35, V36, V37, V38, V39, V4 , V40, V41, V42, V43, V44, V45, V46, V47, V48, V49, V5 , V50, V51, V52, V53, V54, V55, V56, V57, V58, V59, V6 , V60, V7 , V8 , V9 </td><td>0.9142857</td><td>0.5882353</td></tr> <tr><td>V1 , V10, V11, V12, V13, V14, V15, V16, V17, V18, V19, V2 , V20, V21, V22, V23, V24, V25, V26, V27, V28, V29, V3 , V31, V32, V33, V34, V35, V36, V37, V38, V39, V4 , V40, V41, V42, V43, V45, V47, V49, V51, V52, V53, V54, V55, V56, V57, V59, V6 , V60, V7 , V9 </td><td>0.9142857</td><td>0.5882353</td></tr> <tr><td>V1 , V10, V11, V12, V14, V15, V16, V18, V19, V2 , V20, V21, V22, V23, V24, V25, V29, V3 , V30, V31, V33, V34, V36, V37, V38, V39, V40, V42, V43, V46, V47, V48, V49, V5 , V50, V51, V52, V53, V54, V55, V56, V57, V58, V60, V7 , V8 , V9 </td><td>0.9428571</td><td>0.5588235</td></tr> <tr><td>V1 , V10, V11, V12, V13, V14, V15, V16, V17, V18, V19, V2 , V20, V21, V22, V23, V24, V25, V26, V27, V28, V29, V3 , V30, V31, V32, V33, V34, V35, V36, V37, V38, V39, V4 , V40, V41, V42, V43, V44, V45, V46, V47, V48, V49, V5 , V50, V51, V52, V53, V54, V55, V56, V57, V58, V59, V6 , V60, V7 , V8 , V9 </td><td>0.9142857</td><td>0.5882353</td></tr> <tr><td>V1 , V12, V14, V17, V18, V21, V23, V24, V25, V28, V29, V3 , V32, V36, V38, V39, V4 , V42, V43, V46, V5 , V50, V53, V54, V55, V57, V59, V6 , V7 , V8 , V9 </td><td>0.8571429</td><td>0.6176471</td></tr> <tr><td>V1 , V10, V11, V12, V13, V15, V16, V17, V18, V19, V2 , V20, V21, V22, V23, V24, V26, V27, V28, V29, V3 , V30, V31, V32, V33, V34, V35, V36, V37, V38, V39, V4 , V40, V41, V42, V43, V44, V45, V46, V47, V48, V49, V5 , V50, V51, V52, V53, V54, V55, V56, V58, V59, V6 , V60, V7 , V8 , V9 </td><td>0.9142857</td><td>0.5882353</td></tr> </tbody> </table>

嵌套重采样

熟悉，就是auto_tune()换成auto_fselector()

afs <- auto_fselector(
 fselector = fs('random_search'),
 learner = lrn('classif.log_reg'),
 resampling = rsmp('holdout'),
 measure = msr('classif.acc'),
 terminator = trm('evals', n_evals = 10)
)
afs

<AutoFSelector:classif.log_reg.fselector>
* Model: list
* Packages: mlr3, mlr3fselect, mlr3learners, stats
* Predict Type: response
* Feature Types: logical, integer, numeric, character, factor, ordered
* Properties: offset, twoclass, weights

AutoFSelector 可传递给 benchmark() 或 resample() 以进行嵌套重采样
下面将包装后的学习器 afs 与普通逻辑回归 lrn('classif.log_reg') 进行比较
- 看得出用afs进行特征选择后，预测性能更好

grid <- benchmark_grid(
 tsk('sonar'), 
 list(afs, lrn('classif.log_reg')),
 rsmp('cv', folds = 3)
)

bmr <- benchmark(grid)$aggregate(msr('classif.acc'))
as.data.table(bmr)[, .(learner_id, classif.acc)]

<table class='dataframe'> <caption>A data.table: 2 x 2</caption> <thead> <tr><th scope=col>learner_id</th><th scope=col>classif.acc</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>classif.log_reg.fselector</td><td>0.7497585</td></tr> <tr><td>classif.log_reg </td><td>0.6443064</td></tr> </tbody> </table>

【mlr3】4.管道

Sat, 19 Jul 2025 00:00:00 GMT

Cover Pic by @Rafa

Applied Machine Learning Using mlr3 in R

顺序管道

简介

mlr3pipelines包将模块化推进得更多，
使得包括在数据预处理，构建基层模型甚至更复杂的元模型更加流程化
mlr3pipelines 使得利用构建模块在 Learner 中构建各个步骤成为可能，
这些构建模块继承自 PipeOp 类
- PipeOp 可以使用有向边连接起来，形成表示操作之间的数据流 Graph 或 pipeline
- 在模型训练期间，Graph 中的 PipeOp 会转换给定的 Task，
  后续的 PipeOp 会接收转换后的 Task 作为输入
- 除了转换数据，PipeOp 还会生成一个状态
  - 该状态用于在预测期间指导 PipeOp 的操作，
    这类似于学习器在训练期间学习并存储模型参数/权重，
    以指导模型预测
下图中，通过缩放 PipeOp 进行了可视化展示
- 该操作符在训练期间对特征进行缩放，
  并将缩放因子保存为一种状态，以便在预测中使用

种类
- 顺序管道
  - 指数据在管道中从一个PipeOp直接移动到下一个，从头到尾依次进行
- 非顺序管道
  - 数据是通过可能有多个输入和/或输出的PipeOp进行处理的
  - 非顺序管道的特点是有多个分支，
    因此数据可能在不同时间由不同的PipeOp进行处理

`PipeOp`：管道操作符

PipeOp是mlr3pipelines的基本类
- 表示对输入（例如，训练Task）的转换操作，产生一些输出
- 与学习器类似，它包括一个$train()和一个$predict()方法
  - 训练阶段通常会生成数据的特定模型，并将其保存为内部状态
  - 预测阶段PipeOp使用保存状态中的信息对预测Task
- 与学习器一样，PipeOp具有经过训练的参数（即状态）
- 除了参数之外，PipeOp还具有超参数，
  用户可以在构造PipeOp时或通过访问其PipeOp$param_set来设置超参数
- PipeOp可以使用便捷函数po()进行构造，
  对于多个PipeOp可以使用pos()
  - 并且所有可用的PipeOp都可在字典mlr_pipeops中找到
看看有哪些管道操作符

mlr_pipeops %>% as.data.table()

<table class='dataframe'> <caption>A data.table: 174 x 11</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>packages</th><th scope=col>tags</th><th scope=col>feature_types</th><th scope=col>input.num</th><th scope=col>output.num</th><th scope=col>input.type.train</th><th scope=col>input.type.predict</th><th scope=col>output.type.train</th><th scope=col>output.type.predict</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th><th scope=col><int></th><th scope=col><int></th><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th><th scope=col><list></th></tr> </thead> <tbody> <tr><td>adas </td><td>ADAS Balancing </td><td>mlr3pipelines, smotefamily </td><td>imbalanced data, data transform </td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td> 1</td><td> 1</td><td>TaskClassif</td><td>TaskClassif</td><td>TaskClassif</td><td>TaskClassif</td></tr> <tr><td>augment_center_crop </td><td>Center Crop Augmentation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>augment_color_jitter </td><td>Color Jitter Augmentation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>augment_crop </td><td>Crop Augmentation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>augment_hflip </td><td>Horizontal Flip Augmentation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>augment_random_affine </td><td>Random Affine Augmentation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>augment_random_choice </td><td>Random Choice Augmentation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>augment_random_crop </td><td>Random Crop Augmentation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>augment_random_horizontal_flip</td><td>Random Horizontal Flip Augmentation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>augment_random_order </td><td>Random Order Augmentation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>augment_random_resized_crop </td><td>Random Resized Crop Augmentation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>augment_random_vertical_flip </td><td>Random Vertical Flip Augmentation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>augment_resized_crop </td><td>Resized Crop Augmentation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>augment_rotate </td><td>Rotate Augmentation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>augment_vflip </td><td>Vertical Flip Augmentation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>blsmote </td><td>BLSMOTE Balancing </td><td>mlr3pipelines, smotefamily </td><td>imbalanced data, data transform </td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td> 1</td><td> 1</td><td>TaskClassif</td><td>TaskClassif</td><td>TaskClassif</td><td>TaskClassif</td></tr> <tr><td>boxcox </td><td>Box-Cox Transformation of Numeric Features </td><td>mlr3pipelines, bestNormalize</td><td>data transform</td><td>numeric, integer</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>branch </td><td>Path Branching </td><td>mlr3pipelines</td><td>meta</td><td>NA</td><td> 1</td><td>NA</td><td></td><td></td><td></td><td></td></tr> <tr><td>breslowcompose </td><td>Wrap a learner into a PipeOp with survival predictions estimated by the Breslow estimator</td><td>mlr3pipelines, mlr3 , mlr3proba </td><td>abstract</td><td>NA</td><td> 1</td><td> 1</td><td>TaskSurv</td><td>TaskSurv</td><td>NULL</td><td>PredictionSurv</td></tr> <tr><td>chunk </td><td>Chunk Input into Multiple Outputs </td><td>mlr3pipelines</td><td>meta</td><td>NA</td><td> 1</td><td>NA</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>classbalancing </td><td>Class Balancing </td><td>mlr3pipelines</td><td>imbalanced data, data transform </td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td> 1</td><td> 1</td><td>TaskClassif</td><td>TaskClassif</td><td>TaskClassif</td><td>TaskClassif</td></tr> <tr><td>classifavg </td><td>Majority Vote Prediction </td><td>mlr3pipelines, stats </td><td>ensemble</td><td>NA</td><td>NA</td><td> 1</td><td>NULL</td><td>PredictionClassif</td><td>NULL</td><td>PredictionClassif</td></tr> <tr><td>classweights </td><td>Class Weights for Sample Weighting </td><td>mlr3pipelines</td><td>imbalanced data, data transform </td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td> 1</td><td> 1</td><td>TaskClassif</td><td>TaskClassif</td><td>TaskClassif</td><td>TaskClassif</td></tr> <tr><td>colapply </td><td>Apply a Function to each Column of a Task </td><td>mlr3pipelines</td><td>data transform</td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>collapsefactors </td><td>Collapse Factors </td><td>mlr3pipelines</td><td>data transform</td><td>factor , ordered</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>colroles </td><td>Change Column Roles of a Task </td><td>mlr3pipelines</td><td>data transform</td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>compose_probregr </td><td>PipeOpProbregr </td><td>mlr3pipelines, mlr3proba , distr6 </td><td>abstract</td><td>NA</td><td> 2</td><td> 1</td><td>NULL, NULL</td><td>PredictionRegr, PredictionRegr</td><td>NULL</td><td>PredictionRegr</td></tr> <tr><td>copy </td><td>Copy Input Multiple Times </td><td>mlr3pipelines</td><td>meta</td><td>NA</td><td> 1</td><td>NA</td><td></td><td></td><td></td><td></td></tr> <tr><td>crankcompose </td><td>PipeOpCrankCompositor </td><td>mlr3pipelines, mlr3proba </td><td>abstract</td><td>NA</td><td> 1</td><td> 1</td><td>NULL</td><td>PredictionSurv</td><td>NULL</td><td>PredictionSurv</td></tr> <tr><td>datefeatures </td><td>Preprocess Date Features </td><td>mlr3pipelines</td><td>data transform</td><td>POSIXct</td><td> 1</td><td> 1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td><td>...</td></tr> <tr><td>tomek </td><td>Tomek Down-Sampling </td><td>mlr3pipelines, themis </td><td>imbalanced data, data transform </td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td> 1</td><td>1</td><td>TaskClassif</td><td>TaskClassif</td><td>TaskClassif</td><td>TaskClassif</td></tr> <tr><td>torch_callbacks </td><td>Callback Configuration </td><td>mlr3pipelines</td><td>abstract</td><td>NA</td><td> 1</td><td>1</td><td>ModelDescriptor</td><td>Task</td><td>ModelDescriptor</td><td>Task</td></tr> <tr><td>torch_ingress_categ </td><td>Torch Entry Point for Categorical Features </td><td>mlr3pipelines, mlr3torch </td><td>abstract</td><td>factor , ordered, logical</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>ModelDescriptor</td><td>Task</td></tr> <tr><td>torch_ingress_ltnsr </td><td>Ingress for Lazy Tensor </td><td>mlr3pipelines, mlr3torch </td><td>abstract</td><td>lazy_tensor</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>ModelDescriptor</td><td>Task</td></tr> <tr><td>torch_ingress_num </td><td>Torch Entry Point for Numeric Features </td><td>mlr3pipelines, mlr3torch </td><td>abstract</td><td>numeric, integer</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>ModelDescriptor</td><td>Task</td></tr> <tr><td>torch_loss </td><td>Loss Configuration </td><td>mlr3pipelines, torch , mlr3torch </td><td>abstract</td><td>NA</td><td> 1</td><td>1</td><td>ModelDescriptor</td><td>Task</td><td>ModelDescriptor</td><td>Task</td></tr> <tr><td>torch_model_classif </td><td>PipeOp Torch Classifier </td><td>mlr3pipelines, mlr3 , mlr3torch </td><td>learner</td><td>NA</td><td> 1</td><td>1</td><td>ModelDescriptor</td><td>TaskClassif</td><td>NULL</td><td>PredictionClassif</td></tr> <tr><td>torch_model_regr </td><td>Torch Regression Model </td><td>mlr3pipelines, mlr3 , mlr3torch </td><td>learner</td><td>NA</td><td> 1</td><td>1</td><td>ModelDescriptor</td><td>TaskRegr</td><td>NULL</td><td>PredictionRegr</td></tr> <tr><td>torch_optimizer </td><td>Optimizer Configuration </td><td>mlr3pipelines, torch , mlr3torch </td><td>abstract</td><td>NA</td><td> 1</td><td>1</td><td>ModelDescriptor</td><td>Task</td><td>ModelDescriptor</td><td>Task</td></tr> <tr><td>trafo_adjust_brightness </td><td>Adjust Brightness Transformation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>trafo_adjust_gamma </td><td>Adjust Gamma Transformation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>trafo_adjust_hue </td><td>Adjust Hue Transformation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>trafo_adjust_saturation </td><td>Adjust Saturation Transformation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>trafo_grayscale </td><td>Grayscale Transformation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>trafo_nop </td><td>No Transformation </td><td>mlr3pipelines, mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>trafo_normalize </td><td>Normalization Transformation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>trafo_pad </td><td>Padding Transformation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>trafo_reshape </td><td>Reshaping Transformation </td><td>mlr3pipelines, mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>trafo_resize </td><td>Resizing Transformation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>trafo_rgb_to_grayscale </td><td>RGB to Grayscale Transformation </td><td>mlr3pipelines, torchvision , mlr3torch </td><td>torch , data transform</td><td>lazy_tensor</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> <tr><td>trafopred_classifsurv_IPCW </td><td>PipeOpPredClassifSurvIPCW </td><td>mlr3pipelines</td><td>abstract</td><td>NA</td><td> 2</td><td>1</td><td>NULL, NULL</td><td>PredictionClassif, list </td><td>NULL</td><td>PredictionSurv</td></tr> <tr><td>trafopred_classifsurv_disctime</td><td>PipeOpPredClassifSurvDiscTime </td><td>mlr3pipelines</td><td>abstract</td><td>NA</td><td> 2</td><td>1</td><td>NULL , data.table</td><td>PredictionClassif, data.table </td><td>NULL</td><td>PredictionSurv</td></tr> <tr><td>trafopred_regrsurv_pem </td><td>PipeOpPredRegrSurvPEM </td><td>mlr3pipelines</td><td>abstract</td><td>NA</td><td> 2</td><td>1</td><td>NULL , data.table</td><td>PredictionRegr, data.table </td><td>NULL</td><td>PredictionSurv</td></tr> <tr><td>trafotask_survclassif_IPCW </td><td>PipeOpTaskSurvClassifIPCW </td><td>mlr3pipelines</td><td>abstract</td><td>NA</td><td> 1</td><td>2</td><td>TaskSurv</td><td>TaskSurv</td><td>TaskClassif, NULL </td><td>TaskClassif, list </td></tr> <tr><td>trafotask_survclassif_disctime</td><td>PipeOpTaskSurvClassifDiscTime </td><td>mlr3pipelines, pammtools </td><td>abstract</td><td>NA</td><td> 1</td><td>2</td><td>TaskSurv</td><td>TaskSurv</td><td>TaskClassif, data.table </td><td>TaskClassif, data.table </td></tr> <tr><td>trafotask_survregr_pem </td><td>PipeOpTaskSurvRegrPEM </td><td>mlr3pipelines, pammtools </td><td>abstract</td><td>NA</td><td> 1</td><td>2</td><td>TaskSurv</td><td>TaskSurv</td><td>TaskRegr , data.table</td><td>TaskRegr , data.table</td></tr> <tr><td>tunethreshold </td><td>Tune the Threshold of a Classification Prediction</td><td>mlr3pipelines, bbotk </td><td>target transform</td><td>NA</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>NULL</td><td>Prediction</td></tr> <tr><td>unbranch </td><td>Unbranch Different Paths </td><td>mlr3pipelines</td><td>meta</td><td>NA</td><td>NA</td><td>1</td><td></td><td></td><td></td><td></td></tr> <tr><td>vtreat </td><td>Interface to the vtreat Package </td><td>mlr3pipelines, vtreat </td><td>encode , missings , data transform</td><td>logical , integer , numeric , character , factor , ordered , POSIXct , Date , lazy_tensor</td><td> 1</td><td>1</td><td>TaskSupervised</td><td>TaskSupervised</td><td>TaskSupervised</td><td>TaskSupervised</td></tr> <tr><td>yeojohnson </td><td>Yeo-Johnson Transformation of Numeric Features </td><td>mlr3pipelines, bestNormalize</td><td>data transform</td><td>numeric, integer</td><td> 1</td><td>1</td><td>Task</td><td>Task</td><td>Task</td><td>Task</td></tr> </tbody> </table>

下面构建并查看一个PCA管道
在输出中
- not trained：模型尚未被训练
- Input channels的input [Task,Task]：
  训练和预测都接受Task的输入
- Output channels的outnput [Task,Task]：
  训练和预测都输出为Task
与Learner类不同的是，PipeOp可以在训练阶段后返回结果

# 加载R包
# library(mlr3pipelines)

# 选择'pca'管道
po_pca <- po('pca', center = TRUE)
po_pca

PipeOp: <pca> (not trained)
values: <center=TRUE>
Input channels <name [train type, predict type]>:
  input [Task,Task]
Output channels <name [train type, predict type]>:
  output [Task,Task]

下面对penguins_simple任务的缩小版进行PCA分析

# 创建任务
tsk_small <- tsk('penguins')
# 选择没有缺失值的数据
tsk_small$filter(
    tsk_small$
        row_ids[complete.cases(tsk_small$data())]
)

# 放到list里（必须）
poin <- list(tsk_small)
# 传递给`PipeOpPCA`训练
poout <- po_pca$train(poin)
# 查看结果
poout

$output

[36m--[39m [1m[34m<TaskClassif>[39m (333x8): Palmer Penguins[22m [36m--------------------------------------[39m
* Target: species
* Target classes: Adelie (44%), Gentoo (36%), Chinstrap (20%)
* Properties: multiclass
* Features (7):
  * dbl (5): PC1, PC2, PC3, PC4, PC5
  * fct (2): island, sex

查看PCA的结果

# 调取开头5个样本PCA结果
poout[[1]]$head()

# 查看全部样本的PCA结果
# poout[[1]]$data()

训练得到的旋转矩阵也会保存在内部 $state 字段

po_pca$state

Standard deviations (1, .., p=5):
[1] 805.3157531   7.1258611   4.0205105   1.5392977   0.7748449

Rotation (n x k) = (5 x 5):
                         PC1         PC2          PC3           PC4
bill_depth     -1.154327e-03 -0.08678513  0.144143265  0.9837576340
bill_length     4.003162e-03  0.31883248  0.941332235 -0.1084192852
body_mass       9.998759e-01 -0.01571143  0.001020094 -0.0003315664
flipper_length  1.519455e-02  0.94325408 -0.304144443  0.1250176180
year            2.210512e-05  0.02896694 -0.024727723  0.0695461097
                         PC5
bill_depth     -0.0625351521
bill_length     0.0216496177
body_mass       0.0004828135
flipper_length -0.0436763258
year            0.9968514404

之后可以传递给PipeOpPCA$predict()，获取预测结果

# 挑一个样本用于预测结果
# 注意使用`$clone()`，因为`filter()`是就地修改
tsk_onepenguin <- tsk_small$clone()$filter(42)
# 同样需要传入`list`
poin <- list(tsk_onepenguin)
# 预测
poout <- po_pca$predict(poin)
# 查看预测结果
poout[[1]]$data()

<table class='dataframe'> <caption>A data.table: 1 x 8</caption> <thead> <tr><th scope=col>species</th><th scope=col>island</th><th scope=col>sex</th><th scope=col>PC1</th><th scope=col>PC2</th><th scope=col>PC3</th><th scope=col>PC4</th><th scope=col>PC5</th></tr> <tr><th scope=col><fct></th><th scope=col><fct></th><th scope=col><fct></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>Adelie</td><td>Dream</td><td>male</td><td>-307.1238</td><td>-1.959404</td><td>-1.300082</td><td>0.8445978</td><td>-1.072759</td></tr> </tbody> </table>

Graph：PipeOp网络

PipeOp代表机器学习管道中的各个计算步骤，
这些管道本身由 Graph 对象定义
- Graph 是 PipeOp 的集合，带有引导数据流的边（edge）
构建Graph最便捷的方式是使用%>>%运算符（读作“双箭头”）连接一系列PipeOp
- 给定两个PipeOp时，该运算符会创建一个Graph，
  先执行左边的PipeOp，再执行右边的
- 还可用于连接Graph与PipeOp，或连接另一个Graph
以下示例使用po('mutate')为任务添加一个新特征，
然后使用po('scale')对所有数值特征进行缩放和中心化

# 构建`PipeOpMutate`
po_mutate <- po(
 'mutate',
 mutation = list(bill_ratio = ~ bill_length / bill_depth)
)
# 构建`PipeOpScale`
po_scale <- po('scale')
# 连接两个`PipeOp`构建`Graph`
graph <- po_mutate %>>% po_scale
# 查看`Graph`
graph

Graph with 2 PipeOps:
     ID         State sccssors prdcssors
 <char>        <char>   <char>    <char>
 mutate <<UNTRAINED>>    scale          
  scale <<UNTRAINED>>             mutate

Graph$plot()可以进行管道可视化

graph$plot(horizontal = TRUE)

Graph$plot()打印组成的PipeOp的详情

graph$pipeops

$mutate
PipeOp: <mutate> (not trained)
values: <mutation=<list>, delete_originals=FALSE>
Input channels <name [train type, predict type]>:
  input [Task,Task]
Output channels <name [train type, predict type]>:
  output [Task,Task]

$scale
PipeOp: <scale> (not trained)
values: <robust=FALSE>
Input channels <name [train type, predict type]>:
  input [Task,Task]
Output channels <name [train type, predict type]>:
  output [Task,Task]

Graph$edges字段可用于访问边
- 它返回一个data.table，
  列出了沿每条边流动的数据的源（src_id，src_channel）和
  目标（dst_id，dst_channel）

graph$edges

<table class='dataframe'> <caption>A data.table: 1 x 4</caption> <thead> <tr><th scope=col>src_id</th><th scope=col>src_channel</th><th scope=col>dst_id</th><th scope=col>dst_channel</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><td>mutate</td><td>output</td><td>scale</td><td>input</td></tr> </tbody> </table>

除了使用 %>>%，还可以使用 $add_pipeop() 和 $add_edge() 方法
显式创建一个 Graph，以创建 PipeOp 以及连接它们的边

graph <- Graph$new()$
 add_pipeop(po_mutate)$
 add_pipeop(po_scale)$
 add_edge('mutate', 'scale')
graph

Graph with 2 PipeOps:
     ID         State sccssors prdcssors
 <char>        <char>   <char>    <char>
 mutate <<UNTRAINED>>    scale          
  scale <<UNTRAINED>>             mutate

构建完成后，Graph 可以像 Learner 一样，
通过调用 $train() 和 $predict() 来使用
- 不过在训练和预测过程中，它仍然输出一个 list

result <- graph$train(tsk_small)
result

$scale.output

[36m--[39m [1m[34m<TaskClassif>[39m (333x9): Palmer Penguins[22m [36m--------------------------------------[39m
* Target: species
* Target classes: Adelie (44%), Gentoo (36%), Chinstrap (20%)
* Properties: multiclass
* Features (8):
  * dbl (6): bill_depth, bill_length, bill_ratio, body_mass, flipper_length,
  year
  * fct (2): island, sex

result[[1]]$data()[1:3]

<table class='dataframe'> <caption>A data.table: 3 x 9</caption> <thead> <tr><th scope=col>species</th><th scope=col>island</th><th scope=col>sex</th><th scope=col>bill_depth</th><th scope=col>bill_length</th><th scope=col>bill_ratio</th><th scope=col>body_mass</th><th scope=col>flipper_length</th><th scope=col>year</th></tr> <tr><th scope=col><fct></th><th scope=col><fct></th><th scope=col><fct></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>Adelie</td><td>Torgersen</td><td>male </td><td>0.7795590</td><td>-0.8946955</td><td>-1.0421499</td><td>-0.5676206</td><td>-1.4246077</td><td>-1.281813</td></tr> <tr><td>Adelie</td><td>Torgersen</td><td>female</td><td>0.1194043</td><td>-0.8215515</td><td>-0.6804365</td><td>-0.5055254</td><td>-1.0678666</td><td>-1.281813</td></tr> <tr><td>Adelie</td><td>Torgersen</td><td>female</td><td>0.4240910</td><td>-0.6752636</td><td>-0.7434640</td><td>-1.1885721</td><td>-0.4257325</td><td>-1.281813</td></tr> </tbody> </table>

result <- graph$predict(tsk_onepenguin)
result[[1]]$head()

<table class='dataframe'> <caption>A data.table: 1 x 9</caption> <thead> <tr><th scope=col>species</th><th scope=col>island</th><th scope=col>sex</th><th scope=col>bill_depth</th><th scope=col>bill_length</th><th scope=col>bill_ratio</th><th scope=col>body_mass</th><th scope=col>flipper_length</th><th scope=col>year</th></tr> <tr><th scope=col><fct></th><th scope=col><fct></th><th scope=col><fct></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>Adelie</td><td>Dream</td><td>male</td><td>0.6272156</td><td>-0.5838337</td><td>-0.7868552</td><td>-0.3813351</td><td>-0.4257325</td><td>-1.281813</td></tr> </tbody> </table>

顺序学习器管道

简介

mlr3pipelines最常见的应用是用它来执行预处理任务，
如缺失值插补或因子编码，
然后将处理后的数据输入到Learner中
此工作流程的Graph在训练期间对数据进行操作并拟合Learner模型，
以确保在预测阶段以相同的方式处理数据
下图表示顺序学习器管道内训练和预测过程的概念化
- 在训练过程中（顶行），数据通过预处理算子，
  每个算子都会修改数据并创建一个$state，
  最后，学习器接收数据并创建一个模型
- 在预测过程中（底行），数据同样由预处理算子进行转换，
  在此过程中使用它们各自的$state（灰色框）信息；
  然后，学习器接收与训练期间所见数据格式相同的数据，并进行预测

将`Learner`转换为`PipeOp`，将`Graph`转换为`Learner`

Learner可以通过as_pipeop()转换为PipeOp
使用%>>%时无需手动转换，
仅当需要把单独的Learner转换为Graph时，
需要事先转换成PipeOp过渡
- 见下方例子：

# Learner被串起来的例子
lrn_logreg <- lrn('classif.log_reg')
graph <- po('imputesample') %>>% lrn_logreg
graph$plot(horizontal = TRUE)

若要将Graph作为具有相同接口的Learner使用，
可以使用as_learner()将其包装在一个GraphLearner对象中，
然后，该Graph就可以像其他任何Learner一样使用
下面例子中分别建立两种Graph并进行benchmark比较
- 重采样插补的glrn_sample
- 众数插补的glrn_mode

# 将两个`Graph`转换为`Learner`
glrn_sample <- as_learner(graph)
glrn_mode <- as_learner(po('imputemode') %>>% lrn_logreg)

即使转换成了GraphLearner类，
依然可以使用GraphLearner$plot(horizontal = TRUE)
对Graph可视化

glrn_mode$plot(horizontal = TRUE)

转化为GraphLearner后可以和普通的Learner一样
传递到benchmark()中进行比较
- 在下例中可以看出：

# 创建一个benchmark矩阵
design <- benchmark_grid(
 tsk('pima'), 
 list(glrn_sample, glrn_mode),
 rsmp('cv', folds = 3)
)
# 执行benchmark比较
bmr <- benchmark(design)
# 储存聚合结果
aggr <- bmr$aggregate()[, .(learner_id, classif.ce)]
# 查看结果
aggr

<table class='dataframe'> <caption>A bmr_aggregate: 2 x 2</caption> <thead> <tr><th scope=col>learner_id</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>imputesample.classif.log_reg</td><td>0.2330729</td></tr> <tr><td>imputemode.classif.log_reg </td><td>0.2278646</td></tr> </tbody> </table>

检查`Graph`

如果相检查管道和数据流以进一步了解你的管道或对其进行调试
- 首先需要将 $keep_results 标签设置为 TRUE，
  以便保留中间结果，默认情况下该标志是关闭的，以节省内存

# 可以在`as_learner()`前设定
graph$keep_results <- TRUE
glrn_sample$graph_model$keep_results <- TRUE
glrn_sample$train(tsk('pima'))

GraphLearner中的$graph_model字段包含了Graph
- 因此可以对GraphLearner$graph_model进行所有和Graph相同的操作
下列例子中可以查看全部中间结果

imputesample_output <- glrn_sample$
 graph_model$
 pipeops$
 imputesample$
 .result
imputesample_output[[1]]$missings()

diabetes      age pedigree pregnant  glucose  insulin     mass pressure 
       0        0        0        0        0        0        0        0 
 triceps 
       0

可以通过Graph$$pipeops访问底层Learner
- 下面分别显示了每一级的类，方便了解这些包装关系

pipeop_logreg <- glrn_sample$ # GraphLearner
 graph_model$ # Graph
 pipeops$ # PipeOp
 classif.log_reg # PipeOpLearner
learner_logreg <- pipeop_logreg$learner_model # LearnerClassifLogReg
learner_logreg

到这里不妨我们再重新按顺序构建一遍，
并看看它们的类

# 1
lrn('classif.log_reg') %>% class()
# 2
lrn('classif.log_reg') %>% po() %>% class()
# 3
po('imputesample') %>>% {lrn('classif.log_reg') %>% po()} %>% class()
# 4
po('imputesample') %>>% {lrn('classif.log_reg') %>% po()} %>% as_learner() %>% class()

'LearnerClassifLogReg''LearnerClassif''Learner''R6'

'PipeOpLearner''PipeOp''R6'

'Graph''R6'

'GraphLearner''Learner''R6'

配置管道超参数

PipeOp的超参数集中收集在图的 $param_set 中
可以使用完全一样的PipeOp，前提是设置id，以避免参数名冲突

graph <- po('scale', center = FALSE, scale = TRUE, id = 'scale') %>>%
  po('scale', center = TRUE, scale = FALSE, id = 'center') %>>%
  lrn('classif.rpart', cp = 1)
graph$param_set$values

注意：
- 如果你需要更改 Graph 中PipeOp的ID，
  则使用Graph类中的$set_names方法
  - some_graph$set_names(old = 'old_name', new = 'new_name')
不可通过
graph$pipeops$<old_id>$id <- <new_id>更改PipeOp的ID
- 因为这只会更改PipeOp对自身ID的记录，而不会更改Graph的记录，这将导致错误

$scale.center
FALSE
$scale.scale
TRUE
$scale.robust
FALSE
$center.center
TRUE
$center.scale
FALSE
$center.robust
FALSE
$classif.rpart.cp
1
$classif.rpart.xval
0

无论将管道视为Graph还是GraphLearner，超参数的更新和访问方式都是相同的

# `Graph`两种方法
graph$param_set$values$classif.rpart.maxdepth <- 6
graph$param_set$values
graph$param_set$set_values(classif.rpart.maxdepth = 1)
graph$param_set$values

# 转换成`GraphLearner`
graph_learner <- as_learner(graph)

# `GraphLearner`依然两种方法
graph_learner$param_set$values$classif.rpart.maxdepth <- 3
graph_learner$param_set$values
graph_learner$param_set$set_values(classif.rpart.maxdepth = 2)
graph_learner$param_set$values

非顺序管道及调优

简单演示

%>>%能够将PipeOp排列成线性的Graph
gunion()则可以将
PipeOP，Graph或它们的组合
拼接成可以并行的Graph

# library(mlr3pipelines)

# 简单的并联
# 首先用scale开头
graph <- po('scale', center = TRUE, scale = FALSE) %>>%
    # `gunion()`接受`list`的传递
    gunion(
     # `list`内部则是要并联的管道元件
        list(
         # 辨别某特征是否存在缺失值
            po('missind'), 
            # 对缺失值用中位数填充
            po('imputemedian') 
        )
    ) %>>%
    # 最后再串联一个管道元件
    # 合并分支输出的结果
    po('featureunion')

graph$plot(horizontal = TRUE)

Graph$edges依然可以查看输入与输出的表格

graph$edges

<table class='dataframe'> <caption>A data.table: 4 x 4</caption> <thead> <tr><th scope=col>src_id</th><th scope=col>src_channel</th><th scope=col>dst_id</th><th scope=col>dst_channel</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><td>scale </td><td>output</td><td>missind </td><td>input</td></tr> <tr><td>scale </td><td>output</td><td>imputemedian</td><td>input</td></tr> <tr><td>missind </td><td>output</td><td>featureunion</td><td>... </td></tr> <tr><td>imputemedian</td><td>output</td><td>featureunion</td><td>... </td></tr> </tbody> </table>

用刚刚构建的graph作用于tsk('pima')的前三行，
可以看到它如何估算缺失数据，并添加一个列来指示哪些值是缺失的

tsk_pima_head <- tsk('pima')$filter(1:3)
tsk_pima_head$data(cols = c('diabetes', 'insulin', 'triceps'))

result <- graph$train(tsk_pima_head)[[1]]
result$data(
 cols = c(
  'diabetes', 
  'insulin', 
  'missing_insulin', 
  'triceps',
  'missing_triceps'
  )
)

<table class='dataframe'> <caption>A data.table: 3 x 3</caption> <thead> <tr><th scope=col>diabetes</th><th scope=col>insulin</th><th scope=col>triceps</th></tr> <tr><th scope=col><fct></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>pos</td><td>NA</td><td>35</td></tr> <tr><td>neg</td><td>NA</td><td>29</td></tr> <tr><td>pos</td><td>NA</td><td>NA</td></tr> </tbody> </table>

<table class='dataframe'> <caption>A data.table: 3 x 5</caption> <thead> <tr><th scope=col>diabetes</th><th scope=col>insulin</th><th scope=col>missing_insulin</th><th scope=col>triceps</th><th scope=col>missing_triceps</th></tr> <tr><th scope=col><fct></th><th scope=col><dbl></th><th scope=col><fct></th><th scope=col><dbl></th><th scope=col><fct></th></tr> </thead> <tbody> <tr><td>pos</td><td>0</td><td>missing</td><td> 3</td><td>present</td></tr> <tr><td>neg</td><td>0</td><td>missing</td><td>-3</td><td>present</td></tr> <tr><td>pos</td><td>0</td><td>missing</td><td> 0</td><td>missing</td></tr> </tbody> </table>

选择器与并行管道

下图展现了两种操作思路：
- 第一个：先对一部分列进行操作1，再对剩余部分进行操作2
- 第二个：对一部分列进行操作1和对剩余部分进行操作2是并行的，
  最后用po('featureunion')进行整合

上述用了Selector系列的选择器函数
- selector_grep()：
  正则表达式匹配列
- selector_name：
  选择和名字完全匹配的列
- selector_type()：
  列类型匹配列
- selector_intersect：
  选择交集
- selector_union()：
  选择并集
- selector_setdiff()：
  选择差集
- selector_invert()：
  选择补集
- selector_missing()：
  选择有缺失值的列
- selector_cardinality_greater_than()：
  选择基数大雨给定阈值的分类特征
- selector_all()：
  选择所有列
- selector_none()：
  不选择任何列
下面是不使用Task$select()，
而是select_grep()和select_invert()的方便操作

# tsk('penguins_simple')在`mlr3data`包中
# library(mlr3data)

# 建立两个选择器：
# 所有开头为`bill`
sel_bill <- selector_grep('^bill')
# 上面选择器的补集
sel_not_bill <- selector_invert(sel_bill)

# 建立一个`Graph`：
# 先对开头不为`bill`的列缩放
graph <- po('scale', affect_columns = sel_not_bill) %>>% 
 # 再对开头为`bill`的列进行PCA
 po('pca', affect_columns = sel_bill)

# 对`Task`运行`Graph`
result <- graph$train(tsk('penguins'))

# 查看前三行结果
result[[1]]$data()[1:3, ]

<table class='dataframe'> <caption>A data.table: 3 x 11</caption> <thead> <tr><th scope=col>species</th><th scope=col>PC1</th><th scope=col>PC2</th><th scope=col>body_mass</th><th scope=col>flipper_length</th><th scope=col>island.Biscoe</th><th scope=col>island.Dream</th><th scope=col>island.Torgersen</th><th scope=col>sex.female</th><th scope=col>sex.male</th><th scope=col>year</th></tr> <tr><th scope=col><fct></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>Adelie</td><td>-5.014734</td><td> 1.0716828</td><td>-0.5676206</td><td>-1.4246077</td><td>-0.977724</td><td>-0.7641697</td><td>2.463094</td><td>-0.9895421</td><td> 0.9895421</td><td>-1.281813</td></tr> <tr><td>Adelie</td><td>-4.495124</td><td>-0.1852998</td><td>-0.5055254</td><td>-1.0678666</td><td>-0.977724</td><td>-0.7641697</td><td>2.463094</td><td> 1.0075337</td><td>-1.0075337</td><td>-1.281813</td></tr> <tr><td>Adelie</td><td>-3.754628</td><td> 0.4867612</td><td>-1.1885721</td><td>-0.4257325</td><td>-0.977724</td><td>-0.7641697</td><td>2.463094</td><td> 1.0075337</td><td>-1.0075337</td><td>-1.281813</td></tr> </tbody> </table>

对于上面的串联Graph而言，如果顺序弄混，则会导致结果出现重大错误
为了避免这种情况发生，更好的是建立一个并联Graph

po_select_bill <- po(
 'select', 
 id = 's_bill', 
 selector = sel_bill
)
po_select_not_bill <- po(
 'select', 
 id = 's_notbill',
 selector = sel_not_bill
)

path_pca <-  po_select_bill %>>% po('pca')
path_scale <- po_select_not_bill %>>% po('scale')

graph <- gunion(list(path_pca, path_scale)) %>>% po('featureunion')

# 可视化`Graph`流程
graph$plot(horizontal = TRUE)

使用po('nop')表示不进行任何操作

graph <- gunion(list(
 po_select_bill %>>% po('scale'),
 po_select_not_bill %>>% po('nop')
)) %>>% po('featureunion')

graph$plot(horizontal = TRUE)

graph$train(tsk('penguins_simple'))[[1]]$data()[1:3,]

<table class='dataframe'> <caption>A data.table: 3 x 11</caption> <thead> <tr><th scope=col>species</th><th scope=col>bill_depth</th><th scope=col>bill_length</th><th scope=col>body_mass</th><th scope=col>flipper_length</th><th scope=col>island.Biscoe</th><th scope=col>island.Dream</th><th scope=col>island.Torgersen</th><th scope=col>sex.female</th><th scope=col>sex.male</th><th scope=col>year</th></tr> <tr><th scope=col><fct></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><int></th><th scope=col><int></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><int></th></tr> </thead> <tbody> <tr><td>Adelie</td><td>0.7795590</td><td>-0.8946955</td><td>3750</td><td>181</td><td>0</td><td>0</td><td>1</td><td>0</td><td>1</td><td>2007</td></tr> <tr><td>Adelie</td><td>0.1194043</td><td>-0.8215515</td><td>3800</td><td>186</td><td>0</td><td>0</td><td>1</td><td>1</td><td>0</td><td>2007</td></tr> <tr><td>Adelie</td><td>0.4240910</td><td>-0.6752636</td><td>3250</td><td>195</td><td>0</td><td>0</td><td>1</td><td>1</td><td>0</td><td>2007</td></tr> </tbody> </table>

常见模式与`ppl()`

由于大部分的机器学习的一些处理是共同的，
mlr3预设了一些管道
- ppl()可以快速调用
几种常用的
- ppl('bagging', graph)：装袋
  - 在mlr3pipelines中，
    装袋是指在不同的数据样本上多次运行graph，
    然后对结果取平均值的过程
- ppl('branch', graphs)：
  - 使用 PipeOpBranch 从给定的 graphs 中创建不同的路径分支，
    其中只有一个分支会被求值
- ppl('greplicate', graph, n)：
  - 创建一个 Graph，该图将 graph（也可以是单个 PipeOp）复制 n 次
  - 该管道通过向每个 PipeOp 添加后缀来避免ID冲突
- ppl('ovr', graph)：一对多分类
  - 用于将多分类任务转换为多个二分类任务，
    每个任务对应原始任务中的一个类别
  - 然后，这些任务由给定的 graph 进行评估，
    graph 应该是一个学习器
    （或包含一个能生成预测结果的学习器的管道）
  - 对二分类任务所做的预测将合并为原始任务所需的多分类预测
- ppl('robustify')：
  - 执行常见的预处理步骤，
    使任何 Task 都能与给定的 Learner 兼容
- ppl('stacking', base_learners, super_learner)：堆叠法
  - 是指将一个或多个模型（base_learners）的预测结果
    作为后续模型（super_learner）的特征的过程
- ppl('targettrafo', graph)：
  - 创建一个Graph，该Graph转换Task的预测目标，
    并确保在训练期间应用的任何变换
    （使用传递给targetmutate.trafo超参数的函数）
    在最终预测中被反转
    （使用传递给targetmutate.inverter超参数的函数）

例子

使用`greplicate`和`subsample`进行装袋（Bagging）

装袋法（源于“自助聚集”（bootstrapp aggregating））
- 基本思想即把多个预测器聚合成一个更强有力的单一预测器
- 对于回归任务，预测结果通常通过算术平均进行聚合；
  对于分类任务，则通过多数表决进行聚合
- 装袋法背后的潜在直觉是，
  对一组不稳定且多样（即仅弱相关）的预测器进行平均，
  可以降低总体预测的方差
- 每个学习器都在原始数据的不同随机样本上进行训练
下图表示了基本原理：
- 通过对数据进行独立子采样并拟合单个决策树学习器来执行装袋法的图
- 最终的预测结果由多数投票 PipeOp 汇总得出

下面手动构建一个bagging的Graph

# 建立一个`Graph`：
# 从样本中进行0.7比例的无放回采样
# 用采样后的样本训练rpart
gr_single_pred <- po('subsample', frac = 0.7) %>>% lrn('classif.rpart')

# 将`Graph``gr_single_pred`重复10次
gr_pred_set <- ppl('greplicate', graph = gr_single_pred, n = 10)

# 将`Graph``gr_pred_set`传递给`po('classifavg')
# 并输入`innum = 10`以传输重复10次的信息
gr_bagging <- gr_pred_set %>>% po('classifavg', innum = 10)

# 对最终的`Graph`可视化
gr_bagging$plot()

将刚构建的baggingGraph用于`tsk('sonar')
- 可以看出bagging比决策树效果好，
  但是差于随机森林

# 将`Graph`转换成`GraphLearner`
glrn_bagging <- as_learner(gr_bagging)
glrn_bagging$id <- 'bagging'

lrn_rpart <- lrn('classif.rpart')
# 将`glrn_bagging`，`lrn_rpart`, 
# 以及`lrn('classif.ranger')`进行benchmark比较
learners <- c(glrn_bagging, lrn_rpart, lrn('classif.ranger'))

# 进行benchmark比较
bmr <- benchmark(
 benchmark_grid(
  tsk('sonar'), 
  learners,
  rsmp('cv', folds = 3)
 )
)

# 查看整合后的学习器结果
bmr$aggregate()[, .(learner_id, classif.ce)]

<table class='dataframe'> <caption>A bmr_aggregate: 3 x 2</caption> <thead> <tr><th scope=col>learner_id</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>bagging </td><td>0.2404417</td></tr> <tr><td>classif.rpart </td><td>0.2979986</td></tr> <tr><td>classif.ranger</td><td>0.1878537</td></tr> </tbody> </table>

对于上面的bagging Graph 更简单的自动构建方法是用ppl('bagging', ...)
- collect_multiplicity：是否收集跨路径预测结果

ppl(
 'bagging', 
 rn('classif.rpart'),
 iterations = 10, frac = 0.7,
 averager = po(
  'classifavg', 
  collect_multiplicity = TRUE
 )
)

随机森林算法进行了特征变量的子采样
- 为了模拟这一个过程，可以进行如下管道设定

# 创建一个采样器
# 这里的采样器只是一个简单的函数：
# 从`Task`中特征变量中，
# 随机挑选特征变量数量的算术平方根个变量
selector_subsample <- function(task) {
 sample(
  task$feature_names, 
  sqrt(length(task$feature_names))
 )
}

# 创建一个bagging `Graph`
gr_bagging_quasi_rf <- ppl(
 'bagging',
 graph = po('select', selector = selector_subsample) %>>%
     lrn('classif.rpart', minsplit = 1),
 # 迭代100次
 iterations = 100,
 # 设置结果的整合方式
 averager = po('classifavg', collect_multiplicity = TRUE)
)

# 将重采样是否返回设定为TRUE
# 因此变成了自助法重采样
gr_bagging_quasi_rf$
 param_set$
 values$
 subsample.replace <- TRUE

# 将`Graph`转变为`GraphLearner`
glrn_quasi_rf <- as_learner(gr_bagging_quasi_rf)
# 设置一个唯一ID
glrn_quasi_rf$id <- 'quasi.rf'

# 进行benchmark比较
design <- benchmark_grid(
 tsks('sonar'),
 c(
  glrn_quasi_rf, 
  lrn('classif.ranger', num.trees = 100)
 ),
 rsmp('cv', folds = 5)
)
bmr <- benchmark(design)

# 查看聚合结果
bmr$aggregate()[, .(learner_id, classif.ce)]

<table class='dataframe'> <caption>A bmr_aggregate: 2 x 2</caption> <thead> <tr><th scope=col>learner_id</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>quasi.rf </td><td>0.1732869</td></tr> <tr><td>classif.ranger</td><td>0.1681765</td></tr> </tbody> </table>

使用`po(“learner_cv”)`进行堆叠

堆叠
- 将多个模型（通常称为0层模型）的预测结果作为后续模型（1层模型）的特征，
  而1层模型又会结合这些预测结果
一种简单的组合方式可以是线性模型（如果有许多0层模型，可能需要进行正则化），
因为0层模型的加权和通常是合理且足够好的
不过，也可以使用非线性的1层模型，
并且1层模型也有可能同时访问输入特征和0层模型的预测结果
从概念上讲，在mlr3中也可以构建超过两层的堆叠结构，
但在这里只局限于这种更简单的设置，因为它在实际应用中通常也表现良好

这里创建了3个学习器，并且通过连接CV重采样各自形成3个Graph

lrn_rpart <- lrn('classif.rpart', predict_type = 'prob')
po_rpart_cv <- po(
 'learner_cv', 
 learner = lrn_rpart,
 resampling.folds = 2, 
 id = 'rpart_cv'
)

lrn_knn <- lrn('classif.kknn', predict_type = 'prob')
po_knn_cv <- po(
 'learner_cv',
 learner = lrn_knn,
 resampling.folds = 2, 
 id = 'knn_cv'
)

lrn_glmnet <- lrn('classif.glmnet', predict_type = 'prob')
po_glmnet_cv <- po(
 'learner_cv',
 learner = lrn_glmnet,
 resampling.folds = 2, 
 id = 'glmnet_cv'
)

将上述3个Graph并联，并连接一个整合结果的PipeOp
将这个构成的Graph训练tsk('sonar')并查看结果

gr_level_0 <- gunion(list(po_rpart_cv, po_knn_cv, po_glmnet_cv))
gr_combined <- gr_level_0 %>>% po('featureunion')

# 由于`GraphLearner`接受和输出都是`list`
# 对于只有一个起点的输入而言输出也是只包含一个元素的`list`
# 因此用`list[[1]]`来调取
gr_combined$train(tsk('sonar'))[[1]]$head()

<table class='dataframe'> <caption>A data.table: 6 x 7</caption> <thead> <tr><th scope=col>Class</th><th scope=col>rpart_cv.prob.M</th><th scope=col>rpart_cv.prob.R</th><th scope=col>knn_cv.prob.M</th><th scope=col>knn_cv.prob.R</th><th scope=col>glmnet_cv.prob.M</th><th scope=col>glmnet_cv.prob.R</th></tr> <tr><th scope=col><fct></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>R</td><td>0.05555556</td><td>0.94444444</td><td>0.42308735</td><td>0.5769126</td><td>0.77722963</td><td>0.2227703659</td></tr> <tr><td>R</td><td>0.93333333</td><td>0.06666667</td><td>0.72902464</td><td>0.2709754</td><td>0.57270947</td><td>0.4272905324</td></tr> <tr><td>R</td><td>0.89473684</td><td>0.10526316</td><td>0.52294416</td><td>0.4770558</td><td>0.99908407</td><td>0.0009159289</td></tr> <tr><td>R</td><td>0.58333333</td><td>0.41666667</td><td>0.32588147</td><td>0.6741185</td><td>0.46964796</td><td>0.5303520359</td></tr> <tr><td>R</td><td>0.41666667</td><td>0.58333333</td><td>0.58797952</td><td>0.4120205</td><td>0.39418320</td><td>0.6058167974</td></tr> <tr><td>R</td><td>0.41666667</td><td>0.58333333</td><td>0.07610223</td><td>0.9238978</td><td>0.02457426</td><td>0.9754257401</td></tr> </tbody> </table>

由于这是一个二元分类的问题，只需要选择预测M或R即可
- 这里只选择预测M的概率以及结果

gr_stack <- gr_combined %>>%
  po('select', selector = selector_grep('\\.M$'))

连接1级学习器lrn('classif.log_reg')}，
并对Graph可视化

gr_stack <- gr_stack %>>% po('learner', lrn('classif.log_reg'))
gr_stack$plot(horizontal = TRUE)

Graph转换为GraphLearner，并用于训练tsk('sonar')，
再通过查看最终训练好的模型来检查0级学习器的权重
- 模型权重表明，K近邻算法（KNN）以最大的系数对预测结果影响最大

glrn_stack <- as_learner(gr_stack)
glrn_stack$train(tsk('sonar'))
glrn_stack$base_learner()$model

Call:  stats::glm(formula = form, family = 'binomial', data = data, 
    model = FALSE)

Coefficients:
     (Intercept)   rpart_cv.prob.M     knn_cv.prob.M  glmnet_cv.prob.M  
          -4.863             1.423             6.058             1.095  

Degrees of Freedom: 207 Total (i.e. Null);  204 Residual
Null Deviance:     287.4 
Residual Deviance: 144  AIC: 152

将各个模型与堆叠管道一起进行基准测试以验证0级学习器中KNN的效果最佳

glrn_stack$id <- 'stacking'

design <- benchmark_grid(
 tsk('sonar'),
 list(lrn_rpart, lrn_knn, lrn_glmnet, glrn_stack), 
 rsmp('repeated_cv')
)
bmr <- benchmark(design)

bmr$aggregate()[, .(learner_id, classif.ce)]

<table class='dataframe'> <caption>A bmr_aggregate: 4 x 2</caption> <thead> <tr><th scope=col>learner_id</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>classif.rpart </td><td>0.2884048</td></tr> <tr><td>classif.kknn </td><td>0.1413095</td></tr> <tr><td>classif.glmnet</td><td>0.2471429</td></tr> <tr><td>stacking </td><td>0.1296667</td></tr> </tbody> </table>

ppl('stacking', ...)可以快速自动创建上述的堆叠Graph

ppl(
 'stacking',
 base_learners = lrns(
  c(
   'classif.rpart', 
   'classif.kknn',
   'classif.glmnet')
  ),
 super_learner = lrn('classif.log_reg')
)

调优Graphs

可以进行2方面的调优工作：
- 用给定的学习器进行预处理，通过固定的，通常为顺序执行的管道进行调优
- 除了对管道的超参数调优以外，还要确定具体应将哪些PipeOp应用于数据
  - 组合算法选择与超参数优化
    （Combined Algorithm Selection and Hyperparameter optimization）
  - 通过创建分支（branching）或代理（proxy），
    可以方便地创建自己的微型自动化机器学习系统（mini AutoML systems），
    甚至可以针对特定任务进行优化

调优Graphs超参数

下面的例子中，我们要做的是：
- 先构建一个PCA -> KKNN的GraphLearner
- 再分别对PCA的rank.超参数和KKNN的k超参数进行调优

# 设置调优范围并构建`GraphLearner`
po_pca <- po('pca', rank. = to_tune(2, 20))
lrn_knn <- lrn('classif.kknn', k = to_tune(1, 32))
graph_learner <- as_learner(po_pca %>>% lrn_knn)

# 简单确认`GraphLearner`的参数设置情况
graph_learner$param_set$values

可以看到被标记的待调优超参数

$pca.rank.
Tuning over:
range [2, 20]


$classif.kknn.k
Tuning over:
range [1, 32]

接下来是熟悉的auto_tuner()构建一个预备调优的管道和一个不调优的管道，
通过benchmark比较两者性能的差异
- 最后结果可以看出调优的管道性能更好（有更低的交叉熵）

# 调优管道
glrn_tuned <- auto_tuner(
 tnr('random_search'), 
 graph_learner,
 rsmp('holdout'), 
 term_evals = 10
)
# 不调优管道
glrn_untuned <- po('pca') %>>% lrn('classif.kknn')

# Benchmark比较
design <- benchmark_grid(
 tsk('sonar'), 
 # 注意：
 # 这里的`glrn_tuned`是`autoTuner`和`Learner`类
 # `glrn_untuned`则是单纯的`Graph`
 # 依然可以作为`Learner`传递
 c(glrn_tuned, glrn_untuned),
 rsmp('cv', folds = 5))
benchmark(design)$aggregate()[, .(learner_id, classif.ce)]

<table class='dataframe'> <caption>A bmr_aggregate: 2 x 2</caption> <thead> <tr><th scope=col>learner_id</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>pca.classif.kknn.tuned</td><td>0.2062718</td></tr> <tr><td>pca.classif.kknn </td><td>0.2307782</td></tr> </tbody> </table>

使用`po('branch')`调整备选路径

如果只是单纯根据上面的流程对PCA参数进行调优，
是没有考虑调优后的PCA是否真的有利于构建后续模型

# 加载R包
# library(mlr3oml)

# 下载例子数据
otsk_mnist <- otsk(id = 3573)
# 创建`Task`，通过子集化减少运行本例子的工作量
tsk_mnist <- as_task(otsk_mnist)$
 filter(sample(70000, 1000))$
 select(otsk_mnist$feature_names[sample(700, 100)])

# 创建3个预处理管道名称：
# 无操作，PCA，Yeo-Johnson变换
# 注意：这里只是指定名称而已，类似于id
# 也可以叫A，B，C
paths <- c('nop', 'pca', 'yeojohnson')

# 构建一个分支管道
graph <- po(
 'branch', # 指定为'branch'
 paths, # 传递需要分支的管道
 id = 'brnchPO' # 设置管道id
) %>>%
 # 传递需要并联的管道
 gunion(
  # 记得按照上面名称的顺序
  list(
   # 无操作管道
      po('nop'),
      # PCA管道
      po('pca'),
      # Yeo-Johnson变换管道
      po('removeconstants', id = 'rm_const') %>>%
       po('yeojohnson', id = 'YJ')
  )
) %>>% 
 # 接触分支
 po('unbranch', paths, id = 'unbrnchPO')

# 对`Graph`可视化观察一下
graph$plot(horizontal = TRUE)

指定选定的管道的话，传递选用的管道名称到
Graph$param_set$values$brnchPO.selection即可
- 下例为使用PCA管道
- 可以看到结果是经过PCA降纬后的特征变量了

# 指定管道为PCA
graph$
 param_set$
 values$
 brnchPO.selection <- 'pca'
# 查看选择PCA后的`Graph`的训练结果
head(graph$train(tsk_mnist)[[1]]$feature_names)

使用ppl('branch', ...)可以快速简化上面流程

ppl('branch', graphs = pos(c('nop', 'pca', 'yeojohnson')))

构建一个后续包含学习器分支的Graph，并可视化

graph_learner <- graph %>>%
 ppl('branch', lrns(c('classif.rpart', 'classif.kknn')))

graph_learner$plot(horizontal = TRUE)

可以将selection看作超参数，用来选择最合适的管道

# `Graph`将`GraphLearner`
graph_learner <- as_learner(graph_learner)

# 设置待调优的超参数
graph_learner$
 param_set$
 set_values(
  # 第一个branch：预处理branch
  brnchPO.selection = to_tune(paths),
  # 第二个branch：学习器branch
  branch.selection = to_tune(
    c('classif.rpart', 'classif.kknn')
  ),
  # 单独设置有依赖关系的kknn的`k`
  # 因为`k`仅在选择'classif.kknn'时生效
  classif.kknn.k = to_tune(
   p_int(
    1, 32,
    depends = branch.selection == 'classif.kknn'
   )
  )
 )

# 进行实例调优
instance <- tune(
 tnr('grid_search'), 
 tsk_mnist, 
 graph_learner,
 rsmp('repeated_cv', folds = 3, repeats = 3), 
 msr('classif.ce')
)

# 查看结果
instance$archive$data[order(classif.ce)[1:5],
  .(brnchPO.selection, classif.kknn.k, branch.selection, classif.ce)]

<table class='dataframe'> <caption>A data.table: 5 x 4</caption> <thead> <tr><th scope=col>brnchPO.selection</th><th scope=col>classif.kknn.k</th><th scope=col>branch.selection</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><chr></th><th scope=col><int></th><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>yeojohnson</td><td>11</td><td>classif.kknn</td><td>0.2533272</td></tr> <tr><td>yeojohnson</td><td>18</td><td>classif.kknn</td><td>0.2556648</td></tr> <tr><td>yeojohnson</td><td>15</td><td>classif.kknn</td><td>0.2556658</td></tr> <tr><td>yeojohnson</td><td> 8</td><td>classif.kknn</td><td>0.2563362</td></tr> <tr><td>yeojohnson</td><td>22</td><td>classif.kknn</td><td>0.2600015</td></tr> </tbody> </table>

autoplot(instance)

使用`po(“proxy”)`进行调优

po('proxy')
- 一个元运算符，它执行存储在其 content 超参数中的操作
- 超参数可以是另一个 PipeOp 或 Graph
- 可用于调整和选择可以传递给此超参数的不同 PipeOp 或 Graph

首先要用po()'proxy')创建占位符 PipeOpProxy 运算符

graph_learner <- po('proxy', id = 'preproc') %>>%
 po('proxy', id = 'learner')
graph_learner <- as_learner(graph_learner)

超参数content需要传入p_fct() 内容为一组带评估的离散元素
对于复杂的学习器而言，不能直接对代理管道的内部的学习器超参数直接调优
- 需要对学习器进行调优，因此要创建一个上层的超参数进行调优，
  再把调优过的上层超参数传递给下层学习器里的超参数

# -------预处理管道
# `p_fct()`创建`content`
preproc.content <- p_fct(
 list(
  nop = po('nop'),
  pca = po('pca'),
  yeojohnson = po('removeconstants') %>>% po('yeojohnson')
 )
)

# -------学习器管道
# `p_fct()`创建`content`
learner.content <- p_fct(
 list(
     classif.rpart = lrn('classif.rpart'),
     classif.kknn = lrn('classif.kknn')
 )
)
# 创建上层的超参数传递规则
trafo <- function(x, param_set) {
 if (!is.null(x$classif.kknn.k)) {
  # `$clone(deep = TRUE)`就是python的`.deepcopy()`
  # 一定要用深度复制，不然会修改掉原有`Learner`的超参数
  x$learner.content = x$learner.content$clone(deep = TRUE)
  # 将`classif.kknn.k`传递给原本KKNN学习器的`k`
  x$learner.content$param_set$values$k = x$classif.kknn.k
  # 清空`classif.kknn.k`
  x$classif.kknn.k = NULL
    }
    return(x)
}

# 创建搜索空间并将传递规则包装进去
search_space <- ps(
 preproc.content = preproc.content,
 learner.content = learner.content,
 # tune KKNN parameter as normal
 classif.kknn.k = p_int(
  1, 32,
  depends = learner.content == 'classif.kknn'
 ),
 .extra_trafo = trafo
)

将上面的构建用tune()包装并进行实例调优

# 实例调优
instance <- tune(
 tnr('grid_search'), 
 tsk_mnist, 
 graph_learner,
 rsmp('repeated_cv', folds = 3, repeats = 3), 
 msr('classif.ce'),
 search_space = search_space
)

# 查看结果
as.data.table(instance$result)[,
 .(preproc.content,
 classif.kknn.k = x_domain[[1]]$learner.content$param_set$values$k,
 learner.content, classif.ce)
]

<table class='dataframe'> <caption>A data.table: 1 x 4</caption> <thead> <tr><th scope=col>preproc.content</th><th scope=col>classif.kknn.k</th><th scope=col>learner.content</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><chr></th><th scope=col><int></th><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>yeojohnson</td><td>11</td><td>classif.kknn</td><td>0.2583492</td></tr> </tbody> </table>

关于这里$clone(deep = TRUE)的用法，可以简单看看这个例子
- 修改lrn.clone的param_set也会导致lrn被修改
- 原因就是浅拷贝了lrn而没有复制lrn内部镶嵌的数据，
  导致表层虽然被复制，当内部镶嵌的数据依然指向lrn的内部镶嵌数据
  - 意即：lrn.clone内部镶嵌的地址和lrn相同，
    内部数据并非复制，而是引用

lrn <- lrn('classif.rpart')
# Output 1
lrn$param_set

lrn.clone <- lrn$clone()
lrn.clone$param_set$set_values(cp = 0.5)

# Output 2
lrn.clone$param_set

# Output 3
lrn$param_set

<ParamSet(10)>
                id    class lower upper nlevels        default  value
            <char>   <char> <num> <num>   <num>         <list> <list>
 1:             cp ParamDbl     0     1     Inf           0.01 [NULL]
 2:     keep_model ParamLgl    NA    NA       2          FALSE [NULL]
 3:     maxcompete ParamInt     0   Inf     Inf              4 [NULL]
 4:       maxdepth ParamInt     1    30      30             30 [NULL]
 5:   maxsurrogate ParamInt     0   Inf     Inf              5 [NULL]
 6:      minbucket ParamInt     1   Inf     Inf <NoDefault[0]> [NULL]
 7:       minsplit ParamInt     1   Inf     Inf             20 [NULL]
 8: surrogatestyle ParamInt     0     1       2              0 [NULL]
 9:   usesurrogate ParamInt     0     2       3              2 [NULL]
10:           xval ParamInt     0   Inf     Inf             10      

0<ParamSet(10)>
                id    class lower upper nlevels        default  value
            <char>   <char> <num> <num>   <num>         <list> <list>
 1:             cp ParamDbl     0     1     Inf           0.01    0.5
 2:     keep_model ParamLgl    NA    NA       2          FALSE [NULL]
 3:     maxcompete ParamInt     0   Inf     Inf              4 [NULL]
 4:       maxdepth ParamInt     1    30      30             30 [NULL]
 5:   maxsurrogate ParamInt     0   Inf     Inf              5 [NULL]
 6:      minbucket ParamInt     1   Inf     Inf <NoDefault[0]> [NULL]
 7:       minsplit ParamInt     1   Inf     Inf             20 [NULL]
 8: surrogatestyle ParamInt     0     1       2              0 [NULL]
 9:   usesurrogate ParamInt     0     2       3              2 [NULL]
10:           xval ParamInt     0   Inf     Inf             10      

0<ParamSet(10)>
                id    class lower upper nlevels        default  value
            <char>   <char> <num> <num>   <num>         <list> <list>
 1:             cp ParamDbl     0     1     Inf           0.01    0.5
 2:     keep_model ParamLgl    NA    NA       2          FALSE [NULL]
 3:     maxcompete ParamInt     0   Inf     Inf              4 [NULL]
 4:       maxdepth ParamInt     1    30      30             30 [NULL]
 5:   maxsurrogate ParamInt     0   Inf     Inf              5 [NULL]
 6:      minbucket ParamInt     1   Inf     Inf <NoDefault[0]> [NULL]
 7:       minsplit ParamInt     1   Inf     Inf             20 [NULL]
 8: surrogatestyle ParamInt     0     1       2              0 [NULL]
 9:   usesurrogate ParamInt     0     2       3              2 [NULL]
10:           xval ParamInt     0   Inf     Inf             10      0

带子采样的超带算法

本例子中用SVM来建模

# 加载R包
# library(mlr3tuning)

# 构建一个待调优的SVM学习器
learner <- lrn(
 'classif.svm', 
 id = 'svm', 
 type = 'C-classification',
 kernel = 'radial', 
 cost  = to_tune(1e-5, 1e5, logscale = TRUE),
 gamma = to_tune(1e-5, 1e5, logscale = TRUE)
)

# 构建`GraphLearner`
graph_learner <- as_learner(
 po(
  'subsample', 
  frac = to_tune(
   # `tags = 'budget'`是传递给超带算法的标签
   # 告诉超带算法`frac`是保真度参数
   p_dbl(3^-3, 1, tags = 'budget')
  )
 ) %>>%
 learner
)

# 封装函数并设立回退学习器
graph_learner$encapsulate('evaluate', lrn('classif.featureless'))
graph_learner$timeout <- c(train = 30, predict = 30)

# 实例调优
instance <- tune(
 tnr('hyperband', eta = 3), 
 tsk('sonar'), 
 graph_learner,
 rsmp('cv', folds = 3), 
 msr('classif.ce')
)

# 查看结果
instance$result_x_domain

$subsample.frac
[1] 1

$svm.cost
[1] 48971.58

$svm.gamma
[1] 0.004148232

使用过滤管道进行特征选择

选择3个特征变量

# 加载R包
# library(mlr3filters)
# library(mlr3fselect)

# 创建`Task`
task_pen <- tsk('penguins')

# 创建连接过滤器和学习器的`Graph`
po_flt <- po(
 'filter', 
 filter = flt('information_gain'), 
 filter.nfeat = 3
)
graph <- po_flt %>>% po('learner', lrn('classif.rpart'))

# 先用`po_flt`训练`Task`，然后打印选择后的特征变量名
po('filter', filter = flt('information_gain'), filter.nfeat = 3)$
  train(list(task_pen))[[1]]$feature_names

'bill_depth''bill_length''flipper_length'

对变量选择的数量进行调优

# 对过滤器的特征数量标记调优
po_filter <- po(
 'filter', 
 filter = flt('information_gain'),
 filter.nfeat = to_tune(1, task_pen$ncol)
)

# 创建一个`GraphLearner`
graph <- as_learner(
 po_filter %>>% 
 po('learner', lrn('classif.rpart'))
)

# 实例调优
instance <- tune(
 tnr('random_search'), 
 task_pen, graph,
 rsmp('cv', folds = 3), 
 term_evals = 10
)

# 查看结果
instance$result

<table class='dataframe'> <caption>A data.table: 1 x 4</caption> <thead> <tr><th scope=col>information_gain.filter.nfeat</th><th scope=col>learner_param_vals</th><th scope=col>x_domain</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><int></th><th scope=col><list></th><th scope=col><list></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>8</td><td>0, 8</td><td>8</td><td>0.06676837</td></tr> </tbody> </table>

可视化每次迭代的交叉熵
- 虽然交叉熵最低的是选择8个变量，
  但事实上变量少的模型的交叉熵也不是非常高，而是几乎接近
  - 从易解释性上而言，可以不使用最佳结果，
    而是挑选更少的特征变量来建模

autoplot(instance)

预处理

示例数据

示例数据为ames_housing

ames <- mlr3data::ames_housing

head(ames)

<table class='dataframe'> <caption>A data.table: 6 x 82</caption> <thead> <tr><th scope=col>Sale_Price</th><th scope=col>Alley</th><th scope=col>Bedroom_AbvGr</th><th scope=col>Bldg_Type</th><th scope=col>Bsmt_Cond</th><th scope=col>Bsmt_Exposure</th><th scope=col>Bsmt_Full_Bath</th><th scope=col>Bsmt_Half_Bath</th><th scope=col>Bsmt_Qual</th><th scope=col>Bsmt_Unf_SF</th><th scope=col>...</th><th scope=col>Second_Flr_SF</th><th scope=col>Street</th><th scope=col>Three_season_porch</th><th scope=col>Total_Bsmt_SF</th><th scope=col>TotRms_AbvGrd</th><th scope=col>Utilities</th><th scope=col>Wood_Deck_SF</th><th scope=col>Year_Built</th><th scope=col>Year_Remod_Add</th><th scope=col>Year_Sold</th></tr> <tr><th scope=col><int></th><th scope=col><fct></th><th scope=col><int></th><th scope=col><fct></th><th scope=col><fct></th><th scope=col><fct></th><th scope=col><int></th><th scope=col><int></th><th scope=col><fct></th><th scope=col><int></th><th scope=col>...</th><th scope=col><int></th><th scope=col><fct></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><fct></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th></tr> </thead> <tbody> <tr><td>215000</td><td>NA</td><td>3</td><td>OneFam</td><td>Good </td><td>Gd</td><td>1</td><td>0</td><td>Typical</td><td> 441</td><td>...</td><td> 0</td><td>Pave</td><td>0</td><td>1080</td><td>7</td><td>AllPub</td><td>210</td><td>1960</td><td>1960</td><td>2010</td></tr> <tr><td>105000</td><td>NA</td><td>2</td><td>OneFam</td><td>Typical</td><td>No</td><td>0</td><td>0</td><td>Typical</td><td> 270</td><td>...</td><td> 0</td><td>Pave</td><td>0</td><td> 882</td><td>5</td><td>AllPub</td><td>140</td><td>1961</td><td>1961</td><td>2010</td></tr> <tr><td>172000</td><td>NA</td><td>3</td><td>OneFam</td><td>Typical</td><td>No</td><td>0</td><td>0</td><td>Typical</td><td> 406</td><td>...</td><td> 0</td><td>Pave</td><td>0</td><td>1329</td><td>6</td><td>AllPub</td><td>393</td><td>1958</td><td>1958</td><td>2010</td></tr> <tr><td>244000</td><td>NA</td><td>3</td><td>OneFam</td><td>Typical</td><td>No</td><td>1</td><td>0</td><td>Typical</td><td>1045</td><td>...</td><td> 0</td><td>Pave</td><td>0</td><td>2110</td><td>8</td><td>AllPub</td><td> 0</td><td>1968</td><td>1968</td><td>2010</td></tr> <tr><td>189900</td><td>NA</td><td>3</td><td>OneFam</td><td>Typical</td><td>No</td><td>0</td><td>0</td><td>Good </td><td> 137</td><td>...</td><td>701</td><td>Pave</td><td>0</td><td> 928</td><td>6</td><td>AllPub</td><td>212</td><td>1997</td><td>1998</td><td>2010</td></tr> <tr><td>195500</td><td>NA</td><td>3</td><td>OneFam</td><td>Typical</td><td>No</td><td>0</td><td>0</td><td>Typical</td><td> 324</td><td>...</td><td>678</td><td>Pave</td><td>0</td><td> 926</td><td>7</td><td>AllPub</td><td>360</td><td>1998</td><td>1998</td><td>2010</td></tr> </tbody> </table>

数据清洗

通过简单检查数据，可以发现几个问题：

分类仅一种（常量特征）

summary(ames$Misc_Feature_2)

Othr: 2930

数据完全一致

identical(ames$Condition_2, ames$Condition_3)

TRUE

尺度上数据相同

cor(ames$Lot_Area, ames$Lot_Area_m2)

对于上述特征，最好的方法就是直接删除它们
可以简单先标记出来

to_remove <- c('Lot_Area_m2', 'Condition_3', 'Misc_Feature_2')

除此以外还应该检查
- 是否有重复样本：ID列是否全部的值是唯一的
- 是否有缺失值：NA
- 是否有语义错误：负的Lot_Area
- 对于无法处理数值特征的学习器，
  应该将数值特征编码转换为分类特征

# 创建`Task`
tsk_ames <- as_task_regr(ames, target = 'Sale_Price', id = 'ames')
# 删除上述标记的有问题的特征变量
tsk_ames$select(setdiff(tsk_ames$feature_names, to_remove))

# 创建评估器
msr_mae <- msr('regr.mae')
# 创建重采样器
rsmp_cv3 <- rsmp('cv', folds = 3)
# 对需要重采样的`Task`构建重采样实例
rsmp_cv3$instantiate(tsk_ames)

# 创建一个无特征回归学习器，并对中位数进行预测
lrn_baseline <- lrn('regr.featureless', robust = TRUE) 
# 修改id名，以在后续流程中更容易识别
lrn_baseline$id <- 'Baseline' 
# 进行重采样
rr_baseline <- resample(tsk_ames, lrn_baseline, rsmp_cv3) 

# 获取整合结果
rr_baseline$aggregate(msr_mae)

regr.mae: 56067.172671583

因子编码

分类变量可以基于基数（cardinality）进行分组：
- 二元特征
  - 独热编码
- 低基数特征
  - 独热编码
  - 虚拟编码
    - 广义线性模型（GLM）
    - 加法模型（GAM）
- 高基数特征
  - 影响编码
    - 使用目标特征在分类特征和一个数值之间创建映射，
      该数值反映其在预测目标特征时的重要性
    - 步骤
      - 按分类特征对目标变量进行分组
      - 计算每个组中目标变量的均值
      - 计算目标变量的全局均值
      - 计算每个组的影响得分，
        即该组目标变量的均值与目标变量全局均值之间的差值
      - 用影响得分替换分类特征
    - 由于使用目标信息来计算影响分数，
      编码过程必须嵌入到交叉验证中，
      以避免训练数据和测试数据之间的信息泄露
  - 去除常量特征
  - 合并小类别
  - 分层
通常超过10个基数的可以被视为高基数特征

# 找出高基数特征
names(which(lengths(tsk_ames$levels()) > 10))
# 找出二元特征
names(which(lengths(tsk_ames$levels()) == 2))

'Exterior_1st''Exterior_2nd''MS_SubClass''Neighborhood'

'Alley''Central_Air''Street'

构建一个预处理的Graph，注意下面顺序

factor_pipeline <-
 # 去除常量特征
    po('removeconstants') %>>%
    # 合并罕见类别
 po(
  # 合并
  'collapsefactors', 
  # 设置对频率低于1%的类别进行合并
  no_collapse_above_prevalence = 0.01
 ) %>>%
 # 对高基数特征数值编码
 po(
  # 对满足指定条件的特征进行数值编码
  'encodeimpact',
  # 指定作用于基数>2的特征
  affect_columns = selector_cardinality_greater_than(10),
  # 设置识别id
  id = 'high_card_enc'
 ) %>>%
 # 独热编码
 po(
  # 指定处理为因子编码
  'encode', 
  # 指定为独热编码
  method = 'one-hot',
  # 指定作用于基数>2的特征
  affect_columns = selector_cardinality_greater_than(2),
  # 设置识别id
  id = 'low_card_enc'
 ) %>>%
 # 将二元特征哑变量处理
 po(
  # 指定处理为因子编码
  'encode', 
  # 省略因子中第一个级别的变量
  method = 'treatment',
  # 指定类型为因子的特征
  # 到这一步都已经转化为数值了，
  # 所以直接筛选因子即可
  affect_columns = selector_type('factor'), 
  # 设置识别id
  id = 'binary_enc'
 )

将上述预处理与仅进行独热编码预处理两种方式进行benchmark比较
- 可见上述预处理管道的平均绝对误差比仅进行独热编码预处理更好，
  因为平均绝对误差更小

# 构建xgboost学习器
lrn_xgb <- lrn('regr.xgboost', nrounds = 100)

# 将预处理管道与学习器连接并构建`GraphLearner`
glrn_xgb_impact <- as_learner(factor_pipeline %>>% lrn_xgb)
# 设置识别id
glrn_xgb_impact$id <- 'XGB_enc_impact'

# 将仅进行独热编码的管道与学习器连接并构建`GraphLearner`
glrn_xgb_one_hot <- as_learner(po('encode') %>>% lrn_xgb)
# 设置识别id
glrn_xgb_one_hot$id <- 'XGB_enc_onehot'

# benchmark比较
bmr <- benchmark(
 benchmark_grid(
  tsk_ames,
  c(lrn_baseline, glrn_xgb_impact, glrn_xgb_one_hot), 
  rsmp_cv3
 )
)

# 打印整合结果
bmr$aggregate(measure = msr_mae)[, .(learner_id, regr.mae)]

<table class='dataframe'> <caption>A bmr_aggregate: 3 x 2</caption> <thead> <tr><th scope=col>learner_id</th><th scope=col>regr.mae</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>Baseline </td><td>56089.88</td></tr> <tr><td>XGB_enc_impact</td><td>15962.13</td></tr> <tr><td>XGB_enc_onehot</td><td>16500.48</td></tr> </tbody> </table>

缺失值

几种插补方法
- po('imputemean')：均值插补
- po('imputemedian')：中位数插补
- po('imputemode')：众数插补
- po('imputehist')：通过直方图估算数值特征插补
- po('imputeoor')：
  .MISSING，范围外插补（Out of Range Imputation ）
  用低于最小值或高于最大值的常数值填补数值特征
下图为均值插补的示例

查看Task中包含缺失值的特征（）

names(which(tsk_ames$missings() > 0))

'Alley''BsmtFin_SF_1''BsmtFin_SF_2''BsmtFin_Type_1''BsmtFin_Type_2''Bsmt_Cond''Bsmt_Exposure''Bsmt_Full_Bath''Bsmt_Half_Bath''Bsmt_Qual''Bsmt_Unf_SF''Electrical''Fence''Fireplace_Qu''Garage_Area''Garage_Cars''Garage_Cond''Garage_Finish''Garage_Qual''Garage_Type''Garage_Yr_Blt''Lot_Frontage''Mas_Vnr_Area''Mas_Vnr_Type''Misc_Feature''Pool_QC''Total_Bsmt_SF'

impute_hist <- list(
 # 跟踪缺失值
 po(
  # 对缺失值标记为1，否则为0
  'missind', 
  # 对数据里的整数型变量生成缺失值指示变量
  type = 'integer',
  # 选择整数列
  affect_columns = selector_type('integer')
 ),
 # 直方图插补
 po(
  # 选择为直方图插补
  'imputehist', 
  # 选择整数列
  affect_columns = selector_type('integer')
 )
) %>>%
 # 特征合并
 po('featureunion') %>>%
 # 范围外插补
 po(
  # 选择范围外插补
  'imputeoor', 
  # 选择因子列
  affect_columns = selector_type('factor')
 )

# 可视化一下`Graph`
impute_hist$plot(horizontal = TRUE)

通过benchmark比较上述管道和纯imputeoor方法插补的模型的性能差异

# 用上面的管道进行插补并连接随机森林
glrn_rf_impute_hist <- as_learner(impute_hist %>>% lrn('regr.ranger'))
glrn_rf_impute_hist$id <- 'RF_imp_Hist'

# 仅用imputeoor方法插补并连接随机森林
glrn_rf_impute_oor <- as_learner(po('imputeoor') %>>% lrn('regr.ranger'))
glrn_rf_impute_oor$id <- 'RF_imp_OOR'

# 进行两者的benchmark比较
design <- benchmark_grid(
 tsk_ames,
 c(glrn_rf_impute_hist, glrn_rf_impute_oor), 
 rsmp_cv3
)

# 这里代码有问题，会报错
# 以下为官网给出的结果
bmr_new <- benchmark(design)

# 查看结果
bmr$combine(bmr_new)
bmr$aggregate(measure = msr_mae)[, .(learner_id, regr.mae)]

       learner_id regr.mae
1:       Baseline    56056
2: XGB_enc_impact    16068
3: XGB_enc_onehot    16098
4:    RF_imp_Hist    16400
5:     RF_imp_OOR    16395

管道稳健化

ppl('robustify')包含以下的内容：
- po('removeconstants')：
  移除常量特征
- po('colapply')：
  字符和序号特征编码为分类特征，
  日期/时间特征编码为数值特征
- po('imputehist')：
  数值特征通过直方图采样进行插补
- po('imputesample')：
  逻辑特征通过从经验分布中采样进行插补，
  这仅影响 $predict() 步骤
- po('missind')：
  为估算的数值变量和逻辑变量添加缺失数据指示符
- po('imputeoor')：
  分类特征的缺失值用一个新的类别进行编码
- po('fixfactors')：
  修正分类特征的水平，
  以便在预测和训练期间具有相同的水平（这可能涉及删除空因子水平）
- po('imputesample')：
  上一步中因删除类别而在分类特征中引入的缺失值，
  通过从经验分布中采样来进行插补
- po('collapsefactors')：
  分类特征的水平会被合并（从训练数据中最罕见的因素开始），
  直到水平数量少于某个特定数量，该数量由 max_cardinality 参数控制（保守默认值为 1000）
- po('encode')：
  分类特征进行独热编码
- po('removeconstants')：
  移除可能在先前步骤中创建的常量特征
ppl('robustify') 有可选参数 task 和 learner
- 如果提供了这些参数，
  那么生成的管道将被设置为专门处理给定的任务和学习器
- 例如，如果学习器具有 'missings' 属性，
  或者如果任务中一开始就没有缺失值，
  它将不会插补缺失值
这里用线性回归为例子

# 构建一个`GraphLearner`并命名id
glrn_lm_robust <- as_learner(ppl('robustify') %>>% lrn('regr.lm'))
glrn_lm_robust$id <- 'lm_robust'

# benchmark比较
bmr_new <- benchmark(
 benchmark_grid(
  tsk_ames, 
  glrn_lm_robust,  
  rsmp_cv3
 )
)
# 新管道结果与之前的bmr结果合并
bmr$combine(bmr_new)
# 获取整合结果
bmr$aggregate(measure = msr_mae)[, .(learner_id, regr.mae)]

<table class='dataframe'> <caption>A bmr_aggregate: 4 x 2</caption> <thead> <tr><th scope=col>learner_id</th><th scope=col>regr.mae</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>Baseline </td><td>56159.11</td></tr> <tr><td>XGB_enc_impact</td><td>15959.01</td></tr> <tr><td>XGB_enc_onehot</td><td>16374.55</td></tr> <tr><td>lm_robust </td><td>16139.08</td></tr> </tbody> </table>

转换特征和目标

对特征和目标进行简单的变换，对于某些学习器可能是有益的
- 对目标进行对数变换有助于使分布更加对称，并有助于减少异常值的影响
- 对有偏态的特征进行对数变换也有助于降低异常值的影响
下面代码绘制了ames数据集中目标的分布，然后绘制了经过对数变换后的目标分布对变量取对数使分布更加对称，异常值也更少。

# 加载合并plot的R包
# library(patchwork)

# 创建一个用于对数转换的
log_ames <- ames
# 对`Sale_Price`进行对数转换
log_ames[, logSalePrice := log(Sale_Price)]
# 绘图
autoplot(as_task_regr(log_ames, target = 'Sale_Price')) +
 autoplot(as_task_regr(log_ames, target = 'logSalePrice'))

手动进行简单的对数转换

# 用随机数创建示例数据
df <- data.table(x = runif(5), y = runif(5, 10, 20))
df

# 对y进行对数转换
df[, y := log(y)]
df$y

# 用回归模型拟合数据后进行预测
yhat = predict(lm(y ~ x, df), df)
yhat

exp(yhat)

<table class='dataframe'> <caption>A data.table: 5 x 2</caption> <thead> <tr><th scope=col>x</th><th scope=col>y</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>0.16287878</td><td>16.01323</td></tr> <tr><td>0.17030617</td><td>13.71607</td></tr> <tr><td>0.03883123</td><td>19.62250</td></tr> <tr><td>0.23552246</td><td>10.14073</td></tr> <tr><td>0.67070117</td><td>13.95870</td></tr> </tbody> </table>

       1        2        3        4        5 
2.695238 2.692759 2.736655 2.670984 2.525687 

       1        2        3        4        5 
14.80905 14.77237 15.43527 14.45419 12.49948

管道ppl('targettrafo')可以在重采样和benchmark比较时，
简单地将数据转换嵌入进去
- 只需要指定2个参数即可
  - targetmutate.trafo：
    用于在训练期间对目标应用变换
  - targetmutate.inverter：
    用于在预测期间应用变换以反转原始变换
也就是说，在训练和预测时都用转换后的数据，
但是在返回结果的时候是将数据反转回来的

glrn_log_lm_robust <- as_learner(
 ppl(
  'targettrafo',
  graph = glrn_lm_robust,
  targetmutate.trafo = function(x) log(x),
  targetmutate.inverter = function(x){
   list(response = exp(x$response))
  }
 )
)
glrn_log_lm_robust$id <- 'lm_robust_logtrafo'

bmr_new <- benchmark(
 benchmark_grid(
  tsk_ames, 
  glrn_log_lm_robust,
  rsmp_cv3
 )
)

bmr$combine(bmr_new)
bmr$aggregate(measure = msr_mae)[, .(learner_id, regr.mae)]

<table class='dataframe'> <caption>A bmr_aggregate: 5 x 2</caption> <thead> <tr><th scope=col>learner_id</th><th scope=col>regr.mae</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>Baseline </td><td>56159.11</td></tr> <tr><td>XGB_enc_impact </td><td>15959.01</td></tr> <tr><td>XGB_enc_onehot </td><td>16374.55</td></tr> <tr><td>lm_robust </td><td>16139.41</td></tr> <tr><td>lm_robust_logtrafo</td><td>15501.52</td></tr> </tbody> </table>

函数特征提取

本节关注相互依赖的特征
- 因为这些特征单独存在没有用处，
  但组合起来会提供有用信息
下图中
- 变量x1、x2、x3是常规特征
- 变量xt1，…，xt365是函数特征

本节的示例数据
- 在这个数据集中，每一行代表一栋房屋，
  每个特征是给定时间厨房电器的总耗电量
- 耗电量以2分钟为间隔进行测量，因此产生了720个特征

energy_data <- mlr3data::energy_usage
head(energy_data)

<table class='dataframe'> <caption>A data.table: 6 x 720</caption> <thead> <tr><th scope=col>att1</th><th scope=col>att2</th><th scope=col>att3</th><th scope=col>att4</th><th scope=col>att5</th><th scope=col>att6</th><th scope=col>att7</th><th scope=col>att8</th><th scope=col>att9</th><th scope=col>att10</th><th scope=col>...</th><th scope=col>att711</th><th scope=col>att712</th><th scope=col>att713</th><th scope=col>att714</th><th scope=col>att715</th><th scope=col>att716</th><th scope=col>att717</th><th scope=col>att718</th><th scope=col>att719</th><th scope=col>att720</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col>...</th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>0.7152669</td><td>0.7152669</td><td>0.7152669</td><td>0.7152669</td><td>0.7152669</td><td>0.7152669</td><td>0.7152669</td><td>0.7152669</td><td>0.7152669</td><td>0.7152669</td><td>...</td><td>0.5711418</td><td>0.5051663</td><td>0.5011082</td><td>0.5711418</td><td>0.5051663</td><td> 0.5011082</td><td> 0.5711418</td><td> 0.5751999</td><td> 0.7112089</td><td> 0.7112089</td></tr> <tr><td>0.2670886</td><td>0.2670886</td><td>0.2670886</td><td>0.2670886</td><td>0.2670886</td><td>0.2670886</td><td>0.2670886</td><td>0.2670886</td><td>0.2670886</td><td>0.2670886</td><td>...</td><td>0.2670886</td><td>0.2670886</td><td>0.2670886</td><td>0.2670886</td><td>0.2670886</td><td> 0.2670886</td><td> 0.2670886</td><td> 0.2670886</td><td> 0.2670886</td><td> 0.2670886</td></tr> <tr><td>0.4635391</td><td>0.4635391</td><td>0.4796599</td><td>0.4635391</td><td>0.4635391</td><td>0.4635391</td><td>0.4796599</td><td>0.4635391</td><td>0.4635391</td><td>0.4796599</td><td>...</td><td>0.4796599</td><td>0.4635391</td><td>0.4635391</td><td>0.4635391</td><td>0.4796599</td><td> 0.4635391</td><td> 0.4635391</td><td> 0.4635391</td><td> 0.4796599</td><td> 0.4635391</td></tr> <tr><td>0.5989330</td><td>0.5989330</td><td>0.5989330</td><td>0.5026779</td><td>0.5989330</td><td>0.5989330</td><td>0.5989330</td><td>0.5026779</td><td>0.5989330</td><td>0.5989330</td><td>...</td><td>0.5989330</td><td>0.5989330</td><td>0.5026779</td><td>0.5989330</td><td>0.5989330</td><td> 0.5989330</td><td> 0.5026779</td><td> 0.5989330</td><td> 0.5989330</td><td> 0.5989330</td></tr> <tr><td>0.3445082</td><td>0.3445082</td><td>0.2493033</td><td>0.3445082</td><td>0.3445082</td><td>0.3445082</td><td>0.3445082</td><td>0.2493033</td><td>0.3445082</td><td>0.3445082</td><td>...</td><td>0.3445082</td><td>0.3445082</td><td>0.3445082</td><td>0.3445082</td><td>5.9254138</td><td>10.8020196</td><td>13.1427906</td><td>10.8020196</td><td>11.3593466</td><td>10.5233566</td></tr> <tr><td>0.3728099</td><td>0.2765897</td><td>0.2287661</td><td>0.2765897</td><td>0.3728099</td><td>0.2765897</td><td>0.2765897</td><td>0.3246998</td><td>0.2287661</td><td>0.2765897</td><td>...</td><td>0.3770731</td><td>0.3070396</td><td>0.3070396</td><td>0.3292495</td><td>0.3070396</td><td> 0.3070396</td><td> 0.3770731</td><td> 0.3770731</td><td> 0.4693166</td><td> 0.5171402</td></tr> </tbody> </table>

为了确认哪些特征是有用的，
先对第一个样本将2分钟间隔的连续时间点上的电力消费量做图
由于每个单独的特征无法提供有用的信息，
不可能将720个特征都用来建模，
也无法选择最佳的特征变量子集
可以提取曲线中有用的信息：
- 最大使用功率
- 总使用功率
- 峰值数量
- 其他曲线中的有用特征

# 加载绘图包
# library(ggplot2)

# 对2分钟间隔的连续时间点上的电力消费量做图
ggplot(
 data.frame(y = as.numeric(energy_data[1, ])),
    aes(y = y, x = 1:720)
) +
  geom_line() + 
  theme_minimal() +
  labs(x = '2-Minute Interval', y = 'Power Consumption')

编写一个R6类的函数用于提取
提取功耗的均值、最小值、最大值和方差，
然后删除原有的特征变量

PipeOpFuncExtract <- R6::R6Class(
 # 定义一个新类`PipeOpFuncExtract`
 'PipeOpFuncExtract',
 # 选择继承自`PipeOpTaskPreprocSimple`
 inherit = mlr3pipelines::PipeOpTaskPreprocSimple,
 # 定义一个私有方法
 private = list(
  # 定义函数用来变量提取
  .transform_dt = function(dt, levels) {
   # 选择所有'att'开头的特征变量
   ffeat_names <- paste0('att', 1:720)
   # 
   ffeats <- dt[, ..ffeat_names]
   # 提取功耗均值，最小值，最大值，反差
   dt[, energy_means := apply(ffeats, 1, mean)]
   dt[, energy_mins := apply(ffeats, 1, min)]
   dt[, energy_maxs := apply(ffeats, 1, max)]
   dt[, energy_vars := apply(ffeats, 1, var)]
   # 删除原有的特征变量
   dt[, (ffeat_names) := NULL]
   # 返回数据集
   return(dt)
  }
 )
)

测试PipeOp是否按预期工作

# 合并房屋和功耗数据集（原本是同一批样本）
tsk_ames_ext <- cbind(ames, energy_data)
# 创建`Task`，并更改id
tsk_ames_ext <- as_task_regr(tsk_ames_ext, 'Sale_Price', 'ames_ext')
# 移除那些有问题的特征（本章开头筛选出来的）
tsk_ames_ext$select(setdiff(tsk_ames_ext$feature_names, to_remove))

# 创建`PipeOpFuncExtract`类的实例并命名id
func_extractor <- PipeOpFuncExtract$new('energy_extract')
# 用创造的实例处理`tsk_ames_ext`
tsk_ames_ext <- func_extractor$train(list(tsk_ames_ext))[[1]]

# 查看第一个样本的
tsk_ames_ext$data(
 1,
 c('energy_means', 'energy_mins', 'energy_maxs', 'energy_vars')
)

<table class='dataframe'> <caption>A data.table: 1 x 4</caption> <thead> <tr><th scope=col>energy_means</th><th scope=col>energy_mins</th><th scope=col>energy_maxs</th><th scope=col>energy_vars</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>1.061558</td><td>0.01426834</td><td>21.97755</td><td>3.708473</td></tr> </tbody> </table>

接下来用benchmark比较这些管道的模型效果
- 通过添加合并后的电力消耗信息可以让模型拟合的更好

learners <- list(
 lrn_baseline, 
 lrn('regr.rpart'), 
 glrn_xgb_impact,
 # 这个是之前构建失败的，这里就没用它了
    # glrn_rf_impute_oor, 
    glrn_lm_robust, 
    glrn_log_lm_robust
)

bmr_final <- benchmark(
 benchmark_grid(
 c(tsk_ames_ext, tsk_ames), 
 learners,
 rsmp_cv3)
)

# 整合结果
perf <- bmr_final$aggregate(measure = msr_mae)
# 对整合的结果排序后打印
perf[order(learner_id, task_id), .(task_id, learner_id, regr.mae)]

<table class='dataframe'> <caption>A bmr_aggregate: 10 x 3</caption> <thead> <tr><th scope=col>task_id</th><th scope=col>learner_id</th><th scope=col>regr.mae</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>ames </td><td>Baseline </td><td>56159.11</td></tr> <tr><td>ames_ext</td><td>Baseline </td><td>56159.11</td></tr> <tr><td>ames </td><td>XGB_enc_impact </td><td>15959.01</td></tr> <tr><td>ames_ext</td><td>XGB_enc_impact </td><td>14537.98</td></tr> <tr><td>ames </td><td>lm_robust </td><td>16123.83</td></tr> <tr><td>ames_ext</td><td>lm_robust </td><td>14969.29</td></tr> <tr><td>ames </td><td>lm_robust_logtrafo</td><td>15510.96</td></tr> <tr><td>ames_ext</td><td>lm_robust_logtrafo</td><td>13903.53</td></tr> <tr><td>ames </td><td>regr.rpart </td><td>27979.09</td></tr> <tr><td>ames_ext</td><td>regr.rpart </td><td>27689.78</td></tr> </tbody> </table>

并行化

简介

使用parallel包演示简单的并行化
- chunk.size：处理区块

# 加载R包并设置并行化参数
# library(parallel)
cores <- 4
cl <- makeCluster(cores)

# 创建一个简单的函数
x = 1:10000
f = function(y) sqrt(y + 1)

# 单个运行
system.time({parSapply(cl, x, f, chunk.size = 1)})
# 一个区块2500个数据运行
system.time({parSapply(cl, x, f, chunk.size = 2500)})

   user  system elapsed 
  0.392   0.187   1.605 

   user  system elapsed 
  0.002   0.000   0.016

学习器的并行化

构建一个随机森林学习器
- 查看默认线程数可知为1个（无并行化）

# 构建学习器学习器
lrn_ranger <- lrn('classif.ranger')
lrn_ranger$param_set$ids(tags = 'threads')

# 查看初始默认线程数
lrn_ranger$param_set$values$num.threads

设置指定的线程数

set_threads(lrn_ranger, n = 4)
lrn_ranger$param_set$values$num.threads

查看可用的线程数

availableCores()

自动检测并设定最大可用线程数

set_threads(lrn_ranger)
lrn_ranger$param_set$values$num.threads

如果要控制默认使用的线程数量，
可在.Rprofile文件中如下设置

# 设置最大4个
options(mc.cores = 4)

重采样和benchmark的并行化

mlr3 利用 future 实现使用并行后端对重采样迭代进行并行化
- 可通过 plan() 函数对此进行配置
- 默认情况下，除非在 future::plan() 中指定参数 workers，
  否则会使用机器的所有 CPU

# 加载R包
# library(future)

# 计划为多核模式
future::plan('multisession')

# 重采样
tsk_sonar <- tsk('sonar')
lrn_rpart <- lrn('classif.rpart')
rsmp_cv3 <- rsmp('cv', folds = 3)
system.time({resample(tsk_sonar, lrn_rpart, rsmp_cv3)})

   user  system elapsed 
  0.471   0.053   1.926

一般来说，建议仅对每次迭代至少运行几秒的重采样考虑并行化
有两个 mlr3 选项可用于控制执行和粒度：
- 如果mlr3.exec_random设置为TRUE（默认值），则在重抽样和基准测试中，
  任务的顺序将被随机化；
  适用于在运行基准测试或调参时遇到运行时间差异较大的情况
- 选项 mlr3.exec_chunk_size 可用于
  控制将多少个任务映射到单个 future，
  默认值为 1；
  此选项的值会传递给 future_mapply()，
  并且 future.scheduling 始终设置为 TRUE
调整块大小在某些罕见情况下有助于减少并行化开销，
但在较大问题或较长运行时间的情况下不太可能有用
下图展示上面3折CV的重采样并行化流程：
- 主进程调用resample()函数，该函数启动并行化过程，
  并将计算任务分为三个部分用于三折交叉验证
- 这些折被传递给三个worker，
  每个worker在任务的相应子集上拟合模型，
  并对留出的观测值进行预测
- 预测结果（和训练好的模型）被传回主进程，
  主进程将它们合并为一个ResampleResult

基准测试可以看作是多个独立重采样的集合，
其中任务、学习器和重采样策略的组合定义了要执行的一次重采样
可以选择以下两种方式之一：
- 对所有重采样进行并行处理，并按顺序执行每个重采样（并行化外层循环）
- 遍历所有重采样，并并行执行每个重采样（并行化内循环）

foreach combination of (task, learner, resampling strategy) {
    foreach resampling iteration {
        execute(resampling, j)
    }
}

mlr3 通过将所有实验展平到同一级别，
即 benchmark() 会遍历外层和内层循环迭代的笛卡尔积中的元素
- 因此，无需决定是要并行化调参还是重采样，因为始终对两者都进行并行化
- 这种方法使计算更加精细，
  并允许 future 后端将任务分组为合适大小的块（取决于工作线程数），
  还使该过程与并行化重采样完全相同

# 创建benchmark设计
design <- benchmark_grid(
 tsks(c('sonar', 'penguins')),
 lrns(c('classif.featureless', 'classif.rpart')), 
 rsmp_cv3
)

# 设置并行化计算
future::plan('multisession')

# 执行并行化的benchmark比较
bmr <- benchmark(design)

调优的并行化

调优一般是迭代的过程
- 每次迭代后，
  大多数调优器会根据获得的性能值以某种方式进行自我调整
- 随机搜索和网格搜索是例外
  - 它们并不根据过往结果选择配置
  - 对于这些调优器而言，所有评估都是相互独立的
  - 原则上可以完全并行化。
在mlr3中作为迭代benchmark测试来实现
- Tuner提出一批学习器，
  每个学习器的 param_set$values`具有不同的配置，
  其中批次大小通常可以通过batch_size配置参数进行控制
- 该批次会连同调优实例的重采样策略一起传递给benchmark()
由于每次对 benchmark() 的调用都依赖于先前的结果，
因此通常无法在比单个基准测试更高的级别上并行化调优
- 相反，单个 benchmark() 评估由 mlr3 并行化，
  就好像它们是无需调优的实验一样
- 这意味着每个评估配置的单个重采样迭代都同时被并行化
为确保完全并行化，应确保 batch_size 乘以重采样迭代次数至少等于可用工作线程数
- 如果期望运行时是均匀的，
  即对单个学习器或管道进行调优，且没有任何对运行时有重大影响的超参数
  - 那么目标是工作线程数的倍数
一般来说，批次越大，并行化程度越高，而批次越小，则意味着更频繁地检查终止条件
无论是否使用并行化，终止条件仅在批次评估之间进行检查。
以下代码展示了随机搜索的并行执行
- 终止条件设置为20次迭代
- 采用中等批量大小，
  其中36个重采样分割（每个分割有12种配置，共3种分割）在4个worker上并行评估
- 批量大小设置为worker的倍数，以确保有效利用可用资源
注意：调优仅在给定批量大小的倍数之后才会终止
- 在这种情况下，是在24次评估之后

future::plan('multisession', workers = 4)

instance <- tune(
 tnr('random_search', batch_size = 12),
 tsk('penguins'),
 lrn('classif.rpart', minsplit = to_tune(2, 128)),
 rsmp('cv', folds = 3),
 term_evals = 20
)

instance$archive$n_evals

结果的24是怎么来的？
- batch_size = 12表示测试12组超参数
- 每一组是不可拆分的，当term_evals=20时
  - 1组为12，没有超过20
  - 2折则有24组，超过了20
- 当超过20的时候，不会进行下一折的计算，
  但是每组中的超参数都会被测试
- 更改batch_size = 11，结果为22
  - $11 \times 2 = 22 > 20$
- 更改term_evals = 37，结果为48
  - $12 \times 3 =36 < 37$，故测试组 $(3+1) \times 12 = 48$
线程数的作用是什么？
- 每一组的12个超参数平均分配到线程数（4）个，
  每一个worker处理3个超参数
CV的折数有什么关系？
- 无论是3折还是30折，重采样都由相同的worker进行
虽然这里term_evals被设置为20，但是有时并不适用于其他情况
- 例如trm('perf_reached')：
  即使该批次的第一个配置产生的性能优于给定阈值，
  其余11个配置仍会进行不必要的评估

嵌套重采样并行化

嵌套重采样在概念上可以在三个不同层次上并行化，每个层次对应不同粒度的任务：
- 外部重采样的并行化
  - 一项任务就是在外部重采样分割的相应训练集上对学习器进行调优
- 在一次调优迭代中对所提出的一批超参数配置进行并行评估
  - 一项任务可能是对这样一种配置进行交叉验证
- 调优中内部重采样的并行化
  - 一项任务即为单个配置的训练-预测-评分步骤
下面是嵌套重采样并行化的伪代码的简化版
- 第二层中利用了benchmark()的功能：
  - 为每个提议的超参数配置创建一个Learner对象，
    并且在最内层的for循环中，
    所有学习器都在一个基准实验中进行重采样，
    从而有效地在更细的粒度上
    （提议点数乘以内部重采样迭代次数）
    同时执行第二层和第三层
- 因此，当在mlr3中对嵌套重采样进行并行化时，
  只需要在两个选项中做出选择：
  - 对外部重采样进行并行化
  - 还是对内部基准测试进行并行化。

# outer resampling, level 1:
for (i in seq_len(n_outer_splits)) {
 # tuning instance, in this example mainly represents the archive
 tuning_inst = ti(...)
 inner_task = get_training_task(task, outer_splits[[i]])
 # tuning loop, the details of which depend on the tuner being used
 # This does not correspond to a level:
 while (!tuning_inst$is_terminated) {
  proposed_points = propose_points(tuning_inst$archive, batch_size)
  # Evaluation of configurations, level 2:
  for (hp_configuration in proposed_points) {
   split_performances = numeric()
   # Inner resampling, level 3:
   for (j in seq_len(n_inner_splits)) {
   split_performances[j] = evaluate_performance(
    learner, 
    hp_configuration, 
    inner_task, 
    inner_splits[[j]]
   )
  }
   performance = aggregate(split_performances)
   update_archive(
    tuning_inst$archive, 
    configuration, 
    performance
   )
  }
  }
   evaluate_performance(
   learner, 
   tuning_inst$result, 
   task, outer_splits[[i]]
  )
}

下面用单程计算进重采样

# 加载R包
#library(mlr3tuning)
# 设置为单程计算
future::plan('sequential')

# 构建学习器，标记`minsplit`标记
lrn_rpart <- lrn(
 'classif.rpart',
 minsplit  = to_tune(2, 128)
)

lrn_rpart_tuned <- auto_tuner(
 tnr('random_search', batch_size = 2),
 lrn_rpart, 
 rsmp('holdout'), 
 msr('classif.ce'), 
 2
)

rr <- resample(
 tsk('penguins'), 
 lrn_rpart_tuned, 
 rsmp('cv', folds = 5)
)

对于是否并行也可以选择不同的方法

# 仅对外层重采样进行并行运算
# 第二个和第一个是一样的
# 因为如果不指定为'multisession'都默认为'sequential'
future::plan(list('multisession', 'sequential'))
future::plan('multisession')

# 仅对内层重采样进行并行运算
future::plan(list('sequential', 'multisession'))

在外部5重交叉验证中并行化内部顺序2重交叉验证时四个CPU的利用率
- 任务标记为[外部迭代次数]-[内部迭代次数]

在外部使用顺序5折交叉验证对内部基准测试（由2次留出评估组成）进行并行化时，
四个核心的CPU利用率
- 任务标记为[外部迭代次数]-[内部迭代次数]

在上述例子中，两种并行化方式都没有充分发挥四个核心的全部潜力
- 通过对外循环进行并行化，所有结果在16秒后计算完成
- 如果对内循环进行并行化，则在20秒后得到结果
- 在这两种情况下，至少在某些时间段内，部分CPU核心处于空闲状态
mlr3和future使得嵌套并行化的两个循环都能够实现并行化，
即使在不同的并行化后端上也可以，
这在一些分布式计算设置中可能会很有用对于这种嵌套并行化，可用核心的检测不起作用，
必须手动设置工作线程数
- 这个示例将在本地机器上最多使用四个核心运行：
  - 首先，为外部循环生成两个新会话
  - 然后，这两个新会话各自再生成两个额外的会话，
    以评估内部基准测试
  - 尽管在第5次外部重采样迭代运行时仍有2个核心处于空闲状态，
    但这种方法将总运行时间缩短至12秒，
    在这个示例中这是最优的

future::plan(list(
  tweak('multisession', workers = 2),
  tweak('multisession', workers = 2)
))

预测的并行化

由于多个观测值的预测相互独立，单个学习器的预测可以并行化
当测试数据集非常大时，预测并行化可以缩短时间

# 构建任务，学习器并训练模型
tsk_sonar <- tsk('sonar')
lrn_rpart <- lrn('classif.rpart')
lrn_rpart$train(tsk_sonar)

# 设置并行化线程数
future::plan('multisession', workers = 4)
# 启动预测并行化，只需要设置`Learner$parallel_predict = TRUE`即可
lrn_rpart$parallel_predict = TRUE

# 预测
prediction <- lrn_rpart$predict(tsk_sonar)

错误处理

简介

实际构建模型中会出现很多难以预料的问题：
- 学习器无法处理缺失值而报错
- 存在无法处理的观测值
- 学习器无法收敛
lrn('classif.debug')可以模拟机器学习中经常遇到的问题

# 创建任务
tsk_penguins <- tsk('penguins')
# 创建模拟debug学习器
lrn_debug <- lrn('classif.debug')
lrn_debug

[36m--[39m [1m[34m<LearnerClassifDebug>[39m (classif.debug): Debug Learner for Classification[22m [36m-----[39m
* Model: -
* Parameters: list()
* Validate: [34m<NULL>[39m
* Packages: [34mmlr3[39m
* Predict Types: [response] and prob
* Feature Types: logical, integer, numeric, character, factor, and ordered
* Encapsulation: none (fallback: -)
* Properties: hotstart_forward, internal_tuning, marshal, missings, multiclass,
twoclass, validation, and weights
* Other settings: use_weights = 'use'

默认设置下，学习者会记住一个随机标签，
并在不发出任何条件信号的情况下持续预测该标签
- 在以下代码中，让学习者在训练步骤中发出错误信号
- lrn('classif.debug')也可以用于测试流程中如果发生错误时，
  封装和回退学习器是否能够正常工作

# 将发出错误信号的概率设置为`1`
lrn_debug$param_set$values$error_train <- 1
lrn_debug$train(tsk_penguins)

Error in get_private(learner)$.train(task): Error from classif.debug->train()

封装（Encapsulation）

封装可确保截获信号条件（例如消息、警告和错误），
并将训练或预测步骤中引发的所有条件记录到学习器中，
而不会中断程序流程
- 这意味着模型可用于拟合和预测，
  并且任何条件都可以事后分析
- 但是，根据错误发生的位置，实验结果可能会缺少模型和/或预测
每个Learner都有方法Learner$encapsulate()来控制训练或预测步骤的封装方式
第一种封装执行的方式由evaluate包提供
- 该包计算R表达式并捕获和跟踪条件（输出、消息、警告或错误）
- 不会让它们停止进程

# `warning_train = 1`：将训练时触发警告的概率设置为100%
# `error_train = 1`：将训练时触发错误的概率设置为100%
lrn_debug <- lrn('classif.debug', warning_train = 1, error_train = 1)

# 设置封装方法和回退学习器
lrn_debug$encapsulate('evaluate', fallback = lrn('classif.featureless'))

# 训练模型
lrn_debug$train(tsk_penguins)

WARN  [17:30:10.822] [mlr3] train: Warning from classif.debug->train()
ERROR [17:30:10.829] [mlr3] train: Error from classif.debug->train()
INFO  [17:30:10.836] [mlr3] Learner 'classif.debug' on task 'penguins' failed to train a model {learner: <LearnerClassifDebug/LearnerClassif/Learner/R6>, messages: (Warning from classif.debug->train(), Error from classif.debug->train())}
INFO  [17:30:10.841] [mlr3] Calling train method of fallback 'classif.featureless' on task 'penguins' with 344 observations {learner: <LearnerClassifFeatureless/LearnerClassif/Learner/R6>}

查看警告和错误的记录

lrn_debug$log
lrn_debug$warnings
lrn_debug$errors

<table class='dataframe'> <caption>A data.table: 2 x 3</caption> <thead> <tr><th scope=col>stage</th><th scope=col>class</th><th scope=col>msg</th></tr> <tr><th scope=col><fct></th><th scope=col><ord></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><td>train</td><td>warning</td><td>Warning from classif.debug->train()</td></tr> <tr><td>train</td><td><span style=white-space:pre-wrap>error </span></td><td><span style=white-space:pre-wrap>Error from classif.debug->train() </span></td></tr> </tbody> </table>

'Warning from classif.debug->train()'

'Error from classif.debug->train()'

另一种封装方法在callr包中实现
与evaluate不同，计算在一个单独的R进程中处理
- 这可以保护调用会话免受段错误的影响，
  否则段错误会终止整个主R会话
不利的一面是，启动新进程会带来相对更多的计算开销

# 设置封装方法为'callr'以及回退学习器
lrn_debug$encapsulate('callr', fallback = lrn('classif.featureless'))
# 将错误类型修改为段错误
lrn_debug$param_set$values <- list(segfault_train = 1)
# 训练模型并查看错误信息
lrn_debug$train(task = tsk_penguins)$errors

ERROR [19:23:25.504] [mlr3] train: reached elapsed time limit
INFO  [19:23:25.509] [mlr3] Learner 'classif.debug' on task 'penguins' failed to train a model {learner: <LearnerClassifDebug/LearnerClassif/Learner/R6>, messages: `reached elapsed time limit`}
INFO  [19:23:25.513] [mlr3] Calling train method of fallback 'classif.featureless' on task 'penguins' with 344 observations {learner: <LearnerClassifFeatureless/LearnerClassif/Learner/R6>}
'reached elapsed time limit'

除了捕获错误，还可以设置一个超时时间（以秒为单位）
- 这样学习器就不会无限期运行（例如，由于无法收敛），
  而是在指定时间后终止
在使用 callr 封装时，这种方法最为可靠
- 因为如果学习器陷入外部编译代码中，
  evaluate 方法有时无法中断学习器
- 如果学习器被中断，那么封装过程会将其记录为错误
- 同样，超时时间可以针对训练和预测分别设置：

lrn_debug$timeout <- c(train = 1e-5, predict = Inf)
lrn_debug$train(task = tsk_penguins)$errors

WARN  [19:19:47.270] [mlr3] train: Warning from classif.debug->train()
ERROR [19:19:47.281] [mlr3] train: Error from classif.debug->train()
INFO  [19:19:47.289] [mlr3] Learner 'classif.debug' on task 'penguins' failed to train a model {learner: <LearnerClassifDebug/LearnerClassif/Learner/R6>, messages: (Warning from classif.debug->train(), Error from classif.debug->train())}
INFO  [19:19:47.295] [mlr3] Calling train method of fallback 'classif.featureless' on task 'penguins' with 344 observations {learner: <LearnerClassifFeatureless/LearnerClassif/Learner/R6>}
'Error from classif.debug->train()'

如果在训练过程中出现错误，那么将没有训练好的模型可供查询
或者如果在预测过程中出现错误，那么将没有预测结果可供分析

# 这里模拟训练过程中出错时，没有模型被储存的情况
lrn('classif.debug', error_train = 1)$train(tsk_penguins)$model

Error in get_private(learner)$.train(task): Error from classif.debug->train()

# 这里模拟预测过程中出错时，有模型被储存的情况
lrn_debug <- lrn('classif.debug', error_predict = 1)$train(tsk_penguins)
lrn_debug$model

# 但预测是不能完成的
lrn_debug$predict(tsk_penguins)

$response
[1] 'Adelie'

$pid
[1] 5913

$id
[1] '4461f9b7-8390-4e69-a17f-7db817b5b336'

$random_number
[1] 2403

$iter
[1] 1

attr(,'class')
[1] 'classif.debug_model'


Error in get_private(learner)$.predict(task): Error from classif.debug->predict()

回退学习器（Fallback Learners）

假设在重采样过程中，
模型训练的一次或多次迭代中出现了错误，
有三种方法可以继续实验：
- 忽略出现失败的迭代
  - 这可能是实践中最常用的方法，但从统计学角度来看并不合理
  - 假设在试图评估一个模型的性能时，
    在某些重采样划分中，
    如果预测时出现训练期间未见过的因子水平，
    该模型可能会出错，
    从而导致模型无法处理这些情况并报错；
    如果丢弃失败的迭代，尽管模型无法对一整类特征进行预测，
    但它看起来仍会表现良好
- 惩罚失败的学习器
  - 不忽略失败的迭代，
    而是估算出最差的分数（由给定的Measure定义），
    从而对失败的学习器进行严厉惩罚
  - 然而，对于许多问题来说过于苛刻
  - 而且对于某些度量，没有合理的数值可供估算
- 使用回退学习器进行训练和预测
  - 训练一个基线学习器，并根据该模型进行预测，
    而不是用最差的分数进行插补
推荐使用lrn('classif.featureless')或
lrn('classif.featureless')作为回退学习器

# 设置模拟debug学习器为训练期间发生错误
lrn_debug <- lrn('classif.debug', error_train = 1)
# 使用'evaluate'方法并设置无特征分类学习器
lrn_debug$encapsulate('evaluate', fallback = lrn('classif.featureless'))
# 训练`Task`
lrn_debug$train(tsk_penguins)

ERROR [20:27:27.572] [mlr3] train: Error from classif.debug->train()
INFO  [20:27:27.576] [mlr3] Learner 'classif.debug' on task 'penguins' failed to train a model {learner: <LearnerClassifDebug/LearnerClassif/Learner/R6>, messages: `Error from classif.debug->train()`}
INFO  [20:27:27.579] [mlr3] Calling train method of fallback 'classif.featureless' on task 'penguins' with 344 observations {learner: <LearnerClassifFeatureless/LearnerClassif/Learner/R6>}

查看训练结果
- 由于训练发生了错误，因此没有任何模型被储存

lrn_debug
lrn_debug$log
lrn_debug$model

[36m--[39m [1m[34m<LearnerClassifDebug>[39m (classif.debug): Debug Learner for Classification[22m [36m-----[39m
* Model: -
* Parameters: error_train=1
* Validate: [34m<NULL>[39m
* Packages: [34mmlr3[39m
* Predict Types: [response] and prob
* Feature Types: logical, integer, numeric, character, factor, and ordered
* Encapsulation: evaluate (fallback: LearnerClassifFeatureless)
* Properties: hotstart_forward, internal_tuning, marshal, missings, multiclass,
twoclass, validation, and weights
* Other settings: use_weights = 'use'
[31mx[39m Errors: Error from classif.debug->train()

<table class='dataframe'> <caption>A data.table: 1 x 3</caption> <thead> <tr><th scope=col>stage</th><th scope=col>class</th><th scope=col>msg</th></tr> <tr><th scope=col><fct></th><th scope=col><ord></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><td>train</td><td>error</td><td>Error from classif.debug->train()</td></tr> </tbody> </table>

NULL

没有模型储存的话，理应是无法预测才对
但是通过设置了回退学习器，预测依然可以通过`lrn('classif.featureless')执行

prediction <- lrn_debug$predict(tsk_penguins)
prediction$score()

classif.ce: 0.558139534883721

这次将错误发生几率降低到0.5

# 设置模拟debug学习器，错误几率0.5
lrn_debug <- lrn('classif.debug', error_train = 0.5)
# 用`evaluate`方法封装信息，并设置回退学习器
lrn_debug$encapsulate('evaluate', fallback = lrn('classif.featureless'))

# benchmark比较两种方法
aggr <- benchmark(
 benchmark_grid(
  tsk_penguins,
  list(lrn_debug, lrn('classif.rpart')),
  rsmp('cv', folds = 20)
 )
)$aggregate(conditions = TRUE)

# 查看整合结果
aggr[, .(learner_id, warnings, errors, classif.ce)]

<table class='dataframe'> <caption>A bmr_aggregate: 2 x 4</caption> <thead> <tr><th scope=col>learner_id</th><th scope=col>warnings</th><th scope=col>errors</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><chr></th><th scope=col><int></th><th scope=col><int></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>classif.debug</td><td>0</td><td>13</td><td>0.55866013</td></tr> <tr><td>classif.rpart</td><td>0</td><td> 0</td><td>0.05228758</td></tr> </tbody> </table>

如果只是查看某一个学习器的迭代中发生错误的结果，
可以进行如下操作

rr <- aggr[learner_id == 'classif.debug']$resample_result[[1L]]
# 只看
rr$errors

<table class='dataframe'> <caption>A data.table: 13 x 2</caption> <thead> <tr><th scope=col>iteration</th><th scope=col>msg</th></tr> <tr><th scope=col><int></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><td> 1</td><td>Error from classif.debug->train()</td></tr> <tr><td> 2</td><td>Error from classif.debug->train()</td></tr> <tr><td> 3</td><td>Error from classif.debug->train()</td></tr> <tr><td> 5</td><td>Error from classif.debug->train()</td></tr> <tr><td> 7</td><td>Error from classif.debug->train()</td></tr> <tr><td> 8</td><td>Error from classif.debug->train()</td></tr> <tr><td>10</td><td>Error from classif.debug->train()</td></tr> <tr><td>13</td><td>Error from classif.debug->train()</td></tr> <tr><td>14</td><td>Error from classif.debug->train()</td></tr> <tr><td>16</td><td>Error from classif.debug->train()</td></tr> <tr><td>18</td><td>Error from classif.debug->train()</td></tr> <tr><td>19</td><td>Error from classif.debug->train()</td></tr> <tr><td>20</td><td>Error from classif.debug->train()</td></tr> </tbody> </table>

日志记录（Logging）

mlr3中使用lgr包控制输出的详细程度
- “warn”：仅记录不会中断程序的警告
- “info”：记录模型运行时间等信息以及警告信息
- “debug”：用于调试的详细消息，以及信息和警告
mlr3中默认log级别为 "info"，
这意味着仅显示提供信息或更严重级别的消息，
即 "info" 和 "warn"

lgr::get_logger('mlr3')$set_threshold('debug')
lgr::get_logger('mlr3')$set_threshold('warn')
lgr::get_logger('mlr3')$set_threshold('info')

也可以针对特定R包进行设置

lgr::get_logger('bbotk')$set_threshold('info')

将log输出到其他格式文件中
- 以下以JSON文件为例

# 生成一个唯一的临时文件路径
# 前缀为"mlr3log_"，扩展名固定为“.json”
tf <- tempfile('mlr3log_', fileext = '.json')

# 获取 mlr3 的log
logger <- lgr::get_logger('mlr3')

# 添加JSON格式的log输出器
logger$add_appender(lgr::AppenderJson$new(tf), name = 'json')

# 触发警告log
logger$warn('this is a warning from mlr3')

WARN  [22:44:09.578] this is a warning from mlr3

# 读取日志文件内容
x <- readLines(tf)
# 打印
cat(paste0(substr(x, 1, 71), '\n', substr(x, 72, nchar(x))))

{"level":300,"timestamp":"2025-07-08 22:44:09","logger":"mlr3","caller"
:"eval","msg":"this is a warning from mlr3"}

# 移除appender避免后续继续写入
logger$remove_appender('json')

注意：
- 在使用并行化和/或封装时，
  日志可能会延迟、顺序错乱，
  或者在出现某些错误时根本不存在
当需要立即访问日志消息时，例如在调试时，可以选择禁用 future 和封装
要启用调试模式，设置 options(mlr3.debug = TRUE) 并确保学习器的 Learner$encapsulate 插槽设置为 "none"（默认值）或 "evaluate"
调试模式应仅在调试期间启用，而不应在生产环境中使用，
因为它会禁用并行化并导致意外的随机数生成器（RNG）行为，
从而无法实现可重复性

>-------------

数据后端（Data Backends）

简介

Task对象将其数据存储在一个抽象数据对象，即 DataBackend 中
数据后端提供了一个统一的API，用于检索数据子集或查询有关数据的信息
- 无论数据在系统中是如何存储的
- 默认后端通过 DataBackendDataTable 类使用 data.table，
  作为一个非常快速高效的内存数据库
虽然将任务数据存储在内存中对于模型拟合时访问数据来说效率最高，
但存在两个主要缺点：
- 即使只需要一小部分数据，例如在进行子采样时，完整的数据集也会占用内存
- 同时处理大型任务或多个任务，例如进行基准测试，这就会成为一个特别严重的问题
- 在并行化过程中，需要将完整的数据传输给工作节点，这可能会增加开销
处理的方法有：
- DataBackendDplyr：
  为R包dbplyr提供接口，扩展了dplyr，
  使其能够在许多流行的SQL数据库（如MariaDB、PostgresSQL或SQLite）上运行
- DataBackendDuckDB：
  用于通过 duckdb 连接的 DuckDB 数据库，
  它是 SQLite 的一种快速、零配置替代方案。
- DataBackendDuckDB：
  用于Parquet文件，
  这意味着数据无需转换为DuckDB的原生存储格式，
  而是可以直接处理包含一个或多个以流行的Parquet格式存储的文件的目录
由于不是重点，本章略

使用`DataBackendDplyr`的数据库

# load data
requireNamespace('DBI')
requireNamespace('RSQLite')
requireNamespace('nycflights13')
data('flights', package = 'nycflights13')
dim(flights)

# add column of unique row ids
flights$row_id = seq(nrow(flights))

# create sqlite database in temporary file
path = tempfile('flights', fileext = '.sqlite')
con = DBI::dbConnect(RSQLite::SQLite(), path)
tbl = DBI::dbWriteTable(con, 'flights', as.data.frame(flights))
DBI::dbDisconnect(con)

# remove in-memory data
rm(flights)

# establish connection
con = DBI::dbConnect(RSQLite::SQLite(), path)

# select the 'flights' table
library(dplyr)
library(dbplyr)
tbl = tbl(con, 'flights')

# 1. subset columns
keep = c('row_id', 'year', 'month', 'day', 'hour', 'minute', 'dep_time',
  'arr_time', 'carrier', 'flight', 'air_time', 'distance', 'arr_delay')
tbl = select(tbl, all_of(keep))

# 2. filter by missing
tbl = filter(tbl, !is.na(arr_delay))

# 3. select every other row
tbl = filter(tbl, row_id %% 2 == 0)

# 4. merge infrequent carriers
infrequent = c('OO', 'HA', 'YV', 'F9', 'AS', 'FL', 'VX', 'WN')
tbl = mutate(tbl, carrier = case_when(
  carrier %in% infrequent ~ 'other',
  TRUE ~ carrier))

library(mlr3db)
backend_flights = as_data_backend(tbl, primary_key = 'row_id')
c(nrow = backend_flights$nrow, ncol = backend_flights$ncol)

backend_flights$head()

tsk_flights = as_task_regr(backend_flights, id = 'flights_sqlite',
  target = 'arr_delay')
rsmp_sub002 = rsmp('subsampling', ratio = 0.02, repeats = 3)

rr = resample(tsk_flights, lrn('regr.rpart'), rsmp_sub002)

measures = msrs(c('regr.rmse', 'time_train', 'time_predict'))
rr$aggregate(measures)

measures = msrs(c('regr.rmse', 'time_train', 'time_predict'))
rr$aggregate(measures)

rm(tbl)
DBI::dbDisconnect(con)

使用`DataBackendDuckDB`的`Parquet`文件

path = system.file(file.path('extdata', 'spam.parquet'),
  package = 'mlr3db')
backend = as_duckdb_backend(path)
as_task_classif(backend, target = 'type')

扩展`mlr3`并定义新的`Measure`

过程
- 找到要继承的正确类
- 使用正确的属性初始化对象（$initialize()）
- 实现执行实际计算的公共和私有方法
  - 下例中为私有方法 $.score()
下面定义一个评估器
- 若真实值与预测值之间的差异小于真实值的一个标准差，
  则将预测评分为 1，否则将预测评分为 0
- $f(y, \hat{y}) = \frac{1}{n} \sum_{i=1}^n \mathbb{I}(|y_i - \hat{y}_i| < \sigma_y)$
  - $\sigma_y$：真实值的标准差
  - $\mathbb{I}$：指示函数
可以用下面函数表示

# 自定义的函数
threshold_acc <- function(truth, response) {
 mean(ifelse(abs(truth - response) < sd(truth), 1, 0))
}

# 用随意的两组数据测试一下
threshold_acc(c(100, 0, 1), c(1, 11, 6))

0.666666666666667

如果要在mlr3中使用的话，需要创建一个新的R6Class，并且继承于Measure
- 由于上面例子适用于回归任务，所以继承于MeasureRegr
- 在头两行命名了类 MeasureRegrThresholdAcc，
  然后声明这是一个回归度量，它继承自 MeasureRegr
- 通过声明其唯一ID为"thresh_acc"，
  不需要任何外部包（packages = character()），
  以及没有特殊属性（properties = character()）
  来初始化该类
- 传递损失函数的具体细节，即：
  它衡量“响应”类型预测的质量，其值介于(0, 1)之间，
  并且该损失函数以其最大值为优化目标（minimize = FALSE）
- 将分数本身定义为一个名为 .score 的私有方法，
  在这个方法中，将预测结果传递给刚刚定义的损失函数

MeasureRegrThresholdAcc <- R6::R6Class('MeasureRegrThresholdAcc',
 # 继承`MeasureRegr`
 inherit = mlr3::MeasureRegr, 
 # 公共方法
 public = list(
  initialize = function() { # initialize class
  super$initialize(
   # 定义默认用于识别的ID
   id = 'thresh_acc', 
   # 依赖包：无
   packages = character(), 
   # 属性：无
   properties = character(),
   # 预测的种类：响应值'response'
   predict_type = 'response', 
   # 范围：0–1
   range = c(0, 1), 
   # 越大越好，无需最小化
   minimize = FALSE 
  )
 }
),
 # 私有方法
 private = list(
  # 定义评估方法
  .score = function(prediction, ...) {
   # 内容就是上述的函数
   threshold_acc = function(truth, response) {
    mean(ifelse(abs(truth - response) < sd(truth), 1, 0))
    }
   # 设置返回值
   return(threshold_acc(prediction$truth, prediction$response))
  }
 )
)

将上面定义的Measure实操

tsk_mtcars <- tsk('mtcars')
split <- partition(tsk_mtcars)
lrn_featureless <- lrn('regr.featureless')$train(tsk_mtcars, split$train)
prediction <- lrn_featureless$predict(tsk_mtcars, split$test)
prediction$score(MeasureRegrThresholdAcc$new())

thresh_acc: 0.727272727272727

# 也可以直接把放到`mlr_measures`通过命名`id`直接调用
mlr3::mlr_measures$add('regr.thresh_acc', MeasureRegrThresholdAcc)
prediction$score(msr('regr.thresh_acc'))

扩展`mlr3`并定义新的`Learner`

Creating a new Learner

# 加载R包
# library(mlr3)
# library(paradox)
# library(R6)
# library(mlr3misc)

LearnerRegrRpartSimple <- R6Class("LearnerRegrRpartSimple",
  inherit = LearnerRegr,
  public = list(
    initialize = function() {
      param_set = ps(
        cp             = p_dbl(0, 1, default = 0.01, tags = "train"),
        maxcompete     = p_int(0L, default = 4L, tags = "train"),
        maxdepth       = p_int(1L, 30L, default = 30L, tags = "train"),
        maxsurrogate   = p_int(0L, default = 5L, tags = "train"),
        minbucket      = p_int(1L, tags = "train"),
        minsplit       = p_int(1L, default = 20L, tags = "train"),
        surrogatestyle = p_int(0L, 1L, default = 0L, tags = "train"),
        usesurrogate   = p_int(0L, 2L, default = 2L, tags = "train"),
        xval           = p_int(0L, default = 10L, tags = "train")
      )
      param_set$set_values(xval = 10L)
      super$initialize(
        id = "regr.rpart_simple",
        feature_types = c("logical", "integer", "numeric", "factor", "ordered"),
        predict_types = "response",
        packages = "rpart",
        param_set = param_set,
        properties = c("weights", "missings", "importance"),
        label = "Regression Tree",
        man = "mlr3::mlr_learners_regr.rpart"
      )
    },
    importance = function() {
      if (is.null(self$model)) {
        stopf("No model stored")
      }
      # importance is only present if there is at least on split
      if (is.null(self$model$variable.importance)) {
        set_names(numeric())
      } else {
        sort(self$model$variable.importance, decreasing = TRUE)
      }
    }
  ),
  private = list(
    .train = function(task) {
      pv = self$param_set$get_values(tags = "train")
      pv$weights = private$.get_weights(task)
      
      invoke(
        rpart::rpart,
        formula = task$formula(),
        data = task$data(),
        .args = pv
      )
    },
    .predict = function(task) {
      pv = self$param_set$get_values(tags = "predict")

      # ensure same column order in train and predict
      newdata = mlr3extralearners:::ordered_features(task, self)
      response = invoke(predict, self$model, newdata = newdata, .args = pv)
      list(response = unname(response))
    }
  )
)

`openML`：用于大规模benchmarking

简介

大规模（large-scale）
- 意味着它们可能会使用许多数据集、度量标准和学习器
- 数据集必须涵盖广泛的领域和问题类型，
  因为只能针对基准研究中所使用的数据集类型得出结论
mlr3oml
- 为mlr3和OpenML提供一个借口
  - OpenML：用于上传和下载数据集的常用工具
mlr3batchmark
- 将mlr3和batchtools连接起来
  - batchtools：提供了高性能计算群集上管理和执行实验的方法
首先先进行简单的benchmark比较
- 除了german_credit数据集，
  其他两个数据集上随机森林的表现更优

# ----------构建学习器
# 无特征值基线学习器
lrn_baseline <- lrn("classif.featureless", id = "featureless")

# 构建逻辑回归学习器
lrn_lr <- lrn("classif.log_reg")
# 构建用于逻辑回归的`GraphLearner`
# ppl("robustify", learner = lrn_lr)表示用于逻辑回归的管道
lrn_lr <- as_learner(ppl("robustify", learner = lrn_lr) %>>% lrn_lr)
# 识别id
lrn_lr$id <- "logreg"
# 封装及回退学习器
lrn_lr$encapsulate("try", fallback = lrn_baseline)

# 构建随机森林学习器
lrn_rf <- lrn("classif.ranger")
# 构建用于随机森林的`GraphLearner`
lrn_rf <- as_learner(ppl("robustify", learner = lrn_rf) %>>% lrn_rf)
# 识别id
lrn_rf$id <- "ranger"
# 封装及回退学习器
lrn_rf$encapsulate("try", fallback = lrn_baseline)

# 放到一个`list`里
learners <- list(lrn_lr, lrn_rf, lrn_baseline)

# ----------benchmark比较
# benchmark比较的实验设计
design <- benchmark_grid(
 tsks(c("german_credit", "sonar", "pima")),
 learners, 
 rsmp("cv", folds = 10)
)
# 执行benchmark比较
bmr <- benchmark(design)
# 查看结果
bmr$aggregate(msr("classif.acc"))[, .(task_id, learner_id, classif.acc)]

<table class="dataframe"> <caption>A bmr_aggregate: 9 x 3</caption> <thead> <tr><th scope=col>task_id</th><th scope=col>learner_id</th><th scope=col>classif.acc</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>german_credit</td><td>logreg </td><td>0.7510000</td></tr> <tr><td>german_credit</td><td>ranger </td><td>0.7670000</td></tr> <tr><td>german_credit</td><td>featureless</td><td>0.7000000</td></tr> <tr><td>sonar </td><td>logreg </td><td>0.7345238</td></tr> <tr><td>sonar </td><td>ranger </td><td>0.8076190</td></tr> <tr><td>sonar </td><td>featureless</td><td>0.5333333</td></tr> <tr><td>pima </td><td>logreg </td><td>0.7708134</td></tr> <tr><td>pima </td><td>ranger </td><td>0.7708647</td></tr> <tr><td>pima </td><td>featureless</td><td>0.6510253</td></tr> </tbody> </table>

使用OpenML获取数据

数据集

可以通过网站或其REST API（mlr3oml接口）从OpenML中查找数据
list_oml_data() 可用于根据特定属性筛选数据集，
例如根据特征数量、行数或分类问题中的类别数量进行筛选

# 加载R包
# library(mlr3oml)

# 筛选数据mm
odatasets <- list_oml_data(
 # 特征量在10–20间
 number_features = c(10, 20),
 # 样本数量在45000–50000间
 number_instances = c(45000, 50000),
 # 分类级别为2个
 number_classes = 2
)

# 打印筛选出来的数据集
odatasets[
 NumberOfFeatures < 16,
 c(
  "data_id", 
  "name", 
  "NumberOfFeatures", 
  "NumberOfInstances"
 )
]

<table class="dataframe"> <caption>A data.table: 12 x 4</caption> <thead> <tr><th scope=col>data_id</th><th scope=col>name</th><th scope=col>NumberOfFeatures</th><th scope=col>NumberOfInstances</th></tr> <tr><th scope=col><int></th><th scope=col><chr></th><th scope=col><int></th><th scope=col><int></th></tr> </thead> <tbody> <tr><td> 179</td><td>adult </td><td>15</td><td>48842</td></tr> <tr><td> 1590</td><td>adult </td><td>15</td><td>48842</td></tr> <tr><td>43898</td><td>adult </td><td>15</td><td>48790</td></tr> <tr><td>45051</td><td>adult-test </td><td>15</td><td>48842</td></tr> <tr><td>45068</td><td>adult </td><td>15</td><td>48842</td></tr> <tr><td>46468</td><td>Give-Me-Some-Credit-Sampled </td><td>11</td><td>45000</td></tr> <tr><td>46518</td><td>Give-Me-Some-Credit-Sampled-Preprocessed</td><td>11</td><td>45000</td></tr> <tr><td>46553</td><td>Loan_Status </td><td>14</td><td>45000</td></tr> <tr><td>46554</td><td>Loan_Status </td><td>14</td><td>45000</td></tr> <tr><td>46563</td><td>Loan_Approval_Status_Classification </td><td>14</td><td>45000</td></tr> <tr><td>46565</td><td>Loan_Approval_Status </td><td>14</td><td>45000</td></tr> <tr><td>46910</td><td>bank-marketing </td><td>14</td><td>45211</td></tr> </tbody> </table>

OMLData对象包含有关数据集的元数据，不包含数据本身
- 这意味着，无需将整个数据加载到内存中就可以查询有关数据集的信息
- 例如，数据的许可协议和维度
如果想处理实际数据，那么访问$data 字段将下载数据，
然后将 data.table 存储在 OMLData
- 缓存：
  在首次调用 $data 之后，
  所有后续对 $data 的调用将被透明地重定向到内存中的 data.frame
- 通过将选项 mlr3oml.cache 设置为 TRUE 或设置为用作缓存文件夹的特定路径，
  许多对象可以永久缓存在本地文件系统上
查看id为1590的数据集

# 选择数据集
odata <- odt(id = 1590)
odata

# 许可协议
odata$license

# 纬度
c(nrow = odata$nrow, ncol = odata$ncol)

# 下载部分切片
odata$data[1:5, 1:5]

'Public'
nrow48842ncol15
INFO  [23:34:36.779] Retrieving ARFF {url: `https://api.openml.org/data/v1/download/1595261/adult.arff`, authenticated: `FALSE`}

<table class="dataframe"> <caption>A data.table: 5 x 5</caption> <thead> <tr><th scope=col>age</th><th scope=col>workclass</th><th scope=col>fnlwgt</th><th scope=col>education</th><th scope=col>education.num</th></tr> <tr><th scope=col><int></th><th scope=col><fct></th><th scope=col><int></th><th scope=col><fct></th><th scope=col><int></th></tr> </thead> <tbody> <tr><td>25</td><td>Private </td><td>226802</td><td>11th </td><td> 7</td></tr> <tr><td>38</td><td>Private </td><td> 89814</td><td>HS-grad </td><td> 9</td></tr> <tr><td>28</td><td>Local-gov</td><td>336951</td><td>Assoc-acdm </td><td>12</td></tr> <tr><td>44</td><td>Private </td><td>160323</td><td>Some-college</td><td>10</td></tr> <tr><td>18</td><td>NA </td><td>103497</td><td>Some-college</td><td>10</td></tr> </tbody> </table>

可以使用 as_data_backend() 函数转换为 mlr3 后端，然后再转换为任务

# 转换后端
backend <- as_data_backend(odata)
# 创建`Task`
tsk_adult <- as_task_classif(backend, target = "class")
# 查看`Task`
tsk_adult


[36m--[39m [1m[34m<TaskClassif>[39m (48842x15)[22m [36m----------------------------------------------------[39m
* Target: class
* Target classes: >50K (positive class, 24%), <=50K (76%)
* Properties: twoclass
* Features (14):
  * fct (8): education, marital.status, native.country, occupation, race,
  relationship, sex, workclass
  * int (6): age, capital.gain, capital.loss, education.num, fnlwgt,
  hours.per.week

OpenML上的一些数据集包含既不应用作特征也不应用作目标的列
通常作为特征包含的列名可通过字段 $feature_names 访问，
可以相应地将它们分配给 mlr3 任务
虽然对于当前的数据集而言非必要操作，
因为所有非目标列都将被视为预测变量，
但为清晰起见，还是将其包含在内

tsk_adult$col_roles$feature <- odata$feature_names
tsk_adult

[36m--[39m [1m[34m<TaskClassif>[39m (48842x15)[22m [36m----------------------------------------------------[39m
* Target: class
* Target classes: >50K (positive class, 24%), <=50K (76%)
* Properties: twoclass
* Features (14):
  * fct (8): education, marital.status, native.country, occupation, race,
  relationship, sex, workclass
  * int (6): age, capital.gain, capital.loss, education.num, fnlwgt,
  hours.per.week

任务

OpenML任务构建在OpenML数据集之上
- 额外指定目标变量，用于重采样的训练-测试分割等
OpenML任务与mlr3 Task对象不同，
后者不包含有关重采样过程的信息
与mlr3类似，OpenML有不同类型的任务，如回归和分类
与筛选数据集类似，任务可以使用list_oml_tasks()进行筛选
例子还是刚刚id = 1590的数据集

# 将刚刚的数据集id传递给`data_id`参数以便于识别
adult_tasks <- list_oml_tasks(data_id = 1590)

由数据集创建的任务有很多
- 这里选择'Supervised Classification'的任务

adult_tasks[task_type == "Supervised Classification", task_id]

otsk()加载对象数据集，返回一个OMLTask对象

# 选择任务
otask <- otsk(id = 359983)

# 查看任务
otask

# 查看完整数据
otask$data

# 查看数据集的划分
otask$task_splits %>% head()

<OMLTask:359983>
 * Type: Supervised Classification
 * Data: adult (id: 1590; dim: 48842x15)
 * Target: class
 * Estimation: crossvalidation (id: 1; repeats: 1, folds: 10)


<OMLData:1590:adult> (48842x15)
 * Default target: class

<table class="dataframe"> <caption>A data.table: 6 x 4</caption> <thead> <tr><th scope=col>type</th><th scope=col>rowid</th><th scope=col>repeat.</th><th scope=col>fold</th></tr> <tr><th scope=col><fct></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th></tr> </thead> <tbody> <tr><td>TRAIN</td><td>32427</td><td>0</td><td>0</td></tr> <tr><td>TRAIN</td><td>13077</td><td>0</td><td>0</td></tr> <tr><td>TRAIN</td><td>15902</td><td>0</td><td>0</td></tr> <tr><td>TRAIN</td><td>17703</td><td>0</td><td>0</td></tr> <tr><td>TRAIN</td><td>35511</td><td>0</td><td>0</td></tr> <tr><td>TRAIN</td><td>44497</td><td>0</td><td>0</td></tr> </tbody> </table>

从OMLTask对象提取Task

tsk_adult <- as_task(otask)
tsk_adult

[36m--[39m [1m[34m<TaskClassif>[39m (48842x15)[22m [36m----------------------------------------------------[39m
* Target: class
* Target classes: >50K (positive class, 24%), <=50K (76%)
* Properties: twoclass
* Features (14):
  * fct (8): education, marital.status, native.country, occupation, race,
  relationship, sex, workclass
  * int (6): age, capital.gain, capital.loss, education.num, fnlwgt,
  hours.per.week

从OMLTask里提取Resampling

resampling <- as_resampling(otask)
resampling

[36m--[39m [1m[34m<ResamplingCustom>[39m : Custom Splits[22m [36m------------------------------------------[39m
* Iterations: [34m10[39m
* Instantiated: [34mTRUE[39m
* Parameters: list()

tsk()可以允许上面两个步骤一步到位

tsk("oml", task_id = 359983)

[36m--[39m [1m[34m<TaskClassif>[39m (48842x15)[22m [36m----------------------------------------------------[39m
* Target: class
* Target classes: >50K (positive class, 24%), <=50K (76%)
* Properties: twoclass
* Features (14):
  * fct (8): education, marital.status, native.country, occupation, race,
  relationship, sex, workclass
  * int (6): age, capital.gain, capital.loss, education.num, fnlwgt,
  hours.per.week

任务集合

OpenML任务集合是一个捆绑现有任务的容器对象
- 这使得可以创建benchmark测试套件，
  即满足特定质量标准的指定任务集合
OMLCollection对象通过ocl()加载

otask_collection <- ocl(id = 99)
otask_collection

INFO  [01:38:51.539] Retrieving JSON [90m{[39m[38;5;169murl[39m[90m: [39m`https://www.openml.org/api/v1/json/study/99`[90m, [39m[38;5;169mauthenticated[39m[90m: [39m`FALSE`[90m}[39m
<OMLCollection: 99> OpenML-CC18 Curated Class[...]
 * data:  72
 * tasks: 72

查看前五个任务

otask_collection$task_ids[1:5]

[1]  3  6 11 12 14

任务集合可用于在 mlr3 中快速定义基准实验
使用 as_tasks()和 as_resamplings()
轻松构建基准测试套件中的所有任务和重采样

tasks <- as_tasks(otask_collection)
resamplings <- as_resamplings(otask_collection)

进一步筛选数据
- 进行一个包含六项任务的二分类实验，
  我们可以将CC - 18数据集中的任务ID作为参数task_id来运行list_oml_tasks()
- 既可以使用list_oml_tasks()的参数，
  要求类别数量为2
- 可以通过list_oml_tasks()的返回结果是data.table，
  从而对生成的表格进行子集化处理

binary_cc18 <- list_oml_tasks(
  # 上限6个任务
  limit = 6,
  # 用id选择任务
  task_id = otask_collection$task_ids,
  # 筛选二元分类的变量
  number_classes = 2
)

将选定的任务转换为OMLTask并提取Task和Resampling

# 批量传递选择的id给`otsk()`
otasks <- lapply(binary_cc18$task_id, otsk)

# 提取`Task`和`Resampling`
tasks <- as_tasks(otasks)
resamplings <- as_resamplings(otasks)

设计benchmark测试

# ----------这里是最开始的学习器管道
# 无特征值基线学习器
lrn_baseline <- lrn("classif.featureless", id = "featureless")

# 构建逻辑回归学习器
lrn_lr <- lrn("classif.log_reg")
# 构建用于逻辑回归的`GraphLearner`
# ppl("robustify", learner = lrn_lr)表示用于逻辑回归的管道
lrn_lr <- as_learner(ppl("robustify", learner = lrn_lr) %>>% lrn_lr)
# 识别id
lrn_lr$id <- "logreg"
# 封装及回退学习器
lrn_lr$encapsulate("try", fallback = lrn_baseline)

# 构建随机森林学习器
lrn_rf <- lrn("classif.ranger")
# 构建用于随机森林的`GraphLearner`
lrn_rf <- as_learner(ppl("robustify", learner = lrn_rf) %>>% lrn_rf)
# 识别id
lrn_rf$id <- "ranger"
# 封装及回退学习器
lrn_rf$encapsulate("try", fallback = lrn_baseline)

# 放到一个`list`里
learners <- list(lrn_lr, lrn_rf, lrn_baseline)


# benchmark设计
large_design <- benchmark_grid(
 tasks, 
 learners, 
 resamplings,
 paired = TRUE
)
# 查看前六个实验
large_design[1:6]

       task     learner resampling
     <char>      <char>     <char>
1: kr-vs-kp      logreg     custom
2: kr-vs-kp      ranger     custom
3: kr-vs-kp featureless     custom
4: breast-w      logreg     custom
5: breast-w      ranger     custom
6: breast-w featureless     custom

高性能计算集群上的benchmark测试

简介

batchtools 提供了一个框架，
用于简化在这类站点上从R语言并行运行大量计算实验的过程
- 它具有高度的灵活性，适用于各种计算实验，
  包括机器学习、优化、模拟等

实验注册表设置

library(batchtools)

# create registry
reg = makeExperimentRegistry(
  file.dir = "./experiments",
  seed = 1,
  packages = "mlr3verse"
)

library(mlr3batchmark)
batchmark(large_design, reg = reg)

reg

job_table = getJobTable(reg = reg)
job_table = unwrap(job_table)
job_table = job_table[,
  .(job.id, learner_id, task_id, resampling_id, repl)
]

job_table

作业工作

result = testJob(1, external = TRUE, reg = reg)

cf = makeClusterFunctionsSlurm(template = "slurm-simple")

reg$cluster.functions = cf
saveRegistry(reg = reg)

ids = job_table$job.id
chunks = data.table(
  job.id = ids, chunk = chunk(ids, chunk.size = 5, shuffle = FALSE)
)
chunks[1:6] # first 6 jobs

resources = list(ncpus = 1, walltime = 3600, memory = 8000)

submitJobs(ids = chunks, resources = resources, reg = reg)

# wait for all jobs to terminate
waitForJobs(reg = reg)

工作监控、错误处理与结果收集

getStatus(reg = reg)

extra_design = benchmark_grid(tasks,
  lrn("classif.debug", error_train = 0.5), resamplings, paired = TRUE)

batchmark(extra_design, reg = reg)

ids = findNotSubmitted(reg = reg)
submitJobs(ids, reg = reg)

getStatus(reg = reg)

error_ids = findErrors(reg = reg)
summarizeExperiments(error_ids, by = c("task_id", "learner_id"),
  reg = reg)

ids = findExperiments(algo.pars = learner_id != "classif.debug",
  reg = reg)
bmr = reduceResultsBatchmark(ids, reg = reg)
bmr$aggregate()[1:5]

使用batchtools进行自定义实验

reg = makeExperimentRegistry(
  file.dir = "./experiments-custom",
  seed = 1,
  packages = "mlr3verse"
)

for (i in seq_along(tasks)) {
  addProblem(
    name = tasks[[i]]$id,
    data = list(task = tasks[[i]], resampling = resamplings[[i]]),
    fun = function(data, job, ...) data,
    reg = reg
  )
}

addAlgorithm(
  "run_learner",
  fun = function(instance, learner, job, ...) {
    resample(instance$task, learner, instance$resampling)
  },
  reg = reg
)

alg_des = list(run_learner = data.table(learner = learners))
addExperiments(algo.designs = alg_des, reg = reg)
summarizeExperiments()

submitJobs(reg = reg)

rr = loadResult(1, reg = reg)
as.data.table(rr)[1:5]

bmr = reduceResults(c, reg = reg)
bmr$aggregate()[1:5]

统计分析

library(mlr3benchmark)
bma = as_benchmark_aggr(bmr, measures = msr("classif.ce"))
bma$friedman_posthoc()

autoplot(bma, type = "cd", ratio = 1/5)

【mlr3】5.模型解释

Fri, 18 Jul 2025 00:00:00 GMT

Cover Pic by @Lin

Applied Machine Learning Using mlr3 in R

简介

模型解释的方法
- 为了全面了解一个模型，
  确定哪些特征总体上最为重要，
  或者这些特征如何影响预测结果
- 如果（在数据或模型中）发现缺陷，
  例如模型意外地依赖于某一特征，
  需对模型进行改进
- 为了理解和控制单个预测，
  例如确定如果某个特征发生改变，
  给定的预测可能会如何变化
- 为了评估算法公平性，
  检查模型是否对某些子群体或个体产生不利影响

示例学习器

以一个梯度提升机（GBM）为例，
该模型拟合了“german_credit”任务中一半的特征

# 加载R包
# library(mlr3verse)

tsk_german <- tsk('german_credit')$
 select(
  cols = c(
   'duration', 
   'amount', 
   'age', 
   'status', 
   'savings', 
   'purpose',
   'credit_history', 
   'property', 
   'employment_duration', 
   'other_debtors'
  )
)
split <- partition(tsk_german)
lrn_gbm <- lrn('classif.gbm', predict_type = 'prob')
lrn_gbm$train(tsk_german, row_ids = split$train)

`iml` 包

简介

iml
- 为各种与模型无关的解释方法实现了一个统一接口，
  有助于分析和解释机器学习模型
- 支持由任何 R 包拟合的机器学习模型（用于分类或回归），
  特别是所有 mlr3 模型都通过将学习器包装在 Predictor 对象中来提供支持，
  该对象统一了训练模型的输入输出行为
- 此对象包含预测模型以及用于分析模型和生成所需解释的数据

# 加载R包
# library(iml)

# 测试集的特征变量
credit_x <- tsk_german$data(
 rows = split$test,
 cols = tsk_german$feature_names
)
# 测试集的预测变量
credit_y <- tsk_german$data(
 rows = split$test,
 cols = tsk_german$target_names
)

# 构建一个预测器
predictor <- Predictor$new(lrn_gbm, data = credit_x, y = credit_y)

特征重要性（Feature Importance）

最流行的特征重要性方法之一是排列特征重要性（PFI）
- 特征排列是指对数据集中单个特征的观测值进行随机打乱的过程
- 这会消除该特征与目标变量以及所有其他特征之间的原始依赖结构，
  同时保持该特征的边际分布
- PFI衡量的是在排列某个特征之前（原始模型性能）和
  之后（排列后模型性能）模型性能的变化
- 如果某个特征不重要，那么排列该特征后模型性能的变化就会很小；
  相反，如果该特征更为重要，我们预计模型性能会明显下降
- 通常建议重复排列过程，并在多次重复中汇总性能变化，
  以减少结果的随机性
在iml中运行PFI，需构建一个FeatureImp类的对象，并指定性能度量，
- 这里我们使用分类误差
默认情况下，为缩短计算时间，
排列重复五次，并且在每次重复中，计算与分类误差变化相对应的重要性值
- 在调用构造函数$new()时，
  可以使用n.repetitions改变此设置，
  本例中设置n.repetitions = 100
$plot()方法展示五个所得重要性值的中位数（以点表示），
图中的误差线边界对应重要性值的5%和95%分位数
默认情况下，FeatureImp会将重排前后模型性能的比率作为重要性值进行计算；
在调用$new()时传入compare = 'difference'，则可以返回性能指标的差值

importance <- FeatureImp$new(
 predictor, 
 loss = 'ce', 
 n.repetitions = 100
)
importance$plot() + theme_bw()

特征效应（Feature Effects）

通过分析当改变一个特征时预测如何变化，来描述一个特征对模型预测的贡献方式或程度
这些方法可以分为局部特征效应方法和全局特征效应方法
- 全局特征效应方法：
  是指当一个特征发生变化时，平均而言预测如何变化
- 局部特征效应方法：
  当一个特征值发生变化时，给定观测值的单个预测如何变化
- 当局部效应存在异质性时，
  即如果局部效应的变化在不同观测值之间有所不同，
  局部特征效应方法可以揭示模型中的相互作用
个体条件期望（ICE）曲线（其他条件不变效应
- 一种局部特征效应方法，
  用于展示在改变某个感兴趣特征时，
  单个观测值的预测结果如何变化，而所有其他特征保持不变
- 构建方法：
  选取单个观测值和感兴趣的特征，然后用另一个值替换该特征的值，
  并绘制新的预测结果，随后对该特征的许多值重复此过程
  （例如，在该特征值范围的等距网格上进行）
特征效应与线性模型中的回归系数 β 非常相似
- 回归系数的解释为：
  如果在其他所有特征保持不变的情况下，将此特征增加一个单位，预测值平均会增加 β”
- 特征效应并不局限于线性效应，还可以应用于任何类型的预测模型
下例为对特征amount的效应的评估
- 传递感兴趣的特征名称和特征效应方法，初始化FeatureEffect类的对象
- 使用'pdp+ice'表示希望用部分依赖（PD）图（ICE曲线的平均值）来
  可视化个体条件期望（ICE）曲线
下图中，黄色的部分依赖（PD）图和黑色的个体条件期望（ICE）曲线，
展示了信贷金额如何影响预测的信用风险
- 如果金额大致小于10,000，那么平均而言，
  预测信用状况良好的可能性很大
- ICE曲线大致平行，这意味着在涉及金额的情况下，
  似乎不存在强烈的相互作用
- 建议始终将PD曲线和ICE曲线一起绘制，因为单独的PD图可能会掩盖异质性效应

effect <- FeatureEffect$new(
 predictor, 
 feature = 'amount',
 method = 'pdp+ice'
)
effect$plot() + theme_bw()

代理模型（Surrogate Models）

简介

可解释模型（如决策树或线性模型）可用作替代模型，以近似或模拟通常非常复杂的黑箱模型
用于训练替代模型的特征通常与用于训练黑盒模型的特征相同，
或者至少是具有相同分布的数据，
以确保输入空间具有代表性
- 用于训练替代模型的目标是从黑盒模型获得的预测结果，
  而不是基础数据的真实结果
- 只有当替代模型很好地逼近黑盒模型时（即模型保真度较高时），
  从替代模型得出的结论才有效
  - 测量并报告替代模型的逼近误差也很重要
用于训练黑盒模型的数据可能非常复杂或有限，
这使得直接在这些数据上训练一个表现良好的可解释模型具有挑战性
可以使用黑盒模型在输入空间的特定区域生成新的带标签数据，
利用这些数据来扩充原始数据
扩充后的数据可用于训练一个可解释模型，该模型能够捕捉并解释黑盒模型（在特定区域）学到的关系，
或者识别缺陷或意外行为。

全局代理模型

初始化 TreeSurrogate 类会将条件推断树（ctree()）替代模型
应用于训练好的模型的预测结果
- 该类提取由树替代模型创建的决策规则
- $plot() 方法可视化每个终端节点预测结果的分布
下例中，向构造函数传入 maxdepth = 2 以构建具有两个二元分裂的树，
从而产生四个终端节点

tree_surrogate <- TreeSurrogate$new(predictor, maxdepth = 2L)

首先需要检查代理模型是否准确地逼近预测模型
- 可以通过比较树状代理模型的预测结果与黑箱模型的预测结果来进行评估
- 例如，可以量化匹配预测的数量，
  并衡量代理模型在预测黑箱GBM模型预测结果时的准确性
在输出结果中
- 与黑盒模型相比，代理模型的预测准确率约为82%

pred_surrogate <- tree_surrogate$predict(
 credit_x, 
 type = 'class'
)$.class
pred_surrogate <- factor(
 pred_surrogate, 
 levels = c('good', 'bad')
)
pred_gbm <- lrn_gbm$predict_newdata(credit_x)$response
confusion <- mlr3measures::confusion_matrix(
 pred_surrogate, 
 pred_gbm,
 positive = 'good'
)
confusion

        truth
response good bad
    good  261  13
    bad    31  25
acc :  0.8667; ce  :  0.1333; dor :  16.1911; f1  :  0.9223 
fdr :  0.0474; fnr :  0.1062; fomr:  0.5536; fpr :  0.3421 
mcc :  0.4692; npv :  0.4464; ppv :  0.9526; tnr :  0.6579 
tpr :  0.8938

通过绘制终端节点中的分割情况对上述结果作进一步解释，
结果中：
- 图片展示由树替代模型识别的每个终端节点的预测结果分布
- 前两个节点包含账户余额为正的申请
  （status为'0 <= ... < 200 DM'、'... >= 200 DM'或'salary for at least 1 year'），
  且期限小于或等于42个月（左上方），或超过42个月（右上方）
- 底部节点包含没有支票账户或账户余额为负的申请人（status），
  且期限小于或等于36个月（左下方）或超过36个月（右下方）

tree_surrogate$plot() + theme_bw()

通过$tree字段访问训练好的树形代理，
该字段属于TreeSurrogate对象，
之后便能访问partykit中的所有方法

partykit::print.party(tree_surrogate$tree)

[1] root
|   [2] status in no checking account, ... < 0 DM
|   |   [3] credit_history in delay in paying off in the past, critical account/other credits elsewhere, existing credits paid back duly till now: *
|   |   [4] credit_history in no credits taken/all credits paid back duly, all credits at this bank paid back duly: *
|   [5] status in 0<= ... < 200 DM, ... >= 200 DM / salary for at least 1 year
|   |   [6] credit_history in delay in paying off in the past, critical account/other credits elsewhere, existing credits paid back duly till now: *
|   |   [7] credit_history in no credits taken/all credits paid back duly, all credits at this bank paid back duly: *

局部代理模型

一般来说，要在整个特征空间中用可解释的替代模型准确逼近黑盒模型是非常困难的
- 因此，局部替代模型聚焦于特征空间中围绕感兴趣点的一个小区域
局部替代模型构建如下：
- 获取黑盒模型对给定数据集的预测结果
- 根据观测值与我们所关注的点的接近程度，对该数据集中的观测值进行加权
- 在加权数据集上使用黑箱模型的预测结果作为目标，拟合一个可解释的替代模型
- 用代理模型解释我们感兴趣点的预测结果
下例中，选择一个样本并取名为Charlie为例
首先查看黑箱预测的结果
- 以60.1%的概率预测类别为'good'

# 选择样本
Charlie <- tsk_german$data(
 rows = 127L, 
 cols = tsk_german$feature_names
)
# 预测
gbm_predict <- predictor$predict(Charlie)
# 查看
gbm_predict

<table class='dataframe'> <caption>A data.frame: 1 x 2</caption> <thead> <tr><th scope=col>good</th><th scope=col>bad</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>0.671859</td><td>0.328141</td></tr> </tbody> </table>

可以使用LocalModel来找出做出此预测的原因
- 底层代理模型是局部加权L1惩罚线性回归模型，
  这样每个类别只有预先定义数量的特征，
  即k（默认值为3），会有非零系数
  - 因此这些特征就是k个最具影响力的特征
  - 本例中将k = 2
- 还可以设置参数gower.power指定了局部模型的邻域大小
  （默认值为gower.power = 1），
  该值越小，模型就越关注靠近感兴趣点的点
  - 本例中将gower.power = 0.1
- 此实现与局部可解释模型无关解释（LIME）密切相关

predictor$class <- 'good' 
local_surrogate <- LocalModel$new(
 predictor, 
 Charlie, 
 gower.power = 0.1,
 k = 2
)

如果局部模型的预测结果与黑盒梯度提升机（GBM）模型的预测结果差异很大，
那么可能需要尝试更改 k 和 gower.power 参数
- 这些参数可被视为局部代理模型的超参数，
  为获得准确的局部代理模型，应对其进行调整
检查对Charlie的预测结果是否匹配：

c(
 gbm = gbm_predict[[1]], 
 local = local_surrogate$predict()[[1]]
)

      gbm     local 
0.6718590 0.6450047

理想情况下，应该评估查理局部邻域内代理模型的保真度，
即局部代理模型对查理附近多个数据点的黑盒梯度提升机（GBM）模型预测的近似程度
- 评估这种局部模型保真度的一种实用方法是，
  在查理的局部邻域内生成人工数据点
  （并可能应用基于距离的加权），
  或者从原始数据中选择k个最近邻
为了便于说明，使用根据高尔距离从10个最近邻（包括查理）
计算出的平均绝对误差来量化近似误差
- 针对查理的10个最近邻，
  局部代理模型与黑箱模型的预测结果仅相差0.084，可以认为局部模型与黑箱模型之间有良好一致性

# 提取最邻近的10个样本的id
ind_10nn <- gower::gower_topn(
 Charlie, 
 credit_x, 
 n = 10)$index[, 1]
# 用id索引数据
Charlie_10nn <- credit_x[ind_10nn, ]

# 预测器预测结果
gbm_pred_10nn <- predictor$predict(Charlie_10nn)[[1]]
# 代理模型预测结果
local_pred_10nn <- local_surrogate$predict(Charlie_10nn)[[1]]
# 计算平均绝对误差
mean(abs(gbm_pred_10nn - local_pred_10nn))

[1] 0.08418002

预测影响结果影响最大的特征
- duration和status=no checking account是重要的特征
- 它们的影响均是负面的

local_surrogate$results[, c('feature.value', 'effect')]

<table class="dataframe"> <caption>A data.frame: 2 x 2</caption> <thead> <tr><th></th><th scope=col>feature.value</th><th scope=col>effect</th></tr> <tr><th></th><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><th scope=row>duration</th><td>duration=12 </td><td>-0.005847644</td></tr> <tr><th scope=row>status=no checking account</th><td>status=no checking account</td><td>-0.092311934</td></tr> </tbody> </table>

夏普利值（Shapley Values）

沙普利值最初是在合作博弈论的背景下提出的，
用于研究如何在组成团队的参与者之间公平分配博弈的收益
在机器学习中，作为一种局部解释方法，
用于解释每个输入特征对单个观测值的最终模型预测的贡献
- 参与者即特征
- 应在各特征之间公平分配的收益，
  指的是单个观测值的预测与平均预测之间的差异
- 夏普利值估计了每个输入特征对单个观测值的最终预测贡献了多少
  （在减去平均预测值之后）
与作为局部代理模型的惩罚线性模型相比，
夏普利值保证了预测在各个特征之间得到公平分配，
因为在计算每个特征的贡献时，也考虑了特征之间的相互作用
沙普利值经常被误解为从模型训练中移除特征后预测值之间的差异
- 一个特征的沙普利值是通过考虑所有可能的特征子集，
  并计算包含和不包含感兴趣特征时模型预测的差异来计算的
- 它指的是在给定当前特征集的情况下，
  一个特征对实际预测值与平均预测值之差的平均边际贡献
通过将Predictor和感兴趣的观测值传递给Shapley的构造函数，
可以计算夏普利值
- 夏普利值的精确计算很耗时，
  因为这涉及考虑所有可能的特征组合来计算某个特征的边际贡献，
  因此，夏普利值的估计通常采用近似计算
- 可以增大sample.size参数（默认值为sample.size = 100），
  以获得对精确夏普利值更准确的近似
下面是对Charlie的夏普利值的计算及可视化
- 实际预测值（0.63）表示模型对我们感兴趣的观测值的预测
- 平均预测值（0.71）表示给定测试数据集上的平均预测值
- 每个水平条是给定特征的夏普里值（phi）

shapley <- Shapley$new(
 predictor, 
 x.interest = as.data.frame(Charlie),
 sample.size = 1000
)
shapley$plot() + theme_bw()

特征的夏普值（$\phi$）展示了如何在给定特征之间，
将Charlie信用良好的概率与数据集平均概率之间的差异进行公平分配
- 如果所有夏普值（$\phi$）之和等于实际预测值与平均预测值之间的差异，
  那么这种近似就足够好
在这里使用了sample.size = 1000，
使得查理的实际预测值（0.601）与
平均预测值（0.696）之间的预测差异达到 -0.09，
效果足够好
变量purpose对信用良好的概率具有最积极的影响，
预测概率增加了约5%
相比之下，变量status导致预测概率降低了超过10%

`counterfactuals`包

简介

counterfactuals包试图找出
对给定观测的输入特征进行尽可能小的改变，
从而导致不同的预测

假设分析法（What-If Method）

对于要解释的给定预测，反事实是数据集中具有所需预测的最接近的数据点
通常，可能存在许多可能的反事实数据点
一些早期的假设分析法仅生成单个、有点随意的反事实解释，
当反事实用于对模型的洞察或采取行动时可能会被视为有问题
可以使用假设分析方法来了解为使预测概率提高到75%，各特征需要如何变化
- 使用WhatIfClassif对象和Predictor进行初始化，
  并声明我们只想找到一个反事实（n_counterfactuals = 1L），
  增加n_counterfactuals会返回指定数量的最接近感兴趣点的反事实
- $find_counterfactuals()方法生成一个Counterfactuals类的反事实
  - 本例中将期望的预测概率设置在0.75到1之间（desired_prob = c(0.75, 1)）
- $evaluate(show_diff = TRUE)方法表示需要如何改变特征以生成我们期望的类别
下例的输出结果中表示为了达到75%的信用良好概率，
各个特征需要做出的变化条件

# 加载R包
# library(counterfactuals)

whatif <- WhatIfClassif$new(predictor, n_counterfactuals = 1L)
cfe <- whatif$find_counterfactuals(
 Charlie,
 desired_class = 'good', 
 desired_prob = c(0.75, 1)
)
data.frame(cfe$evaluate(show_diff = TRUE))

<table class="dataframe"> <caption>A data.frame: 1 x 15</caption> <thead> <tr><th scope=col>age</th><th scope=col>amount</th><th scope=col>credit_history</th><th scope=col>duration</th><th scope=col>employment_duration</th><th scope=col>other_debtors</th><th scope=col>property</th><th scope=col>purpose</th><th scope=col>savings</th><th scope=col>status</th><th scope=col>dist_x_interest</th><th scope=col>no_changed</th><th scope=col>dist_train</th><th scope=col>dist_target</th><th scope=col>minimality</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><chr></th><th scope=col><dbl></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><dbl></th><th scope=col><int></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>-10</td><td>6</td><td>NA</td><td>NA</td><td>NA</td><td>NA</td><td>NA</td><td>NA</td><td>NA</td><td>... >= 200 DM / salary for at least 1 year</td><td>0.1178903</td><td>3</td><td>0</td><td>0</td><td>2</td></tr> </tbody> </table>

最小改变量（MOC）方法

生成多个通过人工生成的反事实，这些反事实可能与给定数据集中的观测值不相等。反事实的生成基于一个优化问题，该问题旨在生成满足以下条件的反事实：
- 具有期望的预测结
- 接近所关注的观测值
- 只需要改变几个特征
- 与给定数据集中的观测值源自相同的分布
在多目标优化反事实生成法（MOC）中，
所有四个目标通过一种多目标优化方法同时进行优化
- 其他几种反事实方法依赖于单目标优化方法，
  即多个目标被合并为一个单一目标，例如，使用加权和
  - 单目标方法引发了对目标适当加权的担忧，
    并且无法考虑各个目标之间固有的权衡
  - 此外，它可能会将反事实搜索的解集限制为单个候选解
- 多目标优化反事实生成法（MOC）返回一组相对于这四个目标而言
  非支配的、因此同样良好的反事实（类似于帕累托前沿）
调用MOC方法与假设分析方法类似，但使用的是一个MOCClassif()对象
- 将epsilon参数设置为0，
  以便在优化过程中对预测值超出所需范围的反事实情况进行惩罚
- 可以通过fixed_features参数禁止特定特征发生变化，
  本例中限制age变量的变化
仅让多目标优化器运行30次以减少计算时间

moc <- MOCClassif$new(
 predictor, 
 epsilon = 0, 
 n_generations = 30L,
 fixed_features = 'age'
)
cfe_multi <- moc$find_counterfactuals(
 Charlie,
 desired_class = 'good', 
 desired_prob = c(0.75, 1)
)

多目标方法并不能保证所有反事实样本都具有所需的预测结果，
因此使用 $subset_to_valid() 将反事实样本限制为感兴趣的那些

cfe_multi$subset_to_valid()
cfe_multi

3 Counterfactual(s) 
 
Desired class: good 
Desired predicted probability range: [0.75, 1] 
 
Head: 
     age amount                              credit_history duration
   <int>  <int>                                      <fctr>    <int>
1:    40    701 no credits taken/all credits paid back duly       12
2:    40   2418 no credits taken/all credits paid back duly        5
3:    40    701 no credits taken/all credits paid back duly        8
   employment_duration other_debtors              property             purpose
                <fctr>        <fctr>                <fctr>              <fctr>
1:    1 <= ... < 4 yrs          none unknown / no property furniture/equipment
2:    1 <= ... < 4 yrs          none unknown / no property furniture/equipment
3:    1 <= ... < 4 yrs          none unknown / no property furniture/equipment
                      savings                                     status
                       <fctr>                                     <fctr>
1: unknown/no savings account ... >= 200 DM / salary for at least 1 year
2: unknown/no savings account                        no checking account
3: unknown/no savings account                        no checking account

这种方法生成了3个反事实样本
- 但由于这些样本是人工生成的，
  因此不一定等同于基础数据集中的实际观测值
$get_freq_of_feature_changes()方法
- 返回计算的数值结果
$plot_freq_of_feature_changes() 方法
- 该方法将可视化所有返回的反事实样本中特征变化的频率

cfe_multi$get_freq_of_feature_changes()
cfe_multi$plot_freq_of_feature_changes()

           duration              amount              status                 age 
          0.6666667           0.3333333           0.3333333           0.0000000 
     credit_history employment_duration       other_debtors            property 
          0.0000000           0.0000000           0.0000000           0.0000000 
            purpose             savings 
          0.0000000           0.0000000

可视化duration和amount的二位ICE图
- 预测值越高颜色越浅
- 颜色和等高线表示当duration和amount`不同，
  而所有其他特征设置为真实值时模型的预测值
- 白点显示真实预测值，
  黑点是仅对这两个特征进行改变的反事实值

cfe_multi$plot_surface(
 # 因为只能是二维的，所以只能写2个
 feature_names = c('duration', 'amount')
) +
    theme(
  axis.text.x = element_text(
   angle = 15, 
   hjust = .7
  )
 )

`DALEX`包

简介

方法类似于iml，但侧重于模型比较
该R包的逻辑假设：拉氏视角
- 探索模型的过程是迭代的，在连续的迭代中，
  我们希望比较不同的视角，包括不同模型呈现/学习到的视角
DALEX 包能与使用 mlr3 构建的任何分类和回归模型一起使用，
也可以与 R 中的其他框架一起使用
一旦熟悉了使用 DALEX 包的原理，就可以使用这个系列中的其他包，例如
- fairmodels：用于检测和减轻偏差
- modelStudio：用于交互式模型探索
- modelDown：用于自动生成可解释机器学习（IML）模型文档
- survex：用于解释生存模型
- treeshap：用于分析基于树的模型
对模型的分析通常是一个交互式过程
- 首先基于一个或多个性能指标对模型进行评估，这被称为浅层分析
- 在随后的一系列步骤中，可以通过探索单个变量或变量对的重要性，
  逐步深入到对选定变量与模型结果之间关系的深度分析，
  从而系统地加深对模型的理解
DALEX 也实现了一个包装器，为其功能提供了统一的接口
- 对于使用 mlr3 包创建的模型，使用 explain_mlr3()，
  它会创建一个 S3 explainer 对象
- 该对象是一个列表，至少包含：
  - 模型对象
  - 将用于计算解释的数据集
  - 预测函数
  - 计算残差的函数
  - 模型名称/标签
  - 有关模型的其他附加信息

# 加载R包
# library(DALEX)
# library(DALEXtra)

gbm_exp <- DALEXtra::explain_mlr3(
 # 学习器
 lrn_gbm,
 # 预测变量/特征变量
 data = credit_x,
 # 目的变量
 # 这里要转换成数值
 y = as.numeric(
  credit_y$credit_risk == 'bad'
 ),
 # 加一个类似于标题的模型标签
 label = 'GBM Credit',
 # 关闭输出中编码高亮
 colorize = FALSE
)

gbm_exp

Preparation of a new explainer is initiated
  -> model label       :  GBM Credit 
  -> data              :  330  rows  10  cols 
  -> target variable   :  330  values 
  -> predict function  :  yhat.LearnerClassif  will be used (  default  )
  -> predicted values  :  No value for predict function target column. (  default  )
  -> model_info        :  package mlr3 , ver. 1.0.1 , task classification (  default  ) 
  -> predicted values  :  numerical, min =  0.03676402 , mean =  0.2926774 , max =  0.8648177  
  -> residual function :  difference between y and yhat (  default  )
  -> residuals         :  numerical, min =  -0.8589291 , mean =  -0.007828932 , max =  0.9025613  
  A new explainer has been created!  


Model label:  GBM Credit 
Model class:  LearnerClassifGBM,LearnerClassif,Learner,R6 
Data head  :
  age amount                              credit_history duration
1  67   1169     all credits at this bank paid back duly        6
2  25   1295 no credits taken/all credits paid back duly       12
  employment_duration other_debtors                                    property
1            >= 7 yrs          none                       unknown / no property
2              < 1 yr          none building soc. savings agr. / life insurance
              purpose                    savings              status
1 furniture/equipment             ... >= 1000 DM no checking account
2              others unknown/no savings account          ... < 0 DM

全局EMA

全局EMA旨在了解模型对一组观测值的平均表现
在DALEX中，用于全局层面分析的函数都以model_为前缀
model_performance()
- 检测任务类型并选择最合适的度量
- 由于本例使用的是二分类，该函数会自动推荐
  召回率、精确率、F1分数、准确率和AUC
- 同样，默认的绘图方法也是根据任务类型选择的，
  本例中选择的是ROC

perf_credit <- model_performance(gbm_exp)
perf_credit

Measures for:  classification
recall     : 0.393617 
precision  : 0.6607143 
f1         : 0.4933333 
accuracy   : 0.769697 
auc        : 0.815678

Residuals:
         0%         10%         20%         30%         40%         50% 
-0.85892907 -0.41538465 -0.30027241 -0.21133774 -0.16170458 -0.13283445 
        60%         70%         80%         90%        100% 
-0.08615409 -0.04690813  0.45116163  0.64841892  0.90256128

可视化ROC曲线

# 设置绘图风格
# Explanatory Model Analysis, EMA
old_theme <- set_theme_dalex('ema')
plot(perf_credit, geom = 'roc')

特征重要性方法可以通过 model_parts() 计算，然后绘制成图

gbm_effect <- model_parts(gbm_exp)
head(gbm_effect)

<table class="dataframe"> <caption>A model_parts: 6 x 4</caption> <thead> <tr><th></th><th scope=col>variable</th><th scope=col>permutation</th><th scope=col>dropout_loss</th><th scope=col>label</th></tr> <tr><th></th><th scope=col><chr></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><th scope=row>1</th><td>full_model </td><td>0</td><td>0.1843220</td><td>GBM Credit</td></tr> <tr><th scope=row>2</th><td>other_debtors </td><td>0</td><td>0.1839434</td><td>GBM Credit</td></tr> <tr><th scope=row>3</th><td>property </td><td>0</td><td>0.1863190</td><td>GBM Credit</td></tr> <tr><th scope=row>4</th><td>employment_duration</td><td>0</td><td>0.1892851</td><td>GBM Credit</td></tr> <tr><th scope=row>5</th><td>age </td><td>0</td><td>0.1897268</td><td>GBM Credit</td></tr> <tr><th scope=row>6</th><td>savings </td><td>0</td><td>0.1962698</td><td>GBM Credit</td></tr> </tbody> </table>

model_parts函数中的type参数可让指定如何计算特征的重要性，方式包括：
- type = "difference"：损失函数的差值
- type = "ratio"：比例
- type = "raw"：不进行任何变换

plot(gbm_effect, show_boxplots = FALSE)

特征效应可以通过 model_profile() 计算
- 默认情况下以PD图的形式绘制

# 计算特征效应
gbm_profiles <- model_profile(gbm_exp)
# 输出结果
# 但这里只是类似于`head()`出来的上面部分
gbm_profiles

Top profiles    : 
   _vname_    _label_ _x_    _yhat_ _ids_
1 duration GBM Credit   4 0.2219987     0
2 duration GBM Credit   5 0.2219987     0
3 duration GBM Credit   6 0.2219987     0
4 duration GBM Credit   7 0.2219987     0
5 duration GBM Credit   8 0.2219987     0
6 duration GBM Credit   9 0.2393805     0

绘制全局EMA图，可以发现
- age在到40岁前都是负相关
- amount在10000刀后是正相关，
  10000刀以前是一个不稳定的U型相关
- duration与较强的正相关

plot(gbm_profiles) +
 theme(legend.position = 'top') +
 ggtitle('Partial Dependence for GBM Credit model','')

局部EMA

旨在了解模型对单个观测值的表现
在DALEX中，用于局部分析的函数都以predict_为前缀
再次使用Charlie进行以下示例。

predict(gbm_exp, Charlie)

bad: 0.328141025695372

分解（break down）图
- 将模型的预测分解为可归因于不同解释变量的贡献
- 使用 predict_parts() 计算得出的
下图中
- 正归因以绿色显示
- 负归因以红色显示
- 紫色条形对应于被解释观测值的模型预测
- 虚线对应于模型平均预测

plot(
 predict_parts(
  gbm_exp, 
  new_observation = Charlie
 )
)

predict_parts()函数还可通过设置type = "shap"，
使用SHAP算法绘制夏普值
- 分解和SHAP方法的结果通常相似
- 如果模型中存在许多复杂的相互作用，就会出现差异
计算夏普利值可能需要很长时间
- 这个过程可以通过牺牲准确性来加快
- 参数 B 和 N 可用于调整这种权衡
  - N：用于估计条件期望值的观测数量（默认值为500）
  - B：用于计算夏普利值的随机路径数量（默认值为25）

plot(
 predict_parts(
  gbm_exp, 
  new_observation = Charlie, 
  type = 'shap'
 ),
 show_boxplots = FALSE
)

使用 predict_profile() 绘制ICE曲线

plot(
 predict_profile(
  gbm_exp,  
  credit_x[30:40, ]
 )
)

注意事项

罗生门效应（Rashomon Effect）

从解释方法得出的解释可能具有模糊性
一种方法可能会给出多个同样合理但可能相互矛盾的解释
这种效应可能是由于超参数，基础数据集，
甚至初始随机种子的变化导致的

高维数据（High-Dimensional Data）

由于计算成本巨大，将现成的解释方法应用于高维数据集往往不可行
- 诸如使用基于核的估计量的夏普利值等最新方法已被开发出来以帮助克服这一问题
另一个挑战是，为高维数据集生成的高维可解释机器学习输出可能会让用户应接不暇
- 如果能够对特征进行有意义的分组，就可以应用分组版本的方法，例如分组特征重要性

【mlr3】6.回归与分类以外问题

Thu, 17 Jul 2025 00:00:00 GMT

Cover Pic by @bybao

Applied Machine Learning Using mlr3 in R

简介

mlr3中主要的包含4个构建块（building block）
- Task
- Learner
- Prediction
- Measure
部分可与mlr3框架配合使用的扩展任务表

Task	Package	Description
Deterministic regression	`mlr3`	Point prediction of a continuous variable.
Deterministic single-label classification	`mlr3`	Prediction of a single class for each observation.
Probabilistic single-label classification	`mlr3`	Prediction of the probability of an observation falling into one or more mutually exclusive categories.
Cost-sensitive classification	`mlr3` and `mlr3pipelines`	Classification predictions with unequal costs associated with misclassifications.
Survival analysis	`mlr3proba`	Time-to-event predictions with possible ‘censoring’.
Density estimation	`mlr3proba`	Unsupervised estimation of probability density functions.
Spatiotemporal analysis	`mlr3spatiotempcv` and `mlr3spatial`	Supervised prediction of data with spatial (e.g., coordinates) and/or temporal outcomes.
Cluster analysis	`mlr3cluster`	Unsupervised estimation of homogeneous clusters of data points.

代价敏感分类（Cost-Sensitive Classification）

代价敏感分类的目标是使预期代价最小化
示例任务：tsk('german_credit')
背景：假设试图计算借给某人5000美元，
一年后是否能盈利，前提是预计他们会偿还6000美元
为了进行这个计算，你需要预测这个人是否有良好的信用
- 这是一个确定性分类问题，需要预测某人属于'好'或'坏'类别
- 现在让考虑与每个预测和最终结果相关的一些潜在成本
  - 由于成本敏感分类是一个最小化问题，
    假设成本越低，利润/积极结果就越高，
    因此将利润记为负值，损失记为正值

costs <- matrix(
 c(
  # 预测守信且真守信
  -1, # 赚1000
  # 预测失信但守信
  0, # 无得失，因为不会借
  # 预测守信但失信
  5, # 打水飘，亏5000
  # 预测失信且真失信
  0 # 无得失，因为不会借
 ), 
 nrow = 2, 
 dimnames = list(
  'Predicted Credit' = c('good', 'bad'),
  Truth = c('good', 'bad')
 )
)

costs

                Truth
Predicted Credit good bad
            good -1   5  
            bad   0   0

成本敏感度量

msr('classif.costs')
- cost传递成本计算矩阵

# 加载R包
# library(mlr3verse)

# 任务
tsk_german <- tsk('german_credit')
# 评估器
msr_costs <- msr('classif.costs', costs = costs)
# 查看评估器
msr_costs

[36m--[39m [1m[34m<MeasureClassifCosts>[39m (classif.costs): Cost-sensitive Classification[22m [36m--------[39m
* Packages: [34mmlr3[39m
* Range: [-Inf, Inf]
* Minimize: [34mTRUE[39m
* Average: macro
* Parameters: normalize=TRUE
* Properties: weights
* Predict type: response
* Predict sets: test
* Aggregator: mean()

使用3种算法的学习器进行benchmark比较
- 可以看到逻辑回归学习器表现最好，
  因为有最低的成本

learners <- lrns(
 c(
 'classif.log_reg', 
 'classif.featureless',
 'classif.ranger'
 )
)
bmr <- benchmark(
 benchmark_grid(
  tsk_german, 
  learners,
  rsmp('cv', folds = 3)
 )
)
bmr$aggregate(msr_costs)[, c(4, 7)]

<table class='dataframe'> <caption>A bmr_aggregate: 3 x 2</caption> <thead> <tr><th scope=col>learner_id</th><th scope=col>classif.costs</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>classif.log_reg </td><td>0.1608225</td></tr> <tr><td>classif.featureless</td><td>0.7999317</td></tr> <tr><td>classif.ranger </td><td>0.2218926</td></tr> </tbody> </table>

阈值调整

下图为不同概率判断阈值时，成本的曲线变化
- 虽然默认的阈值是0.5，
  但很显然，通过提高阈值可以降低成本

prediction <- lrn(
 'classif.log_reg',
 predict_type ='prob'
)$train(tsk_german)$predict(tsk_german)

autoplot(
 prediction, 
 type = 'threshold', 
 measure = msr_costs
)

对po('tunethreshold')进行调优，
以自动确定最优阈值
- 过使用po('learner_cv')进行内部重采样，
  并使用po('tunethreshold')来寻找最佳阈值，
  显著提高了模型性能，甚至有望实现盈利

po_cv <- po(
 'learner_cv', 
 lrn(
  'classif.log_reg', 
  predict_type = 'prob'
 )
)
graph <- po_cv %>>% po('tunethreshold', measure = msr_costs)

learners <- list(as_learner(graph), lrn('classif.log_reg'))
bmr <- benchmark(
 benchmark_grid(
  tsk_german, 
  learners,
  rsmp('cv', folds = 3)
 )
)

bmr$aggregate(msr_costs)[, c(4, 7)]

<table class='dataframe'> <caption>A bmr_aggregate: 2 x 2</caption> <thead> <tr><th scope=col>learner_id</th><th scope=col>classif.costs</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>classif.log_reg.tunethreshold</td><td>-0.1270222</td></tr> <tr><td>classif.log_reg </td><td> 0.1069962</td></tr> </tbody> </table>

生存分析（Survival Analysis）

简介

生存分析建模的关键在于，假设存在一个假设时间，
即如果马拉松运动员没有被删失，他们本应完成比赛的时间
- 生存分析学习器的任务就是估计类似运动员在未被删失的情况下的
  真实生存时间
从数学角度来看，假设用事件时间$Y$，
假设删失时间$C$，
观察到的结果时间$T=min(Y,C)$，事件指示符$Δ:=(T=Y)$以及通常的一些特征X来表示
学习器基于$(T,Δ)$进行训练，
但关键的是，要根据之前未见过的特征对Y进行预测
这意味着与分类和回归不同，学习器基于两个变量$(T,Δ)$进行训练
- 在R语言中，这通常用一个Surv对象来表示
mlr3 只能讨论右删失问题

本例中，随机生成六个生存时间和六个事件指示符，
结果中带有+表示该结果被删失，
否则表示发生了感兴趣的事件

# 加载R包
# library(survival)

# 随机生成数据，用`Surv`包装
Surv(runif(6), rbinom(6, 1, 0.5))

[1] 0.33865314  0.82852654+ 0.20506836  0.05573181+ 0.48054274  0.44972267

TaskSurv

使用 as_task_surv() 创建生存任务，
并有额外参数：
- time：时间
- event：事件
- type：目前只能为'right'且默认

# 加载R包
# library(mlr3verse)
# library(mlr3proba)
# library(survival)

tsk_rats <- as_task_surv(
 survival::rats, 
 time = 'time',
 event = 'status', 
 type = 'right', 
 id = 'rats'
)

tsk_rats$head()

<table class='dataframe'> <caption>A data.table: 6 x 5</caption> <thead> <tr><th scope=col>time</th><th scope=col>status</th><th scope=col>litter</th><th scope=col>rx</th><th scope=col>sex</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><int></th><th scope=col><dbl></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><td>101</td><td>0</td><td>1</td><td>1</td><td>f</td></tr> <tr><td> 49</td><td>1</td><td>1</td><td>0</td><td>f</td></tr> <tr><td>104</td><td>0</td><td>1</td><td>0</td><td>f</td></tr> <tr><td> 91</td><td>0</td><td>2</td><td>1</td><td>m</td></tr> <tr><td>104</td><td>0</td><td>2</td><td>0</td><td>m</td></tr> <tr><td>102</td><td>0</td><td>2</td><td>0</td><td>m</td></tr> </tbody> </table>

绘制 Kaplan-Meier 图
- 该图是训练集中平均观测值生存概率的非参数估计

autoplot(tsk_rats)

加载其他用于练习的任务

as.data.table(mlr_tasks)[task_type == 'surv']

<table class='dataframe'> <caption>A data.table: 10 x 15</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>task_type</th><th scope=col>nrow</th><th scope=col>ncol</th><th scope=col>properties</th><th scope=col>lgl</th><th scope=col>int</th><th scope=col>dbl</th><th scope=col>chr</th><th scope=col>fct</th><th scope=col>ord</th><th scope=col>pxc</th><th scope=col>dte</th><th scope=col>lt</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><int></th><th scope=col><int></th><th scope=col><list></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th><th scope=col><int></th></tr> </thead> <tbody> <tr><td>actg </td><td>ACTG 320 </td><td>surv</td><td>1151</td><td>13</td><td></td><td>0</td><td>3</td><td>4</td><td>0</td><td>4</td><td>0</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>gbcs </td><td>German Breast Cancer </td><td>surv</td><td> 686</td><td>10</td><td></td><td>0</td><td>4</td><td>4</td><td>0</td><td>0</td><td>0</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>gbsg </td><td>German Breast Cancer </td><td>surv</td><td> 686</td><td>10</td><td></td><td>0</td><td>5</td><td>0</td><td>0</td><td>3</td><td>0</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>grace </td><td>GRACE 1000 </td><td>surv</td><td>1000</td><td> 8</td><td></td><td>0</td><td>2</td><td>4</td><td>0</td><td>0</td><td>0</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>lung </td><td>Lung Cancer </td><td>surv</td><td> 168</td><td> 9</td><td></td><td>0</td><td>6</td><td>0</td><td>0</td><td>1</td><td>0</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>mgus </td><td>MGUS </td><td>surv</td><td> 176</td><td> 9</td><td></td><td>0</td><td>0</td><td>6</td><td>0</td><td>1</td><td>0</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>pbc </td><td>Primary Biliary Cholangitis</td><td>surv</td><td> 276</td><td>19</td><td></td><td>0</td><td>5</td><td>5</td><td>0</td><td>7</td><td>0</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>rats </td><td>Rats </td><td>surv</td><td> 300</td><td> 5</td><td></td><td>0</td><td>2</td><td>0</td><td>0</td><td>1</td><td>0</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>veteran</td><td>Veteran </td><td>surv</td><td> 137</td><td> 8</td><td></td><td>0</td><td>3</td><td>0</td><td>0</td><td>3</td><td>0</td><td>0</td><td>0</td><td>0</td></tr> <tr><td>whas </td><td>Worcester Heart Attack </td><td>surv</td><td> 481</td><td>11</td><td></td><td>0</td><td>4</td><td>3</td><td>0</td><td>2</td><td>0</td><td>0</td><td>0</td><td>0</td></tr> </tbody> </table>

`LearnerSurv`，`PredictionSurv` 以及预测类型

mlr3proba与mlr3的预测接口不同
- 对于所有生存模型，只要有可能，
  就会返回所有可能的预测类型
- 如果一个模型能够计算出特定的预测类型，
  它就会在PredictionSurv中返回
- 做出这种设计决策的原因是，
  所有这些预测类型都可以相互转换
  - 因此一次性返回所有类型在计算上比
    重新运行模型以更改预测类型更简单
可预测的类型
- response：预测的生存时间
- distr：预测的生存分布，离散或连续分布均可
- lp：通过将拟合系数与测试数据相乘计算得出的线性预测值
- crank：连续风险排名

tsk_rats <- tsk('rats')
split <- partition(tsk_rats)
prediction_cph <- lrn('surv.coxph')$
 train(tsk_rats,split$train)$
 predict(tsk_rats, split$test)
prediction_cph

[36m--[39m [1m[34m<PredictionSurv>[39m for [34m99[39m observations:[22m [36m---------------------------------------[39m
 row_ids time status      crank         lp     distr
       2   49   TRUE -0.5700703 -0.5700703 <list[1]>
       9  104  FALSE -0.5470661 -0.5470661 <list[1]>
      10   91  FALSE -2.1443968 -2.1443968 <list[1]>
     ---  ---    ---        ---        ---       ---
     286  104  FALSE -1.0862016 -1.0862016 <list[1]>
     295  104  FALSE  1.4477346  1.4477346 <list[1]>
     296  104  FALSE  0.5571376  0.5571376 <list[1]>

`predict_type = 'response'`

从预测的结果看出，
预测的结果并不准确
- 由于每个真实值都是删失时间，
  预测结果是略有偏差还是糟糕透顶无法得知
- 由于没有切实可行的方法来评估这些模型，
  生存时间预测的实际用处不大

# 加载R包
# library(mlr3extralearners)

# 选择支持向量机
prediction_svm <- lrn(
 # 生存问题的支持向量机
 'surv.svm', 
 # `type = 'regression'` 优化生存时间预测的算法
 type = 'regression', 
 # 通常应该先调优
 gamma = 1e-3
)$
 # 训练
 train(tsk_rats, split$train)$
 # 预测
 predict(tsk_rats, split$test)

# 查看结果
data.frame(
 pred = prediction_svm$response[1:3],
 truth = prediction_svm$truth[1:3]
)

<table class='dataframe'> <caption>A data.frame: 3 x 2</caption> <thead> <tr><th scope=col>pred</th><th scope=col>truth</th></tr> <tr><th scope=col><dbl></th><th scope=col><Surv></th></tr> </thead> <tbody> <tr><td>93.52197</td><td> 49, 1</td></tr> <tr><td>93.11679</td><td>104, 0</td></tr> <tr><td>92.91621</td><td> 91, 0</td></tr> </tbody> </table>

`predict_type = 'distr'`

与回归中最常见的确定性/点预测不同，
生存分析中，分布预测更为常见
mlr3proba 中的大多数生存模型默认会进行分布预测
- 这些预测是使用 distr6 包实现的，
  该包支持对生存曲线（定义为 $1− 累积分布函数$）进行可视化和评估
下面示例中提取前三个 $distr 预测，
并计算在 $t=77$ 时的生存概率
- 预测的前三只老鼠在 $t=77$ 时存活的概率分别为
  97.1%，97.0%和99.4%

prediction_cph$distr[1:3]$survival(77)

A matrix: 1 x 3 of type dbl
77 0.9708998 0.9702328 0.9939012

`predict_type = 'lp'`

线性预测值（lp），在学术写作中常写为$η$，
在计算上是最简单的预测方式，
并且在回归建模中有自然的类似形式
在拟合简单线性回归模型$Y = Xβ$时，我们在估计$β$的值，
然后估计出的线性预测值为$X\hat{β}$
- 其中$\hat{β}$是估计出的系数
在简单生存模型中，线性预测值是相同的量（但估计方式略为复杂）
mlr3proba中的学习器实现主要聚焦于机器学习，
这些模型中很少有简单的线性形式，
这意味着对于大多数此类模型无法计算线性预测值
在实际应用中，当用于预测时，
线性预测值是相对风险/连续排序预测的替代

`predict_type = 'crank'`

在生存分析中最为常见，也是最容易混淆的
- 学术文献在生存分析中常常提到风险预测
  （生存模型常被称为 风险预测模型），
  却没有定义风险的含义
  - 通常，风险被定义为 $exp⁡(η)$，
    因为这是简单线性生存模型中常见的量
  - 有时风险被定义为 $exp⁡(−η)$
  - 有时它可能是一个没有明确意义的任意量
- 在 mlr3proba 为了避免混淆而定义了预测类型 crank
  - 它代表 continuous（连续的）ranking（排序）
下方输出的结果中：
- 第3只老鼠的死亡风险最低（数值越小代表风险越低），
  而第2只老鼠的死亡风险最高
- 预测值之间的差距还表明，
  第1只和第2只老鼠之间的风险差异
  小于第2只和第3只老鼠之间的差异
- 实际数值本身并无意义，
  因此比较样本（或论文或实验）
  之间的 crank 值并无意义。

prediction_cph$crank[1:3]

         1          2          3 
-0.5700703 -0.5470661 -2.1443968

注意：
- 对于生存预测中'风险'的解释，不同的R包之间存在差异，
  有时甚至同一包中的不同模型之间也有差异
- 在mlr3proba中，对crank有一个统一的解释：
  值越低，事件发生的风险越低；值越高，事件发生的风险越高

`MeasureSurv`

使用MeasureSurv对象进行评估
- 这些对象通过msr()以常规方式构建
生存度量可分为
- 判别措施：
  量化模型是否能正确识别
  一个观察结果的风险是否高于另一个；
  评估crank和/或lp预测
- 校准度量：
  量化平均预测是否接近真实情况
  （遗憾的是，在生存背景下，所有校准定义都不明确）；
  评估crank和/或lp预测
- 评分规则：
  量化概率预测是否接近真实值；
  评估distr预测
建议的评估方法
- distr预测的质量：
  综合生存布赖尔分数（ISBS）（msr('surv.graf')）
- 模型的区分度：
  使用一致性指数（msr('surv.cindex')）
- 模型的校准度：
  使用D校准（msr('surv.dcalib')）
全部用于生存任务的评估器

as.data.table(mlr_measures)[
  task_type == 'surv', c('key', 'predict_type')]

<table class='dataframe'> <caption>A data.table: 25 x 2</caption> <thead> <tr><th scope=col>key</th><th scope=col>predict_type</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><td>surv.brier </td><td>distr </td></tr> <tr><td>surv.calib_alpha </td><td>distr </td></tr> <tr><td>surv.calib_beta </td><td>lp </td></tr> <tr><td>surv.calib_index </td><td>distr </td></tr> <tr><td>surv.chambless_auc</td><td>lp </td></tr> <tr><td>surv.cindex </td><td>crank </td></tr> <tr><td>surv.dcalib </td><td>distr </td></tr> <tr><td>surv.graf </td><td>distr </td></tr> <tr><td>surv.hung_auc </td><td>lp </td></tr> <tr><td>surv.intlogloss </td><td>distr </td></tr> <tr><td>surv.logloss </td><td>distr </td></tr> <tr><td>surv.mae </td><td>response</td></tr> <tr><td>surv.mse </td><td>response</td></tr> <tr><td>surv.nagelk_r2 </td><td>lp </td></tr> <tr><td>surv.oquigley_r2 </td><td>lp </td></tr> <tr><td>surv.rcll </td><td>distr </td></tr> <tr><td>surv.rmse </td><td>response</td></tr> <tr><td>surv.schmid </td><td>distr </td></tr> <tr><td>surv.song_auc </td><td>lp </td></tr> <tr><td>surv.song_tnr </td><td>lp </td></tr> <tr><td>surv.song_tpr </td><td>lp </td></tr> <tr><td>surv.uno_auc </td><td>lp </td></tr> <tr><td>surv.uno_tnr </td><td>lp </td></tr> <tr><td>surv.uno_tpr </td><td>lp </td></tr> <tr><td>surv.xu_r2 </td><td>lp </td></tr> </tbody> </table>

评估预测的结果
- C指数>0.5，ISBS较低
- 但是DCalib较高
然而，如果不与某些基线
（通常是Kaplan-Meier法）进行比较，
就很难确定任何生存模型的性能

prediction_cph$score(msrs(c('surv.graf', 'surv.cindex', 'surv.dcalib')))

  surv.graf surv.cindex surv.dcalib 
 0.07465018  0.79166669  2.19975256

合成（Composition）

简介

原生（native）：未经任何后处理的情况下做出的预测
合成（composed）：在后处理后返回的预测

内部合成（Internal Composition）

mlr3proba 在内部使用合成方式，
为每个学习器返回一个'crank'预测
- 这是为了确保至少能依据一个标准（区分性能）
  对所有模型进行有意义的benchmark测试
mlr3proba使用以下规则来创建"crank"预测
- 如果一个模型返回一个'risk'预测，
  那么crank = risk（我们可能会将其乘以，以确保“低数值低风险”的解释）
- 如果模型返回一个response预测值，那么 crank = -response
- 如果一个模型返回一个lp预测值，那么 crank = lp
  （如果需要，也可以 crank = -lp）
- 如果一个模型返回一个distr预测，那么crank设置为累积风险函数的总和

显式合成（Explicit Composition）与管道

预测类型的转换管道
- pipeline_crankcompositor()：
  将"distr"预测转换为"crank"
  - 每当生存模型返回预测结果时，
    内部会使用该管道的一个版本，
    这样每个模型都有一个"crank"预测类型——
    所以只使用该管道来覆盖这些排名预测
- pipeline_distrcompositor()：
  将 "lp" 预测转换为 "distr"
  - 在实践中该管道更常见，
    因为Cox或加速失效时间（AFT）类型的模型
    总是返回一个线性预测值（"lp"），
    但有时内部的predict()函数
    并不提供转换为生存分布预测（"distr"）的功能
- pipeline_responsecompositor()：
  将 "distr" 预测转换为 "response"（生存时间）
  - 将预测的生存曲线汇总为一个单一数字（预期生存时间）
  - 如前所述，这对于评估生存机器学习模型的性能很少有用
在本示例中
- 加载rats数据集
- 删除因子列
- 将数据划分为训练集和测试集
- 围绕生存XGBoost加速失效时间（AFT）学习器
  （lrn("surv.xgboost.aft")）
  构建distrcompositor管道
  - 该学习器默认对"lp"、"crank"和"response"进行预测
管道中
- 指定将使用Kaplan - Meier估计器（estimator = "kaplan"）估计基线分布，
  并假设我们估计的分布采用AFT形式（form = "aft"）
- 以通常的方式进行训练和预测
- 在输出中可以看到distr预测

# 加载R包
# library(mlr3verse)
# library(mlr3extralearners)

# 数据预处理
tsk_rats <- tsk('rats')$select(c('litter', 'rx'))
split <- partition(tsk_rats)

# 学习器
learner <- lrn('surv.xgboost.aft', nrounds = 10)
# 训练和预测
learner$
 train(tsk_rats, split$train)$
 predict(tsk_rats, split$test)

# `GraphLearner`：`lp` -> `distr`
graph_learner <- ppl(
 'distrcompositor',
 learner = learner,
 estimator = 'kaplan',
 form = 'aft',
 graph_learner = TRUE
)
# 训练和预测
graph_learner$
 train(tsk_rats, split$train)$
 predict(tsk_rats, split$test)

[36m--[39m [1m[34m<PredictionSurv>[39m for [34m99[39m observations:[22m [36m---------------------------------------[39m
 row_ids time status     crank        lp response
       2   49   TRUE -5.671391 -5.671391 290.4381
       3  104  FALSE -5.671391 -5.671391 290.4381
       5  104  FALSE -5.671391 -5.671391 290.4381
     ---  ---    ---       ---       ---      ---
     295  104  FALSE -4.918093 -4.918093 136.7416
     298   92  FALSE -4.918093 -4.918093 136.7416
     299  104  FALSE -4.918093 -4.918093 136.7416



[36m--[39m [1m[34m<PredictionSurv>[39m for [34m99[39m observations:[22m [36m---------------------------------------[39m
 row_ids time status     crank        lp response     distr
       2   49   TRUE -5.671391 -5.671391 290.4381 <list[1]>
       3  104  FALSE -5.671391 -5.671391 290.4381 <list[1]>
       5  104  FALSE -5.671391 -5.671391 290.4381 <list[1]>
     ---  ---    ---       ---       ---      ---       ---
     295  104  FALSE -4.918093 -4.918093 136.7416 <list[1]>
     298   92  FALSE -4.918093 -4.918093 136.7416 <list[1]>
     299  104  FALSE -4.918093 -4.918093 136.7416 <list[1]>

从数学角度来看，上述的转换过程为
- 假设我们估计的分布形式为 $S(t) = S_0(\frac{t}{\exp(\eta)})$
  - $S$：生存函数
  - $S_0$：基线生存函数
  - $\eta$：是线性预测值
- 使用XGBoost估计 $\eta$ 预测值 $\hat{\eta}$
- 使用 Kaplan-Meier 估计器估计 $\hat{S}_0(t)$
- 将这些整合为$S(t) = \hat{S}_0(\frac{t}{\exp(\hat{\eta})})$

总揽流程

下面是整体流程
- 用ISBS，D校准和C指数来评估预测结果
- 结果
  - XGBoost-AFT和Cox PH具有最佳的区分度
  - Kaplan-Meier基线具有最佳的校准度
  - Cox PH具有最佳的整体预测准确度（ISBS最低）

# 设置随机数种子
# set.seed(42)
# 加载R包
# library(mlr3extralearners)

# 加载任务
tsk_grace <- tsk('grace')
# 随机挑选500个样本以减少演示例子耗时
tsk_grace$
 filter(
  sample(
   tsk_grace$nrow, 
   500
  )
 )
# 挑选评估器
msr_txt = c("surv.graf", "surv.cindex", "surv.dcalib")
measures <- msrs(msr_txt)

# 构建`GraphLearner`
graph_learner <- ppl(
  'distrcompositor',
  learner = lrn('surv.xgboost.aft', nrounds = 10),
  estimator = 'kaplan',
  form = 'aft',
  graph_learner = TRUE,
  scale_lp = TRUE
)
# 修改识别id
graph_learner$id = 'XGBoost-AFT'


bmr <- benchmark(
 benchmark_grid(
  tsk_grace, 
  # benchmark比较管道和2种基础学习器
  c(
   lrns(c('surv.coxph', 'surv.kaplan')), 
   graph_learner
  ),
  rsmp('cv', folds = 3)
 )
)
# 整合结果
bmr$aggregate(measures)[, c('learner_id', ..msr_txt)]

<table class="dataframe"> <caption>A bmr_aggregate: 3 x 4</caption> <thead> <tr><th scope=col>learner_id</th><th scope=col>surv.graf</th><th scope=col>surv.cindex</th><th scope=col>surv.dcalib</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>surv.coxph </td><td>0.09897859</td><td>0.8421613</td><td>5.328825</td></tr> <tr><td>surv.kaplan</td><td>0.20225391</td><td>0.5000000</td><td>4.148996</td></tr> <tr><td>XGBoost-AFT</td><td>0.21336577</td><td>0.8371936</td><td>5.789641</td></tr> </tbody> </table>

密度估计（Density Estimation）

密度估计旨在估计生成单变量数据集的未知分布
- 更简单地说，估计单个变量的概率密度（或质量）函数
与生存分析一样，密度估计在mlr3proba中实现
- 因为两者都可以进行概率分布预测（因此得名“mlr3probabilistic”）
无条件密度估计（即不使用任何协变量估计目标）被视为无监督任务，
这意味着真实情况永远是未知的
mlr3proba包使用以下用于密度估计的对象对mlr3进行了扩展
- TaskDens：密度问题任务
- LearnerDens：密度学习器
- PredictionDens：密度预测
- MeasureDens：密度性能评估器

`TaskDens`

as_task_dens() 构建密度估计任务

tsk_dens <- as_task_dens(data.table(x = rnorm(1000)))
tsk_dens

[36m--[39m [1m[34m<TaskDens>[39m (1000x1)[22m [36m---------------------------------------------------------[39m
* Target:
* Properties: -
* Features (1):
  * dbl (1): x

查看自带的一些密度估计任务

as.data.table(mlr_tasks)[task_type == 'dens', c(1:2, 4:5)]

<table class="dataframe"> <caption>A data.table: 2 x 4</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>nrow</th><th scope=col>ncol</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><int></th><th scope=col><int></th></tr> </thead> <tbody> <tr><td>faithful</td><td>Old Faithful Eruptions</td><td>272</td><td>1</td></tr> <tr><td>precip </td><td>Annual Precipitation </td><td> 70</td><td>1</td></tr> </tbody> </table>

`LearnerDens` 和 `PredictionDens`

密度学习器可能返回以下预测类型：
- distr：概率分布
- pdf：概率密度函数
- cdf：累积分布函数
所有的学习器都会返回一个distr和pdf预测，
但只有部分学习器能够进行cdf预测

# 直方图学习器
lrn_hist <- lrn('dens.hist')
# 训练和预测
prediction <- lrn_hist$
 train(tsk_dens, 1:900)$
 predict(tsk_dens, 901:1000)
# 设置区间
x <- seq.int(-2, 2, 0.01)
# 创建区间内每个点的概率密度dataframe
df <- data.frame(
 x = x, 
 y = prediction$distr$pdf(x)
)
# 可视化
ggplot(df, aes(x = x, y = y)) + 
 geom_line() + 
 theme_minimal()

pdf和cdf预测类型分别只是围绕distr$pdf和distr$cdf的简单包装器
这里可以发现
- pdf和cdf都储存在prediction里
- 也可从Prediction$distr$pdf()和
  Prediction$distr$cdf()调用学习器重新计算
  - 结果是一致的

prediction <- lrn_hist$
 train(tsk_dens, 1:10)$
 predict(tsk_dens, 11:13)
prediction

[36m--[39m [1m[34m<PredictionDens>[39m for [34m3[39m observations:[22m [36m----------------------------------------[39m
 row_ids pdf       cdf
      11 0.0 1.0000000
      12 0.6 0.7617717
      13 0.4 0.4279775

cbind(
 prediction$
  distr$
  cdf(tsk_dens$data()$x[11:13]),
 prediction$cdf[1:3]
)

<table class="dataframe"> <caption>A matrix: 3 x 2 of type dbl</caption> <tbody> <tr><td>1.0000000</td><td>1.0000000</td></tr> <tr><td>0.7617717</td><td>0.7617717</td></tr> <tr><td>0.4279775</td><td>0.4279775</td></tr> </tbody> </table>

`MeasureDens` 和总揽上述流程

mlr3proba 中用于密度估计的唯一已实施度量是对数损失（logloss）
- 其定义方式与分类中的定义相同，
  即 $L(y) = -\log(\hat{f}_Y(y))$
  - $\hat{f}_Y$：估计的概率密度函数
创建密度评估问题的评估器

msr_logloss <- msr('dens.logloss')
msr_logloss

[36m--[39m [1m[34m<MeasureDensLogloss>[39m (dens.logloss): Log Loss[22m [36m-------------------------------[39m
* Packages: [34mmlr3[39m and [34mmlr3proba[39m
* Range: [0, Inf]
* Minimize: [34mTRUE[39m
* Average: macro
* Parameters: eps=1e-15
* Properties: -
* Predict type: pdf
* Predict sets: test
* Aggregator: mean()

标准的评估器传递

prediction$score(msr_logloss)

dens.logloss: 11.9886309168503

benchmark比较不同密度评估学习器

# 加载R包
# library(mlr3extralearners)

# 任务
tsk_faithful <- tsk('faithful')
# 学习器
learners <- lrns(c('dens.hist', 'dens.pen', 'dens.kde'))
# 评估器
measure <- msr('dens.logloss')

# benchmark比较
bmr <- benchmark(
 benchmark_grid(
  tsk_faithful, 
  learners,
  rsmp('cv', folds = 3)
 )
)

# 结果整合
bmr$aggregate(measure)

      nr  task_id learner_id resampling_id iters dens.logloss
   <int>   <char>     <char>        <char> <int>        <num>
1:     1 faithful  dens.hist            cv     3     1.115927
2:     2 faithful   dens.pen            cv     3     1.377325
3:     3 faithful   dens.kde            cv     3     1.026440
Hidden columns: resample_result

可视化3种学习器的性能
- 复杂的惩罚密度估计器的表现并不优于基线直方图，
  但核密度估计器至少在对数损失结果上更好

autoplot(bmr, measure = measure)

聚类分析（Cluster Analysis）

简介

mlr3cluster使用以下用于聚类分析的对象对mlr3进行了扩展：
- TaskClust：聚类任务
- LearnerClust：聚类学习器的基类
- PredictionClust：聚类预测结果的Prediction对象的特定类
- MeasureClust：聚类性能评估器

`TaskClust`

以cluster包自带的数据集ruspini为例

# 加载R包
# library(mlr3verse)
# library(cluster)

# 创建聚类任务
tsk_ruspini <- as_task_clust(ruspini)
tsk_ruspini

[36m--[39m [1m[34m<TaskClust>[39m (75x2)[22m [36m----------------------------------------------------------[39m
* Target:
* Properties: -
* Features (2):
  * int (2): x, y

tsk_ruspini$data(1:3)

<table class="dataframe"> <caption>A data.table: 3 x 2</caption> <thead> <tr><th scope=col>x</th><th scope=col>y</th></tr> <tr><th scope=col><int></th><th scope=col><int></th></tr> </thead> <tbody> <tr><td> 4</td><td>53</td></tr> <tr><td> 5</td><td>63</td></tr> <tr><td>10</td><td>59</td></tr> </tbody> </table>

鲁西尼（Ruspini）数据集的分布情况

autoplot(tsk_ruspini)

查看所有自带的聚类任务

as.data.table(mlr_tasks)[task_type == 'clust', c(1:2, 4:5)]

<table class="dataframe"> <caption>A data.table: 2 x 4</caption> <thead> <tr><th scope=col>key</th><th scope=col>label</th><th scope=col>nrow</th><th scope=col>ncol</th></tr> <tr><th scope=col><chr></th><th scope=col><chr></th><th scope=col><int></th><th scope=col><int></th></tr> </thead> <tbody> <tr><td>ruspini </td><td>Ruspini </td><td>75</td><td>2</td></tr> <tr><td>usarrests</td><td>US Arrests</td><td>50</td><td>4</td></tr> </tbody> </table>

`LearnerClust` 和 `PredictionClust`

聚类学习器有两种predict_types
- 'partition'：对观测值所属聚类的估计
- 'prob'：一个观测值属于每个聚类的概率
与分类类似，
聚类学习器的预测类型要么是确定性的（"partition"），
要么是概率性的（"prob"）
下例中构建一个预测类型为 "prob" ，
且有3个聚类（centers = 3）的C均值聚类学习器，
在 ruspini 数据集上对其进行训练，
然后返回六个随机观测值的聚类分配（$assignments）

lrn_cmeans <- lrn(
 'clust.cmeans', 
 predict_type = 'prob', 
 centers = 3
)
lrn_cmeans

[36m--[39m [1m[34m<LearnerClustCMeans>[39m (clust.cmeans): Fuzzy C-Means Clustering Learner[22m [36m-------[39m
* Model: -
* Parameters: centers=3
* Packages: [34mmlr3[39m, [34mmlr3cluster[39m, and [34me1071[39m
* Predict Types: partition and [prob]
* Feature Types: logical, integer, and numeric
* Encapsulation: none (fallback: -)
* Properties: complete, fuzzy, and partitional
* Other settings: use_weights = 'error'

lrn_cmeans$train(tsk_ruspini)
lrn_cmeans$assignments[sample(tsk_ruspini$nrow, 6)]

[1] 2 1 1 1 3 2

由于聚类是无监督的，
对新数据使用predict通常没有意义，
不过使用mlr3接口仍有可能实现

lrn_cmeans$
 train(tsk_ruspini, 1:30)$
 predict(tsk_ruspini, 31:32)


[36m--[39m [1m[34m<PredictionClust>[39m for [34m2[39m observations:[22m [36m---------------------------------------[39m
 row_ids partition     prob.1     prob.2    prob.3
      31         3 0.01814044 0.01552007 0.9663395
      32         3 0.01177598 0.01002160 0.9782024

对整个数据集进行聚类，并且可视化聚类结果的分布

prediction <- lrn_cmeans$
 train(tsk_ruspini)$
 predict(tsk_ruspini)
autoplot(prediction, tsk_ruspini)

虽然有两种可能的预测类型，但有些学习器的“预测”永远没有意义
- 例如在层次聚类中
在层次聚类中，目标是通过将大的簇分裂成较小的簇，
或将较小的簇合并成较大的簇，
来构建一个嵌套簇的层次结构
- 最终结果是一棵树或树形图，
  如果添加新的数据点，
  该树或树形图可能会发生变化
为保持一致性，mlr3cluster 为层次聚类提供了
一个 predict 方法，但会给出一个警告：

lrn_hclust <- lrn('clust.hclust', k = 2)
lrn_hclust$
 train(tsk_ruspini)$
 predict(tsk_ruspini)

Warning message in warn_prediction_useless(self$id): "Learner 'clust.hclust' doesn't predict on new data and predictions may not make sense on new data."

[36m--[39m [1m[34m<PredictionClust>[39m for [34m75[39m observations:[22m [36m--------------------------------------[39m
 row_ids partition
       1         1
       2         1
       3         1
     ---       ---
      73         1
      74         1
      75         1

查看聚类结果图
- ruspini数据集层次聚类的树形图
- y轴是点的相似度
- x轴上相连的观测值越低，
  它们的相似度就越高
- 顶部的划分代表两个簇的分离

autoplot(lrn_hclust) + 
 theme(axis.text = element_text(size = 5.5))

`MeasureClust`

无监督任务在模型评估中没有可用于对比的真实数据
- 仍然可以通过量化同一簇内对象的相关程度（簇内聚性）
  以及不同簇之间的差异程度（簇分离性）来衡量簇分配的质量
两种常见的度量指标
- 组内平方和（WSS）度量（msr("clust.wss")）
  - 计算观测值与质心之间的平方差之和，
    这是对聚类凝聚性的一种量化（值越小表明聚类越紧密）
  - 轮廓系数量化了每个点属于其分配的聚类相对于相邻聚类的程度，
    得分越接近 1 表明聚类效果良好，得分越接近 -1 表明聚类效果不佳
- 轮廓系数（msr("clust.silhouette")）
  - 返回所有观测值的平均轮廓得分
  - 当只有单个聚类时，该度量简单地输出0
下面是对聚类结果的评估
- 极高的加权平方和（WSS）以及中等的平均轮廓系数表明，
  聚类还有更多工作要做

measures <- msrs(c('clust.wss', 'clust.silhouette'))

prediction$score(measures, task = tsk_ruspini)

       clust.wss clust.silhouette 
    5.115541e+04     6.413923e-01

通常将无监督任务简化为定量指标可能并无益处（因为不存在真实值）
可视化可能是评估聚类质量更有效的工具

可视化

聚类可视化

由于聚类是一项无监督任务，
可视化不仅对于评估模型至关重要，
对于确定学习器是否按预期完成任务也必不可少
很容易依赖聚类度量来评估聚类的质量，
但应该保持谨慎
- 因为在模型之间进行选择可能取决于其他因素，
  比如聚类是如何形成的
下例中用 mlbench.spirals 生成两条相互缠绕的螺旋线的数据

# 生成数据
spirals <- mlbench::mlbench.spirals(
 n = 300, 
 sd = 0.01
)
# 构建任务
tsk_spirals <- as_task_clust(
 as.data.frame(spirals$x)
)
# 可视化数据
autoplot(tsk_spirals)

拟合模型并查看结果
- K均值聚类给出了更高的平均轮廓系数，
  因此我们可以得出结论，
  具有两个质心的K均值学习器比DBSCAN方法是更好的选择

# 学习器
learners <- list(
  lrn('clust.kmeans'),
  lrn('clust.dbscan', eps = 0.1)
)

# benchmark比较
bmr <- benchmark(
 benchmark_grid(
  tsk_spirals, 
  learners, 
  rsmp('insample')
 )
)

# 整合结果
bmr$aggregate(msr('clust.silhouette'))[, c(4, 7)]

  learner_id   clust.silhouette
1 clust.kmeans 0.37244247      
2 clust.dbscan 0.02929844

通过对聚类结果的可视化，可以看到两种聚类的差别
- K均值聚类像对图像切了一半
- DBSCAN则按曲线进行了区分
应该根据任务的需求结合可视化选择合适的聚类方法，
而并单纯非依赖于评估器给出的结果

# 加载R包
# library(patchwork)

# 提取K均值聚类和DBSCAN两种聚类的结果
# 转换成因子
pred_kmeans <- as.factor(
 bmr$
  resample_result(1)$
  prediction()$
  partition
 )
pred_dbscan <- as.factor(
 bmr$
  resample_result(2)$
  prediction()$
  partition
)
# 绘图
df_kmeans <- cbind(
 tsk_spirals$data(), 
 clust = pred_kmeans
)
df_dbscan <- cbind(
 tsk_spirals$data(), 
 clust = pred_dbscan
)
map <- aes(x = V1, y = V2, color = clust)
p_kmeans <- ggplot(df_kmeans, map) + 
 ggtitle('K-means')
p_dbscan <- ggplot(df_dbscan, map) + 
 ggtitle('DBSCAN')

p_kmeans + 
 p_dbscan + 
 plot_layout(guides = 'collect') & 
 geom_point() &
 theme_minimal() & 
 ggplot2::scale_colour_viridis_d(end = 0.8)

主成分分析与轮廓系数图（Silhouette Plot）

在mlr3viz中实现的用于支持聚类学习器评估的两个最重要的图
- 主成分分析（PCA）图
  - 机器学习中常用的一种降维方法
  - 用于减少数据集中的变量数量，
    或可视化最重要的成分
    - 成分是数据集特征的线性变换
    - 方差越大（因此预测能力越强）的成分被认为越重要
  - 在聚类的背景下，通过将观测值相对于前两个成分进行绘图，
    然后按聚类进行着色，可以可视化高维数据集，
    并且预期会看到观测值分属于不同的组
- 轮廓系数图
  - 通过可视化一个簇中的观测值在个体和群体层面上是否分布合理，
    从而直观地评估估计簇的质量
  - 这些图包含一条虚线
    - 该虚线表示所有数据点的平均轮廓系数，
      每个数据点的轮廓值由一个按其分配簇着色的条形表示
  - 如果给定簇的平均轮廓值低于平均轮廓系数线，
    则意味着该簇定义不明确
下例的可视化结果中
- PCA图
  - 模型通过前两个主成分将观测数据很好地分成了两个簇
- 轮廓系数图
  - 很多观测值都在平均线以下且接近零，
    说明聚类分配质量不是很好，
    这意味着许多观测值很可能被分配到了错误的聚类中

# 任务
tsk_usarrests <- tsk('usarrests')
# 学习器
prediction <- lrn('clust.kmeans')$
 train(tsk_usarrests)$
 predict(tsk_usarrests)

# PCA
autoplot(
 prediction, 
 tsk_usarrests, 
 type = 'pca'
)

# 轮廓系数
autoplot(
 prediction, 
 tsk_usarrests, 
 type = 'sil'
)

总揽上述流程

下面结果中
- C均值算法和K均值算法都明显优于无特征的基线算法，
  但若要确定这两种算法中哪一种更适合，
  还需要结合可视化的进一步分析

# 任务
tsk_usarrests <- tsk('usarrests')
# 学习器
learners <- list(
  lrn('clust.featureless'),
  lrn('clust.kmeans', centers = 4L),
  lrn('clust.cmeans', centers = 3L)
)
# 评估器
measures <- list(
 msr('clust.wss'), 
 msr('clust.silhouette')
)
# benchmark比较
bmr <- benchmark(
 benchmark_grid(
  tsk_usarrests, 
  learners,
  rsmp('insample')
 )
)
# 结果整合
bmr$aggregate(measures)[, c(4, 7, 8)]

Superclass MeasureClust has cloneable=FALSE, but subclass MeasureClustFPC has cloneable=TRUE. A subclass cannot be cloneable when its superclass is not cloneable, so cloning will be disabled for MeasureClustFPC.

Superclass MeasureClust has cloneable=FALSE, but subclass MeasureClustSil has cloneable=TRUE. A subclass cannot be cloneable when its superclass is not cloneable, so cloning will be disabled for MeasureClustSil.

INFO  [23:38:54.167] [mlr3] Running benchmark with 3 resampling iterations
INFO  [23:38:54.220] [mlr3] Applying learner 'clust.featureless' on task 'usarrests' (iter 1/1)
INFO  [23:38:54.254] [mlr3] Applying learner 'clust.kmeans' on task 'usarrests' (iter 1/1)
INFO  [23:38:54.289] [mlr3] Applying learner 'clust.cmeans' on task 'usarrests' (iter 1/1)
INFO  [23:38:54.331] [mlr3] Finished benchmark

<table class="dataframe"> <caption>A bmr_aggregate: 3 x 3</caption> <thead> <tr><th scope=col>learner_id</th><th scope=col>clust.wss</th><th scope=col>clust.silhouette</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>clust.featureless</td><td>355807.82</td><td>0.0000000</td></tr> <tr><td>clust.kmeans </td><td> 34728.63</td><td>0.5012332</td></tr> <tr><td>clust.cmeans </td><td> 47964.27</td><td>0.5319024</td></tr> </tbody> </table>

空间分析（Spatial Analysis）

简介

空间分析
- 可以是任何其他机器学习任务（例如，回归或分类）的一个子集
- 其定义是数据集中存在空间信息
  - 这些信息通常存储为坐标
  - 通常命名为'x'和'y'，
    或者'lat'和'lon'
    （分别代表“纬度”和“经度”）
空间分析是一项独特的任务
- 由于 自相关性 的复杂性，空间数据必须谨慎处理
- 自相关存在于空间数据中，
  因为坐标中编码了隐含信息
  - 例如两个观测值（如城市、国家、大洲）是相距较近还是较远
  - 例如，假设要预测德国疾病爆发两个月后的病例数
    - 疫情从震中向外辐射，因此离德国较近的国家病例数会较多，
      而较远的国家病例数会较少
    - 从空间角度查看数据，
      可以清楚地看到附近观测值之间存在自相关的迹象
  - 在这个例子中自相关是呈辐射状的，
    但在实际情况中并非总是如此

mlr3spatiotempcv 中提供了额外的重采样方法，
以解决由于时空自相关导致的重采样过程中训练集和测试集的相似性问题

`TaskClassifST` 和 `TaskRegrST`

TaskClassifST 和 TaskRegrST为
时空任务的分类与回归任务
- coordinate_names：坐标的特征名
- crs：Coordinate Reference System

# 加载R包
# library(mlr3spatial)
# library(mlr3spatiotempcv)

# 从`data.frame`创建任务对象
tsk_ecuador <- as_task_classif_st(
 ecuador, 
 id = 'ecuador_task',
 target = 'slides', 
 positive = 'TRUE',
 coordinate_names = c('x', 'y'), 
 crs = '32717'
)

# 从`sf`创建任务对象
data_sf <- sf::st_as_sf(
 ecuador, 
 coords = c('x', 'y'), 
 crs = '32717'
)
tsk_ecuador <- as_task_classif_st(
 data_sf, 
 target = 'slides',
 positive = 'TRUE'
)

tsk_ecuador

[36m--[39m [1m[34m<TaskClassifST>[39m (751x11)[22m [36m----------------------------------------------------[39m
* Target: slides
* Properties: twoclass
* Features (10):
  * dbl (10): carea, cslope, dem, distdeforest, distroad, distslidespast,
  hcurv, log.carea, slope, vcurv
* Coordinates:
            X       Y
        <num>   <num>
  1: 712882.5 9560002
  2: 715232.5 9559582
  3: 715392.5 9560172
  4: 715042.5 9559312
  5: 715382.5 9560142
 ---                 
747: 714472.5 9558482
748: 713142.5 9560992
749: 713322.5 9560562
750: 715392.5 9557932
751: 713802.5 9560862

可以用正常的学习器进行建模分析

lrn('classif.rpart')$
 train(tsk_ecuador)$
 predict(tsk_ecuador)

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m751[39m observations:[22m [36m-----------------------------------[39m
 row_ids truth response
       1  TRUE     TRUE
       2  TRUE     TRUE
       3  TRUE     TRUE
     ---   ---      ---
     749 FALSE    FALSE
     750 FALSE    FALSE
     751 FALSE     TRUE

时空交叉验证（Spatiotemporal Cross-Validation）

如果将非空间重采样方法用于空间数据可能会出现什么问题，本例中：
- 'NSpCV'（非空间交叉验证）
  - 是来自mlr3的非空间重采样方法
- 'SpCV'（空间交叉验证）
  - 来自mlr3spatiotempcv
  - 针对空间数据进行优化的
结果展示'NSpCV'使决策树看起来比实际表现更好，其估计性能明显更高
- 然而，这是由于数据中的自相关性导致的过度自信预测

# 学习器
lrn_rpart <- lrn(
 'classif.rpart', 
 predict_type = 'prob'
)
# 普通的重采样
rsmp_nsp <- rsmp(
 'repeated_cv', 
 folds = 3, 
 repeats = 2, 
 id = 'NSpCV'
)
# 空间交叉验证重采样
rsmp_sp <- rsmp(
 'repeated_spcv_coords', 
 folds = 3, 
 repeats = 2,
 id = 'SpCV'
)

# benchmark比较
design <- benchmark_grid(
 tsk_ecuador, 
 lrn_rpart, 
 c(rsmp_nsp, rsmp_sp)
)
bmr <- benchmark(design)

# 结果整合
bmr$aggregate(msr('classif.acc'))[, c(5, 7)]

<table class="dataframe"> <caption>A bmr_aggregate: 2 x 2</caption> <thead> <tr><th scope=col>resampling_id</th><th scope=col>classif.acc</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>NSpCV</td><td>0.676409</td></tr> <tr><td>SpCV </td><td>0.584237</td></tr> </tbody> </table>

由于潜在的空间自相关性，
应用非空间重采样会导致训练集和测试集非常相似
- 因此，在模型训练所用的相同数据上进行测试，结果不会有太大差异
- 为了得到真实的性能结果，应避免这种情况
空间方法考虑了自相关性，
测试数据与训练数据的相关性较低（尽管仍会存在一些关联）
下图中，通过 autoplot() 方法可以直观地看到：
- 空间重采样方法，左图
  - 各个分区在空间上有明显的分隔
- 非空间重采样方法，右图
  - 训练集和测试集的划分重叠较多（因此相关性更强）

# 加载R包
# library(patchwork)

# 对重采样结果可视化
(autoplot(rsmp_sp, tsk_ecuador, fold_id = 1, size = 0.7) +
  ggtitle('Spatial Resampling') +
  autoplot(rsmp_nsp, tsk_ecuador, fold_id = 1, size = 0.7) +
  ggtitle('Non-spatial Resampling')) +
  plot_layout(guides = 'collect') &
  theme_minimal() &
  theme(axis.text = element_text(size = 4), legend.position = 'bottom')

`mlr3spatiotempcv`中其他重采样方法

Blocking：
在二维或三维空间中创建矩形块
Buffering：
创建缓冲区，去除训练集和测试集之间的观测数据
Spatiotemporal clustering：
时空聚类 - 基于坐标（和/或时间点）的聚类
Feature space clustering：
基于特征空间进行聚类，不一定基于时空。
Custom (partitioning)：
按因子变量分组
mlr3spatiotempcv也可以讨论时空问题

空间预测（Spatial Prediction）

进行时空预测，目标是在像素级别进行分类或回归预测，
即对由栅格图像的几何分辨率定义的一个区域进行预测
使用 predict_spatial() 可以对以下任何空间数据类进行空间预测：
- stars（来自 stars 包）
- SpatRaster（来自 terra 包）
- RasterLayer（来自 raster 包）
- RasterStack（来自 raster 包）
下例中
- 加载 leipzig_points 数据集进行训练，
- 并使用 as_task_classif_st() 将其转换为时空任务，
- 同时加载 leipzig_raster 栅格数据
- 这两个文件均作为示例数据包含在 mlr3spatial 中
- 指定创建一个 terra 对象，
  该对象可以使用内置绘图方法进行可视化

# library(mlr3spatial)
# library(sf)
# library(terra, exclude = 'resample')

# 读取需要分析的示例数据
leipzig_vector <- sf::read_sf(
 system.file(
  'extdata',
  'leipzig_points.gpkg', 
  package = 'mlr3spatial'
 ),
 stringsAsFactors = TRUE
)

# 构建任务
tsk_leipzig <- as_task_classif_st(
 leipzig_vector, 
 target = 'land_cover'
)

# 读取示例的栅格数据
leipzig_raster <- terra::rast(
 system.file(
  'extdata', 
  'leipzig_raster.tif',
  package = 'mlr3spatial'
 )
)

# 构建学习器
lrn_ranger <- lrn('classif.ranger')$
 train(tsk_leipzig)

# 预测，但是使用`predict_spatial()`
prediction <- predict_spatial(
 leipzig_raster, 
 lrn_ranger,
 format = 'terra'
)

# 查看预测结果
prediction

class       : SpatRaster 
size        : 206, 154, 1  (nrow, ncol, nlyr)
resolution  : 10, 10  (x, y)
extent      : 731810, 733350, 5692030, 5694090  (xmin, xmax, ymin, ymax)
coord. ref. : WGS 84 / UTM zone 32N (EPSG:32632) 
source      : file48064a40f583.tif 
categories  : categories 
name        : land_cover 
min value   :     forest 
max value   :      water

可视化预测的结果
- 森林（紫色）、牧场（蓝色）、城市（绿色）和水域（黄色）

plot(
 prediction, 
 col = c(
 '#440154FF', 
 '#443A83FF', 
 '#31688EFF',
 '#21908CFF', 
 '#35B779FF', 
 '#8FD744FF', 
 '#FDE725FF'
 )
)

【mlr3】7.算法公平性

Wed, 16 Jul 2025 00:00:00 GMT

Cover Pic by @スコッティ

Applied Machine Learning Using mlr3 in R

简介

基于数据驱动模型的自动化决策系统正变得越来越普遍，但如果没有适当的审计，
这些模型可能会给个人，尤其是弱势群体带来负面后果
举一个现实世界的例子
- 与其他种族群体相比，
  历史和抽样偏差导致白人种族患者的医疗数据质量更高
- 如果一个模型主要基于白人患者的数据进行训练，
  那么该模型在给定的性能指标（例如分类错误）方面可能看起来 “很好”
- 但实际上该模型可能在对白种人患者做出良好预测的同时，
  却对其他患者做出错误甚至有害的预测
由于机器学习驱动的系统被用于具有重大影响力的决策，
因此不仅要从模型的稳健性和预测性能，还要从
潜在偏差方面，开发分析和评估这些模型的能力

示例数据

# 加载R包
# library(mlr3fairness)

# 任务
tsk_adult_train <- tsk('adult_train')
tsk_adult_train

[36m--[39m [1m[34m<TaskClassif>[39m (30718x13)[22m [36m----------------------------------------------------[39m
* Target: target
* Target classes: <=50K (positive class, 75%), >50K (25%)
* Properties: twoclass
* Features (12):
  * fct (7): education, marital_status, occupation, race, relationship, sex,
  workclass
  * int (5): age, capital_gain, capital_loss, education_num, hours_per_week
* Protected attribute: sex

偏差与公平性（Bias and Fairness）

在公平性的背景下，
偏差是指模型对待个体或群体方式上的差异
在成人数据集中，
与女性群体相比，
男性群体中的成年人年收入超过 5 万美元的可能性要大得多

sex_salary <- table(
 tsk_adult_train$
  data(cols = c('sex', 'target')
 )
)
round(proportions(sex_salary), 2)

        target
sex      <=50K >50K
  Female  0.29 0.04
  Male    0.46 0.21

卡方检验进一步验证了上述的结论
- p-value < 2.2e-16

chisq.test(sex_salary)

Pearson's Chi-squared test with Yates' continuity correction

data:  sex_salary
X-squared = 1440.4, df = 1, p-value < 2.2e-16

本例子中，性别变量称为敏感属性（sensitive attribute）
群体公平性
- 目标是确定在由敏感属性定义的各个群体之间，
  决策是否公平
- 任务中的敏感属性是通过'pta'
  （protected attribute，受保护属性）来设置的

tsk_adult_train$
 set_col_roles('sex', add_to = 'pta')

tsk_adult_train

[36m--[39m [1m[34m<TaskClassif>[39m (30718x13)[22m [36m----------------------------------------------------[39m
* Target: target
* Target classes: <=50K (positive class, 75%), >50K (25%)
* Properties: twoclass
* Features (12):
  * fct (7): education, marital_status, occupation, race, relationship, sex,
  workclass
  * int (5): age, capital_gain, capital_loss, education_num, hours_per_week
* Protected attribute: sex

群体公平性概念（Group Fairness Notions）

如果模型做出的预测与敏感属性无关，
则称模型预测是偏差转换的（bias-transforming），
或者满足独立性（independence）
- 偏差转换方法不依赖于标签，
  有助于检测因不同总体基础比率而产生的偏差
如果模型所做的预测在给定真实标签的情况下与敏感属性无关，
则称该模型是偏差保持的（bias-preserving），
或满足分离性（separation）
- 换句话说，该模型在每个组中做出的正确/错误预测数量应大致相同
- 有几个指标属于这一类
  - 均衡几率（equalized odds）
    - 测试不同组之间的真阳性率（TPR）和假阳性率（FPR）是否相等
  - 偏差保持指标（用于测试分离性）
    - 测试模型在不同组中产生的错误是否相等，
      但可能未考虑标签中的偏差
      - 例如，如果现实世界中的结果可能存在偏差，
        比如不同种族群体的人被捕率不同
选择何种公平性概念将取决于模型的用途及其社会背景
- 例如，如果一个模型用于预测某人是否有罪，
  那么可能会更关注误报率或错误发现率，而非真阳性率
无论选择哪种指标，本质上都是将系统性偏差和偏见浓缩为几个数字，
而且所有指标都有局限性，
没有一个指标能够识别数据中可能存在的所有偏差
- 例如，如果社会偏见导致
  具有相同潜在能力的个体
  在某个可观测数量（如学校考试成绩）上出现差异，
  这些指标可能无法识别出存在的偏差
为了在实践中理解这些概念
- 设 $A$ 为一个二元敏感群体，取值为 $0$ 和 $1$
- 设 $M$ 为一个公平性度量指标
- 为了衡量独立性，
  只需计算这些值之间的差异，
  并测试结果是否小于某个阈值 $ϵ$

$$ |\Delta_{M}| = |M_{A=0} - M_{A=1}| < \epsilon $$

如果使用真实阳性率（TPR）作为指标 $M$，
- 那么如果 $|\Delta_{M}| > \epsilon$ （例如 $\epsilon = 0.05$）
- 可得出结论：
  模型的预测违反了机会均等指标，
  并且不满足分离性
如果选择准确率或阳性预测值（PPV）作为指标 $M$
- 可得出结论：模型预测不满足独立性
在 mlr3fairness 中，
可以通过构建 msr("fairness", base_measure, range)，
从任何 Measure 构建一个公平性指标
选择的指标传递给 base_measure，以及该指标可能采用的范围（即基于基本指标的可能差异范围）
在mlr3fairness中实现了几个 Measure，简化了这一步骤
- 这些度量标准名为 fairness.<base_measure>
- 例如，真阳性率（TPR）：msr("fairness.tpr")

fair_tpr <- msr(
 'fairness', 
 base_measure = msr('classif.tpr'),
 range = c(0, 1)
)
fair_tpr

[36m--[39m [1m[34m<MeasureFairness>[39m (fairness.tpr)[22m [36m--------------------------------------------[39m
* Packages: [34mmlr3[39m and [34mmlr3fairness[39m
* Range: [0, 1]
* Minimize: [34mTRUE[39m
* Average: macro
* Parameters: list()
* Properties: requires_task
* Predict type: response
* Predict sets: test
* Aggregator: mean()

针对偏差审核模型（Auditing a Model For Bias）

有了敏感属性集和选定的公平性指标，
现在可以训练一个Learner并测试偏差
下例使用随机森林，
评估男性和女性两组之间的真阳性率绝对差异

tsk_adult_test <- tsk('adult_test')
lrn_rpart <- lrn(
 'classif.rpart', 
 predict_type = 'prob'
)
prediction <- lrn_rpart$
 train(tsk_adult_train)$
 predict(tsk_adult_test)
prediction$
 score(fair_tpr, tsk_adult_test)

fairness.tpr: 0.0603449540669074

当$ϵ$值为0.05时，可以得出模型存在偏差的结论
- 然而，这个ϵ值是任意设定的，
  应该根据具体情况来决定
除了使用公平性指标评估单个模型外，
这些指标还可用于更大规模的benchmark实验，
以比较多个模型之间的偏差
可视化可以帮助更好地理解组间差异或模型间差异
- fairness_prediction_density()：绘制各子组在不同组级别上的密度
- compare_metrics()：通过多个指标对预测进行评分
本例中，
该模型更倾向于预测女性观察对象的薪资较低
- 这可能是由于数据中存在系统性偏见，
  即由于社会偏见，女性更有可能薪资较低，
  也可能是由于算法引入的偏差
- 如右图所示，所有公平性指标都超过了0.05，
  这支持了一种观点，
  即算法可能引入了更多偏差
  （同样要注意0.05这个阈值）

# 加载R包
# library(patchwork)
# library(ggplot2)

p1 <- fairness_prediction_density(
 prediction, 
 task = tsk_adult_test
)
p2 <- compare_metrics(
 prediction,
 msrs(
  c(
   'fairness.fpr', 
   'fairness.tpr', 
   'fairness.eod'
  )
 ),
 task = tsk_adult_test
)

(p1 + p2) *
 theme_minimal() *
 scale_fill_viridis_d(end = 0.8, alpha = 0.8) *
 theme(
  axis.text.x = element_text(angle = 15, hjust = .7),
  legend.position = 'bottom'
  )

公平机器学习（Fair Machine Learning）

mlr3fairness 提供了多种解决模型偏差的方法
- 预处理数据：
  在将基础数据传递给Learner之前，
  会以某种方式对其进行预处理，
  以解决数据中的偏差问题
- 采用公平模型：
  一些算法可以直接纳入公平性考量，
  例如带有公平性约束的广义线性模型
  （lrn("classif.fairzlrm")）
- 后处理模型预测结果：
  对预测应用启发式方法/算法，
  以减轻预测中存在的偏差
可以使用mlr3pipelines集成预处理和后处理方案
在下面示例中
- 第一个是使用po("reweighing_wts")进行预处理以平衡观测权重，
  第二个是使用po("EOd")对预测结果进行后处理
  - 通过随机翻转特定预测来执行均衡优势公平性定义
- 还将lrn("classif.fairzlrm")与其他方法进行benchmark比较

# 方法0:用来被比较的基线学习器
lrn_rpart <- lrn('classif.rpart', predict_type = 'prob')
lrn_rpart$id <- 'rpart'
# 方法1
l1 <- as_learner(
 po('reweighing_wts') %>>% 
  lrn('classif.rpart')
)
l1$id <- 'reweight'
# 方法2
l2 <- as_learner(
 po('learner_cv', lrn('classif.rpart')) %>>%
  po('EOd')
)
l2$id <- 'EOd'
# 方法3
l3 <- as_learner(
 po('collapsefactors') %>>% 
  lrn('classif.fairzlrm')
)
l3$id <- 'fairzlrm'

# 构建任务
task <- tsk('adult_train')
# 设置敏感属性
task$set_col_roles('sex', 'pta')$
 filter(sample(task$nrow, 500))$
 select(setdiff(task$feature_names, 'education_num'))

# benchmark比较试验
lrns <- list(lrn_rpart, l1, l2, l3)
bmr <- benchmark(
 benchmark_grid(
  task, 
  lrns, 
  rsmp('cv', folds = 5)
 )
)
meas <- msrs(c('classif.acc', 'fairness.eod'))
# 整合结果
bmr$aggregate(meas)[,
  .(learner_id, classif.acc, fairness.equalized_odds)]

<table class="dataframe"> <caption>A bmr_aggregate: 4 x 3</caption> <thead> <tr><th scope=col>learner_id</th><th scope=col>classif.acc</th><th scope=col>fairness.equalized_odds</th></tr> <tr><th scope=col><chr></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>rpart </td><td>0.776</td><td>0.2264140</td></tr> <tr><td>reweight</td><td>0.790</td><td>0.1553630</td></tr> <tr><td>EOd </td><td>0.740</td><td>0.2337308</td></tr> <tr><td>fairzlrm</td><td>0.768</td><td>0.1888915</td></tr> </tbody> </table>

可视化结果
- 各折叠（圆点）以及跨折叠聚合（叉号）的学习器
  在分类准确率（x轴）和均衡几率（y轴）方面的比较
重新加权方法似乎比其他方法产生的公平性指标略好，
尽管这种差异不太可能具有显著性
- 在这种情况下，可以得出结论：
  引入偏差缓解措施并没有提高算法公平性

fairness_accuracy_tradeoff(
 bmr, 
 fairness_measure = msr('fairness.eod'),
 accuracy_measure = msr('classif.ce')
) +
 ggplot2::scale_color_viridis_d('Learner') +
 ggplot2::theme_minimal()

【mlr3】8.预测集，验证及内部调优(+)

Tue, 15 Jul 2025 00:00:00 GMT

Cover Pic by @灰色灰烬GREYASH

Applied Machine Learning Using mlr3 in R

预测集与训练误差估计

评估一个完全训练好的模型通常需要对未见过的测试样本进行预测
当直接使用训练好的学习器进行预测时，
我们可以明确控制使用哪些样本

# 任务
tsk_sonar <- tsk('sonar')
# 学习器
lrn_rf <- lrn('classif.ranger')
# 训练模型
lrn_rf$train(tsk_sonar, row_ids = 4:208)

# 预测(两种方法)
pred1 <- lrn_rf$predict(tsk_sonar, row_ids = 1:3)
pred2 <- lrn_rf$predict_newdata(tsk_sonar$data(1:3))

但是，当使用resample() 或 benchmark() 时，
默认行为是对重采样的测试集进行预测
也可以通过配置学习器的 $predict_sets，
对任务和数据的其他特定子集（即训练和 内部验证 数据）进行预测
接下来看看更复杂的 内部验证 选项

# 默认的用于预测的数据集
lrn_rf$predict_sets
# 设置为训练测试都给用上
lrn_rf$predict_sets <- c('train', 'test')
# 再看看当前用于预测的数据集
lrn_rf$predict_sets

# 执行重采样
rr <- resample(tsk_sonar, lrn_rf, rsmp('cv', folds = 3))

'test'
'train''test'

在重采样过程中，学习器在完成当前迭代的训练后，
将对所有请求的数据集生成预测
- 为了获取这些预测
  - 既可以请求一个包含3个预测对象的列表（每个交叉验证折对应一个对象）
  - 也可以请求一个针对整个交叉验证的组合预测对象——
    在这种情况下，该对象包含的预测行数与任务中的观测值数量相同

# 请求列表
str(rr$predictions('test'))
str(rr$predictions('train'))

# 获取
rr$prediction('test') 
rr$prediction('train')

List of 3
 $ :Classes 'PredictionClassif', 'Prediction', 'R6' <PredictionClassif> 
 $ :Classes 'PredictionClassif', 'Prediction', 'R6' <PredictionClassif> 
 $ :Classes 'PredictionClassif', 'Prediction', 'R6' <PredictionClassif> 

List of 3
 $ :Classes 'PredictionClassif', 'Prediction', 'R6' <PredictionClassif> 
 $ :Classes 'PredictionClassif', 'Prediction', 'R6' <PredictionClassif> 
 $ :Classes 'PredictionClassif', 'Prediction', 'R6' <PredictionClassif> 

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m208[39m observations:[22m [36m-----------------------------------[39m
 row_ids truth response
       3     R        M
       4     R        R
       6     R        R
     ---   ---      ---
     200     M        M
     206     M        M
     207     M        M

[36m--[39m [1m[34m<PredictionClassif>[39m for [34m416[39m observations:[22m [36m-----------------------------------[39m
 row_ids truth response
       1     R        R
       2     R        R
      10     R        R
     ---   ---      ---
     202     M        M
     204     M        M
     205     M        M

还可以将性能度量应用于重采样结果的特定数据集
对于一项指标，默认的预测数据集通常是测试集，
但也可以在此请求其他数据集
- 如果为该指标请求了多个预测数据集，
  那么在将其传入该指标之前，会先将这些数据集的预测结果合并，
  然后该指标通常会对数据集中所有预测行计算一个聚合分数
在本例中，不出所料训练误差低于测试误差

rr$aggregate(list(
  msr('classif.ce', predict_sets = 'train', id = 'ce_train'),
  msr('classif.ce', predict_sets = 'test', id = 'ce_test')
))

 ce_train   ce_test 
0.0000000 0.2020014

如果我们只想获取训练期间计算出的信息，
甚至可以将学习器配置为完全不进行任何预测
- 例如对于那些已经（在其底层实现中）在训练期间产生泛化误差估计的学习器很有用
  - 比如使用袋外误差估计或验证分数
    - 前者仅适用于具有'oob_error'属性的学习器，
      可以通过 MeasureOOBError 来访问
    - 后者适用于具有'validation'属性的学习器，
      并实现为 MeasureInternalValidScore
下面使用随机森林的袋外误差对其进行评估
- 由于不需要任何预测集，
  因此可以使用 ResamplingInsample
  - 它将使用整个数据集进行训练

lrn_rf$predict_sets <- NULL
rsmp_in <- rsmp('insample')
rr <- resample(
 tsk_sonar, 
 lrn_rf, 
 rsmp_in, 
 store_models = TRUE
)
msr_oob <- msr('oob_error')
rr$aggregate(msr_oob)

oob_error 
0.1586538

所有这些对于benchmark测试，调优，嵌套重采样，
以及任何其他内部涉及重采样的过程都以完全相同的方式工作，
并且要么生成预测结果，要么评估应用性能指标
下面通过调优随机森林的 mtry.ratio 参数
（使用简单的网格搜索）来说明这一点
- 不是在某些测试数据上显式地进行预测并评估它们，
  而是使用袋外（OOB）误差来评估 mtry.ratio
  - 这可以显著加快调优过程，
    因为在这种情况下只拟合一个随机森林（仅进行训练），
    并且我们可以从这个单一模型中获取袋外误差，
    而无需拟合多个模型
- 由于在集成中每棵树的训练过程中，
  袋外观测值未被触及，
  所以仍然能产生有效的性能估计

# 设置带调优的超参数
lrn_rf$
 param_set$
 set_values(
  mtry.ratio = to_tune(0.1, 1)
)

# 进行实例调优
ti <- tune(
  task = tsk_sonar,
  tuner = tnr('grid_search'),
  learner = lrn_rf,
  resampling = rsmp_in,
  measure = msr_oob,
  term_evals = 10,
  store_models = TRUE
)

# 查看结果
ti$result

<table class='dataframe'> <caption>A data.table: 1 x 4</caption> <thead> <tr><th scope=col>mtry.ratio</th><th scope=col>learner_param_vals</th><th scope=col>x_domain</th><th scope=col>oob_error</th></tr> <tr><th scope=col><dbl></th><th scope=col><list></th><th scope=col><list></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>0.3</td><td>1.0, 0.3</td><td>0.3</td><td>0.1442308</td></tr> </tbody> </table>

验证

对于迭代训练，在训练过程中跟踪模型在验证数据上的性能表现可能很有意义
- 可以将其用于简单的记录或事后分析，
  但主要的应用场景是提前停止训练
- 如果模型在训练数据上的性能持续提升，
  但在验证数据上的性能趋于平稳或下降，
  这就表明出现了过拟合
  - 此时我们应该停止迭代训练
- 在训练过程中以在线方式处理这个问题，
  要比通过传统的离线超参数调整从外部配置迭代次数高效得多
在传统方法中，需要反复使用不同的迭代次数来拟合模型
（并且无法利用有关连续进展的任何信息）
在mlr3中，
学习器可以具有
'validation'（验证）和
'internal_tuning'（内部调优）属性，
以表明它们是否可以使用验证集，
以及是否可以在内部优化超参数，例如通过提前停止
- 要检查给定的学习器是否支持此功能，
  只需访问其$properties字段。
- 这类学习器的包括XGBoost，LightGBM或CatBoost等提升算法，
  以及来自mlr3torch的深度学习模型
本节中在声纳数据集上训练XGBoost，
并跟踪其在验证集上的性能
为启用验证，需要配置验证数据的构建方式
- XGBoost有一个特殊的watchlist参数
- 但mlr3也通过学习器的$validate字段
  提供了一个标准化的接口，该字段可以设置为：
  - NULL：
    不使用验证数据（默认设置）
  - 'predefined'：
    用于使用任务中指定的验证数据
  - 'test'：
    将测试集用作验证数据，
    这仅在与重采样和调优结合使用时有效
- 如果将$validate字段设置为'test'，
  将在训练期间泄露重采样测试集
  - 如果使用验证分数进行提前停止，这将导致有偏差的性能估计
  - 是否可取取决于具体情况：
    - 如果测试集用于在超参数优化期间评估参数配置（即它充当验证集），
      那么这通常是可以的如果测试集的目的是提供无偏差的性能估计，
      例如比较不同的学习器，那么这是不可取的

tsk_sonar <- tsk('sonar')
lrn_xgb <- lrn('classif.xgboost')
lrn_xgb

[36m--[39m [1m[34m<LearnerClassifXgboost>[39m (classif.xgboost): Extreme Gradient Boosting[22m [36m--------[39m
* Model: -
* Parameters: nrounds=1000, nthread=1, verbose=0
* Validate: NULL
* Packages: [34mmlr3[39m, [34mmlr3learners[39m, and [34mxgboost[39m
* Predict Types: [response] and prob
* Feature Types: logical, integer, and numeric
* Encapsulation: none (fallback: -)
* Properties: hotstart_forward, importance, internal_tuning, missings,
multiclass, offset, twoclass, validation, and weights
* Other settings: use_weights = 'use'

下面将XGBoost学习器配置为使用其训练数据的1/3进行验证

lrn_xgb$validate <- 1/3

接下来设置迭代次数（nrounds）和要跟踪的指标（eval_metric），并训练学习器
- 训练任务中 1/3 的观测值将仅用于验证，
  其余 2/3 用于训练
- 如果在任务中启用了分层或分组，也会被继承

lrn_xgb$param_set$set_values(
  nrounds = 100,
  eval_metric = 'logloss'
)
lrn_xgb$train(tsk_sonar)

XGBoost学习器能够记录验证性能日志
- 可以通过$model插槽访问该日志
- 此信息在模型中的具体存储位置取决于特定的学习算法
  - 对于XGBoost，
    该历史记录存储在$evaluation_log中

tail(lrn_xgb$model$evaluation_log)

<table class='dataframe'> <caption>A data.table: 6 x 2</caption> <thead> <tr><th scope=col>iter</th><th scope=col>test_logloss</th></tr> <tr><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td> 95</td><td>0.4774655</td></tr> <tr><td> 96</td><td>0.4785149</td></tr> <tr><td> 97</td><td>0.4804244</td></tr> <tr><td> 98</td><td>0.4785063</td></tr> <tr><td> 99</td><td>0.4797440</td></tr> <tr><td>100</td><td>0.4802833</td></tr> </tbody> </table>

对迭代次数及验证对数损失可视化

lrn_xgb$model$evaluation_log %>%
    ggplot(aes(x = iter, y = test_logloss)) + 
    geom_line() +
    theme_minimal()

可以通过 $internal_valid_scores 字段访问此性能
- 该字段是一个命名列表，可包含多个验证指标

lrn_xgb$internal_valid_scores

$logloss = 0.480283279483969

将 validate 字段设置为 'predefined'，
可以对验证数据进行如此精细的控制

lrn_xgb$validate = 'predefined'

这使我们能够使用训练任务中定义的 $internal_valid_task
下面将验证任务设置为使用60个随机采样的ID，
并将它们从主要任务中移除

# 随机采样60个
valid_ids <- sample(tsk_sonar$nrow, 60)
# 新建移除过这60个样本的验证任务
tsk_valid <- tsk_sonar$clone(deep = TRUE)
tsk_valid$filter(valid_ids)
tsk_sonar$filter(setdiff(tsk_sonar$row_ids, valid_ids))
# 定义用于内部验证的样本
tsk_sonar$internal_valid_task <- tsk_valid

可以查看用于内部验证的样本和训练用样本的个数

c(tsk_sonar$internal_valid_task$nrow, tsk_sonar$nrow)

[1]  60 148

训练模型
- 学习器将在指定的额外任务上进行自我验证
- $internal_valid_task 插槽始终在内部使用，
  即使在 learner$validate 中设置了一个比率值，
  它也只是自动构建（然后传递下去）

lrn_xgb$train(tsk_sonar)

验证也能在GraphLearner中进行，
因为预处理PipeOp也处理验证任务
虽然PipeOp的训练逻辑应用于主要任务，
但预测逻辑应用于验证数据
- 这确保了在XGBoost学习器在验证数据上
  评估其性能时不会出现数据泄露
下例中构建PipeOpPCA并将其应用于带有验证任务的tsk('sonar')

po_pca <- po('pca')
taskout <- po_pca$train(list(tsk_sonar))[[1]]
taskout$internal_valid_task

[36m--[39m [1m[34m<TaskClassif>[39m (60x61): Sonar: Mines vs. Rocks[22m [36m-------------------------------[39m
* Target: Class
* Target classes: M (positive class, 60%), R (40%)
* Properties: twoclass
* Features (60):
  * dbl (60): PC1, PC10, PC11, PC12, PC13, PC14, PC15, PC16, PC17, PC18, PC19,
  PC2, PC20, PC21, PC22, PC23, PC24, PC25, PC26, PC27, PC28, PC29, PC3, PC30,
  PC31, PC32, PC33, PC34, PC35, PC36, PC37, PC38, PC39, PC4, PC40, PC41, PC42,
  PC43, PC44, PC45, PC46, PC47, PC48, PC49, PC5, PC50, PC51, PC52, PC53, PC54,
  PC55, PC56, PC57, PC58, PC59, PC6, PC60, PC7, PC8, PC9

在$train()期间应用于$internal_valid_task的预处理，
等同于对其进行预测

po_pca$predict(list(tsk_sonar$internal_valid_task))[[1L]]

[36m--[39m [1m[34m<TaskClassif>[39m (60x61): Sonar: Mines vs. Rocks[22m [36m-------------------------------[39m
* Target: Class
* Target classes: M (positive class, 60%), R (40%)
* Properties: twoclass
* Features (60):
  * dbl (60): PC1, PC10, PC11, PC12, PC13, PC14, PC15, PC16, PC17, PC18, PC19,
  PC2, PC20, PC21, PC22, PC23, PC24, PC25, PC26, PC27, PC28, PC29, PC3, PC30,
  PC31, PC32, PC33, PC34, PC35, PC36, PC37, PC38, PC39, PC4, PC40, PC41, PC42,
  PC43, PC44, PC45, PC46, PC47, PC48, PC49, PC5, PC50, PC51, PC52, PC53, PC54,
  PC55, PC56, PC57, PC58, PC59, PC6, PC60, PC7, PC8, PC9

这意味着，即使在复杂的图学习器中，跟踪验证性能也能发挥作用，
而如果只是简单设置XGBoost的watchlist参数是不可能实现的
下面将PCA算子与XGBoost衔接起来，
并将其转换为一个GraphLearner

glrn <- as_learner(po_pca %>>% lrn_xgb)

虽然这样几乎就能奏效，但现在需要在两个层面上指定 $validate 字段：
对于GraphLearner本身，
即在Task进入Graph之前，验证数据是如何创建的
哪些具有“validation”属性的PipeOp实际上应该使用它
通过使用 set_validate() 可以简化此配置。当应用于 GraphLearner 时，我们可以指定参数 validate，它决定了如何创建验证数据，还可以选择性地指定参数 ids，它指定了哪些 PipeOp 应该使用该数据
默认情况下，后者设置为
Graph 的 $base_learner()，
即最后一个学习器
- 这意味着以下两个调用是等效的：

set_validate(glrn, validate = 'predefined')
set_validate(glrn, validate = 'predefined', ids = 'classif.xgboost')

现在可以像之前一样训练GraphLearner，
并检查最终的验证指标
- 该指标现在会加上相应PipeOp的ID作为前缀

glrn$validate = 'predefined'
glrn$train(tsk_sonar)
glrn$internal_valid_scores

$classif.xgboost.logloss = 0.427817946910121

注意：
- 由于单个PipeOp无法控制验证数据的生成方式，
  只能控制是否使用验证数据，
  因此其$validate字段只能设置为NULL或'predefined'
- 这就是为什么在运行
  as_pipeop(lrn('classif.xgboost', validate = 0.3))时会出错
- 在GraphLearner中使用验证时，
  最好先构建不指定验证数据的学习器，
  然后使用set_validate()。

内部调优

XGBoost不仅可以记录其验证性能，还可以对其进行监控，
以便提前停止训练
- 即在训练期间对nrounds超参数进行内部调整
这由'internal_tuning'属性标记：

'internal_tuning' %in% lrn_xgb$properties

TRUE

XGBoost可以通过指定early_stopping_rounds参数来
启用提前停止
- 这也被称为耐心值，
  它指定了在训练终止前，
  验证损失在多少轮迭代中没有改善
用于提前停止的指标是传递给eval_metric的第一个值，
即对数损失

lrn_xgb$param_set$set_values(
  early_stopping_rounds = 10,
  nrounds = 100
)

当训练学习器时，
可通过 $internal_tuned_values 字段
访问内部优化的 nrounds

lrn_xgb$train(tsk_sonar)
lrn_xgb$internal_tuned_values

$nrounds = 17

通过使用提前停止策略，在20次迭代后就能够终止训练
将验证损失随时间的变化进行可视化，最优的轮数用红色标记
- 由于耐心值的设置，训练在之后仍持续了一段时间

lrn_xgb$model$evaluation_log %>%
    ggplot(aes(x = iter, y = test_logloss)) + 
    geom_line() +
    # lrn_xgb$model$evaluation_log[17]
    geom_point(
     aes(x = 17, y = 0.3503711), 
     color = 'red'
 ) + 
    theme_minimal()

目前为止仅使用了XGBoost的提前停止实现来优化nrounds，
尚未调整任何其他超参数
- 这就是mlr3发挥作用的地方，
  因为它允许我们将学习器的内部调整与
  通过mlr3tuning进行的（非内部）超参数调整相结合
将两个参数都标记为to_tune()，
但将nrounds标记为进行内部调整

lrn_xgb$
 param_set$
 set_values(
  eta = to_tune(0.001, 0.1, logscale = TRUE),
  nrounds = to_tune(upper = 500, internal = TRUE)
)

通常可能希望使用相同的验证数据来优化eta和nrounds
- 通过指定validate字段为'test'选项可以实现
- 这意味着在每次重采样迭代中，
  验证数据将设置为测试集，
  同样也将用于评估参数配置（以调整eta）的数据

lrn_xgb$validate = 'test'

将继续使用简单的网格搜索来调整XGBoost，
进行10次评估，并采用3折交叉验证进行内部重采样
在内部，这将使用10个不同的 eta 值来训练XGBoost，
同时将 nrounds 参数固定为500，即上述的上限
对于每个 eta 值，将执行带有早停法的3折交叉验证，
从而为每个 eta 值生成3个（可能不同的）早停的 nrounds 值
- 这些值会根据聚合规则合并为单个值
- 默认情况下设置为取平均值，
  但在创建内部调优令牌时可以覆盖该规则
当通过mlr3tuning将内部调优与超参数优化相结合时，
需要指定两个性能指标：
- 一个用于内部调优
- 另一个用于Tuner
因此，即使存在默认值，
mlr3要求显式设置内部调优指标
有两种方法可以在两种类型的超参数优化中使用相同的指标：
- msr('internal_valid_scores', select = <id>)
  - 最终验证分数
  - 由于一个学习器可能有多个内部验证分数，
    该指标允许通过指定select参数来选择其中一个
  - 如果未指定此参数，将使用第一个验证指标
  - 我们还需要指定该指标是否应最小化
- 将eval_metric和调优度量都设置为同一指标
  - 例如，eval_metric = 'error'且
    measure = msr('classif.ce')
  - 有些学习器甚至允许将
    验证指标设置为一个mlr3::Measure
  - 可以通过查看相应的文档来了解哪些学习器支持此功能
使用第一个选项的优势在于可以跳过预测步骤，
因为内部验证分数在训练过程中已经计算好了
注意：
- 使用 GraphLearner 时，
  内部验证分数的名称会以相应 PipeOp 的 ID 为前缀
- 因此 select 参数需要设置为
  '<pipeop id>.<measure id>'

tsk_sonar <- tsk('sonar')
lrn_xgb$predict_sets = NULL

ti <- tune(
 tuner = tnr('grid_search'),
 learner = lrn_xgb,
 task = tsk_sonar,
 resampling = rsmp('cv', folds = 3),
 measure = msr('internal_valid_score',
    select = 'logloss', minimize = TRUE),
 term_evals = 10L
)

调优结果包含为 eta 和 nrounds 找到的最佳配置

ti$result_learner_param_vals[c('eta', 'nrounds')]

$eta
[1] 0.1

$nrounds
[1] 66

下面展示如何从调优存档中提取不同的参数配置
- 所有内部调优的参数都可以通过
  $internal_tuned_values 访问
- 这是一个列表列，
  因为在内部有可能对多个参数进行调优
  - 例如在 GraphLearner 中
- 提取 eta 的值（从对数尺度转换回原值）、nrounds（内部调优）和对数损失
- 后者是在内部验证任务上评估的，
  正如指定 validate = "test" 时，
  这些任务对应于 Resampling 的测试集
通过可视化结果，可以看到两个调优参数之间的反比关系：
较小的步长（eta）需要更多的提升迭代次数（nrounds）

d <- ti$archive$data

d <- data.table(
  eta = exp(d$eta),
  nrounds = unlist(d$internal_tuned_values),
  logloss = d$logloss
)

ggplot(data = d, aes(x = eta, y = nrounds, color = logloss)) +
  geom_point() + theme_minimal()

这同样适用于 AutoTuner
- 它将在最终模型拟合时使用内部优化的nrounds以及
  离线调优的eta
- 这意味着在训练最终模型时
  不进行验证或提前停止，会使用所有可用的数据

at <- auto_tuner(
 tuner = tnr('grid_search'),
 learner = lrn_xgb,
 resampling = rsmp('cv', folds = 3),
 measure = msr('internal_valid_score',
 select = 'logloss', minimize = TRUE),
 term_evals = 10L
)

at$train(tsk_sonar)

在使用重采样的测试集进行验证时必须谨慎
- 这样做是否可行取决于重采样的背景和目的
- 如果重采样的目的是为了获得算法的无偏性能估计，
  而其中一些算法会提前停止，另一些则不会，
  那么这样做是不行的
- 在这种情况下，前者相对于后者会有不公平的优势
下面的例子说明了这样一种情况，
即两个学习器之间的比较并不公平。

lrn_xgb$
 param_set$
 set_values(
  eta = 0.1, 
  nrounds = 500, 
  early_stopping_rounds = 10
)
lrn_xgb$predict_sets = 'test'

design <- benchmark_grid(
 tsk_sonar, 
 list(lrn_xgb, lrn('classif.rpart')), 
 rsmp('cv', folds = 3)
)
bmr <- benchmark(design)

bmr$aggregate(msr('classif.ce'))

<table class='dataframe'> <caption>A bmr_aggregate: 2 x 7</caption> <thead> <tr><th scope=col>nr</th><th scope=col>resample_result</th><th scope=col>task_id</th><th scope=col>learner_id</th><th scope=col>resampling_id</th><th scope=col>iters</th><th scope=col>classif.ce</th></tr> <tr><th scope=col><int></th><th scope=col><list></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><int></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>1</td><td><environment: 0x30f88fee8></td><td>sonar</td><td>classif.xgboost</td><td>cv</td><td>3</td><td>0.1828847</td></tr> <tr><td>2</td><td><environment: 0x30f86d388></td><td>sonar</td><td><span style=white-space:pre-wrap>classif.rpart </span></td><td>cv</td><td>3</td><td>0.3124224</td></tr> </tbody> </table>

使用 to_tune() 虽然更方便，
但手动定义搜索空间在参数转换方面能提供更大的灵活性
- 使用 ps() 函数手动指定搜索空间时启用内部调优
- 将内部调优参数包含在 search_space 中，
  但需要指定一个聚合函数并用
  'internal_tuning' 标记它们

search_space <- ps(
 eta = p_dbl(0.001, 0.1, logscale = TRUE),
 nrounds = p_int(
  upper = 500, 
  tags = 'internal_tuning',
  aggr = function(x) as.integer(mean(unlist(x)))
 )
)

这个搜索空间可以传递给AutoTuner，
然后优化将像以前一样继续进行

at <- auto_tuner(
 tuner = tnr('grid_search'),
 learner = lrn_xgb,
 resampling = rsmp('cv', folds = 3),
 measure = msr('internal_valid_score',
 select = 'logloss', minimize = TRUE),
 search_space = search_space,
 term_evals = 10L
)

at$train(tsk_sonar)

【mlr3】9.不均衡样本

Mon, 14 Jul 2025 00:00:00 GMT

Cover Pic by @Rafa

Applied Machine Learning Using mlr3 in R

准备工作

使用网上的公开数据集

library(mlr3verse)
library(mlr3learners)
library(OpenML)
set.seed(7832)
lgr::get_logger("mlr3")$set_threshold("warn")

ds <- listOMLDataSets(
 number.of.classes = 2,
 number.of.features = c(1, 100),
 number.of.instances = c(5000, 10000)
)
# select imbalanced data sets (without categorical features as SMOTE cannot handle them)
ds <- subset(
 ds, minority.class.size / number.of.instances < 0.2 &
 number.of.symbolic.features == 1
)

# pick one data set from list above
d <- getOMLDataSet(980)


data("optdigits", package = "mlr3data")
task <- as_task_classif(optdigits, target = "binaryclass", positive = "P")

数据轮廓

pastecs::stat.desc(task$data())

<table class="dataframe"> <caption>A data.frame: 14 x 65</caption> <thead> <tr><th></th><th scope=col>binaryclass</th><th scope=col>input1</th><th scope=col>input10</th><th scope=col>input11</th><th scope=col>input12</th><th scope=col>input13</th><th scope=col>input14</th><th scope=col>input15</th><th scope=col>input16</th><th scope=col>input17</th><th scope=col>...</th><th scope=col>input59</th><th scope=col>input6</th><th scope=col>input60</th><th scope=col>input61</th><th scope=col>input62</th><th scope=col>input63</th><th scope=col>input64</th><th scope=col>input7</th><th scope=col>input8</th><th scope=col>input9</th></tr> <tr><th></th><th scope=col><lgl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col>...</th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><th scope=row>nbr.val</th><td>NA</td><td>5620</td><td>5.620000e+03</td><td>5.620000e+03</td><td>5.620000e+03</td><td>5.620000e+03</td><td>5.620000e+03</td><td>5.620000e+03</td><td>5.620000e+03</td><td>5.620000e+03</td><td>...</td><td>5.620000e+03</td><td>5.620000e+03</td><td>5.620000e+03</td><td>5.620000e+03</td><td>5.620000e+03</td><td>5.620000e+03</td><td>5.620000e+03</td><td>5.620000e+03</td><td>5.620000e+03</td><td>5.620000e+03</td></tr> <tr><th scope=row>nbr.null</th><td>NA</td><td>5620</td><td>3.228000e+03</td><td>5.020000e+02</td><td>5.300000e+01</td><td>2.170000e+02</td><td>1.111000e+03</td><td>3.652000e+03</td><td>5.429000e+03</td><td>5.607000e+03</td><td>...</td><td>1.288000e+03</td><td>1.611000e+03</td><td>2.250000e+02</td><td>3.940000e+02</td><td>1.494000e+03</td><td>3.714000e+03</td><td>5.303000e+03</td><td>4.277000e+03</td><td>5.458000e+03</td><td>5.610000e+03</td></tr> <tr><th scope=row>nbr.na</th><td>NA</td><td> 0</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>...</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td></tr> <tr><th scope=row>min</th><td>NA</td><td> 0</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>...</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td></tr> <tr><th scope=row>max</th><td>NA</td><td> 0</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.500000e+01</td><td>5.000000e+00</td><td>...</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>5.000000e+00</td></tr> <tr><th scope=row>range</th><td>NA</td><td> 0</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.500000e+01</td><td>5.000000e+00</td><td>...</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>1.600000e+01</td><td>5.000000e+00</td></tr> <tr><th scope=row>sum</th><td>NA</td><td> 0</td><td>1.107800e+04</td><td>5.909400e+04</td><td>6.631500e+04</td><td>5.909100e+04</td><td>4.640600e+04</td><td>1.172900e+04</td><td>7.750000e+02</td><td>2.400000e+01</td><td>...</td><td>3.237400e+04</td><td>3.143700e+04</td><td>6.738200e+04</td><td>6.503700e+04</td><td>3.777100e+04</td><td>1.176600e+04</td><td>1.428000e+03</td><td>7.752000e+03</td><td>7.770000e+02</td><td>1.800000e+01</td></tr> <tr><th scope=row>median</th><td>NA</td><td> 0</td><td>0.000000e+00</td><td>1.200000e+01</td><td>1.300000e+01</td><td>1.100000e+01</td><td>9.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>...</td><td>5.000000e+00</td><td>4.000000e+00</td><td>1.300000e+01</td><td>1.300000e+01</td><td>6.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td><td>0.000000e+00</td></tr> <tr><th scope=row>mean</th><td>NA</td><td> 0</td><td>1.971174e+00</td><td>1.051495e+01</td><td>1.179982e+01</td><td>1.051441e+01</td><td>8.257295e+00</td><td>2.087011e+00</td><td>1.379004e-01</td><td>4.270463e-03</td><td>...</td><td>5.760498e+00</td><td>5.593772e+00</td><td>1.198968e+01</td><td>1.157242e+01</td><td>6.720819e+00</td><td>2.093594e+00</td><td>2.540925e-01</td><td>1.379359e+00</td><td>1.382562e-01</td><td>3.202847e-03</td></tr> <tr><th scope=row>SE.mean</th><td>NA</td><td> 0</td><td>4.133591e-02</td><td>7.244927e-02</td><td>5.339259e-02</td><td>6.387746e-02</td><td>7.967630e-02</td><td>5.228284e-02</td><td>1.254545e-02</td><td>1.400035e-03</td><td>...</td><td>6.697837e-02</td><td>7.511538e-02</td><td>5.799301e-02</td><td>6.637184e-02</td><td>7.757533e-02</td><td>5.399679e-02</td><td>1.892252e-02</td><td>4.477502e-02</td><td>1.396618e-02</td><td>1.206171e-03</td></tr> <tr><th scope=row>CI.mean</th><td>NA</td><td> 0</td><td>8.103436e-02</td><td>1.420285e-01</td><td>1.046701e-01</td><td>1.252245e-01</td><td>1.561963e-01</td><td>1.024946e-01</td><td>2.459392e-02</td><td>2.744609e-03</td><td>...</td><td>1.313035e-01</td><td>1.472552e-01</td><td>1.136887e-01</td><td>1.301145e-01</td><td>1.520776e-01</td><td>1.058546e-01</td><td>3.709545e-02</td><td>8.777633e-02</td><td>2.737911e-02</td><td>2.364561e-03</td></tr> <tr><th scope=row>var</th><td>NA</td><td> 0</td><td>9.602657e+00</td><td>2.949880e+01</td><td>1.602132e+01</td><td>2.293145e+01</td><td>3.567751e+01</td><td>1.536224e+01</td><td>8.845217e-01</td><td>1.101575e-02</td><td>...</td><td>2.521189e+01</td><td>3.170984e+01</td><td>1.890112e+01</td><td>2.475735e+01</td><td>3.382078e+01</td><td>1.638597e+01</td><td>2.012308e+00</td><td>1.126699e+01</td><td>1.096205e+00</td><td>8.176250e-03</td></tr> <tr><th scope=row>std.dev</th><td>NA</td><td> 0</td><td>3.098815e+00</td><td>5.431280e+00</td><td>4.002664e+00</td><td>4.788680e+00</td><td>5.973066e+00</td><td>3.919470e+00</td><td>9.404901e-01</td><td>1.049560e-01</td><td>...</td><td>5.021145e+00</td><td>5.631149e+00</td><td>4.347542e+00</td><td>4.975675e+00</td><td>5.815564e+00</td><td>4.047959e+00</td><td>1.418558e+00</td><td>3.356633e+00</td><td>1.046998e+00</td><td>9.042262e-02</td></tr> <tr><th scope=row>coef.var</th><td>NA</td><td> NaN</td><td>1.572066e+00</td><td>5.165294e-01</td><td>3.392139e-01</td><td>4.554396e-01</td><td>7.233683e-01</td><td>1.878031e+00</td><td>6.820070e+00</td><td>2.457719e+01</td><td>...</td><td>8.716511e-01</td><td>1.006682e+00</td><td>3.626070e-01</td><td>4.299598e-01</td><td>8.653059e-01</td><td>1.933497e+00</td><td>5.582841e+00</td><td>2.433473e+00</td><td>7.572881e+00</td><td>2.823195e+01</td></tr> </tbody> </table>

table(task$truth())

P    N 
 572 5048

不均衡数据的重采样

在mlr3pipelines中，有一个class balancing和一个smote管道操作符，
可以与任何学习器结合使用
下面使用欠采样，过采样和SMOTE的PipeOp/Graph来控制类别不平衡的程度
将PipeOp/Graph应用于当前具有特定超参数值的Task，以观察类别平衡如何变化：

欠采样（undersampling）

对多类样本中重采样，减少多类样本数量

# 欠采样
po_under <- po(
 # 管道类型
 "classbalancing",
 # 识别id
 id = "undersample", 
 # 调整类呗：结果保存在这里
 adjust = "major",
 # 参考类别：从这里抽
 reference = "major", 
 # 不对生成的任务中的行进行随机排列
 shuffle = FALSE, 
 # 减少比例
 ratio = 1 / 6
)
# reduce majority class by factor '1/ratio'
table(
 po_under$
  train(list(task))$
  output$
  truth()
)

  P   N 
572 841

过采样（oversampling）

对少类样本重采样，增加少类样本数量

# oversample majority class (relative to majority class)
po_over <- po(
 "classbalancing",
 id = "oversample", 
 adjust = "minor",
 reference = "minor", 
 shuffle = FALSE, 
 ratio = 6
)
# enrich minority class by factor 'ratio'
table(
 po_over$
  train(list(task))$
  output$
  truth()
)

   P    N 
3432 5048

SMOTE

分析数量较少类别的样本数据，
基于插值来为少数类合成新样本，并添加到数据集
原始的SMOTE算法只接受数值型特征
- 因此在运行 SMOTE 之前需要对数据进行预处理，
  将整数转换为数值型，之后再进行逆向转换

# SMOTE enriches the minority class with synthetic data
gr_smote <- po(
 "colapply", 
 id = "int_to_num",
 applicator = as.numeric, 
 affect_columns = selector_type("integer")) %>>%
  po("smote", dup_size = 6) %>>%
  po(
   "colapply", 
   id = "num_to_int",
   applicator = function(x){
    as.integer(round(x, 0L))
   },
   affect_columns = selector_type("numeric")
)
# enrich minority class by factor (dup_size + 1)
table(
 gr_smote$
  train(task)[[1L]]$
  truth()
)

   P    N 
4004 5048

构建 `AutoTuner`

构建管道

# 随机森林基础学习器
learner <- lrn("classif.ranger", num.trees = 50)

# 将3种不均衡重采样方法连接随机森林学习器
# 欠采样
learner_under <- as_learner(po_under %>>% learner)
learner_under$id <- "undersample.ranger"
# 过采样
learner_over <- as_learner(po_over %>>% learner)
learner_over$id <- "oversample.ranger"
# SMOTE
learner_smote <- as_learner(gr_smote %>>% learner)
learner_smote$id <- "smote.ranger"

定义搜索空间，以便调整类别不平衡方法的超参数

# 对
search_space_under <- ps(undersample.ratio = p_dbl(1 / 6, 1))
search_space_over <- ps(oversample.ratio = p_dbl(1, 6))
search_space_smote <- ps(
 smote.dup_size = p_int(1, 6),
 smote.K = p_int(1, 6),
  # makes sure we use numbers to the power of two to better explore the parameter space
 .extra_trafo = function(x, param_set) {
  x$smote.K = round(2^(x$smote.K))
  x
 }
)

使用auto_tuner()构建AutoTuner
以基于3折交叉验证，使用F-beta Score作为性能指标来调整图
- 为了降低运行时间，仅为不平衡校正方法定义搜索空间
- 也可以通过使用学习器的超参数扩展搜索空间，
  来联合调整学习器的超参数以及不平衡校正方法
SMOTE有两个超参数K和dup_size
- K会改变SMOTE算法的行为
- dup_size将影响过采样率
为了关注过采样率对性能的影响，
本例中将把K = 2的SMOTE与K = 4的SMOTE视为不同的不平衡校正方法
因此，本例中对欠采样，过采样以及每种SMOTE变体使用
具有5种不同超参数配置的网格搜索进行调优

inner_cv3 <- rsmp("cv", folds = 3)
measure <- msr("classif.fbeta")

learns <- list(
 auto_tuner(
  tuner = tnr("grid_search", resolution = 6),
  learner = learner_under,
  resampling = inner_cv3,
  measure = measure,
  search_space = search_space_under
 ),
 auto_tuner(
     tuner = tnr("grid_search", resolution = 6),
     learner = learner_over,
     resampling = inner_cv3,
     measure = measure,
     search_space = search_space_over
 ),
 auto_tuner(
     tuner = tnr("grid_search", resolution = 6),
     learner = learner_smote,
     resampling = inner_cv3,
     measure = measure,
     search_space = search_space_smote
 )
)

Benchmark测试

AutoTuner 是一个经过完全调优的 Graph，其行为类似于普通的学习器
本例调优时使用3折CV
我们使用 benchmark() 函数，
基于留出法进行外部评估，来比较经过调优的类别不平衡流水线图：

outer_holdout <- rsmp("holdout")
design <- benchmark_grid(
 tasks = task,
 learners = learns,
 resamplings = outer_holdout
)
print(design)

        task                  learner resampling
      <char>                   <char>     <char>
1: optdigits undersample.ranger.tuned    holdout
2: optdigits  oversample.ranger.tuned    holdout
3: optdigits       smote.ranger.tuned    holdout

lgr::get_logger("bbotk")$
 set_threshold("warn")
bmr <- benchmark(design, store_models = TRUE)

可视化benchmark测试结果

bmr$aggregate(measure)
autoplot(bmr, measure = measure)

<table class="dataframe"> <caption>A bmr_aggregate: 3 x 7</caption> <thead> <tr><th scope=col>nr</th><th scope=col>resample_result</th><th scope=col>task_id</th><th scope=col>learner_id</th><th scope=col>resampling_id</th><th scope=col>iters</th><th scope=col>classif.fbeta</th></tr> <tr><th scope=col><int></th><th scope=col><list></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><chr></th><th scope=col><int></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><td>1</td><td><environment: 0x171203760></td><td>optdigits</td><td>undersample.ranger.tuned</td><td>holdout</td><td>1</td><td>0.9602122</td></tr> <tr><td>2</td><td><environment: 0x1711e4030></td><td>optdigits</td><td>oversample.ranger.tuned </td><td>holdout</td><td>1</td><td>0.9459459</td></tr> <tr><td>3</td><td><environment: 0x1711c8298></td><td>optdigits</td><td><span style=white-space:pre-wrap>smote.ranger.tuned </span></td><td>holdout</td><td>1</td><td>0.9465241</td></tr> </tbody> </table>

可视化调优路径

当store_models = TRUE时，
允许 benchmark() 函数存储调优过程中计算出的每个模型
因此可以绘制子采样迭代中最优学习器的调优路径：

# 加载绘图R包
library(ggplot2)

# 提取所有的模型
bmr_data_learners <- as.data.table(bmr)$learner

# 欠采样
utune_path <- bmr_data_learners[[1]]$
 model$
 tuning_instance$
 archive$
 data
utune_gg <- ggplot(
 utune_path, 
 aes(
  x = undersample.ratio, 
  y = classif.fbeta
 )
) +
  geom_point(size = 3) +
  geom_line() + ylim(0.9, 1)

# 过采样
otune_path <- bmr_data_learners[[2]]$
 model$
 tuning_instance$
 archive$
 data
otune_gg <- ggplot(
 otune_path, 
 aes(
  x = oversample.ratio, 
  y = classif.fbeta
 )
) +
  geom_point(size = 3) +
  geom_line() + ylim(0.9, 1)

# SMOTE
stune_path <- bmr_data_learners[[3]]$
 model$
 tuning_instance$
 archive$
 data
stune_gg <- ggplot(
 stune_path, 
 aes(
  x = smote.dup_size,
  y = classif.fbeta, 
  col = factor(smote.K)
 )
) +
  geom_point(size = 3) +
  geom_line() + ylim(0.9, 1)

# 合并图像
library(ggpubr)
ggarrange(utune_gg, otune_gg, stune_gg, common.legend = TRUE, nrow = 1)

随机密码生成器

Thu, 26 Jun 2025 00:00:00 GMT

Cover Pic by @Ray

passwordGenerate <- function(
    # 密码长度
    length = 16, 
    # 是否包含大写字母
    upper = TRUE, 
    # 大写字母出现倍率
    upper_factor = 1, 
    # 是否包含小写字母
    lower = TRUE, 
    # 小写字母出现倍率
    lower_factor = 1,
    # 是否包含数字
    number = TRUE, 
    # 数字出现倍率
    number_factor = 1, 
    # 是否包含特殊字符
    special = TRUE,
    # 特殊字符出现倍率
    special_factor = 1
) {
    
    # 设定字符集
    upperChr <- 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
    lowerChr <- 'abcdefghijklmnopqrstuvwxyz'
    numChr <- '0123456789'
    spcChr <- '!@#$%^&*()-_=+~`[]{}|;:\"\',.<>/?'

    # 初始化字符池
    chars <- ''

    # 根据参数选择字符集
    if (upper) for(i in 1:upper_factor) chars <- paste0(chars, upperChr)
    if (lower) for(i in 1:lower_factor) chars <- paste0(chars, lowerChr)
    if (number) for(i in 1:number_factor) chars <- paste0(chars, numChr)
    if (special) for(i in 1:special_factor) chars <- paste0(chars, spcChr)

    # 检查字符池是否为空
    if (nchar(chars) == 0) {
    stop('Please choose one type of chars at least <3')
    }

    # 生成密码
    password <- sample(strsplit(chars, '')[[1]], length, replace = TRUE)
    cat(paste0(password, collapse = ''))
}

set.seed(42)
passwordGenerate(special_factor = 3)

w#>_;>w$uX(&.[T/

R语言的良好书写规范

Fri, 20 Jun 2025 00:00:00 GMT

Cover Pic by @iJac Ray

规范代码书写

单细胞RNA-seq分析

Sun, 18 May 2025 00:00:00 GMT

Cover Pic by @void_0

Getting Started with Seurat
【bilibili】单细胞数据分析/入门必看/标准分析流程/实战为主/保姆级教程/生物信息学/R语言/生信分析/单细胞/转录组/单细胞测序
 Introduction to single-cell RNA-Seq and Seurat | Bioinformatics for beginners

-----理论部分-----

简介

传统的转录组是在多细胞基础上进行，
仅计算了均值，丢失了细胞间异质性的信息
单细胞转录组

【bilibili】单细胞数据分析/入门必看/标准分析流程/实战为主/保姆级教程/生物信息学/R语言/生信分析/单细胞/转录组/单细胞测序

10X Genomics 10X的基本技术原理:1个油滴=1个凝胶支微珠=1个RNA-Seq

Aksomics-单细胞测序

BD RhapsodyBD的基本技术原理:1个微孔=1个单细胞=1个磁珠=1个RNA-Seq

Aksomics-单细胞测序

双细胞

简介

双细胞：一个液滴或一个微孔中包含了2个或多个细胞
- 同源双细胞：转录相同的细胞（不容易检测）
- 异源双细胞：转率不同的细胞（容易检测）
DoubletFinder原理

从现有单细胞数据中人为产生双细胞
将人工产生的doublets与真实细胞混合在一起
用PCA距离矩阵寻找每个单元的artificial k最近邻（nearest neighbors, NN）的比例
根据预期的双细胞数量进行排序和计算pANN阈值

DoubletFinder参数

参数	作用	调参技巧
pCs	选择用于计算的主成分数	通常与下游分析保持一致，一般取10 - 30
pK	控制双细胞识别灵敏度	通过paramSweep自动寻找最佳值，BCmetric峰值即为最优
pN	生成伪双细胞的比例	默认0.25即可，过高会引入噪声
nExp	预期双细胞数量	根据实验细胞数计算，调整同源双细胞比例后更准确

DoubletFinder: Detect doublets in single-cell RNA-Seq data in R | Detailed workflow tutorial

10x官网提供的Exp

What is the maximum number of cells that can be profiled?

建议

DoubletFinder不适用于聚合的单细胞RNA测序数据
不建议在合并数据上运行（不同样本的细胞类型比例可能不同，且合并后的对象可能体积较大）
应分别在不同样本上运行
输入数据应清除低质量细胞
去除低RNA UMIs、高线粒体读取百分比以及标记基因无信息的细胞簇
预测的双细胞不一定都是双细胞,不同的算法得出的结果也会有有差异
- 因此,要考虑是否真的需要去除双细胞
也可以不移除双细胞
- 具体可以通过预测为双细胞的点是否在聚类结果的图中是否特别离群来判断要不要移除双细胞

术语

UMI
独特分子标识符，即分子标签，可用于检测和量化独特的转录本。
Features
基因
Barcodes
单细胞测序实验使用短DNA条形码“标签”来识别源自同一细胞的读数。
Count Matrix/Feature-Barcode Matrix/Gene-Barcode Matrix
一个计数矩阵，代表每个细胞条形码内每个特征的独特观测数量。
Doublets
两个细胞被包裹在一个反应体积中时的情况。

Seurat层级结构

Seurat v5: structure and main workflow easily explained!

assays
- 在Layer中能够储存多种测序的结果
  - RNA：原始数据及处理后的数据
  - SCT：SCTransform转换后的数据
  - integrated：合并的数据
- 除了RNA，还有能有ATAC assay，ADT assay（CITE-seq）等
meta.data
- 元数据，可以将各种细胞样本信息输入进去，同时在后续的分析中也有部分结果会保存在meta.data当中
reductions
- 应用过的降维方法的列表
  - pca
  - tsne
  - umap
graphs
- 用于聚类和其他分析的图列表
clusters
- 聚类的结果
commands
- 用于生成该对象的命令记录
misc
- 存储不适合其他插槽的任意信息
- 可用于存储额外的分析结果或自定义注释

细胞注释

基于标记的注释

简介

根据已知标记基因的特征表达对细胞或细胞簇进行标记
标记基因与细胞类型之间的已知关系可从以下数据库中获取，例如：
- MSigDB
- PanglaoDB
- CellMarker
- 文献中手动获取
优势
- 这些方法只会将标签分配给与已知标记物相关的细胞，而其他细胞将保持未标记状态。
缺点
- 并非所有细胞类型都容易获取标记物
- 标记基因或基因集（一组标记基因）应在特定细胞或细胞簇中特异性且持续表达
- 一旦收集到相关且足够多的标记基因集，这些方法就能很好地发挥作用
- 这些方法在注释主要细胞类型方面效果更好，但可能无法有效区分亚型

工具

AUCell
- 用于估计曲线下面积
- 单细胞
- 由于在单细胞水平上检测率较低，因此每种细胞类型都需要多种标记物来进行标记基因集富集分析
SCINA
- 期望最大化、高斯混合模型
- 单细胞
- 同时对细胞进行聚类和注释；对错误标记基因的纳入具有稳健性
GSEA/GSVA
- 富集检验
- 细胞簇
- 标记基因列表必须重新格式化为GMT格式标记物在聚类中必须都在同一方向上差异表达

基于参考的注释

简介

将标签从一个参考细胞或细胞簇（来自专家注释的单细胞RNA测序数据）转移到查询数据（待注释数据）中足够相似的细胞或细胞簇上
参考单细胞数据来源于诸如
- 基因表达综合数据库（GEO）
- 单细胞表达图谱
- 细胞图谱项目
优势
- 已分配标签的准确性以及避免对新细胞类型进行错误标记
缺陷
- 只有在高质量且相关的带注释参考单细胞数据可用的情况下，该方法才可行
- 如果参考数据不完整或匹配度不佳，一些工具的准确性会较低

工具

singleCell Net
- 相对表达基因对 + 随机森林
- 单细胞
- 比其他方法慢10到100倍；准确率高
scmap-cluster
- 一致相关性
- 单细胞
- 现有最快的方法；平衡误报和漏报；包含网络界面，可用于大型预构建参考集或自定义参考集
scmap-cell
- 近似最近邻
- 单细胞
- 将单个细胞分配给参考中最近邻的细胞；可绘制细胞轨迹；快速且可扩展
singleR
- 层次聚类 + 斯皮尔曼相关性
- 单细胞
- 包含大型标记参考；无法扩展到≥10000个细胞的数据集；包含带有标记数据库的网络界面
Scikit-learn
- k近邻、支持向量机、随机森林、最近均值分类器和线性判别分析
- 多种对象
- 需要专业知识来正确设计和适当地训练分类器，同时避免过度训练

`SingleR`包

Pokédex for Cell Types

安装

if (!require("BiocManager", quietly = TRUE))
    install.packages("BiocManager")

BiocManager::install("SingleR")

工作原理

将每个细胞的RNA表达与参考数据的不同细胞种类进行spearman相关性检测
根据检测结果打出分数
根据最高分选出最相关的细胞种类

三种注释策略

策略1：使用参考特定标签

未处理批次效应
在每个参考中计算分数时，由于噪声导致精度损失
分类存在技术性的差异导致错误的风险

策略2：跨参考比较分数

不同参考文献中标签缺乏一致性，使得解读变得复杂

策略3：使用协同标签

假设存在协同了的标签
映射过程也存在丢失有关生物学状态（例如激活状态、疾病状况）的相关信息的风险，
如果在本体中该状态没有明显的对应项

-----R中的基本操作-----

考虑到实际情况，操作以多样本为主
单样本无非就是没有数据融合和整合而已

安装官方推荐的包

Seurat包

install.packages('Seurat')

Seurat-wrappers包
- 提供Seurat包的补充功能

options(timeout=300); remotes::install_github('satijalab/seurat-wrappers')

Signac
- 单细胞染色质数据分析

install.packages('Signac')

SeuratData
- 自动加载预先打包为 Seurat 对象的数据集

remotes::install_github("satijalab/seurat-data", quiet = TRUE)

Azimuth
- 跨多个器官和组织的scRNA-seq和scATAC-seq查询的局部注释

# Note: you may need to update some packages prior to installing Azimuth; from a fresh R session run:
update.packages(oldPkgs = c("withr", "rlang"))
# 这之前补个包
if (!require("BiocManager", quietly = TRUE)){
 install.packages("BiocManager")
}
BiocManager::install("glmGamPoi")
# You can install Azimuth from GitHub with:
if (!requireNamespace('remotes', quietly = TRUE) {
  install.packages('remotes')
}
remotes::install_github('satijalab/azimuth', ref = 'master')

数据

种类

一般在ncbi上的GEO database搜索关键词就能获取数据
数据格式
- X10
  - 10X Genomics的标准文件格式
  - 3个文件
    - barcodes.tsv.gz
    - features.tsv.gz / genes.tsv.gz
    - matrix.mtx.gz
  - 不可解压
- H5
  - 存储大规模数据的二进制文件格式
  - 可以保存矩阵，表格，图像等
- RDS
  - R的数据文件格式存储表达矩阵
  - 包含信息
    - assays
      表达矩阵
      - counts
        原始数据
      - data
        Normalize() 规范化后的数据
      - scale.data
        Scale() 缩放后的数据
    - SCT
      SCT方式标准化后的数据
    - meta.data
      细胞的样本注释信息（对照，给药等）
    - active.assay
      默认的矩阵名
    - active.ident
      默认的细胞来源信息
- CSV / TXT
  - 存取单细胞测序的表达矩阵或元数据
如果数据不止scRNA-seq的结果，并且存在处理其他seq的数据的情况时，
应该经常确认是否默认调用的是RNA的数据

DefaultAssay(ifnb_harmony)
# 如果不是`RNA`，应该修改
# DefaultAssay(ifnb_harmony) <- 'RNA'

读取

X10

网上的教程会说需要给每个样本单独创建文件夹，然后拖进去再去掉前缀
- 其实不用

dt_x10 <- ReadMtx(
 mtx = 'matrix.mtx.gz',
 features = 'features.tsv.gz',
 cells = 'barcodes.tsv.gz'
)
dt <- CreateSeuratObject(counts = dt_x10)

H5

dt_h5 <- Read10X_h5(
 filename = 'H5file.h5', 
 use.names = T, 
 unique.features = T
)

RDS

读取数据

dt <- readRDS('RDSfile.rds')

获取内部信息GetAssayData()
- 当不指定@assays$RNA的时候，默认使用@assays$SCT, layer = 'counts

# 简单提取
GetAssayData(object = dt@assays$RNA, layer = 'counts')
GetAssayData(object = dt@assays$SCT, layer = 'data')
GetAssayData(object = dt@assays$RNA, layer = 'data')

# 转换为矩阵
as.matrix(GetAssayData(object = dt@assays$RNA, layer = 'counts'))[1:20,1:20]

修改默认提取信息DefaultAssay()

# 提取RNA而不是默认的SCT
DefaultAssay(dt) <- 'RNA'

修改默认的细胞来源信息Idents()

Idents(dt) <- "WhereIFrom"

CSV / TXT

dt_txt <- fread('TXTfile.txt')
dt <- CreateSeuratObject(counts = dt_txt)

创建SeuratObject

SeuratObject作为一个容器，里面可以保存所有的数据，分析结果以及分析流程记录

dt <- CreateSeuratObject(counts = dt)

如果读取的数据是以Seurat v5之前的版本创建的，可以用这个转换成v5版本

dt <- SeuratObject::UpdateSeuratObject(dt)

数据融合（多样本）

注意融合（merge）与整合（integrate）的区别
单样本无需融合

# sampleList id 就是样本分组名
dt <- merge(dt[1], y = dt[-1], add.cell.ids = sampleList)

最好排个序

dt$orig.ident <- factor(dt$orig.ident, levels = YourOrder)

质量控制

影响因素

在创建Seurat对象以后，会自动计算
- 独特基因数量nFeature_RNA
- 基因表达计数nCount_RNA
对nFeature_RNA和nCount_RNA进行过滤
- 过高代表了双细胞的存在
- 过低表示空液滴或者低质量细胞
除此以外，也可以计算线粒体基因，核糖体基因的表达比例
- 这些代表了细胞正处于异常状态
  - 低质量或者濒死细胞中表现的细胞膜破损导致的细胞质mRNA流出
  - 线粒体或核糖体本身被破坏导致的内部mRNA污染
  - 细胞处于应激受损状态，所以导致过量表达
一些样本可能会有红细胞的污染，可以计算红细胞基因比例来去除
也可以自定义管家基因来判断

# 线粒体RNA比例
dt[["percent.mt"]] <- PercentageFeatureSet(dt, pattern = '^MT-')

# 核糖体RNA比例
dt[['percent.rb']] <- PercentageFeatureSet(dt, pattern = '^RP[SL]')

# 筛选红细胞比例
HB.genes <- c("HBA1","HBA2","HBB","HBD","HBE1","HBG1","HBG2","HBM","HBQ1","HBZ")
HB.genes <- CaseMatch(HB.genes, rownames(dt))
dt[['percent.genes']] <- PercentageFeatureSet(dt, features = HB.genes)

可以通过查看两个变量的相关性查看样本细胞是否正常

# 期待不相关
FeatureScatter(dt, "nCount_RNA", "percent.mt", group.by = "orig.ident")
# 期待强相关
FeatureScatter(dt, "nCount_RNA", "nFeature_RNA", group.by = "orig.ident")

筛选

使用subset()函数可以过滤出合适的细胞
- 过滤的阈值没有具体规定，可以说全凭感觉和喜好了哈
这里的是官方教程对pmbc测序的时候用的

dt <- subset(
 dt, 
 subset = nFeature_RNA > 200 & 
  nFeature_RNA < 2500 & 
  percent.mt < 5
)

如果用DoubletFinder包去除双细胞的话，
可以不用在这里设置nFeature_RNA或nCount_RNA的上限值

归一化

对于机器学习而言，使用归一化是基本中的基本
后面的降维和聚类都需要归一化过的数据
默认的方法是logNormalize
- $X' = log(count \times 10000)$
- 这里的10,000是默认的比例因子，可以在scale.factor参数更换

dt <- NormalizeData(
 dt，
 normalization.method = "LogNormalize", 
 scale.factor = 10000
)

寻找高变基因

高变基因，即在细胞间表达差异很大的基因
聚焦于高变基因可以凸显数据中的生物学信号，并且减少噪声干扰
默认方法就是vst，通过固有的均值-方差建模找出高变基因
从这里开始，后续分析中都默认输入高变基因来计算

pbmc <- FindVariableFeatures(
 pbmc, 
 selection.method = "vst", 
 nfeatures = 2000
)

可以提取最高变的基因

# 选择差异最大的10个高变基因
top10 <- head(FindVariableFeatures(dt), 10)
# 生成显示top10高变基因的散点图，其中高变的用默认的红色标记
LabelPoints(
 # VariableFeaturePlot(dt)是不带label的散点图
 plot = VariableFeaturePlot(dt), 
 points = top10,
 repel = TRUE
)

缩放

缩放也是机器学习重要的步骤
后续的降维和聚类都需要用到缩放的数据

# 仅缩放高变基因
dt <- ScaleData(
 dt,
 features = VariableFeatures(dt) # 默认是仅对高变基因进行缩放
)
# 缩放全部基因
dt <- ScaleData(
 dt,
 features = rownames(dt) # 默认是仅对高变基因进行缩放
)

PCA降维

使用PCA的目的是给后续的分析选择合适的维度
- UMAP或者T-SNE的维度确定都依赖PCA降维的结果
PCA分析

dt <- RunPCA(
 dt,
 features = VariableFeatures(dt)
)

PCA结果可视化

# [['索引']]可以越过层级
dt[["pca"]]

确定拐点
- 我的差不多是以20为拐点

ElbowPlot(dt, ndims = 50)

# 打印前5个维度，前5个基因
print(dt[["pca"]], dims = 1:5, nfeatures = 5)

结果图

# 维度散点分布图
DimPlot(dt, reduction = 'pca', dims = c(1,2))
# 维度mark基因气泡图
VizDimLoadings(dt, dims = 1:4, reduction =  'pca', nfeatures = 20)
# 热图
DimHeatmap(dt, dims = 1:4, cells = 500, balanced = T, nfeatures = 30, ncol = 2)

聚类

方法是KNN
刚刚确定拐点是20，所以这里 dims = 1:20

dt <- FindNeighbors(dt, dims = 1:20)

确定细胞簇

@ 这部分方法很多

Findclusters-resolution怎么选

分别作图查看法

创建不同分辨率的情况来筛选，我这里创造了 0.1–1 的 10个分辨率
分辨率越高，生成的细胞簇就越多

dt <- FindClusters(dt, resolution = seq(0.1, 1, by=0.1))

for (i in seq(0.1, 1, by = 0.1) %>% as.character()){
 DimPlot(dt, group.by = paste('RNA_snn_res.',i,sep=''), label = T)
}

使用`clustree`包

通过

clustree(dt, prefix = 'RNA_snn_res.') + coord_flip()
DimPlot(dt, group.by = 'RNA_snn_res.0.6', label = T)

分配簇

# 分配
dt$seurat_clusters <- 'RNA_snn_res.0.6'
Idents(dt) <- 'seurat_clusters'

# 直接这样也行
# dt$seurat_clusters <- 'RNA_snn_res.0.6'

非线性降维

非线性降维的目的和PCA降维的目的是不同的
- 非线性降维用于可视化来探索结果，
  是将多维的细胞数据降维成二维数据以便可视化
- PCA降维的目的是为了对细胞聚类，确定细胞簇
- 基于PCA降维的结果，可以给非线性降维提供合适的维度
所以我们知道了什么？
- PCA对于聚类和非线性降维是必须的
- PCA和聚类是必须的，用来划分单细胞种类
- 非线性降维不是必须的，但是通常都会做
- 聚类和非线性降维是没有关系的
- 在非线性降维的平面图上标注各个细胞簇可以更好查看聚类结果的合理性
提供UMAP和t-SNE两种方法，UMAP比t-SNE更优
两种可以都做了，因为结果保存在SeuratObject的不同位置

# dims = 1:20 是默认值
dt <- RunUMAP(dt, dims = 1:20)
dt <- RunTSNE(dt, dims = 1:20)

如何选择dims?
- 这里的dims和PCA的dims是没有关系的，
  不需要一样，但肯定是小于PCA的dims的
- 根据PCA的ElbowPlot()结果，选择肘部左右的维度就行

去除双细胞

多样本数据需要分割数据成list，
并且接下来的步骤中要用lapply()进行列表操作

dt <- SplitObject(dt)

寻找最佳pK值

sweep.res <- paramSweep(dt, PCs = 1:20, sct = FALSE)
sweep.stats <- summarizeSweep(sweep.res, GT = FALSE)
sweep.bcmvn <- find.pK(sweep.stats)

pK <- bcmvn_pbmc %>% 
  filter(BCmetric == max(BCmetric)) %>% # 要找BCmetric时的最大的pK
  select(pK) %>%
pK <- as.numeric(as.character(pK[[1]]))

查看生成的pK与BCmetric的曲线图
- 上面代码运行的时候会自动生成，
  所以不需要特地去做这个图，除非想改造一下

ggplot(sweep.bcmvn, aes(pK, BCmetric, group = 1)) +
  geom_point() +
  geom_line()

# 设定推测的双细胞占比，这里是8%，也有7.5%，7.6%的
dblpct <- 0.008 
# 另一种算法：按每增加1000个细胞，双细胞比率增加千分之8来计算
# dblpct <- ncol(dt) * 8 * 1e-6 

homotypic.prop <- modelHomotypic(dt@meta.data$seurat_clusters)
nExp_poi <- round(dblpct * nrow(dt@meta.data))
nExp_poi.adj <- round(nExp_poi*(1-homotypic.prop))

得运算两次，第一次是

dt <- doubletFinder(
 dt, 
 PCs = 1:20, 
 pN = 0.25, 
 pK = pK, 
 nExp = nExp_poi,
 reuse.pANN = NULL, 
 sct = FALSE
)

dt <- doubletFinder(
 dt, 
 PCs = 1:20, 
 pN = 0.25, 
 pK = pK, 
 nExp = nExp_poi.adj,
 reuse.pANN = {dt@meta.data}[length(dt@meta.data), 
 sct = FALSE
)

筛选数据

dt <- subset(dt, subset = {dt@meta.data}[length(dt@meta.data)] == "Singlet")

数据整合（多样本）

对于多样本数据而言，需要对多个样本进行整合
整合integrate而不是融合merge
对于融合的数据而言，
只是列表变成了一个单独的seuratObject，
但是所有的操作都是按样本（一般是Layer，分层）分开来运算的
整合就是混合成一个矩阵一起分析吗？
- 答案是NO
- 整合应该理解为使用一种去除批次效应的算法后的数据
  - 简单而言，模拟一种情况：
    这些不同的样本测定的条件是一样的，
    基因表达的不同仅仅来自于生物体的内部因素或者有人为控制的刺激干预
- 混合成一个矩阵，称之为混层（Join Layers）

dt <- IntegrateLayers(
  object = dt, 
  method = HarmonyIntegration,
  orig.reduction = "pca", 
  new.reduction = "harmony",
  verbose = FALSE
)

什么时候混层？
- 在IntegrateLayers()后如果没有其他操作就可以混层
- 形象点就是：
  - 不混层，分析就是每个层各自做各自的事情，
    类似于lapply()对列表中的多个dataframe进行相同操作，
    结果也是分别保存
  - 混层，就是把列表中矩阵融合成一个大的dataframe，
    然后用dplyr包整列整行，或者分组地批量操作，
    但终究所有的操作都是针对一个大的dataframe
- 这个时候需要使用JoinLayers()进行对混层

# 仅对RNA数据的混合
dt[['RNA']] <- JoinLayers(dt[['RNA']])

# 确认目前使用的是否是RNA数据，如果是可以直接混层，如果不是也可以指定为RNA后再操作
DefaultAssay(dt) # 当有多种数据的时候，最好先确认下assay
DefaultAssay(dt) <- 'RNA' # 修改当前的assay
dt <- JoinLayers(dt) # 直接混层

重新分层的方法

dt <- split(dt, f = 'orig.ident')

注意不要用成SplitObject()了，这个是切分成list的
- 切了再用merge()弄回来也行，不过何必呢？

# ！！！注意不是这个！！！
dt <- splitObject(dt, split.by = 'orig.ident')

寻找差异性表达基因

混合层

dt[['RNA']] <- JoinLayers(dt[['RNA']])

`FindAllMarkers()`

Gene expression markers for all identity classes

迭代地将每个集群与所有其他集群进行比较，为每个集群单独生成标记基因列表

FindAllMarkers(
 dt,
 # 制定分类的群组，一般不需要，因为会按照聚类的结果去比较
 # group.by = 'orig.ident',
 # 测试限制在那些平均而言在两组细胞之间显示出至少X倍差异（对数尺度）的基因
 logfc.threshold = 0.25, 
 # 仅测试在两个群体中任一群体内至少有min.pct比例的细胞中检测到的基因
 min.pct = 0.1, 
 # 仅返回阳性标记
 only.pos = FALSE,
 # 检验方法
 test.use = 'wilcox',
 slot = 'data'
)

一般默认的slot是data，但有的测定方法test.use是要用到counts的

`FindConservedMarkers()`

寻找不受条件影响的（干预/对照）保守的差异基因
ident.1和ident.2填写聚类的编号，可以多对多，例如
ident.1 = c(1,2,3), ident.2 = c(4,5,6,7,8)
ident.2 = NULL（默认）表示将ident.1与之以外的样本进行对比
grouping.var = 'orig.ident'可以使比较在每个组中进行

clust2_mkr <- FindConservedMarkers(
    dt,
    ident.1 = 2,
    # ident.2 = NULL的情况下是用ident.1和剩余所有簇进行比较（把其他簇当成1个簇）
    ident.2 = NULL, 
    grouping.var = 'orig.ident'
)

head(clust2_mkr)

下面可以看到每组中的结果，前缀是orig.ident
p_val：比较结果的p值
avg_log2FC：平均log2 fold change
pct.1：在ident.1样本中的占比
pct.2：在ident.2样本中的占比

<table class="dataframe"> <caption>A data.frame: 6 x 22</caption> <thead> <tr><th></th><th scope=col>3dpi_p_val</th><th scope=col>3dpi_avg_log2FC</th><th scope=col>3dpi_pct.1</th><th scope=col>3dpi_pct.2</th><th scope=col>3dpi_p_val_adj</th><th scope=col>6dpi_p_val</th><th scope=col>6dpi_avg_log2FC</th><th scope=col>6dpi_pct.1</th><th scope=col>6dpi_pct.2</th><th scope=col>6dpi_p_val_adj</th><th scope=col>...</th><th scope=col>1dpi_pct.1</th><th scope=col>1dpi_pct.2</th><th scope=col>1dpi_p_val_adj</th><th scope=col>MOCK_p_val</th><th scope=col>MOCK_avg_log2FC</th><th scope=col>MOCK_pct.1</th><th scope=col>MOCK_pct.2</th><th scope=col>MOCK_p_val_adj</th><th scope=col>max_pval</th><th scope=col>minimump_p_val</th></tr> <tr><th></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col>...</th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th><th scope=col><dbl></th></tr> </thead> <tbody> <tr><th scope=row>C1orf194</th><td>3.656848e-169</td><td>5.582241</td><td>0.818</td><td>0.049</td><td>1.338443e-164</td><td>2.867431e-234</td><td>5.778323</td><td>0.926</td><td>0.064</td><td>1.049509e-229</td><td>...</td><td>0.927</td><td>0.194</td><td>1.462696e-198</td><td>4.405871e-239</td><td>4.471342</td><td>0.968</td><td>0.180</td><td>1.612593e-234</td><td>3.656848e-169</td><td>1.762348e-238</td></tr> <tr><th scope=row>OMG</th><td>5.807800e-158</td><td>5.997568</td><td>0.756</td><td>0.041</td><td>2.125713e-153</td><td>7.773242e-222</td><td>5.832163</td><td>0.857</td><td>0.048</td><td>2.845084e-217</td><td>...</td><td>0.390</td><td>0.031</td><td> 2.023912e-78</td><td>1.312786e-226</td><td>4.724586</td><td>0.820</td><td>0.059</td><td>4.804927e-222</td><td> 5.529663e-83</td><td>5.251143e-226</td></tr> <tr><th scope=row>C9orf24</th><td>2.431279e-160</td><td>5.367758</td><td>0.812</td><td>0.056</td><td>8.898725e-156</td><td>1.055259e-207</td><td>5.072022</td><td>0.931</td><td>0.096</td><td>3.862354e-203</td><td>...</td><td>0.880</td><td>0.142</td><td>1.120115e-198</td><td>9.418606e-226</td><td>4.209846</td><td>0.928</td><td>0.151</td><td>3.447304e-221</td><td>2.431279e-160</td><td>3.767442e-225</td></tr> <tr><th scope=row>FAM183A</th><td>5.815296e-140</td><td>4.987162</td><td>0.710</td><td>0.043</td><td>2.128456e-135</td><td>1.509409e-216</td><td>5.463419</td><td>0.883</td><td>0.063</td><td>5.524586e-212</td><td>...</td><td>0.833</td><td>0.141</td><td>1.790443e-171</td><td>3.856198e-190</td><td>3.870463</td><td>0.846</td><td>0.134</td><td>1.411407e-185</td><td>5.815296e-140</td><td>6.037634e-216</td></tr> <tr><th scope=row>C20orf85</th><td>2.866906e-161</td><td>5.505593</td><td>0.835</td><td>0.065</td><td>1.049316e-156</td><td>5.231875e-204</td><td>5.392041</td><td>0.957</td><td>0.121</td><td>1.914919e-199</td><td>...</td><td>0.944</td><td>0.246</td><td>7.929550e-195</td><td>6.860743e-185</td><td>3.769995</td><td>0.920</td><td>0.253</td><td>2.511100e-180</td><td>2.866906e-161</td><td>2.092750e-203</td></tr> <tr><th scope=row>DYNLRB2</th><td>4.212733e-164</td><td>5.389558</td><td>0.767</td><td>0.036</td><td>1.541902e-159</td><td>4.912858e-195</td><td>5.488527</td><td>0.736</td><td>0.030</td><td>1.798155e-190</td><td>...</td><td>0.817</td><td>0.095</td><td>1.238847e-185</td><td>6.966579e-202</td><td>3.902018</td><td>0.854</td><td>0.114</td><td>2.549838e-197</td><td>4.212733e-164</td><td>2.786632e-201</td></tr> </tbody> </table>

`FindMarkers()`

Gene expression markers of identity classes
比较 特定的两个集群（或一个集群与其他集群的组合），找出在目标集群中差异表达的基因
- 其实FindAllMarkers()可以做到一样的事情，这个不是很常用

mkr_clust2v3 <- FindMarkers(
 ifnb_harmony, 
 ident.1 = 2, 
 ident.2 = 3
)

组合样本及细胞簇

在注释了细胞簇以后（确定细胞簇），可以进行样本+细胞簇的比较
首先组合成一个新的列

# 组合
dt$TypeCondi <- paste0(ifnb_harmony$type,'_', ifnb_harmony$condition)

# 有必要的话可以因子化并排序
dt$TypeCondi <- factor(dt$TypeCondi, levels = YourOrder)

# 可在meta.data查看
# dt$meta.data

# 定义默认的Idents
Idents(dt) <- dt$TypeCondi

之后用FindAllMarkers()还是FindMarkers()都随意

查看标记某基因的表达量的聚类结果图

FeaturePlot()中制定features即可
因为features是复数，提示了可以按需输入多个感兴趣的基因
min.cutoff = 'q10'：表达量小于q10的基因不给颜色；只能填入分位数

# 就看一个
FeaturePlot(dt, features = c('C1orf194'), min.cutoff = 'q10')
# 看两个以上
FeaturePlot(dt, features = c('C1orf194','OMG'), min.cutoff = 'q10')
FeaturePlot(dt, features = c('NDRG1','OMG'), min.cutoff = 'q10',label = TRUE, ncol = 1)

确定细胞簇

细胞Markers已知

如果已知包含哪些细胞以及它们的Marker基因，
可以结合上述的用FeaturePlot()生成的聚类结果图来看各个细胞簇属于哪种细胞
首先需要将细胞的聚类结果Ident替换名称
（这里DataFromIFNB就是dt，由于是特定的数据集的东西所以区分一下）

DataFromIFNB <- RenameIdents(DataFromIFNB, `3` = 'CD16 Mono')

如果meta数据里面已经有注释了（实际上一手数据根本不会有哈）

Idents(dt) <- dt@meta.data$aColOfAnnotations

细胞Markers未知

如果不用现有一些结论提供的细胞Markers的话，需要先找出差异基因再来注释
- 这也是我把【确定细胞簇】放到【寻找差异性表达基因】后面的原因

单注释数据集注释

hpca <- HumanPrimaryCellAtlasData()
pred <- SingleR(test = dt,
        ref = hpca,
        labels = hpca$label.main)
dt$singleR.labels <- pred$labels[match(rownames(dt@meta.data), rownames(pred))]

多注释数据集注释

策略1：使用参考特定标签

# 调取参考数据集
hpca <- celldex::HumanPrimaryCellAtlasData()
dice <- celldex::DatabaseImmuneCellExpressionData()

# 给基因名按数据集添加前缀以做区分
hpca$label.main <- paste0('HPCA.', hpca$label.main)
dice$label.main <- paste0('DICE.', dice$label.main)

# 注意：intersect只能两个数据，x和y
# 3个数据的时候要两两intersect
shared <- GenomicRanges::intersect(rownames(hpca), rownames(dice))
# shared <- GenomicRanges::intersect(rownames(shared), rownames(set3))

# 合并参考数据集
combined <- cbind(hpca[shared,], dice[shared,])

# 检查一下combined中是否存在基因，有的数据库基因不相同，导致空基因会报错的
combined 

# 注释
pred <- SingleR(
        test = GetAssayData(dt, slot = 'counts'),
        ref = combined,
        labels = combined$label.main)

dt$singleR.labels <- pred$labels[match(rownames(dt@meta.data), rownames(pred))]

策略2：跨参考比较分数

# 调取参考数据集
hpca <- celldex::HumanPrimaryCellAtlasData()
dice <- celldex::DatabaseImmuneCellExpressionData()

# 如果直接调用策略1中的hpca和dice的话，记得去掉前缀
# hpca$label.main <- gsub('HPCA\\.','', hpca$label.main)
# dice$label.main <- gsub('DICE\\.','', dice$label.main)

# 注释
pred <- SingleR(test = GetAssayData(dt, slot = 'counts'),
        ref = list(HPCA = hpca, DICE = dice),
        labels = list(hpca$label.main, dice$label.main))

dt$singleR.labels <- pred$labels[match(rownames(dt@meta.data), rownames(pred))]

策略3：使用统一标签

# 调取参考数据集
# cell.ont 字符串，指定是否将细胞本体术语包含在 colData 中。若为 "nonna"，所有没有有效术语的样本将被丢弃；若为 "all"，所有样本将返回（可能带有 NA）术语；若为 "none"，则不添加术语。
hpca.ont <- celldex::HumanPrimaryCellAtlasData(cell.ont = 'nonna')
dice.ont <- celldex::DatabaseImmuneCellExpressionData(cell.ont = 'nonna')

# 筛选相同项目基因
shared <- GenomicRanges::intersect(rownames(hpca.ont), rownames(dice.ont))

# 不同于策略1，这里是分别保存而不是cbind
hpca.ont <- hpca.ont[shared,]
dice.ont <- dice.ont[shared,]

# 注释
pred <- SingleR(test = GetAssayData(dt, slot = 'counts'),
        ref = list(HPCA = hpca.ont, DICE = dice.ont),
        labels = list(hpca.ont$label.ont, dice.ont$label.ont))

dt$singleR.labels <- pred$labels[match(rownames(dt@meta.data), rownames(pred))]

运行这部分我会报错
- 应该是dice.ont <- celldex::DatabaseImmuneCellExpressionData(cell.ont = 'nonna')有connection问题
- 不过也懒得管了哈

...
cacheError: failed to load resource  
name: EH3488  
title: DICE RNA-seq
...

使用ATC注释

ATC是一个在线细胞簇注释工具
将FindAllMarkers()的结果输出出来，复制到ATC的Ordered up-regulated genes中

res_allmkr <- list()
for (i in unique(res_allmkr$cluster)){
    res_allmkr[[i]] <- paste(i,':',{res_allmkr %>% filter(cluster == i)}$gene %>% paste(collapse=","), sep = "")
}
res_allmkr %>%  paste(collapse = '\n') %>% cat()

下载注释结果，重命名为clust.txt（随便啥名）然后读取，合并

clust <- read_delim("Clusters/clust.txt") %>% 
 mutate(across(3, ~ifelse(is.na(.), 'Unknown', .)))
dt@meta.data <- left_join(dt@meta.data, clust_roc[,2:3], by = c('seurat_clusters' = 'Cluster'))

弄到meta数据里然后把Ident改成'Cell.Type'

Ident(dt) <- 'Cell.Type'

查看注释结果

得分热图

plotScoreHeatmap(pred)
plotDeltaDistribution(pred)

总结分类结果的列联表

table(Assigned=pred$labels, Clusters=dt$seurat_clusters)

查看细胞注释得分

grouping <- paste0(pred$labels,'.', pred$reference)
best_ref <- as.data.frame(split(pred, grouping))

查看参考数据集中marker种类

metadata(pred$orig.results$HPCA)$de.genes
metadata(pred$orig.results$DICE)$de.genes

colData(hpca.ont)
colData(dice.ont)

hpca.fle <- system.file("mapping","hpca.tsv", package = "celldex")
hpca.mapping <- read.delim(hpca.fle, header = F)

数据来源

样本取自成年人类肺外气道组织
- GSM8162955_MOCK：未播种COVID-9病毒的细胞样本
- GSM8162956_1dpi：播种COVID-9病毒的细胞样本后感染1天的细胞样本
- GSM8162957_3dpi：播种COVID-9病毒的细胞样本后感染3天的细胞样本
- GSM8162958_6dpi：播种COVID-9病毒的细胞样本后感染6天的细胞样本

Functions

Check Packages

checkPack <- function(){

    options(timeout=300)

    if(!require(devtools)){
        install.packages('devtools')
    }else{
        library(devtools)
    }

    if(!require(patchwork)){
        install.packages('patchwork')
    }else{
        library(patchwork)
    }
    
    if(!require(Seurat)){
        install.packages('Seurat')
    }else{
        library(Seurat)
    }

    if(!require(SeuratWrappers)){
        remotes::install_github('satijalab/seurat-wrappers')
    }else{
        library(SeuratWrappers)
    }

    if(!require(tidyverse)){
        install.packages('tidyverse')
    }else{
        library(tidyverse)
    }

    if(!require(patchwork)){
        install.packages('patchwork')
    }else{
        library(patchwork)
    }

    if(!require(DoubletFinder)){
        remotes::install_github('chris-mcginnis-ucsf/DoubletFinder', force = TRUE)
    }else{
        library(DoubletFinder)
    }

    if(!require(harmony)){
        install.packages('harmony')
    }else{
        library(harmony)
    }

    if (!require('BiocManager', quietly = TRUE)){
        install.packages('BiocManager')
    }
        
    if(!require(SingleR)){
        BiocManager::install('SingleR')
    }else{
        library(SingleR)
    }
    
    if(!require(multtest)){
        BiocManager::install('multtest')
    }else{
        library(multtest)
    }

    if(!require(clustree)){
        install.packages('clustree')
    }else{
        library(clustree)
    }

    if(!require(metap)){
        install.packages('metap')
    }else{
        library(metap)
    }

    if(!require(SingleR)){
        BiocManager::install('SingleR')
    }else{
        library(SingleR)
    }

    if(!require(celldex)){
        BiocManager::install('celldex')
    }else{
        library(celldex)
    }

    if(!require(pheatmap)){
        install.packages('pheatmap')
    }else{
        library(pheatmap)
    }

    if(!require(DESeq2)){
        BiocManager::install('DESeq2')
    }else{
        library(DESeq2)
    }

if(!require(monocle3)){
        BiocManager::install(c('BiocGenerics', 'DelayedArray', 'DelayedMatrixStats',
                       'limma', 'lme4', 'S4Vectors', 'SingleCellExperiment',
                       'SummarizedExperiment', 'batchelor', 'HDF5Array',
                       'terra', 'ggrastr'))
        devtools::install_github('cole-trapnell-lab/monocle3')
    }else{
        library(monocle3)
    }

    if(!require(hdWGCNA)){
        BiocManager::install(c('WGCNA', 'UCell', 'GenomicRanges', 'GeneOverlap'))
        devtools::install_github('smorabit/hdWGCNA', ref='dev')
    }else{
        library(hdWGCNA)
        library(WGCNA)
    }

}

10X data to SeuratObject

rdMtx <- function(
    sample, 
    path = 'Data',
    project = NULL,
    min.features = 200, 
    min.cells = 3
){

    args <- list(
        mtx = paste(path,'/',sample,'_matrix.mtx.gz',sep=''),
        features = paste(path,'/',sample,'_features.tsv.gz',sep=''),
        cells = paste(path,'/',sample,'_barcodes.tsv.gz',sep='')
    )

    matrix <- do.call(ReadMtx, args)

    matrix <- CreateAssay5Object(
        counts = matrix
    )

    args2 <- list(
        matrix,
        min.features = min.features, 
        min.cells = min.cells
    )

    if (!is.null(project)) args2$project <- project
    
    matrix <- do.call(CreateSeuratObject, args2)

    return(matrix)
}

Get Samples and Names

getSampleList <- function(path = 'Data'){
    sampleList <- lapply(
    list.files(
        path = paste(path, '/', sep=''), 
        pattern = '_features.tsv.gz'
    ),
    function(x) {
        regmatches(x, regexpr('^[^_]+_[^_]+', x))
    }
) %>%
    unlist()
}

getNameList <- function(path = 'Data'){
    nameList <- lapply(
    list.files(
        paste(path, '/', sep=''), 
        pattern = '_features.tsv.gz'
    ),
    function(x) {
        regmatches(x, regexpr('(?<=_)[^_]+(?=_)', x, perl = TRUE))
    }
) %>% 
    unlist()
}

Combine local 10X data into one SeuratObject

get10xData <- function(
    path = 'Data',
    min.features = 200, 
    min.cells = 3,
    merge = TRUE,
    JoinLayers = FALSE
){
    sampleList <- getSampleList()
    nameList <- getNameList()

    Sample_list <- list()
    for (i in sampleList){
        Sample_list <- append(
            Sample_list,
            rdMtx(
                i, 
                project = nameList[which(i == sampleList)], 
                min.features = min.features,
                min.cells = min.cells
            )
        )
    }

    if (merge == TRUE) Sample_list <- merge(Sample_list[[1]], y = Sample_list[-1], add.cell.ids = sampleList)

    if (JoinLayers == TRUE) Sample_list <- JoinLayers(Sample_list)

    return(Sample_list)
}

Quality Control

QuaCtr <- function(
    data,
    filter = TRUE,
    min.nFeature = NULL,
    max.nFeature = NULL,
    min.nCount = NULL,
    max.nCount = NULL,
    pct.mt = NULL,
    pct.hb = NULL,
    pct.rb = NULL
){
    # mitochondrial genes
    data[['percent.mt']] <- PercentageFeatureSet(data, pattern = '^MT-')
    # ribosomal genes
    data[['percent.rb']] <- PercentageFeatureSet(data, pattern = '^RP[SL]')
    # hemoglobin genes
    data[['percent.hb']] <- PercentageFeatureSet(
        data, 
        features = CaseMatch(
            c('HBA1','HBA2','HBB','HBD','HBE1','HBG1','HBG2','HBM','HBQ1','HBZ'), 
            rownames(data)
        )
    )

    if (filter == TRUE){
        if(!is.null(min.nFeature)) data <- subset(data, subset = nFeature_RNA > min.nFeature)
        if(!is.null(max.nFeature)) data <- subset(data, subset = nFeature_RNA < max.nFeature)
        if(!is.null(min.nCount)) data <- subset(data, subset = nCount_RNA > min.nCount)
        if(!is.null(max.nCount)) data <- subset(data, subset = nCount_RNA < max.nCount)
        if(!is.null(pct.mt)) data <- subset(data, subset = percent.mt < pct.mt) 
        if(!is.null(pct.hb)) data <- subset(data, subset = percent.hb < pct.hb) 
        if(!is.null(pct.rb)) data <- subset(data, subset = percent.rb < pct.rb)
    }

    return(data)
}

ccDetect <- function(data){

    data <- CellCycleScoring(
        data,
        g2m.features = CaseMatch(
            search = cc.genes$g2m.genes, 
            match = rownames(data)
        ),
        s.features = CaseMatch(
            search = cc.genes$s.genes,
            match = rownames(data)
        )
    )

    data$CC.Difference <- data$S.Score - data$G2M.Score

    return(data)
}

QuaCtrPlot <- function(
    data = data,
    group.by = 'orig.ident',
    plot.featrures = c('nFeature_RNA', 'nCount_RNA', 'percent.mt', 'percent.hb', 'percent.rb')
    ){

    plots <- list()

    for(i in 1:length(plot.featrures)){
        plots[[i]] = VlnPlot(
            data, 
            group.by= group.by, 
            pt.size = 0,
            features = plot.featrures[i]
        ) + 
        theme(axis.title.x = element_blank()) + 
        NoLegend()
    }

    violin <- wrap_plots(plots = plots, ncol = 2)
    
    print(violin)
    
    {FeatureScatter(data, 'nCount_RNA', 'nFeature_RNA', group.by = group.by) + geom_smooth( method='lm', color = 'pink')} /
        {FeatureScatter(data, 'nCount_RNA', 'percent.mt', group.by = group.by) + geom_smooth( method='lm', color = 'pink')}  / 
        {FeatureScatter(data, 'nCount_RNA', 'percent.hb', group.by = group.by) + geom_smooth( method='lm', color = 'pink')}  /
        {FeatureScatter(data, 'nCount_RNA', 'percent.rb', group.by = group.by) + geom_smooth( method='lm', color = 'pink')}  /
        {FeatureScatter(data, 'nCount_RNA', 'CC.Difference', group.by = group.by) + geom_smooth( method='lm', color = 'pink')}  

}

Normalization, Find Variable Features, Scale data and PCA

prepc <- function(
  data,
  normalization.method = 'LogNormalize',
  scale.factor = 10000,
  selection.method = 'vst',
  nfeatures = 2000,
  vars.to.regress = c('nCount_RNA', 'nFeature_RNA', 'percent.mt', 'percent.rb', 'percent.hb', 'CC.Difference'),
  scale.features = NULL,
  pca.plts = TRUE,
  VFplt = TRUE,
  VDLplt = TRUE,
  DPplt = TRUE,
  DHplt = TRUE,
  EPplot = TRUE,
  VFplt.n = 10,
  VizDimLoadings.dims = 1:2,
  ElbowPlot.ndims = 50,
  DimHeatmap.dims = 1:15,
  DimHeatmap.cells = 500
){

  data <- data %>%
    NormalizeData(
        normalization.method = normalization.method,
        scale.factor = scale.factor,
    ) %>%
    FindVariableFeatures(
        selection.method = selection.method,
        nfeatures = nfeatures
    ) %>% 
    ScaleData(
        vars.to.regress = vars.to.regress,
        features = scale.features
    ) %>%
    RunPCA()
  
  if (pca.plts == TRUE) {
    if(VFplt ==TRUE) print(VariableFeaturePlot(data) %>% LabelPoints(points = head(VariableFeatures(data), VFplt.n), repel = TRUE))
    if(VDLplt ==TRUE) print(VizDimLoadings(data, dims = 1:2, reduction = "pca"))
    if(DPplt ==TRUE) print(DimPlot(data, reduction = "pca"))
    if(DHplt ==TRUE) print(DimHeatmap(data, dims = DimHeatmap.dims, cells = DimHeatmap.cells, balanced = TRUE,ncol = 3))
    if(EPplot ==TRUE) print((ElbowPlot(data, ndims = ElbowPlot.ndims)))
  }

  return(data)
}

Clustering and Find Clusters

clustR <- function(
    data,
    reduction = 'pca',
    resolution = seq(0.1, 1, by = 0.1),
    reso.select.plt = TRUE,
    NLdim.final.plt = TRUE,
    clustreePlot = TRUE,
    multiDim = TRUE,
    Nldim.dims = 1:20,
    pca.plt = FALSE,
    tsne.plt = FALSE,
    umap.plt = TRUE,
    group.by = NULL,
    split.by = NULL,
    plt.dims = c(1:2),
    plt.label.size = 4,
    plt.repel = TRUE,
    plt.label = TRUE
    ){
    

    data <- data %>% 
        FindNeighbors(dims = Nldim.dims, reduction = reduction) %>%
        FindClusters(resolution = resolution) %>%
        RunTSNE(dims = Nldim.dims, reduction = reduction) %>%
        RunUMAP(dims = Nldim.dims, reduction = reduction) 

    if (reso.select.plt == TRUE){
        if(clustreePlot==TRUE) print(clustree(data, prefix = 'RNA_snn_res.') + coord_flip())
        if(multiDim==TRUE){
            snnresPlot <- list()
            for (i in resolution %>% as.character()){
                snnresPlot[[i]] <- DimPlot(data, group.by = paste('RNA_snn_res.',i,sep=''), label = T)
            }
            if (length(resolution) == 1) {
                print(snnresPlot[[1]])
            }else{
                print(wrap_plots(plots = snnresPlot, ncol = 2))
            }
        }
    }

    if (NLdim.final.plt == TRUE){
        args <- list(
            object = data,
            dims = plt.dims,
            label.size = plt.label.size,
            repel = plt.repel,
            label = plt.label
        )

        if(!is.null(group.by)) args$group.by <- group.by
        if(!is.null(split.by)) args$split.by <- split.by
        
        if(pca.plt){
            args$reduction <- 'pca'
            do.call(DimPlot, args) %>% print()
        } 

        if(tsne.plt){
            args$reduction <- 'tsne'
            do.call(DimPlot, args) %>% print()
        } 

        if(umap.plt){
            args$reduction <- 'umap'
            do.call(DimPlot, args) %>% print()
        } 
    }
    
    return(data)

}

clustPlot <- function(
    data,
    pca = FALSE,
    tsne = FALSE,
    umap = TRUE,
    group.by = NULL,
    split.by = NULL,
    dims = c(1:2),
    label.size = 4,
    repel = TRUE,
    label = TRUE
){
    args <- list(
        object = data,
        dims = dims,
        label.size = label.size,
        repel = repel,
        label = label       
    )

    if(!is.null(group.by)) args$group.by <- group.by
    if(!is.null(split.by)) args$split.by <- split.by
    
    if(pca){
        args$reduction <- 'pca'
        do.call(DimPlot, args) %>% print()
    } 

    if(tsne){
        args$reduction <- 'tsne'
        do.call(DimPlot, args) %>% print()
    } 

    if(umap){
        args$reduction <- 'umap'
        do.call(DimPlot, args) %>% print()
    } 

}

Non-linear dimensional reduction

NLdimReduce <- function(
    data,
    Nldim.dims = 1:20,
    reduction = 'pca',
    pca.plt = FALSE,
    tsne.plt = TRUE,
    umap.plt = TRUE,
    group.by = NULL,
    split.by = NULL,
    plt.dims = c(1:2),
    plt.label.size = 4,
    plt.repel = TRUE,
    plt.label = TRUE
    ){
    

    data <- data %>% 
        RunTSNE(dims = Nldim.dims, reduction = reduction, reduction.name = paste('tsne.',reduction, sep = '')) %>%
        RunUMAP(dims = Nldim.dims, reduction = reduction, reduction.name = paste('umap.',reduction, sep = '')) 

    args <- list(
        object = data,
        dims = Nldim.dims,
        label.size = plt.label.size,
        repel = plt.repel,
        label = plt.label
    )

    if(!is.null(group.by)) args$group.by <- group.by
    if(!is.null(split.by)) args$split.by <- split.by
    
    if(pca){
        args$reduction <- 'pca'
        do.call(DimPlot, args) %>% print()
    } 

    if(tsne){
        args$reduction <- 'tsne'
        do.call(DimPlot, args) %>% print()
    } 

    if(umap){
        args$reduction <- 'umap'
        do.call(DimPlot, args) %>% print()
    } 


    return(data)

}

Find doublets

findDbl <- function(
    data,
    PCs = 1:20,
    sct = FALSE,
    num.cores = 1,
    GT = FALSE,
    pN = 0.25,
    dblpct = 0.008
){
    if (GT == TRUE){
        sweep.res <- paramSweep(data, PCs = PCs, sct = sct)
        gt.calls <- data@meta.data[rownames(sweep.res[[1]]), 'GT']
        sweep.stats <- summarizeSweep(sweep.res, GT = gt.calls)
        sweep.bcmvn <- find.pK(sweep.stats)
    }
    
    if (GT == FALSE){
        sweep.res <- paramSweep(data, PCs = PCs, sct = sct)
        sweep.stats <- summarizeSweep(sweep.res, GT = FALSE)
        sweep.bcmvn <- find.pK(sweep.stats)
    }

    pK <- sweep.bcmvn %>% 
    filter(BCmetric == max(BCmetric)) %>% 
    select(pK)
    pK <- as.numeric(as.character(pK[[1]]))

    homotypic.prop <- modelHomotypic(data@meta.data$seurat_clusters)
    nExp_poi <- round(dblpct * nrow(data@meta.data))
    nExp_poi.adj <- round(nExp_poi*(1-homotypic.prop))

    data <- doubletFinder(
        data, 
        PCs = PCs, 
        pN = pN, 
        pK = pK, 
        nExp = nExp_poi,
        reuse.pANN = NULL, 
        sct = sct
    )

    data <- doubletFinder(
        data, 
        PCs = PCs, 
        pN = pN, 
        pK = pK, 
        nExp = nExp_poi.adj,
        reuse.pANN = {data@meta.data %>% colnames()}[length(data@meta.data)-2], 
        sct = sct
    )

    return(data)
}

Harmony

hmny <- function(
    data
){
    data <- data %>% 
        IntegrateLayers(
            method = HarmonyIntegration,
            orig.reduction = 'pca', 
            new.reduction = 'harmony',
            verbose = FALSE
        ) 
    return(data)
}

Find All Markers

ClusterNSelect <- function(
    data,
    Nldim.dims = 1:20,
    resolution = 0.1,
    reso.select.plt = FALSE,
    min.pct = 0.1,
    only.pos = TRUE,
    test.use = 'roc',
    slot = 'data',
    avg_log2FC.threshold = 1
){
    data <- data %>% clustR(Nldim.dims = Nldim.dims, resolution = resolution, reso.select.plt = FALSE, NLdim.final.plt = FALSE)
    allMkr_roc <- FindAllMarkers(
        data,
        min.pct = min.pct,
        only.pos = only.pos,
        test.use = test.use,
        slot = slot
    ) 

    allMkr_roc %>% write_csv(paste0('Table/allMkr_roc_res', resolution, '.csv'))

    allMkr_roc.list <- list()
    for (i in unique(allMkr_roc$cluster)){
        allMkr_roc.list[[i]] <- paste(i,':',{allMkr_roc %>% filter(cluster == i, avg_log2FC > avg_log2FC.threshold)}$gene %>% paste(collapse=','), sep = '')
    }

    allMkr_roc.list %>%  paste(collapse = '\n') %>% writeLines(paste0('Table/allMkr_roc.list_res', resolution,'.txt'))

    cellClusters <- cellTable %>%
        left_join(allMkr_roc %>% filter(avg_log2FC > avg_log2FC.threshold), by =c('marker' = 'gene')) %>%
        filter(!is.na(myAUC)) %>%
        group_by(tissue_class, tissue_type, cell_name, cluster) %>%
        summarize(Markers = paste0(marker, collapse=','), marker_n = n())

    write_csv(cellClusters, paste0('Table/cellClusters_res', resolution, '.csv'))
}

Library Packages

checkPack()

Load data

dt.prep <- get10xData(path = 'Data', merge = TRUE, JoinLayers = FALSE)
sampleList <- getSampleList()
nameList <- getNameList()
dt.prep$orig.ident <- factor(dt.prep$orig.ident, levels = c('MOCK', '1dpi', '3dpi', '6dpi'))

Quality Control

dt.prep <- dt.prep %>% QuaCtr(filter = F)

Normalization, Find Feature Variables, Scaling and PCA

dt.prep <- dt.prep %>% prepc(vars.to.regress = NULL, pca.plts = FALSE) %>% ccDetect() %>% prepc(vars.to.regress = NULL)
QuaCtrPlot(dt.prep)

Dim reduction

dt.prep %>% clustR(
 Nldim.dims = 1:20, 
 resolution = seq(0.1, 1, by = 0.1), 
 NLdim.final.plt = FALSE
)
dt.prep <- dt.prep %>% 
 clustR(
  Nldim.dims = 1:20, 
  resolution = 0.7, 
  reso.select.plt = FALSE
 )

Find Doublets

dt.dbl <- SplitObject(dt.prep, split.by = 'orig.ident')
for (i in 1:length(dt)) {
    dt.dbl[[i]] <- findDbl(dt.dbl[[i]], PCs = 1:20)
    dt.dbl[[i]] <- subset(dt.dbl[[i]], !!sym(colnames(dt.dbl[[i]]@meta.data)[ncol(dt.dbl[[i]]@meta.data)]) == 'Singlet')
}

Merge

dt <- merge(dt.dbl[[1]], y = dt.dbl[-1], add.cell.ids = sampleList)

Normalization, Find Feature Variables, Scaling and PCA

dt <- dt %>% 
 prepc(vars.to.regress = NULL) %>% 
 ccDetect() %>% 
 prepc(vars.to.regress = NULL)

Dim reduction

dt %>% 
 clustR(
  Nldim.dims = 1:15, 
  resolution = seq(0.1, 1, by = 0.1), 
  NLdim.final.plt = FALSE
 )

dt <- dt %>% 
 clustR(
  Nldim.dims = 1:15, 
  resolution = 0.6, 
  reso.select.plt = FALSE
 )

Harmony

dt.hmy <- dt %>% hmny()

Join Layers

dt.hmy <- dt %>% JoinLayers()

Dim reduction

dt.hmy %>% clustR(reduction = 'harmony', Nldim.dims = 1:15, resolution = seq(0.1, 1, by = 0.1), NLdim.final.plt = FALSE)
dt.hmy <- dt.hmy %>% clustR(reduction = 'harmony', Nldim.dims = 1:15, resolution = 0.7, reso.select.plt = FALSE)

Find Markers and cluster Identification

allMkr_roc <- FindAllMarkers(
    dt.hmy,
    min.pct = 0.1,
    only.pos = TRUE,
    test.use = 'roc',
    slot = 'data'
)

consMkr_roc <- lapply(X = dt$seurat_clusters %>% unique(), function(x){
    FindConservedMarkers(
        dt.hmy,
        ident.1 = x,
        test.use = 'roc',
        grouping.var = 'orig.ident'
    )
})

allMkr_roc.list <- list()
for (i in unique(allMkr_roc$cluster)){
    allMkr_roc.list[[i]] <- paste(i,':',{allMkr_roc %>% filter(cluster == i)}$gene %>% paste(collapse=','), sep = '')
}

allMkr_roc.list %>%  paste(collapse = '\n') %>% cat()

consMkr_roc.list <- list()
for (i in dt.hmy$seurat_clusters %>% unique() %>% sort() %>% as.numeric()){
    consMkr_roc.list[[i]] <- paste(i,':',consMkr_roc[[i]] %>% rownames() %>% paste(collapse=','), sep = '')
    print(consMkr_roc.list[[i]])
}

{DimPlot(
    dt.hmy,
    group.by = 'seurat_clusters',
    label.size = 10,
    repel = TRUE,
    label = TRUE,
    
) + labs(color = 'Clusters',title = 'Clusters')} & 
{DimPlot(
    dt.hmy,
    group.by = 'orig.ident',
    label.size = 8,
    repel = TRUE,
    label = TRUE
) + labs(color = 'Samples',title = 'Samples')}

Cell Markers

cellTable <- read_csv('Clusters/Table.csv')

for (i in 1:length(consMkr_roc)){
 left_join(cellTable, consMkr_roc[[i]] %>% 
  rownames_to_column(var = 'gene') %>% 
  filter(
   MOCK_avg_log2FC >0, 
   `1dpi_avg_log2FC` >0, 
   `6dpi_avg_log2FC` >0, 
   `6dpi_avg_log2FC` >0), 
   by =c('Cell marker' = 'gene')
  ) %>% 
  filter(!is.na(MOCK_myAUC)) %>% 
  group_by(`Cell name`) %>%
  summarize(
   Markers = paste0(`Cell marker`, collapse=','),
   n = n()
  ) %>%
  ungroup() %>%
  arrange(desc(n)) %>%
  mutate(cluster = i) %>%
  print()
}

Cell.Type <- tibble(
    clust = dt.hmy$seurat_clusters %>% unique() %>% sort() ,
    Cell.Type = c(
        'Epithelial cell', #1
        'Early secretory cell', #2
        'Epithelial cell', #3
        'Basal cell', #4
        'Early secretory cell', #5
        'Basal cell', #6
        'Early secretory cell', #7
        'Basal cell', #8
        'Basal cell', #9
        'Epithelial cell', #10
        'Basal cell', #11
        'Epithelial cell' #12
    )
)

dt$Cell.Type <- left_join(
 dt[['seurat_clusters']], 
 Cell.Type, 
 by = c('seurat_clusters' = 'clust')
)$Cell.Type

DimPlot(dt.hmy, reduction = 'umap', group.by = 'Cell.Type')

Pseudo-bulk RNA-seq Analysis

dt.hmy$my.group <- ifelse(dt.hmy$orig.ident %in% c('MOCK','1dpi'), 'CondiA', 'CondiB')

dt.hmy$ind <- 1:nrow(dt.hmy@meta.data)

dt.hmy$samp <- paste0(dt.hmy$my.group,'-',dt.hmy$ind)

dt.agg <- AggregateExpression(
    dt.hmy,
    group.by = c('Cell.Type', 'samp'),
    assays = 'RNA',
    slot = 'counts'
)
dt.pse <- t(dt.agg$RNA) %>% as.data.frame()

rn.cellType <- gsub('_.*','',rownames(dt.pse))

dt.split <- split.data.frame(
    dt.pse,
    f = gsub('_.*','',rownames(dt.pse)) %>% factor()
)

dt.split <- lapply(dt.split, function(x){
  rownames(x) <- gsub('.*_(.*)', '\\1', rownames(x))
  t(x)
})

counts_bc <- dt.split$`Basal cell` + 1
meta_bc <- data.frame(samples = colnames(counts_bc)) %>%
    mutate(condition = ifelse(
        grepl('CondiA', samples), 'A','B')
    ) %>%
    column_to_rownames('samples')
dds <- DESeqDataSetFromMatrix(countData = counts_bc,
                       colData = meta_bc,
                       design = ~ condition)

dds[rowSums(counts(dds)) >= 10,]

Run DESeq2

dds <- DESeq(dds)

Generate results object

res <- results(dds)
res

Trajectory Analysis

cds <- as.cell_data_set(dt.hmy)
cds <- cluster_cells(cds)

plot_cells(cds,
           color_cells_by = 'Cell.Type',
           label_groups_by_cluster = FALSE,
           group_label_size = 10) +
  theme(legend.position = 'right') |
plot_cells(cds,
           color_cells_by = 'partition',
           label_groups_by_cluster = FALSE,
           group_label_size = 10) +
  theme(legend.position = 'right')

cds <- learn_graph(cds, use_partition = FALSE)
plot_cells(cds,
           color_cells_by = 'Cell.Type',
           label_groups_by_cluster = FALSE,
           group_label_size = 10) +
  theme(legend.position = 'right')
cds <- order_cells(
 cds, reduction_method = 'UMAP', 
 root_cells = cds[,pData(cds)$Cell.Type == 'Basal cell'] %>% colnames()
)

Idents(dt) <- dt$Cell.Type
dt$pseudotime <- pseudotime(cds)

plot_cells(cds,
           color_cells_by = 'pseudotime',
           label_groups_by_cluster = FALSE,
           group_label_size = 10) +
  theme(legend.position = 'right') | 
plot_cells(cds,
           color_cells_by = 'Cell.Type',
           label_groups_by_cluster = FALSE,
           group_label_size = 10) +
  theme(legend.position = 'right')
as.data.frame(colData(cds)) %>%
    mutate(pseudotime = pseudotime(cds)) %>%
    ggplot(aes(pseudotime, reorder(Cell.Type, pseudotime, median), fill = Cell.Type)) +
  geom_boxplot() + 
  labs(x = 'Pseudotime', y = 'Cell Type') +
  theme(legend.position = 'none') +
  theme_bw()

cds_gt <- graph_test(cds, neighbor_graph = 'principal_graph', cores = 4)

cds_gt %>% 
    filter(status == 'OK') %>%
    arrange(q_value) %>%
    head(10)

FeaturePlot(
    dt.hmy, 
    features = cds_gt %>% 
        filter(status == 'OK') %>%
        arrange(q_value) %>%
        head(10) %>%
        rownames(),
    label = T   
) /
FeaturePlot(
    dt.hmy, 
    features = 'pseudotime',
    label = T   
)

元分析（Meta-analysis）

Tue, 13 May 2025 00:00:00 GMT

Cover Pic by @笠木梨Ceey

<center><h1>-占坑，不咕-</h1></center> 天坑系列

孟德尔随机化

Mon, 12 May 2025 00:00:00 GMT

Cover Pic by @笠木梨Ceey

参考

Mendelian randomization with GWAS summary data
Mendelian Randomization Tutorial
【bilibili】2022.05孟德尔随机化操作
 【bilibili】孟德尔随机化傻瓜教程之概念介绍
 【bilibili】孟德尔随机化 - 从入门到实践 | 自学 | 小白 | 代码 | 原理
 知乎专栏-孟德尔随机化研究
 孟德尔随机化系列之一：基础概念 Mendelian randomization I
孟德尔随机化系列之二：两样本MR – TwoSampleMR

------ 理论部分 ------

孟德尔随机化的原理基础

简介

排除内生性因素的干扰，确定暴露（等位基因有无）与结局是否存在因果关系

【bilibili】孟德尔随机化傻瓜教程之概念介绍

暴露因素
影响结局的任何因素或特征,可以是内部因素的的也可以是外部因素的,内部因素比如外貌、体型等生物学特征,外部因素比如饮酒、吸烟等生生活方式或一些环境因素等
结局变量
结局是与研究的问题相关的一个定量或定性的拍旨标,如肾小球滤过率水平、糖尿病等
混杂因素
同时影响着暴露与结局的其他因素。
反向因果
当暴露与结果之间的关联不是由于暴露导致结果果变化,而是由于结果导致暴露变化时,则发生反向因果关系。

GWAS

工具变量

调节 工具变量（instrumental variables, IV） 的影响
- 定义
  - 与X相关
  - 与被忽略的混淆因素无关
  - 与Y无关
- 变异基因Z
  - 与暴露因素X相关
  - 与Y没有直接因果关系
  - 变异基因Z与结果Y相关，只能通过X对Y的因果关系被观察到

工具变量的假设

假设

相关性假设：工具变量与暴露密切相关
独立性假设：工具变量与任何影响暴露-结局关联的混杂因素均不相关
排他性假设：除非借助与暴露的关联，否则工具变量不会影响结局
MR：工具变量（基因位点）之间是相互独立的

违反假设的机制

生物学机制
- 多效性（pleiotropy）
- 渠化（canalization）
非孟德尔式遗传
- 连锁不平衡（linkage disequilibrium, LD）
  - 指分属两个或两个以上基因座位的等位基因同时出现在一条染色体上的几率，
    高于随机出现的频率
  - 只要两个基因不是完全独立地遗传，就会表现出某种程度的连锁
- 效应修正（effect modification）
群体效应（population effects）
- 人群分层（population stratification）
- 确定性效应（ascertainment effect）

工具变量的挑选

首先确定和暴露有相关性的工具变量
再确定挑选的工具变量与结局是不相关的，相关的工具变量需要剔除（假设3）

二阶最小二乘法（two-stage least squares，2SLS）

第一阶段回归：遗传IV对暴露的回归
- 计算暴露在IV上的拟合值
第二阶段回归：第一阶段暴露的拟合值对结局的回归
- 因果估计的效应量就是是该第二阶段的回归系数，
  用于反映由于暴露量单位变化而导致的结局变化
- 对于单个IV：
  2SLS估计与比率估计（Wald ratio estimation）相同
- 对于多个IV：
  2SLS估计量可以看作是单个工具变量计算出的比率估计值的加权平均值，
  其中权重由第一阶段回归中工具变量的相对强度确定
假设
- $k$个工具变量，下标 $i = 1,2,...$
- 总人数$N$，下标 $k = 1,2,...$
- 每个个体暴露值 $X_i$ ，结局 $Y_i$
- 假定每个工具变量遵循加性模型，$g_{ik}$ 为第 $i$ 个个体在第 $k$ 个工具变量上的基因型
第一阶段回归
- 构建工具变量对X的线性回归模型

$$ x_{i}= \alpha_{0}+ \sum\limits_k\alpha_kg_{ik} + \epsilon_{X_{i}} $$

因此拟合值 $\hat{x}_i$ 有
- 其实无非就是用工具变量对变量X进行调整而已

$$ \hat{x}{i}= \hat{\alpha}{0}+ \sum\limits_k\hat{\alpha}kg{ik} $$

第二阶段回归

$$ y_{i}= \beta_{0}+ \beta_1\hat{x}_{i}+ \epsilon _{Y_i} $$

在等式中的误差项的方差齐性下

$$ y_{i}= \beta_{0}+ \beta_1x_{i}+ \epsilon^{'}_{Y_i} $$

2SLS估计量的渐近方程

$$ \hat{\sigma}^2(X^TG(G^TG)^{-1}G^TX)^{-1}=\hat{\sigma}^2(\hat{X}^T\hat{x}) ^{-1} $$

孟德尔随机化种类

双样本孟德尔随机化

最基础的孟德尔随机化方法

双向孟德尔随机化

将双样本孟德尔随机化的暴露-结局颠倒，重新做一次

多变量孟德尔随机化

基本概念

多种暴露相关的遗传变异来估计没中暴露和单一结局之间的因果关系
使用条件
- 很难找到SNP只与一种暴露因素相关，但可以找到SNP与一些相互关联的暴露因素相关
- 与暴露相关的SNP中有很多斗鱼某个或者某几个混杂因素相关
工具变量的SNP至少与一种暴露因素相关

【bilibili】一个视频让你学会多变量孟德尔随机化实操！

多效性

一个SNP与多种表型相关
- 垂直多效性：SNP与一种表型相关，继而影响另一种表型
- 水平多效性：SNP与两种或多种表型独立相关
在双样本孟德尔随机化（单变量）分析中，出现SNP具有潜在的水平多效性时，
多变量孟德尔随机化可以对其进行调整，并将该表型作为额外暴露进行分析

中介孟德尔随机化

基本概念

评估一个中介变量在暴露因素和结局之间的中介作用
成立假设
- 每个变量之间没有混杂因素
- 暴露不会造成额外的混杂因素
- 暴露和中介之间没有相互作用

多变量中介孟德尔随机化

计算暴露与结局双样本孟德尔随机化，得到总效应$\beta_{XY}$
计算暴露与中介双样本孟德尔随机化，得到总效应$\beta_{XM}$
计算暴露+中介与结局双样本孟德尔随机化，得到调整后的$\beta_{XY}'$和$\beta_{MY}$
计算

中介效应：$a = \beta_{XM} \beta_{MY}$
中介占比：$b = \frac{a}{\beta_{XY}}$

【bilibili】一节课学会中介孟德尔随机化实操!生信小白快来!!!

分步双样本孟德尔随机化

适用于暴露到结局的直接效应是不知道的情况
多变量中介孟德尔随机化的结果中中介效应不显著可以用这个
多变量中介孟德尔随机化中，暴露和中介没有相同的工具变量时只能用这个

分别进行3次孟德尔随机化

计算暴露与结局双样本孟德尔随机化，得到总效应$\beta_{XY}$
计算暴露与中介双样本孟德尔随机化，得到总效应$\beta_{XM}$
计算中介与结局双样本孟德尔随机化，得到总效应$\beta_{MY}$

计算

中介效应：$a = \beta_{XM} \beta_{MY}$
直接效应：$\beta_{XY}' = \beta_{XY} - \beta_{XM} \beta_{MY}$
中介占比：$b = \frac{a}{\beta_{XY}}$

【bilibili】一节课学会中介孟德尔随机化实操!生信小白快来!!!

系数乘积检验法

检验 $a = \beta_{XM} \beta_{MY}$ 是否具有显著性
- 通过查看 $a$ 的95%置信区间是否跨0确定
计算标准误差：$S_{M}= \sqrt{\beta_{SM}^{2} S_{XM}^{2}+\beta_{MY}^{2} S_{MY}^{2}}$
用$S_M$计算95%置信区间
计算统计量Z：$Z = \frac{a}{S_{M}}$

数据

GWAS数据库

PGC (https://www.med.unc.edu/pgc/)：精神病学的基因组学
SSGAC (https://www.thessgac.org/)：社会科学的基因组学
CTG (https://ctg.cncr.nl/software/summary_statistics)
IEU (https://gwas.mrcieu.ac.uk/)
GWAS Catalog (https://www.ebi.ac.uk/gwas/)

IEU OpenGWAS project API

使用前需要在IEU OpenGWAS project注册API <token>
将获取到的API写在.RENVIRON文件中，位置一般在home(~)下，没有就vim创建
添加OPENGWAS_JWT=<token>
初始的Trial等级：100 per 10 minutes，
填写完个人信息后可以变成Standard等级：100000 per 10 minutes

注意点

大部分GWAS数据来源于欧洲样本
暴露和结局的样本群体至少为同一人种
双样本MR的暴露于结局数据不存在或存在少量可接受范围内的样本重叠（样本独立性）

数据构成

不同的数据的标签是不一样的
- SNP id (rs...)：单核苷酸多态性id
- Effect allele; Alternative allele：效应位点
- Other allele; Reference allele：非效应位点
- Effect，Beta，b，OR（对于二分类变量，$\beta = \text{ln}(OR)$）：
  回归系数，表示效应位点对结局的正负影响
- Se：标准误差
- EAF：效应等位基因频率
- P：关联性的p值

工具变量的获取

GWAS原文
已经发表的MR文章中获取
R program提取

分析流程

获取暴露与结局的GWAS数据
选择工具变量
去除连锁不平衡
数据协同
MR分析
敏感性分析：评价分析结果的稳健性

异质性检验
- 检验暴露和结局的样本是否存在异质性
- 当存在异质性时，应该剔除导致偏移的SNP
- 但是对于IVW的MR主要检验方法而言是可以接受的
多效性检验
- 检验SNP是否对多种遗传性状产生影响

结果可视化

------ 实操部分 ------

数据来源及分析流程

随便找的3个GWAS数据
- 暴露X：1型糖尿病，GCST90475661
- 中介M：CKD，GCST90478532
- 结局Y：FGF23，GCST90469223

导入包

library(MendelianRandomization)
library(TwoSampleMR)
library(readr)
library(tidyverse)

读取数据

TwoSampleMR包只有IEU的API，实际上下载到本地的情况肯定会更多

# DM1: x
x <- read_tsv('Data/DM1/GCST90475661.tsv')
# FGF23: m
m <- read_tsv('Data/FGF23/GCST90469223.tsv')
# CKD: y
y <- read_tsv('Data/CKD/GCST90478532.tsv')

随便看看

head(x,3); head(m, 3); head(y, 3)

预处理

Odds Ratio转换beta

calcuBeta <- function(x){
    x <- x %>%
        mutate(
            beta = log(odds_ratio),
            standard_error = (ci_upper - ci_lower)/(qnorm(0.95)*2)
        ) %>%
    return(x)
}

x <- calcuBeta(x)
y <- calcuBeta(y)

格式整理

编一个函数，后面看的清楚
也可以跳过直接调用format_data()

fmt_data <- function(
        x, 
        type = 'exposure',
        snp_col = 'rsid'
    ){

    args <- list(
        dat = x,
        beta_col = 'beta',
        pval_col = 'p_value',
        se_col = 'standard_error',
        eaf_col = 'effect_allele_frequency',
        effect_allele_col = 'effect_allele',
        other_allele_col = 'other_allele',
        type = type,
        snp_col = snp_col
    )
    
    formatted <- do.call(format_data, args)
    return(formatted)

}

格式整理

x_fmt <- fmt_data(
    x,
 type = 'exposure'
)

m.exp_fmt <- fmt_data(
    m,
    type = 'exposure',
    snp_col = "rs_id"
)

m.oc_fmt <- fmt_data(
    m,
    type = 'outcome',
    snp_col = "rs_id"
)

y_fmt <- fmt_data(
    y,
 type = 'outcome'
)

简单查看结果

head(x_fmt); head(m.exp_fmt); head(m.oc_fmt); head(y_fmt)

ID重命名便于区分

x_fmt$exposure <- 'x'
m.exp_fmt$exposure <- 'm'
m.oc_fmt$outcome <- 'm'
y_fmt$outcome <- 'y'

筛选SNP

如果GWAS只用一次的话，筛选SNP可以放在格式整理之前
如果以后可能作为结局数据使用的话，可以先格式整理好，
因为结局是不可以筛选SNP的

x_filted <- subset(x_fmt, pval.exposure  < 5e-06)
m.exp_filted <- subset(m.exp_fmt, pval.exposure  < 5e-06)

去除连锁不平衡

去除部分

编一个函数，也可以直接调用ieugwasr::ld_clump()
这里是本地去除连锁不平衡的方法

ldClump <- function(
        x,
        clump_kb = 10000,
        clump_r2 = 0.001,
        clump_p = 1,
        pop = 'EUR',
        bfile = 'Data/1kg.v3/EUR', 
        plink_bin = plinkbinr::get_plink_exe()
    ){
    clumped <- ieugwasr::ld_clump(
        dplyr::tibble(
            rsid = x$SNP,
            pval = x$pval.exposure
        ),
        clump_kb = clump_kb,
        clump_r2 = clump_r2,
        clump_p = clump_p,
        pop = pop,
        bfile = bfile, 
        plink_bin = plink_bin
    )
    return(clumped)
}

x_clumped <- ldClump(x_filted)
m.exp_clumped <- ldClump(m.exp_filted)

保留去除后的结果

x_pick <- semi_join(x_filted, x_clumped, by = c("SNP" = "rsid"))
m.exp_pick <- semi_join(m.exp_filted, m.exp_clumped, by = c("SNP" = "rsid"))

双样本孟德尔随机化

X to Y

y4x_pick <- semi_join(y_fmt, x_clumped, by = c("SNP" = "rsid"))

harmo_x2y <- harmonise_data(x_pick, y4x_pick)
res_mr_x2y <- mr(harmo_x2y)

res_mr_x2y

X to M

m4x_pick <- semi_join(m.oc_fmt, x_clumped, by = c("SNP" = "rsid"))

harmo_x2m <- harmonise_data(x_pick, m4x_pick)
res_mr_x2m <- mr(harmo_x2m)

res_mr_x2m

M to Y

y4m_pick <- semi_join(y_fmt, m.exp_clumped, by = c("SNP" = "rsid"))

harmo_m2y <- harmonise_data(m.exp_pick, y4m_pick)
res_mr_m2y <- mr(harmo_m2y)

res_mr_m2y

多变量孟德尔随机化

去除合并X和M的连锁不平衡

合并

xm_pick <- bind_rows(x_pick, m.exp_pick)
xm_pick <- subset(xm_pick, SNP %in% unique(xm_pick$SNP))

去除连锁不平衡

xm_pick_clumped <- ldClump(xm_pick)
xm_pick_clumped

将去除连锁不平衡的筛选结果初步保存

y4xm_pick <- semi_join(y_fmt, xm_pick_clumped, by = c("SNP" = "rsid")) %>% 
    distinct(SNP, .keep_all = T)
x4xm_pick <- semi_join(x_fmt, xm_pick_clumped, by = c("SNP" = "rsid")) %>% 
    distinct(SNP, .keep_all = T) 
m.exp4xm_pick <- semi_join(m.exp_fmt, xm_pick_clumped, by = c("SNP" = "rsid")) %>% 
    distinct(SNP, .keep_all = T)

为了确保选择的SNP一样，取一个交集重新筛选一遍

common_snp <- y4xm_pick %>%
    inner_join(x4xm_pick, by = 'SNP') %>%
    inner_join(m.exp4xm_pick, by = 'SNP') %>%
    select(SNP)

y4xm_pick <- semi_join(y_fmt, common_snp, by = 'SNP') %>% 
    distinct(SNP, .keep_all = T)
x4xm_pick <- semi_join(x_fmt, common_snp, by = 'SNP') %>% 
    distinct(SNP, .keep_all = T) 
m.exp4xm_pick <- semi_join(m.exp4xm_pick, common_snp, by = 'SNP') %>% 
    distinct(SNP, .keep_all = T)

协同数据

harmo_x4xm <- harmonise_data(x4xm_pick, y4xm_pick)
harmo_m.exp4xm <- harmonise_data(m.exp4xm_pick, y4xm_pick)

转换成MendelianRandomization包的输入格式

转换输入的数据

xm2y_input <- mr_mvinput(
    bx = cbind(harmo_x4xm$beta.exposure, harmo_m.exp4xm$beta.exposure),
    bxse = cbind(harmo_x4xm$se.exposure, harmo_m.exp4xm$se.exposure),
    by = y4xm_pick$beta.outcome,
    byse = y4xm_pick$se.outcome
)

确保数据长度一致，不然后续分析会报错

glimpse(xm2y_input)

Multivariable MR-Egger method

res_xm2y_egger <- mr_mvegger(xm2y_input)
res_xm2y_egger

Multivariable inverse-variance weighted method

res_xm2y_ivwme <- mr_mvivwme(xm2y_input)
res_xm2y_ivwme

Multivariable median-based method

res_xm2y_median <- mr_mvmedian(xm2y_input)
res_xm2y_median

Multivariable inverse-variance weighted method with measurement error

res_xm2y_median <- mr_mvmedian(xm2y_input)
res_xm2y_median

Mediation Mendelian Randomization

简单回顾上系数计算及检验的方法
多变量法

计算暴露与结局双样本孟德尔随机化，得到总效应$\beta_{XY}$
计算暴露与中介双样本孟德尔随机化，得到总效应$\beta_{XM}$
计算暴露+中介与结局双样本孟德尔随机化，得到调整后的$\beta_{XY}'$和$\beta_{MY}$
计算

中介效应：$a = \beta_{XM} \beta_{MY}$
中介占比：$b = \frac{a}{\beta_{XY}}$
分步法

分别进行3次孟德尔随机化

计算暴露与结局双样本孟德尔随机化，得到总效应$\beta_{XY}$
计算暴露与中介双样本孟德尔随机化，得到总效应$\beta_{XM}$
计算中介与结局双样本孟德尔随机化，得到总效应$\beta_{MY}$

计算

中介效应：$a = \beta_{XM} \beta_{MY}$
直接效应：$\beta_{XY}' = \beta_{XY} - \beta_{XM} \beta_{MY}$
中介占比：$b = \frac{a}{\beta_{XY}}$
系数检验
- 检验 $a = \beta_{XM} \beta_{MY}$ 是否具有显著性
  - 通过查看 $a$ 的95%置信区间是否跨0确定
- 计算标准误差：$S_{M}= \sqrt{\beta_{SM}^{2} S_{XM}^{2}+\beta_{MY}^{2} S_{MY}^{2}}$
- 用$S_M$计算95%置信区间
- 计算统计量Z：$Z = \frac{a}{S_{M}}$

多变量法

Beta

(betaXY_mvm <- res_mr_x2y[3,7])
(betaXM_mvm <- res_mr_x2m[3,7])
# 唯一的区别就在这里：是否用多变量调整过的中介-结局
(betaMY_mvm <- res_xm2y_ivwme@Estimate[2]) 
(a_mvm <- betaXM_mvm * betaMY_mvm)
(b_mvm <- a_mvm / betaXY_mvm)
(direct_mvm <- 1 - b_mvm)

SE

(seXM_mvm = res_mr_x2m[3,8])
(seMY_mvm = res_xm2y_ivwme@StdError[2])

P value

(S_mvm = sqrt(betaXM_mvm^2*seXM_mvm^2+betaMY_mvm^2*seMY_mvm^2))
(Z_mvm = a_mvm / S_mvm)
(P_mvm = 2 * pnorm(q = abs(Z_mvm), lower.tail = F))

CI

(a_mvm_lower <- a_mvm - S_mvm)
(a_mvm_upper = a_mvm + S_mvm)
(b_mvm_lower = a_mvm_lower/betaXY_mvm) 
(b_mvm_upper = a_mvm_upper/betaXY_mvm)

分步法

Beta

(betaXY_2step <- res_mr_x2y[3,7])
(betaXM_2step <- res_mr_x2m[3,7])
# 唯一的区别就在这里：是否用多变量调整过的中介-结局
(betaMY_2step <- res_mr_m2y[3,7])
(a_2step <- betaXM_2step * betaMY_2step)
(b_2step <- a_2step / betaXY_2step)

SE

(seXM_2step = res_mr_x2m[3,8])
(seMY_2step = res_mr_m2y[3,8])

P value

(S_2step = sqrt(betaXM_2step^2*seXM_2step^2+betaMY_2step^2*seMY_2step^2))
(Z_2step = a_2step / S_2step)
(P_2step = 2 * pnorm(q = abs(Z_2step), lower.tail = F))

CI

(a_2step_lower <- a_2step - S_2step)
(a_2step_upper = a_2step + S_2step)
(b_2step_lower = a_2step_lower/betaXY_2step) 
(b_2step_upper = a_2step_upper/betaXY_2step)

Jupyter中使用R

Fri, 02 May 2025 00:00:00 GMT

Cover Pic by @リョンsan

简介

Rstudio固然不错，但不可能只用R吧
虽然Rstudio也支持Python了，但正经人谁会用Rstudio写Python呢
习惯以后还是随手点开VScode然后新建.ipynb切R内核写代码爽哈，一点都不比RMarkdown差

安装

Jupyter

安装Jupyter参考：Installing Jupyter

JupyterLab（Web版IDE）

# 安装
pip install jupyterlab
# 打开
jupyter lab

Jupyter Notebook（纯Notebook）

# 安装
pip install notebook
# 打开
jupyter notebook

R kernel

安装R内核参考：IRkernel/IRkernel

打开R终端，输入以下代码即可

install.packages('IRkernel')
IRkernel::installspec()  
jupyter labextension install @techrah/text-shortcuts

快捷键

个人设置的快捷键

[
    {
        "key": "ctrl+cmd+[Minus]",
        "command": "editor.action.insertSnippet",
        "when": "editorTextFocus && editorLangId == 'r'|'Rmd'|'ipynb'",
        "args": {
            "snippet": " <- "
        }
    },
    {
        "key": "ctrl+cmd+[Equal]",
        "command": "editor.action.insertSnippet",
        "when": "editorTextFocus && editorLangId == 'r'|'Rmd'|'ipynb'",
        "args": {
            "snippet": " %>% "
        }
    },
    {
        "key": "ctrl+cmd+[IntlYen]",
        "command": "editor.action.insertSnippet",
        "when": "editorTextFocus && editorLangId == 'r'|'Rmd'|'ipynb'",
        "args": {
            "snippet": " |> "
        }
    },
    {
        "key": "ctrl+cmd+5",
        "command": "type",
        "args": {
            "text": " %in% "
        }
]

通路分析

Thu, 01 May 2025 00:00:00 GMT

Cover Pic by @超凶の狄璐卡

用DESeq2进行差异性分析

Mon, 28 Apr 2025 00:00:00 GMT

Cover Pic by @saturn_illus

教程

官方教程

Analyzing RNA-seq data with DESeq2

介绍了一般的分析方法

https://bioconductor.org/packages/devel/bioc/vignettes/DESeq2/inst/doc/DESeq2.html#interactions

RNA-seq workflow: gene-level exploratory analysis and differential expression

介绍了更加丰富的用法，用于第一个教程的补充

# install the package
if (!requireNamespace("BiocManager", quietly = TRUE))
    install.packages("BiocManager")
BiocManager::install("rnaseqGene")

# view the vignettes
browseVignettes("rnaseqGene")

其他参考

108-如何利用DESeq2分析转录组数据？

https://www.jieandze1314.com/post/cnposts/108/

RNA-seq分析（微信公众号文章）

https://mp.weixin.qq.com/mp/appmsgalbum?__biz=MzkwMzQwNjYyNg==&action=getalbum&album_id=2673613335581474816#wechat_redirect

Jwindler/Ice_story（Github仓库）

https://github.com/Jwindler/Ice_story?tab=readme-ov-file

使用DESeq2分析RNA-seq数据

http://xuchunhui.top/2020/03/28/%E4%BD%BF%E7%94%A8DEseq2%E5%88%86%E6%9E%90RNA-seq%E6%95%B0%E6%8D%AE/

并行运算

初始设置

library("BiocParallel") # 载入R包
register(MulticoreParam(4)) # 设置并行内核为4

后续的分析中，如果有parallel参数都可以设置TRUE来使用

DESeq(..., parallel = TRUE)
lfcShrink(..., parallel = TRUE)

数据导入

DESeq2必须输入计数矩阵（counts matrix）
对于计数矩阵，一般用DESeqDataSetFromMatrix()即可
用下列函数能创造一个DEseqDataSet对象（一般略称为dds），需要声明：
colData：包含样本信息的meta data
desgin：实验设计，用formula类型表示~ Condition

dds <- DESeqDataSetFromMatrix(
         countData = countsMatrix,
         colData = metaData,
         design = ~ Condition
         )

function	package	framework	output	DESeq2 input function
tximport	tximport	R/Bioconductor	list of matrices	DESeqDataSetFromTximport
tximeta	tximeta	R/Bioconductor	SummarizedExperiment	DESeqDataSet
htseq-count	HTSeq	Python	files	DESeqDataSetFromHTSeq
featureCounts	Rsubread	R/Bioconductor	matrix	DESeqDataSetFromMatrix
summarizeOverlaps	GenomicAlignments	R/Bioconductor	SummarizedExperiment	DESeqDataSet

查看DEseqDataSet对象内容
- 计数：assay(dds)，counts(dds)
- 基因信息：rowRanges(dds)
- 样本信息，即meta data：colData(dds)
- $查看：meta data中包含的分组
- @查看：
  - design
  - dispersionFunction
  - rowRanges
  - colData
  - assays
  - NAMES
  - elementMetadata
  - metadata

基因预过滤

为了提高运算性能，可以删除表达量约等于0的基因
如果配置不太吃力，一般可以不用预过滤，避免产生偏差

smallestGroupSize <- 3
# 设定满足筛选要求的样本最小数量
keep <-rowSums(dds %>% counts() >= 10) >= smallestGroupSize
# dds %>% counts() >= 10：计算每个样本的每个基因表达量是否大于等于10，结果返回为布尔值
# rowSums(.)：按基因（行）统计结果为TRUE的样本数量
# rowSums(.) >= smallestGroupSize：满足筛选要求的样本最小数量（10）的基因被保留
dds_filtered <- dds[keep, ]
# 基本筛选语法

比较级别

对meta data的列进行因子化
levels的第一个级别为对照组

# 对dds对象进行因子化
dds$condition <- factor(dds$condition, levels = c("untreated","treated"))
# 在创建dds对象前对meta data因子化
metaData$condition <- factor(metaData$condition, levels = c("untreated","treated"))
dds <- DESeqDataSetFromMatrix(countData = countsMatrix,
         colData = metaData,
         design = ~ Condition)

只指定参考级别

dds$condition <- relevel(dds$condition, ref = "untreated")

删除子集中没有样本的级别
例如有三种Condition A，B，C
只选择子集A和B进行分析，数据中不包含C，但因子级别中包含，
用droplevels()去除空白的因子级别

dds$condition <- droplevels(dds$condition)

基因注释

本节参考：【R】遺伝子ID/遺伝子名の変換方法

biomaRt

需要用到R包biomaRt

# 安装
if (!require("BiocManager", quietly = TRUE))
    install.packages("BiocManager")
BiocManager::install("biomaRt")

# 加载

library(biomaRt)

罗列可以选择的Marts

listMarts()

选择要用的Marts

db <- useMart(biomart = "ENSEMBL_MART_ENSEMBL")

以小鼠为例，在ENSEMBL_MART_ENSEMBL的description中查看包含小鼠"Mouse"的行

listDatasets(db) %>% filter(grepl("Mouse",description))

把注释信息提取出来

Mm <- useDataset("mmusculus_gene_ensembl", mart = db)

查看mmusculus_gene_ensembl包含的所有小鼠基因信息

listAttributes(Mm)

创建一个所有基因名字的列表

# 提取需要的注释信息
gene_annotation <- getBM(
# 这里的attributes就是listAttributes(Mm)中选的
    attributes = c("ensembl_gene_id",
                   # "ensembl_transcript_id",
                   "hgnc_symbol", 
                   "external_gene_name",
                   "entrezgene_id", 
                   "description"), 
 mart = Mm
    )
gene_annotation <- gene_annotation %>%
# 创建一个GENE的列：
# 如果有external_gene_name就用external_gene_name
# 如果没有就保留ensembl_gene_id
    mutate(GENE = ifelse(external_gene_name == "",
          ensembl_gene_id, 
          external_gene_name)) %>%
# 一个ensembl_gene_id可能有多个entrezgene_id，我们只选择第一个即可
# 在KEGG通路分析中只能用entrezgene_id，所以事先提取出来更方便
# 事实上，mapIds()抓取genome wide annotation包的时候对于一对多也可以设置multiVals="first"来只提取第一个对应的
 group_by(ensembl_gene_id) %>%
    slice(1) %>%
    ungroup() %>%
    mutate(GENE = ifelse(external_gene_name == "", 
     ensembl_gene_id, external_gene_name)) 
# 由于存在相同基因名称的基因，并且变成rownames的时候是不可以有重复的
# 给重复的基因名后面加个小尾巴 .1 .2 这种
 group_by(GENE) %>%
    mutate(
        count = n(),
        GENE = if_else(count == 1, GENE, paste0(GENE, ".", row_number()))
    ) %>%
    ungroup() %>%
    select(-count)

添加基因名称的时候只用left_join()就行了

resultDataFrame %>% 
 left_join(genes_annotation, by = "gene")

Genome wide annotation包

这个比较简单，很容易上手
这个包是一个系列，都是org.XX.eg.db这种类型的
但是没有预测基因，会出现很多NA的基因名
ensembldb::select（dplyr的select更常用，建议library的时候把dplyr往下方放）

gene_annotation <- ensembldb::select(x = org.Mm.eg.db, # 注释基因包
   # 这里keys(org.Mm.eg.db,"ENSEMBL")提取了包里的全部基因的ENSEMBL
            keys = keys(org.Mm.eg.db,"ENSEMBL"), # 需要注释的基因
            keytype = "ENSEMBL", # 匹配ENSEMBL ID
            # 抽取匹配到基因的"SYMBOL","ALIAS","GENENAME","GENETYPE"
            columns = c("SYMBOL","ALIAS","GENENAME","GENETYPE"))

resultDataFrame %>% 
 left_join(genes_annotation, 
     by = c("ENSEMBL","SYMBOL","ALIAS","GENENAME","GENETYPE"))

ensembldb::mapIds

gene_annotation <- mapIds(x = org.Mm.eg.db,
    keys = keys(org.Mm.eg.db,"ENSEMBL"),
    keytype = "ENSEMBL",
    column = "ENTREZID", # mapIds只能提取一列，注意column不是复数
    multiVals = "first")

resultDataFrame %>% 
 left_join(genes_annotation, 
     by = c("ENSEMBL","SYMBOL","ALIAS","GENENAME","GENETYPE"))

差异性表达分析

DESeq()，可以执行Wald检验和LRT检验，作用对象为dds对象

Wald检验

默认的选项，约等于双样本t检验

# 下面两个一样
dds <- DESeq(dds)
dds <- DESeq(dds, test = "Wald")

# 可以加入并行运算

dds <- DESeq(dds, parallel = TRUE)

似然比检验（LRT检验）

比较多样本的选项，约等于ANOVA
reduced选项表示从原有的实验设计（完整模型）剔除需要比较的项后的模型（简化模型）
results()返回的结果中，log2FoldChange和lfcSE是没有任何实际意义的内容

对于使用似然比检验的分析，p 值仅由完整模型公式和简化模型公式之间的偏差差异决定
单个 log2 倍变化打印在结果表中以与其他结果表输出保持一致，但与实际测试无关

简单的实验设计：`~ Condition`

检验Condition里不同水平是否存在差异

# 因为检验Condition，所以从实验设计的formula中剔除Condition
# 什么都没有的情况下填写~1
dds <- DESeq(dds, test = "LRT", reduced = ~1)

复杂点的实验设计：`~ ConditionA + ConditionB`

检验ConditionB里不同水平是否存在差异

# 同理，检验ConditionB则剔除ConditionB，保留~ ConditionA
dds <- DESeq(dds, test = "LRT", reduced = ~ ConditionA)

交互作用：`~ ConditionA + ConditionB + ConditionA:ConditionB`

检验ConditionB里不同水平是否存在差异

# 无论多么复杂的实验设计，检验什么就剔除什么
# 这里检验ConditionB，所以保留~ ConditionA + ConditionA:ConditionB
dds <- DESeq(dds, test = "LRT",
    reduced = ~ ConditionA + ConditionA:ConditionB)

查看结果

查看比较元素

主要用于results()中用name或contrast指定比较对象
也可以用于lfcShrink()的coef和contrast指定对象

resultsNames(dds)

选择比较的对象

对于简单的比较，name和contrast都可以
name的值不是随便起的，在用resultsNames()确认后使用
以下3个用法是等价的

res <- results(dds, name="condition_treated_vs_untreated")
res <- results(dds, contrast=c("condition","treated","untreated"))
res <- results(dds, contrast=list(c("condition_treated_vs_untreated")))

对于复杂的比较，只能用contrast
- c("condition","treated","untreated")
  是选择某一条件中两者进行对比，顺序为：
  - 条件
  - 比对项目
  - 被比对（参考）项目
- 仅能包含一个向量，向量包含3个元素
- list(c("..1.."), c("..2.."))
  用于更加复杂的对比，list()中包含2个向量，
  如果只声明1个，那么另一个就是截距

整理，筛选，打印结果

可以直接在results对象上操作

# 官方文档的方法
resOrdered <- res[order(res$pvalue),]
summary(res)
sum(res$padj < 0.1, na.rm=TRUE)
res05 <- results(dds, alpha=0.05)
summary(res05)

个人喜欢转换成熟悉的data.frame类型更方便

res_df <- res %>% as.data.frame()

不建议直接使用results()去获取结果，
可以首先通过LFC收缩lfcShrink()调整LFC后再获取结果
- 这个时候不用results()了，直接将LFC收缩完的对象变换成data.frame即可

p值调整

传统调整方法

在results()中可以设置p值调整的方法，默认为"BH"
使用?p.adjust可以获取所有的调整方法：
- "holm"
- "hochberg"
- "hommel"
- "bonferroni"
- "BH"
- "BY"
- "fdr"
- "none"

# BH
results(dds)
results(dds, pAdjustMethod = "BH")
# Bonferroni
results(dds, pAdjustMethod = "bonferroni")
# 其他类似

独立假设加权

一种给每个检验的结果分配权重增加统计效果的方法
增加更多的原假设拒绝以更好筛选那些显出差异明显的基因

# 使用R包IHW
library("IHW")
# 设置filterFun为ihw
resIHW <- results(dds, filterFun=ihw)
#
summary(resIHW)
sum(resIHW$padj < 0.1, na.rm=TRUE)
metadata(resIHW)$ihwResult

LFC收缩

目的是为了解决低计数基因或者高离散度的数据在计算LFC时引起的误差
官方文档对于3种LFC估计器的介绍

方法:	`apeglm`	`ashr`	`normal`
适合LFC排名	✓	✓	✓
保存大LFC的尺寸	✓	✓
可以计算s值	✓	✓
允许使用`coef`	✓	✓	✓
允许使用`lfcThreshold`	✓	✓	✓
允许使用`contrast`		✓	✓
可以收缩交互术语	✓	✓

基本用法

lfcShrink(dds, coef = Comparison, type = LFCShrinkAlgorithm)

对于简单的实验设计，apeglm是最推荐的方法
- coef等同于results()中的name

lfcShrink(dds, coef = "Condition_B_vs_A", type = LFCShrinkAlgorithm)

对于复杂的实验设计，由于需要指定contrast，所以只有ashr才行

lfcShrink(
 dds, 
 contrast = list(c("..1.."),c("..2..")), 
 type = LFCShrinkAlgorithm
 )

打印的结果的s值：检验收缩后的LFC是否与制定的阈值lfcThreshold相等
- lfcThreshold默认为0
- 可以通过设置不同的lfcThreshold来检查s值的变化

lfcShrink(
 dds, 
 coef = Comparison, 
 type = LFCShrinkAlgorithm, 
 lfcThreshold = 1
 )

目前不支持IHW与LFC收缩的混用

数据可视化

数据转换

数据转换不用于差异性表达分析，而是用于各种可视化
- 之后需要用到数据转换的数据用rld表示

对数化

ntd <- normTransform(dds)

vsd，适合>=30的大数据

vsd <- vst(dds, blind = FALSE)

rlog，适合<30样本的小数据

rld <- rlog(dds, blind = FALSE)

检查每个样本的计数

分开检查每个样本的计数分布

dt[,1:ncol(dt)] %>%
    map2(.x=., .y=names(.),
        ~dt_GE %>%
        ggplot(aes(x=.x)) +  
        geom_histogram(stat='bin', bins=20) +
        geom_freqpoly(binwidth = 1000) +
        labs(x='Raw expression count',
            y='Number of genes',
            title=.y) +
        theme_bw()
    )

检查所有样本计数总数

colSum_df <- colSums(dt) %>%
 as.data.frame() %>%
 rownames_to_column()
colnames(colSum_df) <- c('Sample', 'Counts')
colSum_df %>%
  ggplot(aes(x = Sample, y = Counts / 1e6, fill = Sample)) +
         geom_bar(stat = "identity") + theme_bw() +
         labs(x = "Sample", y = "Total count in millions") +
         theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))

样本关联性热图

rld_mat <- assay(rld)
rld_cor <- cor(rld_mat)
pheatmap(
 rld_cor_GE,
 annotation = dplyr::select(meta_dt, c('ConditionA', 'ConditionB'))
 )

PCA plot

rld_PCA <- plotPCA(
 rld,
 intgroup = c("ConditionA", "ConditionB"),
 returnData = TRUE
 )

rld_PCA_pv <- round(100 * attr(rld_PCA, "percentVar"))

rld_PCA %>%
 ggplot(aes(PC1,
      PC2,
      color=ConditionA,
      shape=ConditionB,
      linetype=Time)
     ) +
    geom_point(size = 3) +
    xlab(paste0("PC1: ",rld_GE_PCA_pv[1],"% variance")) +
    ylab(paste0("PC2: ",rld_GE_PCA_pv[2],"% variance")) +
    stat_ellipse() +
    theme_bw()

变换-方差图

{vsn::meanSdPlot(assay(rld), ranks = FALSE)}$gg + theme_bw()

分散估计图

检查模型拟合的情况，对象为DESeq()处理过的dds

plotDispEsts(dds)

MA图

res_lfcShrink是lfcShrink(dds, ...)之后的结果

plotMA(res_lfcShrink, ylim=c(-2,2))

火山图

res_lfcShrink是lfcShrink(dds, ...)之后的结果

res_lfcShrink_volc <- res_lfcShrink %>%
            as.data.frame() %>%
            rownames_to_column(var = "gene") %>%
            left_join(all_genes, by = "gene") %>%
            mutate(diffexpressed = case_when(
              {padj < 0.05} & {log2FoldChange > 1} ~ "UP",
              {padj < 0.05} & {log2FoldChange < -1} ~ "DOWN",
              TRUE ~ "NO"
              ))

res_lfcShrink_volc$diffexpressed <- factor(res_8h_vs_4h_volc$diffexpressed,levels = c("DOWN", "NO", "UP"))

res_lfcShrink_volc %>%
ggplot(aes(log2FoldChange, -log10(padj), color = diffexpressed))+
  geom_hline(yintercept = -log10(0.05), linetype = "dashed", color = "black")+
  geom_vline(xintercept = c(-1,1), linetype = "dashed", color = "black")+
  geom_point(size = 0.8)+
  scale_color_manual(values = c("#989ad6", "#e4e4e4", "#e27e9a"),
                     labels = c("DOWN", "NO", "UP"))  +
  theme_bw(base_size = 12)+
  theme(legend.position = 'right',
        legend.justification = c(0,1))+

# 添加标签

  geom_text_repel(data = filter(res_lfcShrink_volc, padj < 0.05 & abs(log2FoldChange) > 1),
                  max.overlaps = getOption("ggrepel.max.overlaps", default = 20),
                  # 这里的filter很关键，筛选你想要标记的基因
                  aes(label = GENE), # 这里的GENE就是注释部分生成的基因名称
                  size = 3,
                  color = 'black') +
  xlab("Log2FC")+
  ylab("-Log10(FDR q-value)")

基因表达热图

使用R包ComplexHeatmap
这个包的功能很强大，本文仅限于简单出图
具体说明见ComplexHeatmap中文版说明

# 两种安装方式
install.packages("ComplexHeatmap")
devtools::install_github("jokergoo/ComplexHeatmap")

# 加载
library(ComplexHeatmap)

首先提取归一化处理，并将行名换成基因名

counts_dds <- counts(dds, normalized = T) %>%
    as.data.frame() %>%
    rownames_to_column("gene") %>%
    left_join(gene_annotation, by = "gene") %>%
    select(-gene) %>%
    column_to_rownames("name")
counts_dds <- t(scale(t(counts_dds))) # 需要对每行进行归一化，所以得转置2次

绘制热图
- SigGenes为筛选出来的基因名

Heatmap(counts_dds[SigGenes,])

DESeq2中多因子设计

Sat, 19 Apr 2025 00:00:00 GMT

Cover Pic by @Rvoid_0

内容来自DnA lab short read sequencing workshop-Multifactor Designs in DESeq2以及个人的额外补充

交互作用

2X2设计

设计矩阵

这里的实验设计， ~ Genotype + Treatment + Genotype:Treatment
其中
- Genotype：1，2
- Treatment：Control，Treatment
- 原视频中首字母都是小写，为了看的更清晰我改成了首字母大写
- 在读取meta data之后，要factor一下，并且按照对比的顺序设定levels
查看研究设计矩阵的代码

model.matrix(~ Genotype + Treatment + Genotype:Treatment, data = meta_dt)

图形直观查看设计矩阵
- 输出的是图片，内容大致如下

vd <- ExploreModelMatrix::VisualizeDesign(sampleData = colData(dds), 
                      designFormula = ~ Genotype + Treatment + Genotype:Treatment)
vd$plot

<table class="dataframe"> <caption>A tibble: 2 x 3</caption> <thead> <tr><th scope=col>Genotype</th><th scope=col>Con</th><th scope=col>Treatment</th></tr> <tr><th scope=col><dbl></th><th scope=col><chr></th><th scope=col><chr></th></tr> </thead> <tbody> <tr><td>1</td><td>(Intercept) + Time8h</td><td>(Intercept) + TreatmentTreatment + Genotype2.TreatmentTreatment</td></tr> <tr><td>2</td><td>(Intercept) </td><td>(Intercept) + TreatmentTreatment </td></tr> </tbody> </table>

解释
- Genotype 1 Control：对照
- Genotype 2 Treatment：Genotype 1接受处理；
  - 与Genotype 1 Control的差值，为蓝色箭头
    - 表示在经过处理后，与Genotype 1 Control的差值
- Genotype 2 Control：Genotype 2型的对照；
  - 与Genotype 1 Control的差值，为红色箭头
    - 表示在未经过任何处理，单纯由于genotype影响的情况
- Genotype 2 Treatment：Genotype 2型接受处理；
  - 与Genotype 2 Control的差值，为深蓝色箭头
    - 表示在经过处理后，与Genotype 2 Control的差值
  - 如果不存在交互作用，那么它和Genotype 2 Control的差值理应相同，即差值为蓝色箭头
  - 交互作用，即实际的差值和理论的差值的差
    - 检验交互作用，就是实际的差值和理论的差值的差是否为0
    - 即，深蓝色箭头（实际）-蓝色箭头（理论）是否为0

contrast参数中的项名

contrast中的项名不是自定义的，而是根据矩阵生成的
通过resultsNames()查看所有的项名

resultsNames(dds)

对交互作用的检验

直接对交互项检验即可
- 这里是和~1比的
- ~1就是截距项，
  就是和Genotype 1 Control进行差值对比，
  检验上述交互项代表的实际与理论差值是否为0

results(dds, contrast = c("Genotype2.TreatmentTreatment"))

对Genotype 2实际效果的验证

交互项 = 实际 - 理论，
那么简单的等式移项就可以得到，实际 = 交互 + 理论
对Genotype 2实际效果，即为深蓝色箭头

results(dds, contrast = list(c("Treatment_Treatment_vs_Control","Genotype2.TreatmentTreatment")))

这里最终可以看到
- 第一行中的公式中出现了加号
- 即最终的取值是list中的向量包含的两个项的和
- list中最多包含两个向量
  - 第一个向量是比较项
  - 第二个向量是被比较项
  - 当没有输入第二个向量的时候，即为与~1截距项比较

Con，A，B，A+B设计

设计矩阵

meta data格式

实验设计， ~ Treatment1 + Treatment2 + Treatment1:Treatment2

更复杂的实验设计

2组X多时间节点

2种细胞（Control，Mutant）在4个时间点（0，6，12，24h）的基因表达

分析思路
- 时间点两两比较
  - 6h vs 0h
  - 12h vs 0h
  - 24h vs 0h
  - 12h vs 6h
  - 24h vs 12h
  - 24h vs 12h
  - 问题
    - 没有充分利用时间序列的信息，得到的结果不全面
- 充分利用时间序列的本质，跨越全部时间段进行多组比较
  - 在本例中，2种对比设计（用以区别实验设计）
    - 简化版模型：不考虑细胞种类的影响
    - 全面版模型：考虑细胞种类的影响

对比设计

首先得判断是否有必要使用全面版模型，因此需要做一个简单对比
在DESeqDataSetFromMatrix()中还是要填写完整的实验设计
- ~ Batch + Genotype + Time + Genotype:Time

dds <- DESeqDataSetFromMatrix(
 countData = countMatrix,
 colData = metaData,
 design = ~ Batch + Genotype + Time + Genotype:Time)

由于存在多levels的比较，
正如t检验用于双样本，ANOVA适用于多样本一样，
Wald检验用于双样本，而LRT用于多样本
- test = "wald是默认的，改用LRT需要声明一下
- 要注意：reduced中填写简化后保留的变量，而并非要剔除的变量s

简化版模型

dds_full <- DESeq(dds, test = "LRT", reduced = ~ Batch + Time)

结果中的baseMean，log2FoldChange等结果均无实际意义
这里主要关注的是统计量stat以及p值pval

原视频

Blog创建完成

Thu, 17 Apr 2025 00:00:00 GMT

Cover Pic by @晕欧欧

开启我的blog

随便写写各种
以摸鱼为主
有什么想到的再追加

Nab-iak's Blog

[PIN] RNA-seq Analysis Service from University of Tsukuba

<center>Plan 1: from Extraction and Purification to Data Analysis</center>

Sample

<center>Plan 2: from Purified RNA to Data Analysis</center>

Sample

Note

<center>Plan 3: from Quality-checked RNA to Data Analysis</center>

Sample

Note

<center>Plan 4: from Quality-checked RNA to FASTQ Delivery</center>

Sample

Note

<center>Bioinformatics Analysis Support</center>

倾向得分匹配（PSM）

参考

使用倾向得分调整混淆变量的方法

示例数据

使用逻辑回归估计倾向得分

逻辑回归估计

ROC曲线

Hosmer-Lemeshow检验

使用倾向得分的逆概率加权法（IPW）

权重的计算

极端权重值的对应方法

对3种加权方式的比较

WeightIt包的一步到位

cobalt包检查权重平衡

MatchIt包检查权重平衡

估计治疗效果

MatchIt包进行倾向得分匹配

确定协变量的平衡性

构建倾向得分匹配过的队列

查看匹配后的协变量平衡性

可视化匹配结果

估计治疗效果

使用logit变换的倾向得分

快速变量编码转换函数

简介

autoTx：一键转换变量编码

示例

公共卫生PhD技能清单

描述人群健康状况，包括比较不同人群的健康状况

1.1 提出优质问题

1.2 人、地点、时间

1.3 疾病监测

1.4 数据收集和数据来源

1.5 发生的测量指标

1.6 关联和影响的测量指标（包括计算与解释）

1.7 生物统计学

1.8 研究设计

1.9 偏倚概述

1.10 评价效应异质性

1.11 诊断，预后和筛查研究

分析流行病学

2.1 因果推断框架

2.2 因果图

2.3 目标试验框架

2.4 混杂偏倚

2.5 选择偏倚

2.6 测量偏倚

2.7 数据分析基础

2.9 模型构建和拟合优度

复杂流行病学分析方法

3.1 纵向和多水平数据分析

3.2 生存分析

3.3 时依性暴露

3.4 调整混杂因素的高级方法

3.5 定量偏倚分析方法

3.6 变量选择和预测，特别是在高维数据背景下

3.7 中介分析

流行病学研究的解释与应用，流行病学实践

4.1 研究的实际实施

4.2 研究伦理

4.3 开展与政策相关的研究

4.4 批判性评价与同行评审

4.5 证据综合

4.6 基金申请书撰写：研究目的

4.7 基金申请书撰写：研究方法

4.7 基金申请书撰写：描述潜在影响

`WeightIt`包的一步到位

`cobalt`包检查权重平衡

`MatchIt`包检查权重平衡

`MatchIt`包进行倾向得分匹配

`autoTx`：一键转换变量编码

使用`case.weights`减少缺失值较多的行的影响

`mlr3`框架生态