医学统计分析与r语言


目录 1 如何使用 11 1.1 R 的安装 ............................. 11 1.2 Rstudio 安装 ........................... 13 1.3 TexLive2015 安装 ......................... 13 1.4 Fandol 字体 ............................ 14 2 描述性统计 15 2.1 常用统计量 ............................ 15 2.1.1 矩 ............................. 15 2.1.2 均值 (Mean) ....................... 15 2.1.3 标准差 (Standard Deviation) .............. 16 2.1.4 中位数 (Median) ..................... 20 2.1.5 四分位差 (quartile deviation) .............. 20 2.1.6 数学期望 (mathematical expectation) ......... 23 2.1.7 方差 (Variance) ...................... 23 2.1.8 众数 (Mode) ....................... 24 2.1.9 协方差 (Covariance) ................... 24 2.1.10 相关系数 (Correlation coefficient) ............ 24 2.1.11 偏度 (skewness) ...................... 25 2.1.12 峰度 (kurtosis) ...................... 25 2.1.13 几何平均数(Geometric mean)............ 26 2.1.14 变异系数(Coefficient of Variation).......... 27 2.1.15 样本校正平方和(CSS)................. 27 2.1.16 样本未校正平方和(USS)............... 27 2.1.17 标准误(Standard Deviation)............. 28 2.1.18 极差 ............................ 28 2.1.19 数据中心化和标准化 ................... 29 2.2 数据操作 ............................. 32 2.2.1 数据输入 ......................... 32 2.2.2 数据输出 ......................... 32 2.2.3 字符串操作 ........................ 33 2.2.4 数据操作 ......................... 35 12.2.5 长宽格式数据转换 .................... 43 2.2.6 分类汇总 ......................... 46 2.3 频数表和列联表 .......................... 48 2.3.1 一维列联表 ........................ 48 2.3.2 二维列联表 ........................ 49 2.3.3 多维列联表 ........................ 53 3 常用数据分布 56 3.1 正态分布 (Normal distribution) ................. 56 3.2 指数分布 ............................. 60 3.3 ￿(伽玛) 分布 ............................ 64 3.4 weibull 分布 ............................ 68 3.5 F 分布 ............................... 72 3.6 T 分布 ............................... 76 3.7 ￿(贝塔 Beta) 分布 ......................... 80 3.8 χ2(卡方) 分布 ........................... 84 3.9 均匀分布 ............................. 88 3.10 Poisson 分布 ........................... 92 3.11 数据分布直接的关系 ....................... 93 3.12 探索数据分布 ........................... 93 4 参数估计 100 4.1 点估计 ............................... 100 4.1.1 矩估计法 ......................... 100 4.1.2 极大似然估计法(MLE)................ 101 4.1.3 最小二乘法 ........................ 104 4.1.4 EM 算法 ......................... 105 4.1.5 Bootstrap 法 ....................... 108 4.2 区间估计 ............................. 109 4.2.1 单正态总体参数的区间估计 ............... 110 4.2.2 两正态总体参数的区间估计 ............... 113 4.3 单总体比率 p 的区间估计 .................... 115 4.4 两总体比率差 p1 − p2 的区间估计 ................ 116 4.5 基于 Bootstrap 的区间估计 ................... 117 25 样本容量估计 121 5.1 均数比较的样本量估计 (Comparing Means) .......... 123 5.1.1 单组设计 (One-Sample Design) ............. 123 5.1.2 两组平行设计 (Two-Sample Parallel Design) ...... 125 5.1.3 两组交叉设计(Two-Sample Crossover Design)... 126 5.1.4 多组设计 (Multiple-Sample One-Way ANOVA) .... 127 5.2 率比较的样本量估计 (Large Sample Tests for Proportions) .. 132 5.2.1 单组设计 (One-Sample Design) ............. 132 5.2.2 两组平行设计 (Two-Sample Parallel Design) ...... 134 5.2.3 两组交叉设计 (Two-Sample Crossover Design) .... 135 5.2.4 多组设计 (One-Way Analysis of Variance) ....... 137 5.2.5 相对危险度平行设计 (Relative Risk—Parallel Design) 140 5.2.6 相对危险度交叉设计 (Relative Risk—Crossover Design)141 5.3 计数资料的精确检验 (Exact Tests for Proportions) ...... 143 5.3.1 二项分布(Binomial Test)............... 143 5.3.2 Fisher’s 精确检验 (Fisher’s Exact Test) ........ 147 5.3.3 单 组 优 化 多 阶 段 设 计 (Optimal Multiple-Stage Designs for Single Arm Trials) ............. 150 5.4 拟合优度和列联表检验的样本量估计(Tests for Goodness- of-Fit and Contingency Tables)................ 191 5.4.1 拟合优度检验 (Tests for Goodness-of-Fit),样本含量 估算公式 ......................... 191 5.4.2 单层独立性检验 (Test for Independence—Single Stra- tum) ............................ 191 5.4.3 多层独立性检验 (Test for Independence—Multiple Strata) .......................... 193 5.4.4 类别转换检验 (Categorical Shift Test) ......... 195 5.4.5 残留效应检验 (Carry-Over Effect Test) ........ 198 5.5 时间事件(生存分析)的样本量计算 (Time-to-Event) .... 198 5.5.1 基于指数模型的生存分析 (Exponential Model) .... 199 5.5.2 基于 Cox 比例风险模型的生存分析 ........... 201 5.5.3 基于 Logrank 检验的生存分析 ............. 204 5.6 成组序贯设计 (Group Sequential Methods) .......... 206 35.6.1 Pocock’s Test ....................... 208 5.6.2 O’Brien and Fleming 检验 ................ 211 5.6.3 Wang and Tsiatis 检验 .................. 214 5.6.4 Inner Wedge 检验 .................... 217 5.6.5 率比较的样本量估计 ................... 222 5.6.6 时间事件数据(生存分析) ............... 224 5.6.7 α 消耗函数 ........................ 226 5.6.8 样本量再估计 ....................... 229 5.7 变异性比较的样本量估计 (Comparing Variabilities) ...... 231 5.7.1 重复平行对照设计 .................... 231 5.7.2 简单随机效应模型 .................... 234 5.7.3 个体间变异的比较 .................... 236 5.7.4 总体变异的比较 ...................... 240 5.8 生物等效性 (Bioequivalence) .................. 247 5.8.1 平均生物等效性 ...................... 248 5.8.2 群体生物等效性 ...................... 249 5.8.3 个体生物等效性 ...................... 249 5.8.4 体外实验法 ........................ 251 5.9 剂量反应研究 (Dose Response Studies) ............. 253 5.9.1 计量资料(Continuous Response)........... 254 5.9.2 二分类变量(Binary Response)............ 254 5.9.3 时间事件数据(Time-to-Event Endpoint)...... 255 5.9.4 最小有效剂量(MED)................. 255 5.9.5 Cochran-Armitage 趋势检验 ............... 256 5.9.6 爬坡试验 (Dose Escalation Trials) ........... 257 5.10 微阵列研究 (Microarray Studies) ................ 259 5.10.1 错误发现率 (False Discovery Rate) ........... 259 5.11 非参数检验 (Nonparametrics) .................. 262 5.11.1 单组位置检验 (One-Sample Location Problem) .... 262 5.11.2 两组位置检验 (Two-Sample Location Problem) .... 263 5.11.3 独立性检验 (Test for Independence) .......... 263 5.12 其他研究 (Sample Size Calculation in Other Areas) ...... 264 5.12.1 QT/QTc .......................... 264 45.12.2 非随机化临床试验中的倾向得分 ............. 266 5.12.3 重复测量方差分析 (ANOVA with Repeated Measures) 268 5.12.4 生存质量 (Quality of Life,QOL) ............. 269 5.12.5 衔接性设计 (Bridging Studies) ............. 269 5.12.6 疫苗临床试验 (Vaccine Clinical Trials) ......... 270 6 假设检验 273 6.1 参数假设检验 ........................... 273 6.1.1 正态总体均值的假设检验 ................ 273 6.1.2 总体比例的假设检验 ................... 276 6.2 相关性度量 ............................ 280 6.2.1 相关 ............................ 281 6.2.2 Pearson 积矩相关系数 .................. 281 6.2.3 偏相关 ........................... 283 6.3 独立性检验 ............................ 284 6.3.1 Cochran-Mantel-Haenszel 检验 ............. 285 6.3.2 趋势检验 ......................... 288 7 回归分析 295 7.1 一元线性回归 ........................... 295 7.1.1 共线性,条件数 ...................... 310 7.1.2 预测新值及其置信区间 .................. 310 7.1.3 改进措施 ......................... 311 7.2 多元线性回归 ........................... 313 7.2.1 多重共线性 ........................ 323 7.2.2 模型比较 ......................... 325 7.3 逐步回归 ............................. 326 7.4 交叉验证 ............................. 334 7.5 相对重要性 ............................ 335 7.6 分位数回归 ............................ 336 7.6.1 穷人和富人的消费比较 .................. 342 7.6.2 模型比较 ......................... 343 7.6.3 残差形态检验 ....................... 345 7.6.4 分位数回归的分解 .................... 347 58 广义线性模型 350 8.1 Logistic 回归 ........................... 351 8.1.1 单因素 Logistics 回归 .................. 352 8.1.2 多因素 Logistics 回归 .................. 361 8.1.3 稳健 Logistic 回归 .................... 367 8.1.4 条件 logistic 回归 ..................... 369 8.1.5 无序多分类 Logistic 回归 ................ 372 8.1.6 有序多分类 Logistic 回归 ................ 381 8.1.7 精确 Logistic 回归 .................... 389 8.2 Possion 回归 ........................... 389 8.2.1 拟合优度检验 ....................... 391 8.2.2 模型的系数及解释 .................... 392 8.2.3 过度离散 ......................... 393 8.2.4 异方差一致的标准误差 .................. 395 8.2.5 时间段变化的 Poisson 回归 ............... 395 8.2.6 零膨胀的 Poisson 回归 .................. 396 8.2.7 稳健 Poisson 回归 .................... 397 8.2.8 负二项回归 (Negative binomial regression) ....... 398 8.2.9 拟合优度检验 ....................... 400 8.2.10 模型的系数及解释 .................... 401 8.2.11 零膨胀的负二项回归回归 ................ 401 9 广义加性模型 404 9.1 交互作用 ............................. 407 10 方差分析 408 10.1 单因素方差分析(one-way ANOVA)............. 409 10.1.1 假设检验 ......................... 411 10.1.2 oneway.test() 和 aov() 函数进行方差分析 ....... 412 10.1.3 模型比较 ......................... 414 10.1.4 效果大小 (Effect size) .................. 415 10.1.5 多重比较 ......................... 416 10.1.6 离群点检测 ........................ 420 10.1.7 残差的相关检验 ...................... 420 610.2 单因素协方差分析 (Analysis of covariance ,ANCOVA) .... 421 10.2.1 调整的组均值 ....................... 423 10.2.2 多重比较 ......................... 424 10.2.3 检验回归斜率的同质性 .................. 424 10.2.4 结果可视化 ........................ 425 10.2.5 I 类型的平方和 (Type I sum of squares) 单因素协方 差分析 ........................... 426 10.2.6 II/III 类型的平方和 (Type II/III sum of squares) 单 因素协方差分析 ...................... 427 10.2.7 基于 II 类型的平方和的模型比较 ............ 427 10.2.8 回归系数 (Test individual regression coefficients) ... 428 10.2.9 效果大小 (Effect size) .................. 429 10.2.10 调整的组均值 ...................... 430 10.3 双因素方差分析(Two-way ANOVA)............. 430 10.3.1 I 型双因素方差分析 (SS type I) ............. 432 10.3.2 II/III 型双因素方差分析 (SS type II or III) ...... 433 10.3.3 绘制边际均数及格均数图 ................ 434 10.3.4 效果大小 (Effect size estimate) ............. 436 10.3.5 简单效应 (Simple effects) ................ 437 10.3.6 多重比较 ......................... 437 10.3.7 单元多重比较 (Cell comparisons using the associated one-way ANOVA) .................... 440 10.3.8 非计划 Scheffe 检验 ................... 441 10.3.9 残差的相关检验 ...................... 442 10.3.10 正态性检验 ........................ 442 10.4 重复测量方差分析 ........................ 444 10.4.1 单因素重复测量方差分析 (One-way repeated mea- sures ANOVA) ...................... 444 10.4.2 双因素重复测量方差分析 (Two-way repeated- measures ANOVA) .................... 451 10.4.3 宽格式数据 ........................ 454 10.4.4 anova.mlm() 和 mauchly.test() ............. 456 10.4.5 效果大小 (Effect size estimates) ............. 459 710.4.6 简单效应 (Simple effects) ................ 459 10.4.7 多元方法 (Multivariate approach) ........... 460 10.5 两级裂区设计(Two-way split-plot ANOVA)......... 465 10.5.1 宽数据格式 ........................ 466 10.5.2 宽数据格式 anova.mlm() 和 mauchly.test() ...... 467 10.5.3 效果大小 (Effect size estimates) ............. 469 10.5.4 简单效应 ......................... 469 10.5.5 计 划 的 多 重 比 较 (Planned comparisons for the between-subjects factor)................ 470 10.6 再裂区设计(Three-way split-plot ANOVA)......... 471 10.6.1 SPF-pq￿r ......................... 473 10.6.2 SPF-p￿qr ......................... 477 10.7 混合模型重复测量方差分析(Mixed-effects models for repeated-measures ANOVA).................. 484 10.7.1 单因素重复测量方差分析 (One-way repeated mea- sures ANOVA, RB-p design) .............. 485 10.7.2 双因素重复测量方差分析 (Two-way repeated mea- sures ANOVA ,RBF-pq design) ............. 489 10.7.3 两级裂区设计的方差分析 (Two-way split-plot- factorial ANOVA ,SPF-p￿q design) ........... 491 10.7.4 三级裂区设计的方差分析 (Three-way split-plot- factorial ANOVA ,SPF-pq￿r design) .......... 493 10.7.5 三级裂区设计的方差分析 Three-way split-plot- factorial ANOVA (SPF-p￿qr design) .......... 496 10.7.6 四级裂区设计的方差分析 (Four-way split-plot- factorial ANOVA ,SPF-pq￿rs design) .......... 498 11 生存分析 503 11.1 非参数法 ............................. 504 11.1.1 寿命表(Life Table).................. 504 11.1.2 Kaplan-Meier 曲线 .................... 511 11.1.3 分层比较 ......................... 515 11.1.4 累积风险率 ........................ 516 11.2 参数法 (Parametric proportional hazards models) ....... 518 811.2.1 假定生存时间符合 weibull 分布 ............. 518 11.2.2 AFT 参数转换为 Cox 模型的 β ............. 519 11.2.3 模型比较 ......................... 519 11.2.4 生存曲线估计 ....................... 520 11.3 半参数法 (COX 回归)...................... 520 11.3.1 模型拟合 ......................... 522 11.3.2 模型诊断 (Model diagnostics) .............. 525 11.3.3 预测风险 (Predicted hazard ratios) ........... 528 12 非参数检验 533 12.1 单样本 (One-sample) ....................... 533 12.1.1 符号检验 (Sign-test) ................... 533 12.1.2 Wilcoxon 符号秩检验 (Wilcoxon signed rank test) .. 535 12.2 两独立样本 (Two independent samples) ............ 536 12.2.1 符号检验 (Sign-test) ................... 536 12.2.2 Wilcoxon 符号秩和检验 (Wilcoxon rank-sum test) .. 537 12.3 多组样本 (more than two samples) ............... 541 12.3.1 无序独立样本 (Independent samples - unordered groups) .......................... 541 12.3.2 有序独立样本 (Independent samples - ordered groups) 544 12.3.3 无序非独立样本 (Dependent samples - unordered groups) .......................... 545 12.3.4 有序非独立样本 (Dependent samples - ordered groups) 549 12.4 二项分布检验 (Binomial test) .................. 550 12.4.1 单侧 (One-sided) ..................... 550 12.4.2 双侧 (Two-sided) ..................... 551 12.4.3 置信区间 (Confidence intervals) ............. 552 12.5 Pearson 拟合优度 χ2 检验 .................... 552 12.6 Kolmogorov-Smirnov 检验 .................... 553 12.6.1 单样本检验 ........................ 553 12.6.2 两样本检验 ........................ 554 12.7 列联表的独立性检验 ....................... 555 12.8 卡方检验 (χ2 检验)........................ 556 12.9 游程检验 (Runs-test) ....................... 557 912.9.1 置换检验 (Manual permutation test) .......... 557 12.10 无序分类联合检验 (Association tests and measures for un- ordered categorical variables) .................. 560 12.10.1 (2×2) 列联表 ...................... 560 12.10.2 灵敏度、特异度等 (Prevalence, sensitivity, specificity, CCR, F-score) ...................... 561 12.10.3 OR 值、相对危险度等 (Odds ratio, Yule’s Q and risk ratio) ........................... 563 12.10.4 (r×c) 列联表 ....................... 564 12.11 有序分类联合检验 (Association tests and measures for or- dered categorical variables) ................... 568 12.11.1 线性间的联合检验 (Linear-by-linear association test) 568 12.11.2 多序列相关 (Polychoric and polyserial correlation) .. 569 12.11.3 异构相关矩阵 (Heterogeneous correlation matrices) . 569 12.11.4 有序变量和连续性变量 (Association measures involv- ing categorical and continuous variables) ........ 571 12.12 Cochran Q 检验 (Cochran-Q-test) ............... 572 12.13 McNemar 检验 (McNemar test) ................ 574 12.14 Bowker 检验 (Bowker test) ................... 577 12.15 Stuart Maxwell 检验 (Stuart-Maxwell-test for marginal ho- mogeneity) ............................ 579 12.16 基于尺度参数的检验 ...................... 579 12.16.1 尺度参数的 Ansari-Bradley 检验 ............ 579 12.16.2 尺度参数的 Fligner-Killeen 检验 ............ 580 12.17 重抽样(Resampling)..................... 581 12.17.1 置换检验(Permutation tests)............ 581 12.18 自主法 (Bootstrapping) ..................... 608 12.18.1 单个统计量 ........................ 608 12.18.2 多个统计量 ........................ 610 12.19 分层自主法 (Stratified bootstrapping) ............. 612 13 地图展示 614 14 参考文献 615 101 如何使用 相对于 R 在其他行业的流行,医学领域 R 应用更加少见,医学领域目 前仍然以 SPSS 和 SAS 为主,本书主要目的在于介绍 R 在医学领域的应 用。本书使用 markdown 衍生版本 R Markdown(Rmd)V2 进行撰写,在 TeXLive 环境下使用 xelatex 编译,所有的 R 语言代码都基于 knitr 运行和 生成。本书的所有代码都在 R 3.2 下经过严格的测试。其中测试的操作系统 为 Linux Mint 17.2。 1.1 R 的安装 在 Linux Mint 下安装 R,需要安装如下依赖库和编译库 sudo apt-get install build-essential git-core gfortran libxml2-dev libcurl4-openssl-dev libcurl4-gnutls-dev libfreetype6-dev libbz2-dev liblapack-dev libpcre++-dev liblzma-dev r-cran-rcpp r-cran-rjava openjdk-7-* curl libgmp3-dev libmysql++-dev libmpfr-dev libgdal1-dev libproj-dev libglu1-mesa-dev r-cran-boot r-cran-class r-cran-cluster r-cran-codetools r-cran-foreign r-cran-kernsmooth r-cran-lattice r-cran-mass r-cran-matrix r-cran-mgcv r-cran-nlme r-cran-nnet r-cran-rpart r-cran-spatial r-cran-survival r-cran-rodbc sudo apt-get install libgsl0ldbl sudo apt-get install gsl-bin libgsl0-dev #Step 1: Update Sources.List File #- Edit the sources.list file sudo gedit /etc/apt/sources.list #- Add following entry deb http://cran.rstudio.com/bin/linux/ubuntu trusty/ #Step 2: Add the Public Keys gpg --keyserver keyserver.ubuntu.com --recv-key E084DAB9 gpg -a --export E084DAB9 | sudo apt-key add - #Step 3: Install R-base 11sudo apt-get update sudo apt-get upgrade sudo apt-get install r-base r-base-dev 安装 Java 的 jdk 时,在 shell 中运行 sudo R CMD javareconf 命令,解 决 jdk 安装问题。R 升级可通 shell 完成 sudo apt-get update sudo apt-get upgrade sudo apt-get install r-base cp -r ~/R/x86_64-pc-linux-gnu-library/3.1/* ~/R/x86_64-pc-linux-gnu-library/3.2 # at the shell prompt update.packages(checkBuilt=TRUE, ask=FALSE)#at the R prompt 本书涉及的 R 语言包较多,CRAN 中包可通过下列方式一次性完成安 装。 wants <- c("knitr","rmarkdown","devtools","epicalc","mosaic", "showtext","pander","PerformanceAnalytics","fitdistrplus", "CircStats","MASS","mixtools","boot","TrialSize","vcd", "ggplot2","pspearman","gvlma","car","lmtest","leaps", "plyr","bootstrap","elrm","rms","Deducer","bestglm", "survival","robust","mlogit","nnet","VGAM","ordinal", "Sample.Size","phia","mvtnorm","pscl","mosaic","XML", "pipeR","Rcmdr","rgl","HH","DescTools","multcomp", "effects","sandwich","qcc","devtools","ggmap","mosaic", "Hmisc","pastecs","psych","doBy","gmodels","CircStats", "expm","koRpus","ldbounds","ggm","coin","DescTools", "Rcurl","maptools","rgdal","animation","leaflet", "polycor","pROC","rms","pgirmess","rateratio.test", "exactci","Deducer","VGAM","ordinal","AER","gplots", "AICcmodavg") has <- wants %in% rownames(installed.packages()) if(any(!has)) install.packages(wants[!has]) 12在 CRAN 上已经下线包,采用离线安装 install.packages("~/Downloads/epicalc_2.15.1.0.tar.gz", repos = NULL, type = "source") install.packages("~/Downloads/lmPerm_1.1-2.tar.gz", repos = NULL, type = "source") GitHub 中 R 包通过以下方式进行安装 devtools::install_github("rstudio/rticles") devtools::install_github("rstudio/rmarkdown") bioconductor 中 R 包通过以下方式进行安装 source("http://bioconductor.org/biocLite.R") biocLite(c("GenomicFeatures","AnnotationDbi","LBE")) R-Forge 等其它第三方源中的包,通过以下方式进行安装 install.packages("blotter", repos="http://R-Forge.R-project.org") 本书使用的 R 语言编译器是 Rstudio,源代码托管于 GitHub(https: //github.com/xuefliang/RInMedicine￿ 。 1.2 Rstudio 安装 wget https://download1.rstudio.org/rstudio-0.99.486-amd64.deb sudo dpkg -i /home/xuefliang/Downloads/rstudio-0.99.486-amd64.deb 1.3 TexLive2015 安装 sudo mount -t iso9660 -o ro,loop,noauto texlive2015.iso /mnt cd /mnt sudo ./install-tl sudo umount -l /mnt 13# 安装完成后需要设置环境变量,即在/etc/profile 下加入 vi /etc/profile export MANPATH=/usr/local/texlive/2015/texmf/doc/man:$MANPATH export INFOPATH=/usr/local/texlive/2015/texmf/doc/info:$INFOPATH export PATH=/usr/local/texlive/2015/bin/x86_64-linux:$PATH # 使环境变量生效 source /etc/profile 1.4 Fandol 字体 wget http://mirrors.ctan.org/fonts/fandol.zip # 字体保存到 ~/.fonts 文件夹下 mkdir ~/.fonts cd ~/Downloads unzip ~/Downloads/fandol.zip cp ~/Downloads/fandol/* ~/.fonts cd ~/.fonts fc-cache -fv # 测试 tex -v # 字体查看 fc-list :lang=zh-cn 142 描述性统计 统计分析分为统计描述和统计推断两个部分,统计描述是通过绘制统计 图、计算统计量等方法描述数据的分布特征,是数据分析的基本步骤。 2.1 常用统计量 2.1.1 矩 设 X 和 Y 是随机变量,若 E(Xk), k = 1, 2,··· 存在,则称它为 X 的 k 阶原点矩,简称 k 阶矩。若 E { [X − E(x)]k } , k = 2, 3,··· 存在,则称它为 X 的 k 阶中心距。若 E(XkY l), k, l = 1, 2,··· 存在,则称它为 X 和 Y 的 k+l 阶混合距。若 E { [X − E(X)]k[Y − E(Y)]l } , k, l = 1, 2,··· 存在,则称它为 X 和 Y 的 k+l 阶混合中心距。X 的数学期望 E(X) 是 X 的一阶原点矩,方差 D(X) 是 X 的二阶中心矩,协方差 Cov(X,Y) 是 X 和 Y 的二阶混合中心矩。 2.1.2 均值 (Mean) 一阶原点矩又称均数是一组数据的平均值, 均数(记为 ¯x)定义为 ¯X = 1 n n∑ i=1 Xi 用它来描述正态分布数据的集中趋势。 152.1.3 标准差 (Standard Deviation) 样本方差定义为 S2 = 1 n − 1 n∑ i=1 (Xi − ¯X)2 , 标准差是方差的算术平方根,是一组数值自均数分散开来的程度的一种测 量观念。定义为 δ = vuut 1 N n∑ i=1 (xi − u)2 一个较大的标准差,代表大部分的数值和其平均值之间差异较大;一个较小 的标准差,代表这些数值较接近平均值。 例已知 50 名患者的收缩压(mmHg)分别为:147 163 159 124 120 94 135 185 109 143 116 129 157 146 149 127 124 160 101 129 130 154 151 119 128 147 127 122 145 159 141 131 117 139 142 152 147 157 134 146 144 119 160 136 122 172 170 109 151 144 求血压的集中趋势和离散趋势及集中趋势 的 95% 可信区间。思路:先判断数据是否为正态分布,然后根据结果选择 描述集中趋势的统计量。 sbp <- c(147,163,159,124,120,94,135,185,109,143,116,129,157,146,149, 127,124,160,101,129,130,154,151,119,128,147,127,122,145,159, 141,131,117,139,142,152,147,157,134,146,144,119,160,136 , 122,172,170,109,151,144) qqnorm(sbp) qqline(sbp) #plot(density(sbp)) 核密度 hist(sbp,freq = F) #freq=T, 则绘制频数 result <- shapiro.test(sbp) result ## ## Shapiro-Wilk normality test 16−2 −1 0 1 2 100 120 140 160 180 Normal Q−Q Plot Theoretical Quantiles Sample Quantiles 图 1: Histogram of sbp sbp Density 100 120 140 160 180 0.000 0.010 0.020 图 2: 17## ## data: sbp ## W = 0.99175, p-value = 0.9783 ks.test(sbp,"pnorm",mean(sbp),sd(sbp)) ## Warning in ks.test(sbp, "pnorm", mean(sbp), sd(sbp)): ties should not be ## present for the Kolmogorov-Smirnov test ## ## One-sample Kolmogorov-Smirnov test ## ## data: sbp ## D = 0.071566, p-value = 0.9599 ## alternative hypothesis: two-sided 样本大小在 3 和 5000 之间, 选择 Shapiro-Wilk 进行正态性检验。W 值 为 0.9917495,P 值为 0.9782552 大于 0.05,不能拒绝其于正态分布一致的 假设。如果样本数较大,可以选择 Kolmogorov-Smirnov 检验。对于服从正 态分布的数据,选择均数和标准差描述其集中趋势和离散趋势。 mean(sbp) ## [1] 138.64 sd(sbp) ## [1] 18.91308 均值为 138.64, 标准差为 18.9130772。对均数和标准差的计算还可以通 过 base 包中的 summary() 函数,该函数提供了最小值、最大值、四分位 数和数值型变量的均值,以及因子向量和逻辑型向量的频数统计。epicalc 包中的 summ() 和 mosaic 包中的 favstats() 等函数也可获得类似结果,如 favstats() 一次就可以完成均数和标准差的计算。 18favstats(sbp) ## min Q1 median Q3 max mean sd n missing ## 94 124.75 141.5 151 185 138.64 18.91308 50 0 对均数的 95% 可信区间的计算可通过 t.test() 获得,对一个给定的可 信区间,它表示一个总体参数的估计范围。根据中位数和均数可以快速检查 数据分布,如中位数小于均数,说明分布有可能向右倾斜。 t.test(sbp) ## ## One Sample t-test ## ## data: sbp ## t = 51.834, df = 49, p-value < 2.2e-16 ## alternative hypothesis: true mean is not equal to 0 ## 95 percent confidence interval: ## 133.265 144.015 ## sample estimates: ## mean of x ## 138.64 通过设置 conf.level=0.99,可以将可信区间水平提高到 99%。 t.test(sbp,conf.level=0.99) ## ## One Sample t-test ## ## data: sbp ## t = 51.834, df = 49, p-value < 2.2e-16 ## alternative hypothesis: true mean is not equal to 0 ## 99 percent confidence interval: ## 131.4719 145.8081 19## sample estimates: ## mean of x ## 138.64 2.1.4 中位数 (Median) 对于一组有限个数的数据来说,它们的中位数是这样的一种数:这群数 据里的一半的数据比它大,而另外一半数据比它小。计算有限个数的数据的 中位数的方法是:把所有的同类数据按照大小的顺序排列。如果数据的个数 是奇数,则中间那个数据就是这群数据的中位数;如果数据的个数是偶数, 则中间那 2 个数据的算术平均值就是这群数据的中位数。通常用中位数来 描述非正态分布数据的集中趋势,极值对中位数影响不大。定义为实数 x1, x2,..., xn 按大小顺序(顺序,降序皆可)排列为 x′ 1, x′ 2,..., x′ n、实数数 列 x = (x1, x2, . . . , xn) 的中位数 Q 1 2 (x) 为 Q 1 2 (x) =    x′ n+1 2 , if n is odd. 1 2 (x′ n 2 + x′ n 2 +1), if n is even. odd 为奇数,even 为偶数。 2.1.5 四分位差 (quartile deviation) 是上四分位数(QU,即位于 75%)与下四分位数(QL,即位于 25%) 的差的一半。计算公式为:Qd = QU − QL。四分位差反映了中间 50% 数 据的离散程度,其数值越小,说明中间的数据越集中;其数值越大,说明中 间的数据越分散。四分位差不受极值的影响。例某地 17 名患者的月收入分 别为:23408 3468 1939 4360 23545 12233 4583 3546 35781 6578 8981 1345 5567 23455 23564 7623 14334 求收入的集中趋势和离散趋势及集中趋势的 95% 可信区间。思路:仍然先判断数据是否为正态分布,然后根据结果选择 描述集中趋势的统计量。 income <- c(23408,3468,1939,4360,23545,12233,4583,3546,35781,6578, 8981,1345,5567,23455, 23564,7623,14334) qqnorm(income) qqline(income) 20−2 −1 0 1 2 0 10000 20000 30000 Normal Q−Q Plot Theoretical Quantiles Sample Quantiles 图 3: #plot(density(income)) hist(income,freq = F) result <- shapiro.test(income) result ## ## Shapiro-Wilk normality test ## ## data: income ## W = 0.85488, p-value = 0.01274 根据 QQ 图和 Shapiro-Wilk 进行正态性检验结果,W 值为 0.8548814, P 值为 0.0127409 小于 0.05,选择中位数和四分位差描述其集中趋势和离散 趋势。 21Histogram of income income Density 0 10000 20000 30000 40000 0e+00 2e−05 4e−05 6e−05 图 4: quantile(income) ## 0% 25% 50% 75% 100% ## 1345 4360 7623 23408 35781 中位数为 7623,四分位差为 75% 的分位数减去 25% 的分位数。对中 位数的可信区间估计,可通过 wilcox.test() 函数获得 wilcox.test(income, conf.int=TRUE) ## ## Wilcoxon signed rank test ## ## data: income ## V = 153, p-value = 1.526e-05 ## alternative hypothesis: true location is not equal to 0 ## 95 percent confidence interval: ## 5460.0 17820.5 22## sample estimates: ## (pseudo)median ## 12376.5 2.1.6 数学期望 (mathematical expectation) 离散型随机变量:离散型随机变量的一切可能的取值 xi 与对应的概率 Pi(= xi) 之积的和称为该离散型随机变量的数学期望,记为 E(X)。数学期 望是最基本的数学特征之一。它反映随机变量平均取值的大小 E(X) = ∑ i xipi 连续型随机变量:若随机变量 X 的分布函数 F(x) 可表示成一个非负可积 函数 f(x) 的积分,则称 X 为连续性随机变量,f(x) 称为 X 的概率密度函 数,积分值为 X 的数学期望,记为 E(X)。 E(X) = ∫ +∞ −∞ xf(x)dx 2.1.7 方差 (Variance) 方差是各个数据与平均数之差的平方的平均数。在概率论和数理统计 中,方差用来度量随机变量和其数学期望(即均值)之间的偏离程度。设 X 为随机变量,如果 E[X − E(X)]2 存在,则称 E[X − E(X)]2 为 X 的方差, 记为 V ar(X)。离散型随机变量方差计算公式为 V ar(X) = E(X2) − (E(X))2 , 连续型随机变量方差计算公式为 V ar(x) = ∫ +∞ −∞ (x − E(X))2f(x)dx = E(X2) − (E(X))2 例计算样本 (2,5,78,45,89,124) 的方差 s <- c(2,5,78,45,89,124) var(s) ## [1] 2365.367 232.1.8 众数 (Mode) 观察资料中出现次数最多的数值或类别,不受极值影响,由于可能 有不只一个,也可能没有众数,一般不适合进行统计分析。例计算样本 (4,22,31,33,3,27,27,27,27,569,110,8,21,31,33,33) 的众数 S <- c(4,22,31,33,3,27,27,27,27,569,110,8,21,31,33,33) names(which.max(table(S))) ## [1] "27" 2.1.9 协方差 (Covariance) 协方差用于衡量两个变量的总体误差。而方差是协方差的一种特 殊情况,即当两个变量是相同的情况。设 X,Y 为两个随机变量,称 E[X − E(X)][Y − E(Y)] 为 X 和 Y 的协方差,记录 Cov(X,Y)。方差是 协方差的一种特殊情况,即当两个变量是相同的情况。 Cov(X,Y) = E{[X − E(X)][Y − E(Y)]} = E(XY) − E(X)E(Y) 例计算 X(2,5,7) 和 Y(6,7,9) 的协方差。 x <- c(2,5,7) y <- c(6,7,9) cov(x,y) ## [1] 3.666667 2.1.10 相关系数 (Correlation coefficient) 相关系数是用以反映变量之间相关关系密切程度的统计指标。相关系 数是按积差方法计算,同样以两变量与各自平均值的离差为基础,通过两个 离差相乘来反映两变量之间相关程度。当 V ar(X) > 0, V ar(Y) > 0 时,称 Cov(X,Y)/sqrt(V ar(X) ∗ V ar(Y)) 为 X 与 Y 的相关系统。 ρ(X,Y) = Cov(X,Y)√ V ar(X)V ar(Y) 例计算 X(2,5,7) 和 Y(6,7,9) 的相关系数 24x <- c(2,5,7) y <- c(6,7,9) cor(x,y) ## [1] 0.953821 2.1.11 偏度 (skewness) 是统计数据分布偏斜方向和程度的度量,是统计数据分布非对称程度的 数字特征。设分布函数 F(x) 有中心矩 µ2 = E(X − E(X))2,µ3 = E(X − E(X))3, 则 µ3 µ 3 2 2 为偏度系数。当 Cs>0 时,概率分布偏向均值右则,Cs<0 时, 概率分布偏向均值左则。 Cs = µ3 µ 3 2 2 2.1.12 峰度 (kurtosis) 表征概率密度分布曲线在平均值处峰值高低的特征数。峰度刻划不同 类型的分布的集中和分散程序。设分布函数 F(x) 有中心矩 µ2 = E(X − E(X))2, µ4 = E(X − E(X))4,则 Ck = µ4 µ2 2 − 3 为峰度系数。 Ck = µ4 µ2 2 − 3 例计算 10000 个正态分布的样本的偏度和峰度 S<-rnorm(10000) skewness(S) ## [1] -0.01226009 kurtosis(S) ## [1] 0.05807039 hist(S,breaks=100) 25Histogram of S S Frequency −4 −2 0 2 4 0 100 200 300 400 图 5: 2.1.13 几何平均数(Geometric mean) 是 n 个变量值连乘积的 n 次方根, 是用于反映一组经对数转换后呈对 称分布的变量值在数量上的平均水平即对数正态分布数据,在医学研究中常 适用于免疫学的指标。对于变量值呈倍数关系或呈对数正态分布(正偏态 分布),如抗体效价及抗体滴度,某些传染病的潜伏期,细菌计数等,宜用 几何均数表示其平均水平。 H = G = n √ X1 ∗ X2 ∗ ... ∗ Xn = ∑ n vuut n∏ i=1 Xn 例 5 名学龄儿童的麻疹血凝抑制抗体滴度为 1:25,1:50,1:50,1:100, 1:400,求几何均数及标准差。 geomean <- function(x, na.rm = FALSE, trim = 0, ...) { exp(mean(log(x, ...), na.rm = na.rm, trim = trim, ...)) } 26geosd <- function(x, na.rm = FALSE, ...) { exp(sd(log(x, ...), na.rm = na.rm, ...)) } s<-c(25,50,50,100,400) shapiro.test(log(s)) ## ## Shapiro-Wilk normality test ## ## data: log(s) ## W = 0.91408, p-value = 0.4925 geomean(s) ## [1] 75.78583 geosd(s) ## [1] 2.86111 也可以安装 NCStats 包,调用 geomean 和 geosd() 函数。 2.1.14 变异系数(Coefficient of Variation) 是刻画数据相对分散性的一种度量,记为 cv, 是概率分布离散程度的一 个归一化量度,其定义为标准差 σ 与平均值 µ 之比 cv = σ µ 2.1.15 样本校正平方和(CSS) 样本与均值差的平方的求和 CSS = ∑n i=1(xi − x) 2.1.16 样本未校正平方和(USS) 样本值平方的求和 USS = ∑n i=1 x2 i 272.1.17 标准误(Standard Deviation) 是某种统计量在抽样分布上的标准差称为该种统计量的标准误,即样本 统计量的标准差,是描述对应的样本统计量抽样分布的离散程度及衡量对应 样本统计量抽样误差大小的尺度。设 n 个测量值的误差为 v1、v2……vn,则 这组测量值的标准误差 σ σ = vuut 1 n − 1 n∑ i=1 v2 i 2.1.18 极差 描述样本分散性,数据越分散,其极差越大。 R = max(x) − min(x) 例对第一个例子求变异系数、样本校正平方和、样本未校正平方和、极差和 均值的标准误。 cv <- 100*sd(sbp)/mean(sbp) cv ## [1] 13.64186 css <- sum((sbp-mean(sbp))^2) css ## [1] 17527.52 uss <- sum(sbp^2) uss ## [1] 978580 r <- max(sbp)-min(sbp) r ## [1] 91 28通常由于总体的均数或总体的方差并不知道,样本均值的标准误 SD = s√ n ,s 为标准差,n 为样本数。 sd <- sd(sbp)/sqrt(length(sbp)) sd ## [1] 2.674713 2.1.19 数据中心化和标准化 数据中心化是将某变量中的观察值减去该变量的平均数,数据标准化将 某变量中的观察值减去该变量的平均数,然后除以该变量的标准差。经标准 化的数据都是没有单位的纯数量。对变量进行的标准差标准化可以消除量 纲(单位)影响和变量自身变异的影响。例对下表中三科成绩进行标准化。 Math Science English — — — 502 95 25 465 67 12 621 78 22 575 66 18 454 96 15 634 89 30 576 78 37 421 56 12 599 68 22 666 100 38 R 语言中 scale() 函数可以实现数据标准化,两个参数 center 和 scale 为 True 分别表示计算中心化和标准化 Math <- c(502,465,621,575,454,634,576,421,599,666) Science <- c(95,67,78,66,96,89,78,56,68,100) English <- c(25,12,22,18,15,30,37,12,22,38) Student <- as.data.frame(cbind(Math,Science,English)) options(digits=2)# 限定为 2 位小数 scale(Student[,1:3],center = T,scale = F) # 数据中心化 ## Math Science English ## [1,] -49 15.7 1.9 ## [2,] -86 -12.3 -11.1 ## [3,] 70 -1.3 -1.1 ## [4,] 24 -13.3 -5.1 ## [5,] -97 16.7 -8.1 ## [6,] 83 9.7 6.9 29## [7,] 25 -1.3 13.9 ## [8,] -130 -23.3 -11.1 ## [9,] 48 -11.3 -1.1 ## [10,] 115 20.7 14.9 ## attr(,"scaled:center") ## Math Science English ## 551 79 23 scale(Student[,1:3],center = F,scale = T) # 数据标准化 ## Math Science English ## [1,] 0.85 1.12 0.96 ## [2,] 0.79 0.79 0.46 ## [3,] 1.06 0.92 0.84 ## [4,] 0.98 0.78 0.69 ## [5,] 0.77 1.13 0.57 ## [6,] 1.08 1.05 1.15 ## [7,] 0.98 0.92 1.42 ## [8,] 0.72 0.66 0.46 ## [9,] 1.02 0.80 0.84 ## [10,] 1.13 1.18 1.45 ## attr(,"scaled:scale") ## Math Science English ## 587 85 26 apply() 函数或 sapply() 函数计算所选择的任意描述性统计量。对于 sapply() 函数,其使用格式为:sapply(x,FUN,options) 其中的 x 是输入的 数据框(或矩阵),FUN 为一个任意的函数。如果指定了 options,它们将被 传递给 FUN。你可以在这里插入的典型函数有 mean、sd、var、min、max、 median、length、range 和 quantile。可以根据需要自定义需要的统计量,如 下 mystats <- function(x, na.omit = FALSE){ if (na.omit) x <- x[!is.na(x)] 30m <- mean(x) n = length(x) s <- sd(x) skew <- sum((x - m)^3/s^3)/n kurt <- sum((x - m)^4/s^4)/n - 3 return(c(n = n, mean = m, stdev = s, skew = skew, kurtosis = kurt)) } data(drugDat,package = "elrm") sapply(drugDat,mystats) ## sex treatment recovered n ## n 4.00 4.00 4.0 4.00 ## mean 0.50 0.50 11.5 24.75 ## stdev 0.58 0.58 3.9 5.91 ## skew 0.00 0.00 0.0 0.18 ## kurtosis -2.44 -2.44 -2.1 -2.16 Hmisc 包中的 describe() 函数可返回变量和观测的数量、缺失值和唯 一值的数目、平均值、分位数,以及五个最大的值和五个最小的值。pastecs 包中有一个名为 stat.desc() 的函数,它可以计算种类繁多的描述性统计量。 使用格式为:stat.desc(x,basic=TRUE,desc=TRUE,norm=FALSE,p=0.95) 其中的 x 是一个数据框或时间序列。若 basic=TRUE(默认值),则计算其 中所有值、空值、缺失值的数量,以及最小值、最大值、值域,还有总和。 若 desc=TRUE(同样也是默认值),则计算中位数、平均数、平均数的标 准误、平均数置信度为 95% 的置信区间、方差、标准差以及变异系数。最 后,若 norm=TRUE(不是默认的),则返回正态分布统计量,包括偏度和 峰度(以及它们的统计显著程度)和 Shapiro–Wilk 正态检验结果。这里使 用了 p 值来计算平均数的置信区间(默认置信度为 0.95)。psych 包也拥有 一个名为 describe() 的函数,它可以计算非缺失值的数量、平均数、标准差、 中位数、截尾均值、绝对中位差、最小值、最大值、值域、偏度、峰度和平 均值的标准误。 312.2 数据操作 2.2.1 数据输入 readr 包中的函数使数据读入的速度更快,相对于基础包中的函数,对 字符类型并不需要指定 stringsAsFactors = FALSE 防止字符类型自动转为 因子,对列名限制更少。固定分割的数据使用 read_delim(), read_csv(), read_tsv() 和 read_csv2() 函数,固定宽度的数据使用 read_fwf() 和 read_table()。 WHO<- read_csv("WHO.csv",col_names=T) #col_names 相当于 header=T,默认为 True # 可以从压缩包或网站上直接输入 mtcars <- read_csv(system.file("extdata/mtcars.csv.bz2", package = "readr")) #mtcars <- #read_csv("https://github.com/hadley/readr/raw/master/inst/extdata/mtcars.csv") 2.2.2 数据输出 用 readr 包读入的数据,变量的引用使用如下格式 WHO$Adolescent fertility rate (%),不同于通常的引用。write_csv() 将数据框快速的输 出为 csv 文件。 who <- read_csv("WHO.csv", col_types = list( CountryID = col_integer(), Continent=col_double(), Country=col_factor(c("Country")) #col_date() 使用 Y-m-d 格式,col_datetime() 使用 ISO8601 日期时间格式 )) ## Warning: 202 parsing failures. ## row col expected actual ## 1 Country value in level set Afghanistan ## 2 Country value in level set Albania ## 3 Country value in level set Algeria ## 4 Country value in level set Andorra ## 5 Country value in level set Angola 32## ... ....... .................. ........... ## .See problems(...) for more details. class(who) #tbl_df、tbl 和 data.frame 类型 ## [1] "tbl_df" "tbl" "data.frame" 2.2.3 字符串操作 2.2.3.1 合并字符串 IT <- c("google","baidu","bing") res <- str_c(1:3,IT,sep='',collapse='') str_c('My work place is ',res,collapse='') ## [1] "My work place is 1 google 2 baidu 3 bing" 2.2.3.2 计算字符串长度 str_length(c("programming R and Python", 123,res)) ## [1] 24 3 23 2.2.3.3 按位置取子字符串 str_sub(IT, 1, 3) ## [1] "goo" "bai" "bin" 2.2.3.4 子字符串重新赋值 capital <-toupper(str_sub(IT,1,1)) str_sub(IT, rep(1,3),rep(1,3)) <- capital 2.2.3.5 重复字符串 33str_dup(IT, c(2,3,4)) ## [1] "GoogleGoogle" "BaiduBaiduBaidu" "BingBingBingBing" 2.2.3.6 加空白和去除空白 str_pad(IT, 10,"both") ## [1] " Google " " Baidu " " Bing " str_trim(IT) ## [1] "Google" "Baidu" "Bing" 2.2.3.7 根据正则表达式检验是否匹配 str_detect(IT, "g$")# 查找以 g 结尾 ## [1] FALSE FALSE TRUE str_detect(IT, "[aiu]")# 查找是否包含 a、i、u ## [1] FALSE TRUE TRUE 2.2.3.8 查找匹配的字符串位置 str_locate(IT, "a")# 返回起始和结束的位置 ## start end ## [1,] NA NA ## [2,] 2 2 ## [3,] NA NA 2.2.3.9 提取匹配的部分 34str_extract(IT, "[a-z]+") ## [1] "oogle" "aidu" "ing" str_extract(IT, "[a-z]{1,3}") ## [1] "oog" "aid" "ing" str_match(IT, "[a-z]+") ## [,1] ## [1,] "oogle" ## [2,] "aidu" ## [3,] "ing" 2.2.3.10 替换匹配的部分 str_replace(IT, "[aeiou]","-") ## [1] "G-ogle" "B-idu" "B-ng" 2.2.3.11 分割 str_split(res, "") ## [[1]] ## [1] "1" "google" "2" "baidu" "3" "bing" 2.2.4 数据操作 dplyr 包将 plyr 包中的 ddply() 等函数进一步分离强化, 专注接受 dataframe 对象, 大幅提高了运算速度, 并且提供了更稳健的与其它数据库 对象间的接口。 352.2.4.1 数据集类型 将过长过大的数据集转换为显示更友好的 tbl_df 类型 iris_df<- tbl_df(iris) iris_df ## Source: local data frame [150 x 5] ## ## Sepal.Length Sepal.Width Petal.Length Petal.Width Species ## (dbl) (dbl) (dbl) (dbl) (fctr) ## 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.3 0.2 setosa ## 4 4.6 3.1 1.5 0.2 setosa ## 5 5.0 3.6 1.4 0.2 setosa ## 6 5.4 3.9 1.7 0.4 setosa ## 7 4.6 3.4 1.4 0.3 setosa ## 8 5.0 3.4 1.5 0.2 setosa ## 9 4.4 2.9 1.4 0.2 setosa ## 10 4.9 3.1 1.5 0.1 setosa ## .. ... ... ... ... ... 2.2.4.2 筛选 filter 用于选择满足条件的观测(行),第一个参数是 data frame 名字, 第二个参数是条件。 # 选取 Species == versicolor 的观测 filter(iris_df, Species == "versicolor") ## Source: local data frame [50 x 5] ## ## Sepal.Length Sepal.Width Petal.Length Petal.Width Species ## (dbl) (dbl) (dbl) (dbl) (fctr) ## 1 7.0 3.2 4.7 1.4 versicolor ## 2 6.4 3.2 4.5 1.5 versicolor 36## 3 6.9 3.1 4.9 1.5 versicolor ## 4 5.5 2.3 4.0 1.3 versicolor ## 5 6.5 2.8 4.6 1.5 versicolor ## 6 5.7 2.8 4.5 1.3 versicolor ## 7 6.3 3.3 4.7 1.6 versicolor ## 8 4.9 2.4 3.3 1.0 versicolor ## 9 6.6 2.9 4.6 1.3 versicolor ## 10 5.2 2.7 3.9 1.4 versicolor ## .. ... ... ... ... ... # 选取 Sepal.Length 为 7.0,5.2,6.6 的观测 filter(iris_df, Sepal.Length %in% c(7.0, 5.2,6.6)) ## Source: local data frame [7 x 5] ## ## Sepal.Length Sepal.Width Petal.Length Petal.Width Species ## (dbl) (dbl) (dbl) (dbl) (fctr) ## 1 5.2 3.5 1.5 0.2 setosa ## 2 5.2 3.4 1.4 0.2 setosa ## 3 5.2 4.1 1.5 0.1 setosa ## 4 7.0 3.2 4.7 1.4 versicolor ## 5 6.6 2.9 4.6 1.3 versicolor ## 6 5.2 2.7 3.9 1.4 versicolor ## 7 6.6 3.0 4.4 1.4 versicolor 对于多条件的选择,需要完整条件的,然后使用集合运算符将条件拼接 起来。集合运算符有!、|、&、xor(交补)。条件的判断符有 >(=)、<(=)、==、 !=、%in% (判断元素是否在集合或者列表内,返回逻辑值)。 filter(iris_df, Sepal.Length>=6.3 & Species=="versicolor") ## Source: local data frame [14 x 5] ## ## Sepal.Length Sepal.Width Petal.Length Petal.Width Species ## (dbl) (dbl) (dbl) (dbl) (fctr) 37## 1 7.0 3.2 4.7 1.4 versicolor ## 2 6.4 3.2 4.5 1.5 versicolor ## 3 6.9 3.1 4.9 1.5 versicolor ## 4 6.5 2.8 4.6 1.5 versicolor ## 5 6.3 3.3 4.7 1.6 versicolor ## 6 6.6 2.9 4.6 1.3 versicolor ## 7 6.7 3.1 4.4 1.4 versicolor ## 8 6.3 2.5 4.9 1.5 versicolor ## 9 6.4 2.9 4.3 1.3 versicolor ## 10 6.6 3.0 4.4 1.4 versicolor ## 11 6.8 2.8 4.8 1.4 versicolor ## 12 6.7 3.0 5.0 1.7 versicolor ## 13 6.7 3.1 4.7 1.5 versicolor ## 14 6.3 2.3 4.4 1.3 versicolor 2.2.4.3 排列 arrange 用于根据变量排序,如果排序依据(列)是字符,按照字母表 的顺序,如果是数字,默认按照从小到大的顺序排序,如果需要使用逆序排, 可以使用 desc(var) 或者 -var。 arrange(iris_df, Petal.Length) ## Source: local data frame [150 x 5] ## ## Sepal.Length Sepal.Width Petal.Length Petal.Width Species ## (dbl) (dbl) (dbl) (dbl) (fctr) ## 1 4.6 3.6 1.0 0.2 setosa ## 2 4.3 3.0 1.1 0.1 setosa ## 3 5.8 4.0 1.2 0.2 setosa ## 4 5.0 3.2 1.2 0.2 setosa ## 5 4.7 3.2 1.3 0.2 setosa ## 6 5.4 3.9 1.3 0.4 setosa ## 7 5.5 3.5 1.3 0.2 setosa ## 8 4.4 3.0 1.3 0.2 setosa 38## 9 5.0 3.5 1.3 0.3 setosa ## 10 4.5 2.3 1.3 0.3 setosa ## .. ... ... ... ... ... arrange(iris_df, desc(Petal.Length)) ## Source: local data frame [150 x 5] ## ## Sepal.Length Sepal.Width Petal.Length Petal.Width Species ## (dbl) (dbl) (dbl) (dbl) (fctr) ## 1 7.7 2.6 6.9 2.3 virginica ## 2 7.7 3.8 6.7 2.2 virginica ## 3 7.7 2.8 6.7 2.0 virginica ## 4 7.6 3.0 6.6 2.1 virginica ## 5 7.9 3.8 6.4 2.0 virginica ## 6 7.3 2.9 6.3 1.8 virginica ## 7 7.2 3.6 6.1 2.5 virginica ## 8 7.4 2.8 6.1 1.9 virginica ## 9 7.7 3.0 6.1 2.3 virginica ## 10 6.3 3.3 6.0 2.5 virginica ## .. ... ... ... ... ... 2.2.4.4 选择 select 用于选择列, 类似于 R 自带的 subset() 函数,select 中负号表示 不选择。其中变量的声明还有其他形式,比如 B:F 表示从 B 列到 F 列 所有列;ends_with(“string”) 表示选取列名以 string 结尾的全部列;con- tains(“string”) 表示选取列名中含有 string 的所有列。 select(iris_df, Petal.Length) ## Source: local data frame [150 x 1] ## ## Petal.Length ## (dbl) 39## 1 1.4 ## 2 1.4 ## 3 1.3 ## 4 1.5 ## 5 1.4 ## 6 1.7 ## 7 1.4 ## 8 1.5 ## 9 1.4 ## 10 1.5 ## .. ... 2.2.4.5 变形 mutate 用于添加新的变量,直接使用列名进行计算得到新变量即可。可 使用刚添加的变量,也就是在一个语句中可以多个变量,而且变量可以来源 于刚新建的变量。 mutate(iris_df, double=Petal.Length*2,quadruple=double*2) ## Source: local data frame [150 x 7] ## ## Sepal.Length Sepal.Width Petal.Length Petal.Width Species double ## (dbl) (dbl) (dbl) (dbl) (fctr) (dbl) ## 1 5.1 3.5 1.4 0.2 setosa 2.8 ## 2 4.9 3.0 1.4 0.2 setosa 2.8 ## 3 4.7 3.2 1.3 0.2 setosa 2.6 ## 4 4.6 3.1 1.5 0.2 setosa 3.0 ## 5 5.0 3.6 1.4 0.2 setosa 2.8 ## 6 5.4 3.9 1.7 0.4 setosa 3.4 ## 7 4.6 3.4 1.4 0.3 setosa 2.8 ## 8 5.0 3.4 1.5 0.2 setosa 3.0 ## 9 4.4 2.9 1.4 0.2 setosa 2.8 ## 10 4.9 3.1 1.5 0.1 setosa 3.0 ## .. ... ... ... ... ... ... 40## Variables not shown: quadruple (dbl) 2.2.4.6 分类汇总 summarise 可以用于分类汇总, 实际上它是把 data frame 依据分组依 据拆分成多个 data frame,然后对每 data frame 分别计算,类似于 ddply。 summarise 可以使用的函数有:min(x), median(x), max(x), quantile(x, p), 计算个数 n(), 计算 x 中唯一值的个数 n_distinct(), sum(x), mean(x),sum(x > 10), mean(x > 10),sd(x), var(x), iqr(x), mad(x) group <- group_by(iris_df, Species) # 分组依据 summarise(group, Speciessum = sum(Sepal.Length), Speciesmean=mean(Petal.Length, na.rm = TRUE)) # 分组求和 ## Speciessum Speciesmean ## 1 876 3.8 2.2.4.7 管道操作 %>% 与 pipeR 和 magrittr 包中%>% 操作符一样,用来将上一步产生 的对象管道输出为下一步调用的函数的第一个参数。 iris_df %>% group_by(Species) %>% summarise(total = sum(Sepal.Length)) %>% arrange(desc(total)) %>%head(5) ## total ## 1 876 2.2.4.8 变量查重 通常用 select 指定需要查重的变量,distinct 返回没有重复的数据。 #Sepal.Length,Species 这两列中没有重复的数据 distinct(select(iris_df, Sepal.Length,Species)) ## Source: local data frame [57 x 2] ## 41## Sepal.Length Species ## (dbl) (fctr) ## 1 5.1 setosa ## 2 4.9 setosa ## 3 4.7 setosa ## 4 4.6 setosa ## 5 5.0 setosa ## 6 5.4 setosa ## 7 4.4 setosa ## 8 4.8 setosa ## 9 4.3 setosa ## 10 5.8 setosa ## .. ... ... 2.2.4.9 随机抽样 使用 sample_n 和 sample_frac 从数据框中随机的返回一些行,sam- ple_n 按指定的行数返回,sample_frac 按指定的比例返回。 sample_n(iris, 10)# 返回 10 行 ## Sepal.Length Sepal.Width Petal.Length Petal.Width Species ## 14 4.3 3.0 1.1 0.1 setosa ## 108 7.3 2.9 6.3 1.8 virginica ## 81 5.5 2.4 3.8 1.1 versicolor ## 17 5.4 3.9 1.3 0.4 setosa ## 70 5.6 2.5 3.9 1.1 versicolor ## 130 7.2 3.0 5.8 1.6 virginica ## 42 4.5 2.3 1.3 0.3 setosa ## 118 7.7 3.8 6.7 2.2 virginica ## 96 5.7 3.0 4.2 1.2 versicolor ## 36 5.0 3.2 1.2 0.2 setosa sample_frac(iris, 0.01)# 返回总行数的 0.01 倍 ## Sepal.Length Sepal.Width Petal.Length Petal.Width Species 42## 116 6.4 3.2 5.3 2.3 virginica ## 13 4.8 3.0 1.4 0.1 setosa 2.2.5 长宽格式数据转换 在 wide format 中,每一个样本点 (subject) 自成一行,这一行内记录 了这个样本点的所有信息。典型的宽格式数据如下: data_wide <- read.table(header=TRUE, text=' subject sex control cond1 cond2 1 M 7.9 12.3 10.7 2 F 6.3 10.6 11.1 3 F 9.5 13.1 13.8 4 M 11.5 13.4 12.9 ') data_wide ## subject sex control cond1 cond2 ## 1 1 M 7.9 12 11 ## 2 2 F 6.3 11 11 ## 3 3 F 9.5 13 14 ## 4 4 M 11.5 13 13 long format 把 wide format 中的某几个 numerical variables 变成了一 个 factor variable 之下的 levels,而这几个 numerical variables 的取值都被 集中在了一个变量之下。reshape2 包中 melt 函数把 wide format 变成 long format。 data_long <- melt(data_wide, id.vars = c('subject','sex'), #ID variables 是指将被保存在 long format 中的变量, 它起到指示样本点的作用 variable.name = 'condition', value.name = 'measurement') data_long ## subject sex condition measurement 43## 1 1 M control 7.9 ## 2 2 F control 6.3 ## 3 3 F control 9.5 ## 4 4 M control 11.5 ## 5 1 M cond1 12.3 ## 6 2 F cond1 10.6 ## 7 3 F cond1 13.1 ## 8 4 M cond1 13.4 ## 9 1 M cond2 10.7 ## 10 2 F cond2 11.1 ## 11 3 F cond2 13.8 ## 12 4 M cond2 12.9 在 long format 中,每个样本点被拆成了三个行,两个新的变量出现。第 一个新变量是一个 factor variable,fator levels 是 wide format 中的三个变 量。第二个新变量是一个 numeric variable,记录的数值对应于 wide format 中该样本点在 control, cond1, cond2 三列的取值。除了 id.variable 之外,其 他变量都被变成了 long format 的形式, 数据的长短是相对的,如果把没有 转换的 sex 变量转换掉,数据将变得更长。 melt(data_wide, id.vars = 'subject') ## Warning: attributes are not identical across measure variables; they will ## be dropped ## subject variable value ## 1 1 sex M ## 2 2 sex F ## 3 3 sex F ## 4 4 sex M ## 5 1 control 7.9 ## 6 2 control 6.3 ## 7 3 control 9.5 ## 8 4 control 11.5 ## 9 1 cond1 12.3 44## 10 2 cond1 10.6 ## 11 3 cond1 13.1 ## 12 4 cond1 13.4 ## 13 1 cond2 10.7 ## 14 2 cond2 11.1 ## 15 3 cond2 13.8 ## 16 4 cond2 12.9 Wide format 转换为 long format 时,最极端的情况是所有变量都转换 掉 melt(data_wide, id.vars = NULL) ## Warning: attributes are not identical across measure variables; they will ## be dropped ## variable value ## 1 subject 1 ## 2 subject 2 ## 3 subject 3 ## 4 subject 4 ## 5 sex M ## 6 sex F ## 7 sex F ## 8 sex M ## 9 control 7.9 ## 10 control 6.3 ## 11 control 9.5 ## 12 control 11.5 ## 13 cond1 12.3 ## 14 cond1 10.6 ## 15 cond1 13.1 ## 16 cond1 13.4 ## 17 cond2 10.7 ## 18 cond2 11.1 45## 19 cond2 13.8 ## 20 cond2 12.9 reshape2 包中 Cast 函数把 long format 变成 wide format 的函数,dcast 针对 data.frame,acast 针对的是 array 或 matrices。dcast 中需要一个 for- mular 来说明转换的形式,formular 的左边是 id variables,右边是一个 factor variables,它的 factor levels 将会在 wide format 中成为新的 variables,这 些 variables 的取值用 value.var 来指定,最后得到的 wide format 如下: data.wide <- dcast(data_long, subject + sex ~ condition, value.var = "measurement") data.wide ## subject sex control cond1 cond2 ## 1 1 M 7.9 12 11 ## 2 2 F 6.3 11 11 ## 3 3 F 9.5 13 14 ## 4 4 M 11.5 13 13 2.2.6 分类汇总 在比较多组个体或观测时,关注的焦点经常是各组的描述性统计信息, 而不是整体的描述性统计信息时,可以使用 aggregate() 分组获取描述性统 计量。例 epicalc 中 HW93 数据集是 1993 年泰国南部钩虫感染的调查资料, 其中 intense 变量表示感染的严重程度为有序多分类变量,egp 为感染的数 量,shoes 表示是否穿鞋,agegr 是年龄分组, 需要计算每个年龄的构虫平均 感染钩虫的数量。使用 aggregate() 分组获取描述性统计量 data(HW93,package = "epicalc") aggregate(HW93$epg,by=list(epg=HW93$agegr),mean) ## epg mean.HW93$epg ## 1 <15 yrs 1087 ## 2 15-59 yrs 908 ## 3 60+ yrs 3094 注意 list(epg=HW93age)list(HW93age),则 age 列将被标注为 Group.1 而不是 age。如果有多个分组变量,可以使用 by=list(name1=groupvar1, 46name2=groupvar2, … , groupvarN) 这样的语句。aggregate() 仅允许在每次 调用中使用平均数、标准差这样的单返回值函数。doBy 包和 psych 包也提供 了分组计算描述性统计量的函数,doBy 包中 summaryBy() 函数的使用格式 为:summaryBy(formula,data=dataframe,FUN=function) 其中的 formula 接受以下的格式:var1+var2+…+varNgrounpvar1+goupvar2+…+groupvarN, 在 左侧 的变量是需要分析的数值型变量,而右侧的变量是类别型的分组变量。func- tion 可为任何内建或用户自编的 R 函数。psych 包中的 describe.by() 函数 可计算和 describe 相同的描述性统计量,只是按照一个或多个分组变量分 层,使用 psych 包中的 describe.by() 和使用 doBy 包中的 summaryBy() 分 组计算概述统计量如下,describe.by() 函数不允许指定任意函数,所以它 的使用范围较窄。若存在一个以上的分组变量,你可以使用 list(groupvar1, groupvar2, … , groupvarN) 来表示它们。但这仅在分组变量交叉后不出现空 白单元时有效。 summaryBy(epg~agegr,data=HW93,FUN=max) ## agegr epg.max ## 1 <15 yrs 39123 ## 2 15-59 yrs 13223 ## 3 60+ yrs 24242 describe.by(HW93$epg,HW93$agegr) ## Warning: describe.by is deprecated. Please use the describeBy function ## group: <15 yrs ## vars n mean sd median trimmed mad min max range skew kurtosis se ## 1 1 259 1087 3279 92 374 136 0 39123 39123 7.3 72 204 ## -------------------------------------------------------- ## group: 15-59 yrs ## vars n mean sd median trimmed mad min max range skew kurtosis se ## 1 1 331 908 1670 247 506 366 0 13223 13223 3.4 15 92 ## -------------------------------------------------------- ## group: 60+ yrs ## vars n mean sd median trimmed mad min max range skew kurtosis se 47## 1 1 47 3094 6055 690 1504 1023 0 24242 24242 2.6 5.4 883 需要使用复杂函数则需要 plyr 包中的 *ply 族函数。该函数将这类任 务以 “分割-应用-结合” 这种三步方式进行处理:通过一种或多种 factor 将数据集进行分割,而后应用某项函数,最后将结果整合回数据集当中。 Plyr 包中囊括了一整套 “ply” 函数,其第一个字母表示输入的类型,第 二个字母表示输出的类型,输入:array,dataframe,list 三种格式,输出: ar- ray,dataframe,list,discareded 四种格式。plyr 包中的 ddply() 可以得到相同 结果。summarize 不会提供来自原始数据框中其它列中的任何信息,如果需 要列出其它 column 数据,则可以把 “summarize” 替换为 “transform”,且 允许一次应用多个函数。 ddply(.data = HW93,.(agegr),summarize,mean=mean(epg),max=max(epg),min=min(epg)) rate <- function(x){ return(sum(x,na.rm = T)/length(x)) } ddply(.data = HW93,.(agegr),.fun = function(x){rate(x$epg)}) 2.3 频数表和列联表 table(var1, var2, …, varN) 使用 N 个类别型变量(因子)创建一个 N 维列联表。xtabs(formula, data) 根据一个公式和一个矩阵或数据框创建一 个 N 维列联表。prop.table(table, margins) 依 margins 定义的边际列表将 表中条目表示为分数形式。margin.table(table, margins) 依 margins 定义的 边际列表计算表中条目的和 addmargins(table, margins) 将概述边 margins (默认是求和结果)放入表中。ftable(table) 创建一个紧凑的 “平铺” 式列联 表 2.3.1 一维列联表 data(Arthritis,package = "vcd") pander(head(Arthritis)) 48ID Treatment Sex Age Improved 57 Treated Male 27 Some 46 Treated Male 29 None 77 Treated Male 30 None 17 Treated Male 32 Marked 36 Treated Male 46 Marked 23 Treated Male 58 Marked mytable<-with(Arthritis,table(Improved)) mytable ## Improved ## None Some Marked ## 42 14 28 可以用 prop.table() 将这些频数转化为比例值 prop.table(mytable) ## Improved ## None Some Marked ## 0.50 0.17 0.33 2.3.2 二维列联表 对于二维列联表,table() 函数的使用格式为:table(A,B), 其中的 A 是 行变量,B 是列变量。xtabs() 函数还可使用公式风格的输入创建列联表,格 49式为:xtabs(~A+B,data=mydata),其中的 mydata 是一个矩阵或数据框, 要进行交叉分类的变量应出现在公式的右侧(即 ~ 符号的右方),以 + 作 为分隔符。若某个变量写在公式的左侧,则其为一个频数向量(在数据已经 被表格化时很有用)。 mytable<-xtabs(~Treatment+Improved,data=Arthritis) mytable ## Improved ## Treatment None Some Marked ## Placebo 29 7 7 ## Treated 13 7 21 可以使用 margin.table() 和 prop.table() 函数分别生成边际频数 (行和) 和比例 (行比)。 margin.table(mytable,1) ## Treatment ## Placebo Treated ## 43 41 prop.table(mytable,1) ## Improved ## Treatment None Some Marked ## Placebo 0.67 0.16 0.16 ## Treated 0.32 0.17 0.51 列和与列比例可以这样计算 margin.table(mytable,2) ## Improved ## None Some Marked ## 42 14 28 50prop.table(mytable,2) ## Improved ## Treatment None Some Marked ## Placebo 0.69 0.50 0.25 ## Treated 0.31 0.50 0.75 各单元格所占比例可用如下语句获取 prop.table(mytable) ## Improved ## Treatment None Some Marked ## Placebo 0.345 0.083 0.083 ## Treated 0.155 0.083 0.250 可以使用 addmargins() 函数为这些表格添加边际和 addmargins(mytable) ## Improved ## Treatment None Some Marked Sum ## Placebo 29 7 7 43 ## Treated 13 7 21 41 ## Sum 42 14 28 84 addmargins(prop.table(mytable)) ## Improved ## Treatment None Some Marked Sum ## Placebo 0.345 0.083 0.083 0.512 ## Treated 0.155 0.083 0.250 0.488 ## Sum 0.500 0.167 0.333 1.000 在使用 addmargins() 时,默认是表中所有的变量创建边际和 51addmargins(prop.table(mytable,1),2) ## Improved ## Treatment None Some Marked Sum ## Placebo 0.67 0.16 0.16 1.00 ## Treated 0.32 0.17 0.51 1.00 注意 table() 函数默认忽略缺失值(NA)。要在频数统计中将 NA 视为 一个有效的类别,请设定参数 useNA=“ifany”。 table(Arthritis$Treatment,Arthritis$Improved,useNA = "ifany") ## ## None Some Marked ## Placebo 29 7 7 ## Treated 13 7 21 使用 gmodels 包中的 CrossTable() 函数生成二维列联表 CrossTable(Arthritis$Treatment,Arthritis$Improved) ## ## ## Cell Contents ## |-------------------------| ## | N | ## | Chi-square contribution | ## | N / Row Total | ## | N / Col Total | ## | N / Table Total | ## |-------------------------| ## ## ## Total Observations in Table: 84 ## 52## ## | Arthritis$Improved ## Arthritis$Treatment | None | Some | Marked | Row Total | ## --------------------|-----------|-----------|-----------|-----------| ## Placebo | 29 | 7 | 7 | 43 | ## | 2.616 | 0.004 | 3.752 | | ## | 0.674 | 0.163 | 0.163 | 0.512 | ## | 0.690 | 0.500 | 0.250 | | ## | 0.345 | 0.083 | 0.083 | | ## --------------------|-----------|-----------|-----------|-----------| ## Treated | 13 | 7 | 21 | 41 | ## | 2.744 | 0.004 | 3.935 | | ## | 0.317 | 0.171 | 0.512 | 0.488 | ## | 0.310 | 0.500 | 0.750 | | ## | 0.155 | 0.083 | 0.250 | | ## --------------------|-----------|-----------|-----------|-----------| ## Column Total | 42 | 14 | 28 | 84 | ## | 0.500 | 0.167 | 0.333 | | ## --------------------|-----------|-----------|-----------|-----------| ## ## CrossTable() 函数有很多选项计算(行、列、单元格)的百分比;指定 小数位数;进行卡方、Fisher 和 McNemar 独立性检验;计算期望和(皮尔 逊、标准化、调整的标准化)残差;将缺失值作为一种有效值;进行行和列 标题的标注; 2.3.3 多维列联表 table() 和 xtabs() 都可以基于三个或更多的类别型变量生成多维列联 margin.table()、prop.table() 和 addmargins() 函数也可以推广到多维的情 况。另外,ftable() 函数可以以一种紧凑而吸引人的方式输出多维列联表 53mytable<-xtabs(~Treatment+Sex+Improved,data=Arthritis) mytable ## , , Improved = None ## ## Sex ## Treatment Female Male ## Placebo 19 10 ## Treated 6 7 ## ## , , Improved = Some ## ## Sex ## Treatment Female Male ## Placebo 7 0 ## Treated 5 2 ## ## , , Improved = Marked ## ## Sex ## Treatment Female Male ## Placebo 6 1 ## Treated 16 5 ftable(mytable) ## Improved None Some Marked ## Treatment Sex ## Placebo Female 19 7 6 ## Male 10 0 1 ## Treated Female 6 5 16 ## Male 7 2 5 54# 治疗情况(Treatment) × 改善情况(Improved)的边际频数 margin.table(mytable,c(1,3)) ## Improved ## Treatment None Some Marked ## Placebo 29 7 7 ## Treated 13 7 21 553 常用数据分布 如果给定一种概率分布,通常会有四类计算问题:计算其概率密度 den- sity(d); 计算其概率分布 probability(p); 计算其百分位数 quantile(q); 随机 数模拟 random(r),R 中常见的函数、分布和参数如下 R funciton Distribution Parameters beta beta shape1,shape2 binom binomial sample,size,probability cauchy Cauchy location,scale exp exponential rate(optional) chisq Chi-squared degrees of freedom f Fisher’s F df1,df2 gamma gamma shape geom geometric probability hyper hypergeometric m,n,k lnorm lognormal mean,standard deviation logis logistic location,scale nbinom negative binomial size,probability norm normal mean,standard deviation pois Poisson mean signrank Wilcoxon signed ran k sample size n t Student’s t degree of freedom unif uniform minimum,maximum(opt.) weibull Weibull shape wilcox Wilcoxon rank sum m,n 3.1 正态分布 (Normal distribution) 又名高斯分布 (Gaussian distribution),是一个在数学、物理及工程等 领域都非常重要的概率分布,在统计学的许多方面有着重大的影响力。若随 机变量 X 服从一个数学期望为 、方差为 σ2 的正态分布,记为 N(uσ2)。其 概率密度函数为正态分布的期望值 u 决定了其位置,其标准差 σ2 决定了分 布的幅度。因其曲线呈钟形,因此人们又经常称之为钟形曲线。我们通常所 56说的标准正态分布是 u = 0,σ = 1 的正态分布。概率密度函数 f(x) = 1√ 2πσ e− (x−µ)2 2σ2 fun1 <- function(x){ y <- dnorm(x,mean = 0,sd = 1) return(y) } fun2 <- function(x){ y <- dnorm(x,mean = 0,sd = 0.5) return(y) } fun3 <- function(x){ y <- dnorm(x,mean = 0,sd = 2) return(y) } ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x = -5:5, g = factor(1)), fun = fun1) + stat_function(data = data.frame(x = -5:5, g = factor(2)), fun = fun2) + stat_function(data = data.frame(x = -5:5, g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The Normal Density Distribution") 累积分布函数 F(x; u, σ) = 1√ 2πσ ∫ x −∞ exp(−(t − u)2 2σ2 )dt fun1 <- function(x){ y <- pnorm(x,mean = 0,sd = 1) return(y) 570.0 0.2 0.4 0.6 0.8 −5.0 −2.5 0.0 2.5 5.0 x density g red green blue The Normal Density Distribution 图 6: } fun2 <- function(x){ y <- pnorm(x,mean = 0,sd = 0.5) return(y) } fun3 <- function(x){ y <- pnorm(x,mean = 0,sd = 2) return(y) } ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x = -5:5, g = factor(1)), fun = fun1) + stat_function(data = data.frame(x = -5:5, g = factor(2)), fun = fun2) + 58stat_function(data = data.frame(x = -5:5, g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The Normal Cumulative Distribution") 0.00 0.25 0.50 0.75 1.00 −5.0 −2.5 0.0 2.5 5.0 x density g red green blue The Normal Cumulative Distribution 分布检验 Shapiro-Wilk 正态分布检验: 用来检验是否数据符合正态分布, 类似于线性回归的方法一样,是检验其于回归曲线的残差。该方法推荐在 样本量很小的时候使用,样本在 3 到 5000 之间。该检验原假设为 H0: 数据 集符合正态分布,统计量 W 为: W = ( ∑n i=1 aix(i))2 ∑n i=1(xi − ¯x)2 统计量 W 最大值是 1,越接近 1,表示样本与正态分布匹配,p 值,如果 p-value 小于显著性水平 α(0.05),则拒绝 H0 set.seed(1) S<-rnorm(1000) shapiro.test(S) ## 59## Shapiro-Wilk normality test ## ## data: S ## W = 1, p-value = 0.7 结论:W 接近 1,p-value>0.05,不能拒绝原假设,所以数据集 S 符合 正态分布! Kolmogorov-Smirnov 连续分布检验: 检验单一样本是不是服从某一预 先假设的特定分布的方法。以样本数据的累计频数分布与特定理论分布比 较,若两者间的差距很小,则推论该样本取自某特定分布族。该检验原假设 为 H0: 数据集符合正态分布,H1: 样本所来自的总体分布不符合正态分布。 令 F0(x) 表示预先假设的理论分布,F n(x) 表示随机样本的累计概率 (频 率) 函数. 统计量 D 为:D = max|F0(x) − F n(x)| D 值越小,越接近 0,表 示样本数据越接近正态分布,p 值,如果 p-value 小于显著性水平 α(0.05),则 拒绝 H_{0} set.seed(1) S<-rnorm(1000) ks.test(S, "pnorm") ## ## One-sample Kolmogorov-Smirnov test ## ## data: S ## D = 0.02, p-value = 0.8 ## alternative hypothesis: two-sided 结论:D 值很小, p-value>0.05,不能拒绝原假设,所以数据集 S 符合 正态分布! 3.2 指数分布 指数分布 (Exponential distribution) 用来表示独立随机事件发生的时 间间隔,比如旅客进机场的时间间隔、中文维基百科新条目出现的时间间隔 等等。许多电子产品的寿命分布一般服从指数分布。有的系统的寿命分布也 60可用指数分布来近似。它在可靠性研究中是最常用的一种分布形式。指数分 布是伽玛分布和 weibull 分布的特殊情况,产品的失效是偶然失效时,其寿 命服从指数分布。指数分布可以看作当 weibull 分布中的形状系数等于 1 的 特殊分布,指数分布的失效率是与时间 t 无关的常数,所以分布函数简单。 概率密度函数 f(x; λ) = { λe−λx, x >= 0 0, x < 0 其中 λ> 0 是分布的一个参数,常被称为率参数(rate parameter)。即每单 位时间发生该事件的次数。指数分布的区间是 [0, ∞)。如果一个随机变量 X 呈指数分布,则可以写作:X ~ Exponential(λ)。 fun1 <- function(x){ y <- dexp(x,0.5) return(y) } fun2 <- function(x){ y <- dexp(x,1) return(y) } fun3 <- function(x){ y <- dexp(x,2) return(y) } ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x=seq(0,3,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(0,3,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(0,3,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), 61labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The Exponential Density Distribution") 0.0 0.5 1.0 1.5 2.0 0 1 2 3 x density g red green blue The Exponential Density Distribution 累积分布函数 F(x; λ) = { 1 − eλx, x >= 0 0, x < 0 fun1 <- function(x){ y <- pexp(x,0.5) return(y) } fun2 <- function(x){ y <- pexp(x,1) return(y) } fun3 <- function(x){ 62y <- pexp(x,2) return(y) } ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x=seq(0,3,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(0,3,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(0,3,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The Exponential Cumulative Distribution Function") 0.00 0.25 0.50 0.75 1.00 0 1 2 3 x density g red green blue The Exponential Cumulative Distribution Function 分布检验 Kolmogorov-Smirnov 连续分布检验: 检验单一样本是不是服从某 一预先假设的特定分布的方法。以样本数据的累计频数分布与特定理论分 布比较,若两者间的差距很小,则推论该样本取自某特定分布族。该检验 63原假设为 H0: 数据集符合指数分布,H1: 样本所来自的总体分布不符合指 数分布。令 F0(x) 表示预先假设的理论分布,F n(x) 表示随机样本的累计 概率 (频率) 函数. 统计量 D 为:D = max|F0(x) − F n(x)| D 值越小,越 接近 0,表示样本数据越接近指数分布,p 值,如果 p-value 小于显著性水平 α(0.05),则拒绝 H0 set.seed(1) S<-rexp(1000) ks.test(S, "pexp") ## ## One-sample Kolmogorov-Smirnov test ## ## data: S ## D = 0.04, p-value = 0.1 ## alternative hypothesis: two-sided 结论:D 值很小, p-value>0.05,不能拒绝原假设,所以数据集 S 符合 指数分布! 3.3 ￿(伽玛) 分布 伽玛分布 (Gamma) 是著名的皮尔逊概率分布函数簇中的重要一员,称 为皮尔逊 ￿ 型分布。它的曲线有一个峰,但左右不对称。伽玛分布中的参数 ￿,称为形状参数,￿ 称为尺度参数。 Ga(x) = 1 βαΓ(α)xα−1e− x β , x > 0 伽玛函数为: Γ(x) = ∫ ∞ 0 tx−1e−tdt 伽玛函数是阶乘在实数上的泛化。概率密度函数 f(x) = xk−1 exp(−x/θ) Γ(k)θk 64fun1 <- function(x){ y <- dgamma(x,1,2) return(y) } fun2 <- function(x){ y <- dgamma(x,2,2) return(y) } fun3 <- function(x){ y <- dgamma(x,5,1) return(y) } ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The Gamma Density Distribution") 650.0 0.5 1.0 1.5 2.0 0.0 2.5 5.0 7.5 10.0 x density g red green blue The Gamma Density Distribution 累积分布函数 f(x) = γ(k, x/θ) Γ(k) fun1 <- function(x){ y <- pgamma(x,1,2) return(y) } fun2 <- function(x){ y <- pgamma(x,2,2) return(y) } fun3 <- function(x){ y <- pgamma(x,5,1) return(y) } ggplot(NULL, aes(x=x, colour = g)) + 66stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The Gamma Cumulative Distribution Function") 0.00 0.25 0.50 0.75 1.00 0.0 2.5 5.0 7.5 10.0 x density g red green blue The Gamma Cumulative Distribution Function 分布检验 Kolmogorov-Smirnov 连续分布检验: 检验单一样本是不是服从某 一预先假设的特定分布的方法。以样本数据的累计频数分布与特定理论分 布比较,若两者间的差距很小,则推论该样本取自某特定分布族。该检验原 假设为 H0: 数据集符合指数分布,H1: 样本所来自的总体分布不符合指数 分布。令 F0(x) 表示预先假设的理论分布,F n(x) 表示随机样本的累计概 率 (频率) 函数. 统计量 D 为:D = max|F0(x) − F n(x)| D 值越小,越接近 0,表示样本数据越接近 ￿(伽玛) 分布,p 值,如果 p-value 小于显著性水平 α(0.05),则拒绝 H0 67set.seed(1) S<-rgamma(1000,1) ks.test(S, "pgamma", 1) ## ## One-sample Kolmogorov-Smirnov test ## ## data: S ## D = 0.04, p-value = 0.1 ## alternative hypothesis: two-sided 结论:D 值很小, p-value>0.05,不能拒绝原假设,所以数据集 S 符合 shape=1 伽玛分布! ks.test(S, "pgamma", 2) ## ## One-sample Kolmogorov-Smirnov test ## ## data: S ## D = 0.4, p-value <2e-16 ## alternative hypothesis: two-sided 结论:D 值不够小, p-value<0.05,拒绝原假设,所以数据集 S 符合 shape=2 伽玛分布! 3.4 weibull 分布 weibull(韦伯) 分布,又称韦氏分布或威布尔分布,是可靠性分析和寿 命检验的理论基础。Weibull 分布能被应用于很多形式,分布由形状、尺度 (范围)和位置三个参数决定。其中形状参数是最重要的参数,决定分布密 度曲线的基本形状,尺度参数起放大或缩小曲线的作用,但不影响分布的形 状。Weibull 分布通常用在故障分析领域 ( field of failure analysis) 中;尤 其是它可以模拟 (mimic) 故障率 (failture rate) 持续 ( over time) 变化的分 布。故障率为:一直为常量 (constant over time),那么 α = 1,暗示在随机 68事件中发生一直减少 (decreases over time),那么 α < 1,暗示 “早期失效 (infant mortality)” 一直增加 (increases over time),那么 α > 1,暗示 “耗 尽 (wear out)” 随着时间的推进,失败的可能性变大概率密度函数 f(x; λ, k) = { k/λ(x/λ)k−1e−(x/λ)k , x ≥ 0 0, x < 0 fun1 <- function(x){ y <- dweibull(x,0.5) return(y) } fun2 <- function(x){ y <- dweibull(x,1) return(y) } fun3 <- function(x){ y <- dweibull(x,5) return(y) } ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x=seq(0,2.5,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(0,2.5,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(0,2.5,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The Weibull Density Distribution") 690 1 2 0.0 0.5 1.0 1.5 2.0 2.5 x density g red green blue The Weibull Density Distribution 累积分布函数 F(x) = 1 − e−(x/λ)k fun1 <- function(x){ y <- pweibull(x,0.5) return(y) } fun2 <- function(x){ y <- pweibull(x,1) return(y) } fun3 <- function(x){ y <- pweibull(x,5) return(y) } ggplot(NULL, aes(x=x, colour = g)) + 70stat_function(data = data.frame(x=seq(0,2.5,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(0,2.5,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(0,2.5,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The Weibull Cumulative Distribution Function") 0.00 0.25 0.50 0.75 1.00 0.0 0.5 1.0 1.5 2.0 2.5 x density g red green blue The Weibull Cumulative Distribution Function 分布检验 Kolmogorov-Smirnov 连续分布检验: 检验单一样本是不是服从某 一预先假设的特定分布的方法。以样本数据的累计频数分布与特定理论分 布比较,若两者间的差距很小,则推论该样本取自某特定分布族。该检验原 假设为 H0: 数据集符合指数分布,H1: 样本所来自的总体分布不符合指数 分布。令 F0(x) 表示预先假设的理论分布,F n(x) 表示随机样本的累计概 率 (频率) 函数. 统计量 D 为:D = max|F0(x) − F n(x)| D 值越小,越接近 0,表示样本数据越接近 weibull 分布,p 值,如果 p-value 小于显著性水平 α(0.05),则拒绝 H0 71set.seed(1) S<-rweibull(1000,1) ks.test(S, "pweibull",1) ## ## One-sample Kolmogorov-Smirnov test ## ## data: S ## D = 0.02, p-value = 0.6 ## alternative hypothesis: two-sided 结论:D 值很小, p-value>0.05,不能拒绝原假设,所以数据集 S 符合 shape=1 的 weibull 分布! 3.5 F 分布 F-分布(F-distribution)是一种连续概率分布,被广泛应用于似然比率 检验,特别是 ANOVA 中。F 分布定义为:设 X、Y 为两个独立的随机变 量,X 服从自由度为 k1 的卡方分布,Y 服从自由度为 k2 的卡方分布,这 2 个独立的卡方分布被各自的自由度除以后的比率这一统计量的分布。即: 上式 F 服从第一自由度为 k1,第二自由度为 k2 的 F 分布。F 分布是一种 非对称分布它有两个自由度,即 n1 -1 和 n2-1,相应的分布记为 F(n1 –1, n2-1),n1 –1 通常称为分子自由度,n2-1 通常称为分母自由度 F 分布是一 个以自由度 n1 –1 和 n2-1 为参数的分布族,不同的自由度决定了 F 分布的 形状 F 分布的倒数性质:F α, df1, df2 = 1/F1 − α, df1, df2[1] 概率密度函 数 f(x) = √ d1xd1d2d2 (d1x+d2)d1+d2 xB( d1 2 , d2 2 ) B 是 Beta 函数 (beta function) fun1 <- function(x){ y <- -df(x,1,1,0) return(y) } 72fun2 <- function(x){ y <- -df(x,1,1,2) return(y) } fun3 <- function(x){ y <- -df(x,2,2,2) return(y) } ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x=seq(0,5,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(0,5,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(0,5,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The F Density Distribution") 73−1.0 −0.5 0.0 0 1 2 3 4 5 x density g red green blue The F Density Distribution 累积分布函数 F(x) = I d1x d1x + d2(d1/2, d2/2) I 是不完全 Beta 函数 fun1 <- function(x){ y <- -pf(x,1,1,0) return(y) } fun2 <- function(x){ y <- -pf(x,1,1,2) return(y) } fun3 <- function(x){ y <- -pf(x,2,2,2) return(y) } 74ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x=seq(0,5,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(0,5,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(0,5,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The F Cumulative Distribution Function") −0.6 −0.4 −0.2 0.0 0 1 2 3 4 5 x density g red green blue The F Cumulative Distribution Function 分布检验 Kolmogorov-Smirnov 连续分布检验: 检验单一样本是不是服从某 一预先假设的特定分布的方法。以样本数据的累计频数分布与特定理论分 布比较,若两者间的差距很小,则推论该样本取自某特定分布族。该检验 原假设为 H0: 数据集符合指数分布,H1: 样本所来自的总体分布不符合指 数分布。令 F0(x) 表示预先假设的理论分布,F n(x) 表示随机样本的累计 概率 (频率) 函数. 统计量 D 为:D = max|F0(x) − F n(x)| D 值越小,越 75接近 0,表示样本数据越接近 F 分布,p 值,如果 p-value 小于显著性水平 α(0.05),则拒绝 H0 set.seed(1) S<-rf(1000,1,1,2) ks.test(S, "pf", 1,1,2) ## ## One-sample Kolmogorov-Smirnov test ## ## data: S ## D = 0.01, p-value = 1 ## alternative hypothesis: two-sided 3.6 T 分布 学生 t-分布(Student’s t-distribution),可简称为 t 分布。应用在估计 呈正态分布的总体的平均数。它是对两个样本均值差异进行显著性测试的 学生 t 检定的基础。学生 t 检定改进了 Z 检定(Z-test),因为 Z 检定以总 体标准差已知为前提。虽然在样本数量大(超过 30 个)时,可以应用 Z 检 定来求得近似值,但 Z 检定用在小样本会产生很大的误差,因此必须改用 学生 t 检定以求准确。在总体标准差未知的情况下,不论样本数量大或小皆 可应用学生 t 检定。在待比较的数据有三组以上时,因为误差无法压低,此 时可以用变异数分析(ANOVA)代替学生 t 检定。概率密度函数 f(x) = Γ((ν + 1)/2)√ νπΓ(ν/2)(1 + x2/ν)(v1+1)/2 v 等于 n − 1。T 的分布称为 t-分布。参数 ν 一般被称为自由度。γ 是伽玛 函数。 fun1 <- function(x){ y <-dt(x,1,0) return(y) } 76fun2 <- function(x){ y <-dt(x,5,0) return(y) } fun3 <- function(x){ y <-dt(x,5,2) return(y) } ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x=seq(-5,5,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(-5,5,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(-5,5,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The T Density Distribution") 770.0 0.1 0.2 0.3 −5.0 −2.5 0.0 2.5 5.0 x density g red green blue The T Density Distribution 累积分布函数 f(x) = 1 2 + xΓ((ν + 1)/2)2F1( 1 2 ,(ν + 1)/2; 3 2 ; − x2 v )√ νπΓ(ν/2) ν 等于 n − 1。T 的分布称为 t-分布。参数 ν 一般被称为自由度。γ 是伽玛 函数。 fun1 <- function(x){ y <-pt(x,1,0) return(y) } fun2 <- function(x){ y <-pt(x,5,0) return(y) } fun3 <- function(x){ y <-pt(x,5,2) 78return(y) } ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x=seq(-5,5,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(-5,5,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(-5,5,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The T Cumulative Distribution Function") 0.00 0.25 0.50 0.75 1.00 −5.0 −2.5 0.0 2.5 5.0 x density g red green blue The T Cumulative Distribution Function 分布检验 Kolmogorov-Smirnov 连续分布检验: 检验单一样本是不是服从某 一预先假设的特定分布的方法。以样本数据的累计频数分布与特定理论分 布比较,若两者间的差距很小,则推论该样本取自某特定分布族。该检验 原假设为 H0: 数据集符合指数分布,H1: 样本所来自的总体分布不符合指 79数分布。令 F0(x) 表示预先假设的理论分布,F n(x) 表示随机样本的累计 概率 (频率) 函数. 统计量 D 为:D = max|F0(x) − F n(x)| D 值越小,越 接近 0,表示样本数据越接近 T 分布,p 值,如果 p-value 小于显著性水平 α(0.05),则拒绝 H0 set.seed(1) S<-rt(1000, 1,2) ks.test(S, "pt", 1, 2) ## ## One-sample Kolmogorov-Smirnov test ## ## data: S ## D = 0.03, p-value = 0.5 ## alternative hypothesis: two-sided 结论:D 值很小, p-value>0.05,不能拒绝原假设,所以数据集 S 符合 df1=1, ncp=2 的 T 分布! 3.7 ￿(贝塔 Beta) 分布 贝塔分布 (Beta Distribution) 是指一组定义在 (0,1) 区间的连续概率分 布,Beta 分布有 ￿ 和 ￿ 两个参数 α,β>0,其中 α 为成功次数加 1,β 为失败 次数加 1。Beta 分布的一个重要应该是作为伯努利分布和二项式分布的共 轭先验分布出现,在机器学习和数理统计学中有重要应用。贝塔分布中的参 数可以理解为伪计数,伯努利分布的似然函数可以表示为,表示一次事件发 生的概率,它为贝塔有相同的形式,因此可以用贝塔分布作为其先验分布。 概率密度函数 f(x) = 1 B(α, β)(xα−1)(1 − x)β−1 随机变量 X 服从参数为 α, β,服从 Beta 分布 γ 是伽玛函数 fun1 <- function(x){ y <-dbeta(x,0.5,0.5) return(y) } 80fun2 <- function(x){ y <-dbeta(x,5,1) return(y) } fun3 <- function(x){ y <-dbeta(x,1,3) return(y) } ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x=seq(0,1,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(0,1,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(0,1,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The Beta Density Distribution") 810 1 2 3 4 5 0.00 0.25 0.50 0.75 1.00 x density g red green blue The Beta Density Distribution 累积分布函数 F(x; α, β) = Bx(α, β) B(α, β) = Ix(α, β) I 是正则不完全 Beta 函数 fun1 <- function(x){ y <-pbeta(x,0.5,0.5) return(y) } fun2 <- function(x){ y <-pbeta(x,5,1) return(y) } fun3 <- function(x){ y <-pbeta(x,1,3) return(y) } 82ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x=seq(0,1,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(0,1,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(0,1,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The Beta Cumulative Distribution Function") 0.00 0.25 0.50 0.75 1.00 0.00 0.25 0.50 0.75 1.00 x density g red green blue The Beta Cumulative Distribution Function 分布检验 Kolmogorov-Smirnov 连续分布检验: 检验单一样本是不是服从某 一预先假设的特定分布的方法。以样本数据的累计频数分布与特定理论分 布比较,若两者间的差距很小,则推论该样本取自某特定分布族。该检验原 假设为 H0: 数据集符合指数分布,H1: 样本所来自的总体分布不符合指数 分布。令 F0(x) 表示预先假设的理论分布,F n(x) 表示随机样本的累计概 率 (频率) 函数. 统计量 D 为:D = max|F0(x) − F n(x)| D 值越小,越接近 830,表示样本数据越接近 ￿(贝塔 Beta) 分布,p 值,如果 p-value 小于显著性 水平 α(0.05),则拒绝 H0 set.seed(1) S<-rbeta(1000,1,2) ks.test(S, "pbeta",1,2) ## ## One-sample Kolmogorov-Smirnov test ## ## data: S ## D = 0.02, p-value = 0.8 ## alternative hypothesis: two-sided 结论:D 值很小, p-value>0.05,不能拒绝原假设,所以数据集 S 符合 shape1=1, shape2=2 的 Beta 分布! 3.8 χ2(卡方) 分布 总体 X ∼ N(µ, σ2), 则样本的统计量 1 σ2 ∑n i=1(Xi − µ), 服从自由度为 n 的 χ2 分布。样本统计量 1 σ2 ∑n i=1(Xi − ¯X), 服从自由度为 n-1 的 χ2 分布。 若 n 个相互独立的随机变量 ε1, ε2, ..., εn ,均服从标准正态分布(也称独立 同分布于标准正态分布),则这 n 个服从标准正态分布的随机变量的平方和 构成一新的随机变量,其分布规律称为 χ2 分布(chi-square distribution)。 其中参数 n 称为自由度,自由度不同就是另一个 χ2 分布,正如正态分布中 均值或方差不同就是另一个正态分布一样。概率密度函数 fk(x) = (1/2)k/2 Γ(k/2) xk/2−1e−x/2 γ 是伽玛函数 fun1 <- function(x){ y <-dchisq(x,1) return(y) } 84fun2 <- function(x){ y <-dchisq(x,2) return(y) } fun3 <- function(x){ y <-dchisq(x,3) return(y) } ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The Chisq Density Distribution") 850.00 0.25 0.50 0.75 1.00 1.25 0.0 2.5 5.0 7.5 10.0 x density g red green blue The Chisq Density Distribution 累积分布函数 fk(x) = γ(k/2, x/2) Γ(k/2) γ 是伽玛函数 fun1 <- function(x){ y <-pchisq(x,1) return(y) } fun2 <- function(x){ y <-pchisq(x,2) return(y) } fun3 <- function(x){ y <-pchisq(x,3) return(y) } 86ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The Chisq Cumulative Distribution Function") 0.00 0.25 0.50 0.75 1.00 0.0 2.5 5.0 7.5 10.0 x density g red green blue The Chisq Cumulative Distribution Function 分布检验 Kolmogorov-Smirnov 连续分布检验: 检验单一样本是不是服从某 一预先假设的特定分布的方法。以样本数据的累计频数分布与特定理论分 布比较,若两者间的差距很小,则推论该样本取自某特定分布族。该检验原 假设为 H0: 数据集符合指数分布,H1: 样本所来自的总体分布不符合指数 分布。令 F0(x) 表示预先假设的理论分布,F n(x) 表示随机样本的累计概 率 (频率) 函数. 统计量 D 为:D = max|F0(x) − F n(x)| D 值越小,越接近 870,表示样本数据越接近 χ2(卡方) 分布,p 值,如果 p-value 小于显著性水平 α(0.05),则拒绝 H0 set.seed(1) S<-rchisq(1000,1) ks.test(S, "pchisq",1) ## ## One-sample Kolmogorov-Smirnov test ## ## data: S ## D = 0.03, p-value = 0.5 ## alternative hypothesis: two-sided 3.9 均匀分布 均匀分布 (Uniform distribution) 是均匀的,不偏差的一种简单的概率 分布,分为:离散型均匀分布与连续型均匀分布。概率密度函数 f(x) = { 1 b−a for a ≤ x ≤ b 0 elsewhere fun1 <- function(x){ y <-dunif(x,0,1) return(y) } fun2 <- function(x){ y <-dunif(x,0,0.5) return(y) } fun3 <- function(x){ y <-dunif(x,-3,1) return(y) 88} ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The Uniform Density Distribution") 0.0 0.5 1.0 1.5 2.0 0.0 2.5 5.0 7.5 10.0 x density g red green blue The Uniform Density Distribution 累积分布函数 F(x)    0 for x < a x−a b−a for a ≤ x < b 1 for x ≥ b 89fun1 <- function(x){ y <-punif(x,0,1) return(y) } fun2 <- function(x){ y <-punif(x,0,0.5) return(y) } fun3 <- function(x){ y <-punif(x,-3,1) return(y) } ggplot(NULL, aes(x=x, colour = g)) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(1)), fun = fun1) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(2)), fun = fun2) + stat_function(data = data.frame(x=seq(0,10,length.out=100), g = factor(3)), fun = fun3) + scale_colour_manual(values = c("red","green","blue"), labels = c("red","green","blue"))+ ylab(label = "density")+ labs(title="The Uniform Cumulative Distribution Function") 900.00 0.25 0.50 0.75 1.00 0.0 2.5 5.0 7.5 10.0 x density g red green blue The Uniform Cumulative Distribution Function 分布检验 Kolmogorov-Smirnov 连续分布检验: 检验单一样本是不是服从某 一预先假设的特定分布的方法。以样本数据的累计频数分布与特定理论分 布比较,若两者间的差距很小,则推论该样本取自某特定分布族。该检验 原假设为 H0: 数据集符合指数分布,H1: 样本所来自的总体分布不符合指 数分布。令 F0(x) 表示预先假设的理论分布,F n(x) 表示随机样本的累计 概率 (频率) 函数. 统计量 D 为:D = max|F0(x) − F n(x)| D 值越小,越 接近 0,表示样本数据越接近均匀分布,p 值,如果 p-value 小于显著性水平 α(0.05),则拒绝 H0 set.seed(1) S<-runif(1000) ks.test(S, "punif") ## ## One-sample Kolmogorov-Smirnov test ## ## data: S ## D = 0.02, p-value = 0.6 ## alternative hypothesis: two-sided 91结论:D 值很小, p-value>0.05,不能拒绝原假设,所以数据集 S 符合 均匀分布! 例某年级医学生解剖学考试成绩 X(分) 近似服从 N(65, 102),问解剖学 成绩在 85 分以上的考生的概率是多少? pnorm(85,65,10,lower.tail = F) ## [1] 0.023 #pnorm() 函数是正态分布的分布函数,用来计算对应分布下的概率 #lower.tail = F 默认为 T 计算小于 x 的概率,F 表示计算大于 x 的概率 解剖学成绩在 85 分以上的考生概率为 0.02 3.10 Poisson 分布 Poisson 分布常用于描述单位时间、单位平面或单位空间中罕见事件的 随机分布规律,Poisson 分布的均数和方差相等。概率密度函数为 f(x) = e−λλx x!, x ∈ 0, 1, 2, 3, ... ggplot(data.frame(x=c(0:10)),aes(x=x))+ stat_function(fun=dpois,colour="red",args = list(lambda=1))+ stat_function(fun=dpois,colour="green",args = list(lambda=2))+ stat_function(fun=dpois,colour="blue",args = list(lambda=3))+ ylab(label = "density")+ labs(title="The Poisson Density Distribution") 累积分布函数 f(x) = e−λ |x|∑ i=0 λi i!, x ∈ 0, 1, 2, 3, ... ggplot(data.frame(x= seq(-0.01, 5, 0.01)),aes(x=x))+ stat_function(fun=ppois,colour="red",args = list(lambda=1))+ stat_function(fun=ppois,colour="green",args = list(lambda=2))+ 920.0 0.1 0.2 0.3 0.0 2.5 5.0 7.5 10.0 x density The Poisson Density Distribution 图 7: stat_function(fun=ppois,colour="blue",args = list(lambda=3))+ ylab(label = "density")+ labs(title="The Poisson Cumulative Distribution Function") 例随机变量 X 服从参数为 3 的 Poisson 分布,求概率 P{x=6}. dpois(6,3) ## [1] 0.05 参数为 3 的 Poisson 分布在 X=6 时的概率为 0.05。 3.11 数据分布直接的关系 3.12 探索数据分布 要了解样本数据的总体分布情况,仅有特征统计量是不够的,还需要研 究数据的分布状况。经验分布函数是指根据样本构造的概率分布函数,设 930.00 0.25 0.50 0.75 1.00 0 1 2 3 4 5 x density The Poisson Cumulative Distribution Function 图 8: 图 9: 常见数据分布之间的关系 94x1, x2, ..., xn 为一组样本,定义函数 m(x) 表示样本中小于或者等于 x 的样 本个数,则称函数 F x n = m(x) n 为样本 x1, x2, ..., xn 的经验分布函数。由 Glivenko-Cantelli 定理,当样本数 组数足够大时,经验分布函数是总体分布函数的一个良好的近似。对数据分 布的探索可参考下图中的决策树 图 10: 数据分布探索决策树 例探索 fitdistrplus 中 groundbeef 的数据分布。思路:首先判断数据的 特点选择较为可能的分布,然后利用 fitdist() 获得可能分布的参数估计,再 利用 gofstat() 选择较优的分布,最后可用 ks.test() 进行验证。 data(groundbeef) serving <- groundbeef$serving fitW <- fitdist(serving, "weibull") fitg <- fitdist(serving, "gamma") fitln <- fitdist(serving, "lnorm") summary(fitW) ## Fitting of the distribution ' weibull ' by maximum likelihood ## Parameters : ## estimate Std. Error ## shape 2.2 0.1 95## scale 83.3 2.5 ## Loglikelihood: -1255 AIC: 2514 BIC: 2522 ## Correlation matrix: ## shape scale ## shape 1.00 0.32 ## scale 0.32 1.00 summary(fitg) ## Fitting of the distribution ' gamma ' by maximum likelihood ## Parameters : ## estimate Std. Error ## shape 4.008 0.3413 ## rate 0.054 0.0049 ## Loglikelihood: -1254 AIC: 2511 BIC: 2518 ## Correlation matrix: ## shape rate ## shape 1.00 0.94 ## rate 0.94 1.00 summary(fitln) ## Fitting of the distribution ' lnorm ' by maximum likelihood ## Parameters : ## estimate Std. Error ## meanlog 4.17 0.034 ## sdlog 0.54 0.024 ## Loglikelihood: -1261 AIC: 2527 BIC: 2534 ## Correlation matrix: ## meanlog sdlog ## meanlog 1 0 ## sdlog 0 1 96#plot(fitg, demp = TRUE) #plot(fitg, histo = FALSE, demp = TRUE) cdfcomp(list(fitW, fitg, fitln), legendtext=c("Weibull","gamma","lognormal")) 50 100 150 200 0.0 0.2 0.4 0.6 0.8 1.0 Empirical and theoretical CDFs data CDF Weibull gamma lognormal 图 11: denscomp(list(fitW, fitg, fitln), legendtext=c("Weibull","gamma","lognormal")) qqcomp(list(fitW, fitg, fitln), legendtext=c("Weibull","gamma","lognormal")) ppcomp(list(fitW, fitg, fitln), legendtext=c("Weibull","gamma","lognormal")) 97Histogram and theoretical densities data Density 50 100 150 200 0.000 0.004 0.008 0.012 Weibull gamma lognormal 图 12: 0 50 100 150 200 250 300 50 100 150 200 Q−Q plot Theoretical quantiles Empirical quantiles Weibull gamma lognormal 图 13: 980.0 0.2 0.4 0.6 0.8 1.0 0.0 0.2 0.4 0.6 0.8 1.0 P−P plot Theoretical probabilities Empirical probabilities Weibull gamma lognormal 图 14: gofstat(list(fitW, fitg, fitln), fitnames=c("Weibull","gamma","lognormal")) ## Goodness-of-fit statistics ## Weibull gamma lognormal ## Kolmogorov-Smirnov statistic 0.14 0.13 0.15 ## Cramer-von Mises statistic 0.68 0.69 0.83 ## Anderson-Darling statistic 3.57 3.57 4.54 ## ## Goodness-of-fit criteria ## Weibull gamma lognormal ## Aikake's Information Criterion 2514 2511 2527 ## Bayesian Information Criterion 2522 2518 2534 选择 AIC 和 BIC 值较小的 gamma 分布 994 参数估计 参数估计 (Parameter Estimation) 是指用样本指标 (称为统计量) 估计 总体指标 (称为参数)。参数估计有点估计 (point estimation) 和区间估计 (interval estimation) 两种。 4.1 点估计 设总体 X 的分布函数 F(x; θ) 形式已知,其中 θ 是待估计的参数,点 估计就是利用样本 (x1, x2, ..., xn),构造一个统计量 ˆθ = ˆθ(x1, x2, ..., xn) 来 估计 θ,称 ˆθ(x1, x2, ..., xn) 为 θ 的点估计量,它是一个随机变量。将样本观 测值 (x1, x2, ..., xn) 代入估计量 ˆθ(x1, x2, ..., xn),就得到它的一个具体数值 ˆθ(x1, x2, ..., xn),这个数值成为 θ 的点估计值。点估计是依据样本估计总体 分布中所含的未知参数或未知参数的函数。通常它是总体的某个特征值,如 数学期望、方差和相关系数等。点估计问题就是要构造一个只依赖于样本的 量,作为未知参数或未知参数的函数的估计值。构造点估计常用的方法是: 4.1.1 矩估计法 设 (x1, x2, ..., xn) 是来自总体 X 的一个样本,根据大数定律,对任意 ε > 0, 有 limn→∞ P{| ¯X − E(X)| ≥ ε} = 0 并且对于任何 k,只要 E(Xk) 存在,同样有 limn→∞ P{| 1 n n∑ i=1 Xk i − E(Xk)| ≥ ε} = 0, k = 1, 2, ... 因此用样本矩估计总体矩,从而得到总体分布中参数的一种估计。如用样本 均值估计总体均值。矩法的优点是简单易行,并不需要事先知道总体是什么 分布,缺点是当总体类型已知时,没有充分利用分布提供的信息,且矩估计 量不具有唯一性。 例设某药厂一天中发生着火现象的次数 X 服从参数为 λ 的 Poisson 分 布,λ 未知,有以下样本值,试用矩法估计参数 λ。 着火的次数 0 1 2 3 4 5 6 发生 k 次着火的天数 nk 75 90 54 22 6 2 1 100EX = λ, A1 = 1 n ∑n i=1 Xi = ¯X, 令 ¯X = λ 则 ¯λ = ¯x = 1 250 (0 × 57 + 1 × 90 + ... + 6 × 1) = 1.22, 所以 ¯X = λ, 估计值 ˆλ = 1.22 例正态分布 N(0,1)的矩估计 x<-rnorm(100)# 产生 N(0,1)的 100 个随机数 mu<-mean(x) # 对 N(mu,sigma) 中的 mu 做矩估计 sigma<-var(x) # 这里的 var 并不是样本方差的计算函数, # 而是修正的样本方差,其实也就是 x 的总体方差 mu ## [1] 0.00071 sigma ## [1] 1.1 4.1.2 极大似然估计法(MLE) 它是建立在极大似然原理的基础上的一个统计方法,极大似然原理的直 观想法是:一个随机试验如有若干个可能的结果 A,B,C,…。若在一次试 验中,结果 A 出现,则一般认为试验条件对 A 出现有利,也即 A 出现的概 率很大。当从模型总体随机抽取 n 组样本观测值后,最合理的参数估计量 应该是使得从模型中抽取该 n 组样本观测值的概率最大。在任一次随机抽 取中,样本观测值都以一定的概率出现。如果已经知道总体的参数,当然由 变量的频率函数可以计算其概率。如果只知道总体服从某种分布,但不知道 其分布参数,通过随机样本可以求出总体的参数估计。 例对 MASS 包中的 geyser 数据,该数据采集自美国黄石公园内的一个名 叫 Old Faithful 的喷泉。“waiting” 就是喷泉两次喷发的间隔时间,“duration” 当然就是指每次喷发的持续时间。在这里,我们只用到 “waiting” 数据 panderOptions('table.split.table', Inf) pander(head(geyser)) 101waiting duration 80 4.017 71 2.15 57 4 80 4 75 4 77 2 hist(geyser$waiting,freq = F) # 从图中可以看出,其分布是两个正态分布的混合。 Histogram of geyser$waiting geyser$waiting Density 40 50 60 70 80 90 100 110 0.00 0.01 0.02 0.03 0.04 用如下的分布函数来描述该数据 f(x) = pN(xi; µ1, σ1) + (1 − p)N(xi; µ2, σ2) 该函数中有 5 个参数 pµ1σ1µ2σ2 需要确定。上述分布函数的对数极大似然 函数为: l = n∑ i=1 log{pN(xi; µ1, σ1) + (1 − p)N(xi; µ2, σ2)} 在 R 中定义对数似然函数 102LL<-function(params,data) # 定义 log-likelihood 函数, 参数"params" 是一个向量, # 依次包含了五个参数:p,mu1,sigma1,#mu2,sigma2.# 参数"data",是观测数据。 { t1<-dnorm(data,params[2],params[3]) # 这里的 dnorm() 函数是用来生成正态密度函数的。 t2<-dnorm(data,params[4],params[5]) f<-params[1]*t1+(1-params[1])*t2 ll<-sum(log(f)) # 混合密度函数,log-likelihood 函数 return(-ll) #nlminb() 函数是最小化一个函数的值, # 但我们是要最大化 log-likeilhood 函数,所以需要在“ll”前加个“-”号。 } # 参数估计 hist(geyser$waiting,freq = F) lines(density(geyser$waiting)) Histogram of geyser$waiting geyser$waiting Density 40 50 60 70 80 90 100 110 0.00 0.01 0.02 0.03 0.04 图 15: 103# 初始值为 p=0.5,mu1=50,sigma1=10,mu2=80,sigma2=10 geyser.res<-nlminb(c(0.5,50,10,80,10),LL, data=geyser$waiting, lower=c(0.0001,-Inf,0.0001,-Inf,-Inf,0.0001), upper=c(0.9999,Inf,Inf,Inf,Inf)) 估计结果 geyser.res$par # 查看拟合的参数 ## [1] 0.31 54.20 4.95 80.36 7.51 X<-seq(40,120,length=100) p<-geyser.res$par[1] mu1<-geyser.res$par[2] sig1<-geyser.res$par[3] mu2<-geyser.res$par[4] sig2<-geyser.res$par[5] f<-p*dnorm(X,mu1,sig1)+(1-p)*dnorm(X,mu2,sig2) # 将估计的参数函数代入原密度函数。 hist(geyser$waiting,probability=T,col=0,ylab="Density", # 作出数据的直方图 ylim=c(0,0.04),xlab="Eruption waiting times") lines(X,f) # 画出拟合的曲线 4.1.3 最小二乘法 当从模型总体随机抽取 n 组样本观测值后,最合理的参数估计量应该 使得模型能最好地拟合样本数据,即实际值与估计值的距离最小,主要用于 线性统计模型中的参数估计问题。 例用最小二乘法估计线性回归模型 104Histogram of geyser$waiting Eruption waiting times Density 40 50 60 70 80 90 100 110 0.00 0.01 0.02 0.03 0.04 图 16: x <- c(5.05, 6.75, 3.21, 2.66) y <- c(1.65, 26.5,-5.93, 7.96) lsfit(x, y)$coefficients # 或者 lm(y ~ x)$coefficients ## Intercept X ## -16.3 5.4 plot(x, y) abline(lsfit(x, y)$coefficients, col="red") 4.1.4 EM 算法 EM 算法是一种在观测到数据后,用迭代法估计未知参数的方法。可以 证明 EM 算法得到的序列是稳定单调递增的。这种算法对于截尾数据或参 数中有一些不感兴趣的参数时特别有效。EM 算法的步骤为:E-step(求期 望):利用对隐藏变量的现有估计值,计算其最大似然估计值。M-step(求 极值):最大化在 E 步上求得的最大似然值来计算参数的值,重复以上两步, 1053 4 5 6 −5 0 5 10 15 20 25 x y 图 17: 直至收敛即可得到 theta 的 MLE。可以看到对于一个参数的情况,EM 仅 仅只是求解 MLE 的一个迭代算法。 sim.x <- c() sim.y <- c() # 用循环产生 2000 个点 for (i in 1:2000){ # first draw to determine which normal distribution is used first.draw = rmultinom(1, 1, c(0.1, 0.2, 0.7))[, 1] y = which(first.draw == 1) sim.y[i] = y # second draw to generate X from corresponding distribution if (y == 1){ x = rnorm(1, mean = 0, sd = 1) sim.x[i] = x } if (y == 2){ 106x = rnorm(1, mean = 10, sd = 5) sim.x[i] = x } if (y == 3){ x = rnorm(1, mean = -10, sd = 1) sim.x[i] = x } } plot(density(sim.x), main = "Density plot of sim.x") −20 −10 0 10 20 0.00 0.04 0.08 0.12 Density plot of sim.x N = 2000 Bandwidth = 1.572 Density 图 18: mix.model <- normalmixEM(sim.x, lambda = c(0.3, 0.3, 0.4), mu = c(-20, 0, 20), sigma = c(1, 1, 1), k = 3) ## number of iterations= 34 107summary(mix.model) ## summary of normalmixEM object: ## comp 1 comp 2 comp 3 ## lambda 0.67425 0.1197072 0.206043 ## mu -10.04963 0.0522245 9.707353 ## sigma 1.01251 1.0747572 4.742589 ## loglik at estimate: -5122 plot(mix.model, which = 2, density = TRUE) Density Curves Data Density −10 0 10 20 0.00 0.05 0.10 0.15 0.20 0.25 图 19: 4.1.5 Bootstrap 法 以原始数据为基础的模拟抽样统计推断法, 可用于研究一组数据的某统 计量的分布特征, 特别适用于那些难以用常规方法导出对参数的区间估计、 假设检验等问题。“Bootstrap” 的基本思想是: 在原始数据的围内作有放回 108的再抽样, 样本容量仍为 n, 原始数据中每个观察单位每次被抽到的概率相 等, 为 1,…,n, 所得样本称为 bootstrap 样本。于是可得到参数 Η 的一个估 计值 Η(b), 这样重复若干次, 记为 B。设 B=1000, 就得到该参数的 1000 个 估计值, 则参数 Η 的标准误的 bootstrap 估计。简而言之就是:就是从样本 中重复抽样。 gauss<-rnorm(1000,4,10) boot<-0 for(i in 1:1000){boot[i]=mean(sample(gauss,replace=T))} summary(boot) ## Min. 1st Qu. Median Mean 3rd Qu. Max. ## 3.0 3.7 3.9 3.9 4.1 4.9 summary(gauss) ## Min. 1st Qu. Median Mean 3rd Qu. Max. ## -28 -3 3 4 10 40 sd(boot) ## [1] 0.33 4.2 区间估计 由于点估计不能说明估计值与真实值的偏差到底有多大,也不能说明这 个估计有多大的可行度,这些问题需要区间估计予以解决。区间估计是依据 抽取的样本,根据一定的正确度与精确度的要求,构造出适当的区间,作为 总体分布的未知参数或参数的函数的真值所在范围的估计。求置信区间常 用的三种方法:1. 利用已知的抽样分布. 利用区间估计与假设检验的联系。 3. 利用大样本理论。 设总体 X 的分布中含有未知参数 θ, α 是任意给定的正数 (0 < α < 1), 如果能从样本除服确定出两个统计量 ˆθ1(x1, x2, ..., xn), ˆθ2(x1, x2, ..., xn),使 得 P { ˆθ1 < θ < ˆθ2 } = 1 − α 109成立,我们称 1 − α 为置信度或置信概率,区间 ˆθ1, ˆθ2 为参数 θ 的置信度 为 1 − α 的置信区间。分别称 ˆθ1, ˆθ2 为置信上线和置信下线。置信度为 0.95 是指 100 组样本值所得置信区间的实现中,约有 95 个能覆盖 θ,而不是说 一个实现以 0.95 的概率覆盖了 θ。区间的宽度反应了估计的精度,区间越 小,精度越高。区间估计中精确性和可靠性是相互矛盾的。当样本容量一定 时,提供估计的可靠性,将降低估计的精度,相反,提高估计的精确性,将 降低估计的可靠性。实际使用中,总是在保证一定的可靠度的情况下尽可能 地提高其精度。区间估计的基本步骤 1. 选取一个合适的随机变量 T, 这个 随机变量一方面包括了待估参数 θ,另一方面,它的分布是已知的;2. 根据 实际需要,选取合适的置信度 1 − α;3. 根据相应分布的分位数的概念,写 出如下形式的概率表达式 P{T1 < T < T2} = 1 − α 4. 将上式表达形式变为 P { ˆθ1 < θ < ˆθ2 } = 1 − α 5. 写出参数 θ 的置信区间 ˆθ1, ˆθ2 4.2.1 单正态总体参数的区间估计 4.2.1.1 方差已知时的均值的区间估计 总体方差已知,均值的置信度为 1−α 的单侧置信上限 ¯X + σ√ n z1−α, 单 侧置信下线 ¯X − σ√ n z1−α。 例某单位随机抽样的 15 位员工的身高分别为: 159 158 164 169 161 161 160 157 158 163 161 154 166 168 159, 假设身高服从方差为 4 的正态分布, 要求估计该单位员工身高均值的置信区间,置信水平为 95%。 z.test<-function(x,sigma,conf.level=0.95,u0=0,alt="two.sided"){ result<-list() mean<-mean(x) a=1-conf.level n <- length(x) z<-(mean-u0)/(sigma/sqrt(n)) p<-pnorm(z,lower.tail=F) result$z<-z result$p.value<-p if(alt=="two.sided"){ result$p.value<-2*p } 110else if (alt == "greater"|alt =="less" ){ result$p.value

0,则试验药的疗效较好;治疗差异 <0,则对 照药疗效较好;如果允许试验药疗效比对照药疗效低一定范围,仍然认为两 药疗效相当,即确定 ∆ 表示临床意义上判断疗效不差所允许的最大差异值, 则如果治疗差异 >-∆,便是试验药非劣效于对照药,此处的 ∆ 称为非劣效 试验的判断界值(margin)。非劣效试验的原假设为 H0 µT −µS ⩾ −δ, 备择 121假设为 H1 µT − µS < −δ,S(standard) 为标准组,T(test) 为试验组,通常 用于与已上市的有效药物或标准治疗方案进行比较以求能提供一个新的治 疗选择。等效性检验指主要研究目的是要显示两种或多种处理的反应间差 异的大小在临床上并无重要性的试验,通常通过显示真正的差异在临床上可 以接受的等效的上下界值之间来证实其原假设为 H0 |µT − µS| ⩾ δ,备择假 设为 H0 |µT − µS| < δ 为等效标准,也称界值), 只有两组假设同时成立, 才 认为等效,多见于对同一活性成分的生物等效性以及血浆无法测定时的临床 等效验证。优效性试验指主要研究目的是显示所研究的药物的反应优于对 比制剂(阳性或安慰剂对照),优效性试验的原假设为 H0 µT − µS ⩽ δ, 备 择假设为 H1 µT − µS > δ, 通常用于具有某方面优势的在新研发的试验药, 一般需要与安慰剂进行优效性试验以比较其真正的疗效和安全性,来判断其 上市的利益风险。如果当前已有曾经优效性试验证实的有效药物的话,还常 常与其进行比较,并判定待验证药物的疗效至少不差于(非劣于)已有有效 药物作为其上市的最低标准。临床试验中,(临床) 界值的选择,应由研究者 与统计学家共同商定,是基于统计推理及临床判断的双重考虑;若无公认界 值,可参考 EMEA《Guideline on the choice of the non-inferiority margin》 及《Issues on the selection of non-inferiority margin in clinical trials》等文 献. 随机对照临床试验(randomized clinical trial,RCT)是临床试验中比 较重要的试验,根据设计方案,常分为平行设计、交叉设计、析因设计和序贯 设计。除序贯设计不需事先估计样本含量外,其余设计均需要估计样本含量。 (1) 平行设计 (parallel design):将研究对象随机分配到两组(或多组),分 别接受不同的处理,两组同时开始进行研究,同时分析和比较研究结果。平 行设计的双盲随机对照试验是临床试验的金标准。(2) 交叉设计(cross-over design)四队两组受试者使用两种不同的处理措施,然后将处理措施相互交 换,最后将结果进行对比分析的方法。这种设计比平行设计检验效率更高, 所需样本量也少。但第一阶段干预效应可能会对第二阶段有影响,产生遗留 效应或其他交互效应,设计和分析比较复杂。还存在试验周期较长等不足。 (3) 析因设计(factorial design)是将两个或多个以上的处理因素的各水平 进行组合,对各种可能的组合都进行实验,用以评价不同处理的单独作用和 联合应用的交互效应。析因设计可以分析处理交互因素,但设计和分析也比 较复杂。(4) 序贯设计 (sequential design) 在试验前不规定样本,按照先后 顺序用随机化方法分配进入实验组或对照组,每试验一个或一对受试者后, 122及时进行分析,一旦可以判定结果,即可停止试验。序贯设计符合临床患者 陆续就医的实际,比较适合以单一指标做为结论依据的新药和老药或新药和 安慰剂的配对比较,节省人力物力,但不适用于慢性病、多变量、长期随访 等研究设计。在本章中,对微阵列数据基于族错误率 (FWER) 样本量计算 和基于贝叶斯统计的样本量计算未能用 R 语言实现。 5.1 均数比较的样本量估计 (Comparing Means) 5.1.1 单组设计 (One-Sample Design) 没有对照组的开放设计为单组设计,常用于治疗组数据与标准公认值比 较或基线数据与治疗后数据的分析比较。#### 显著性性检验当标准差为 σ2, 检验功效为 1 − β,置信度为 1 − α, 差值(样本均值与某参考值的差值, 或者,在配对设计中,配对个体观察值之差的均数,或试验组终点与基线之 差的均数)为 ϵ, 样本容量为 n = (zα/2+zβ )2σ2 ϵ2 例已知某社区 50~70 岁男性的平均收缩压为 158mmHg,标准差为 18mmHg。用某新型药品治疗后,差值为 10mmHg,在 α = 0.05,β = 0.1,问 需要多大的样本容量? OneSampleMean.Equality(0.05,0.1,18,10) ## [1] 34 当标准差未知检验功效为 1 − β,置信度为 1 − α, 差值为 ϵ, 样本容量 为 n = (tα/2+tβ )2σ2 ϵ2 例已知某社区 50~70 岁男性的平均收缩压总体方差未知,样本标准差 为 18mmHg,用某新型药品治疗后,差值为 10mmHg,在 α = 0.05,β = 0.1, 问需要多大的样本容量?总体方差未知的情况下,一般采用 t 分布代替 z 分 布。使用 t 分布时,假设了初始值,采用迭代算法。 OneSampleMean.Equality2 <- function(alpha, beta, sigma, margin,m=1000) { t0<-qt(alpha/2,m,lower.tail=FALSE)+qt(beta,m,lower.tail=FALSE) n0 <- (t0*sigma/margin)^2 t1 <- qt(alpha/2,n0,lower.tail=FALSE)+qt(beta,n0,lower.tail=FALSE) n1<-(t1*sigma/margin)^2 123while(abs(n1-n0)>0.5){ n0<-((qt(alpha/2,n1,lower.tail=FALSE)+ qt(beta,n1,lower.tail=FALSE))*sigma/margin)^2 n1<-((qt(alpha/2,n0,lower.tail=FALSE)+ qt(beta,n0,lower.tail=FALSE))*sigma/margin)^2 } n1 } OneSampleMean.Equality2(0.05,0.1,18,10) ## [1] 36 5.1.1.1 非劣效/优效性检验 当差值的标准差为 σ, 检验功效为 1 − β,置信度为 1 − α, 差值为 ϵ,δ 具有临床意义的界值, 进行非劣效性检验,界值应为负值,若进行优效性检 验,界值为正值。样本容量为 n = (zα+zβ )2σ2 (ϵ−δ)2 例一项临床试验研究新型降压药治疗高血压的作用,对某社区 50~70 岁平均收缩压为 158mmHg,标准差为 18mmHg 的男性进行治疗,进行 非劣性设计。如果认为有临床价值界值为 10mmHg,差值为 8mmHg, 在 α = 0.05,β = 0.1,问需要多大的样本容量? OneSampleMean.NIS(0.05,0.1,18,8,-10) ## [1] 8.6 5.1.1.2 等效性检验 当差值的标准差为 σ, 检验功效为 1 − β,置信度为 1 − α, 差值为 ϵ,δ 具有临床意义的界值, 样本容量为 n = (zα+zβ/2)2σ2 (δ−|ϵ|)2 例一项临床试验研究新型降压药治疗高血压的作用,对北京某社区 50~70 岁平均收缩压为 158mmHg,标准差为 18mmHg 的男性进行治疗, 进行等效性检验。如果认为有临床价值界值为 10mmHg,差值为 8mmHg, 在 α = 0.05,β = 0.1,问需要多大的样本容量? 124OneSampleMean.Equivalence(0.05,0.1,18,8,10) ## [1] 694 5.1.2 两组平行设计 (Two-Sample Parallel Design) 5.1.2.1 显著性性检验 当差值的标准差为 σ, 检验功效为 1 − β,置信度为 1 − α, 差值为 ϵ = µtest − µreference, 样本容量为 nc = (zα/2+zβ )2σ2(1+1/k) ϵ2 ,nt = kn2,k 为 实验组/对照组即 k = nt nc 。 例为研究某地正常成年男、女末稍血液的红细胞的差别,据文献报道, 男性红细胞均数为 465 万/mm3 ,女性红细胞均数为 422 万/mm3,标准差 为 52 万/mm3,1:1 平行对照设计,取双侧 α = 0.05,β = 0.1,问要抽查多 少人才能发现男女间红细胞的差别? n <- TwoSampleMean.Equality(0.05,0.1,52,1,43)#465-422=43 n ## [1] 31 每组样本量为 31 人。若实验组和对照组方差齐性采用 Pooled 合 并方差 (Pooled varance) 计算样本量;若两组方差不齐,则使用 Welch– Satterthwaite 方程对自由度进行近似的方法计算样本量。 5.1.2.2 非劣效/优效性检验 当差值的标准差为 σ, 检验功效为 1 − β,置信度为 1 − α, 差值为 ϵ = µtest − µreference, 样本容量为 nc = (zα/2+zβ )2σ2(1+1/k) (ϵ−δ)2 ,nt = kn2,k 为实 验组/对照组即 k = nt nc 。 例为研究某地正常成年男、女末稍血液的红细胞的差别,据文献报道, 男性红细胞均数为 465 万/mm3 ,女性红细胞均数为 422 万/mm3,标准 差为 52 万/mm3,1:1 平行对照设计,取双侧 α = 0.05,β = 0.1,界值为 10mmHg,进行非劣性设计,要抽查多少人才能发现男女间红细胞的差别? n <- TwoSampleMean.NIS(0.05,0.1,52,1,-10,43) n 125## [1] 16 每组样本量为 17 人。若实验组和对照组方差齐性采用 Pooled 合 并方差 (Pooled varance) 计算样本量;若两组方差不齐,则使用 Welch– Satterthwaite 方程对自由度进行近似的方法计算样本量。 5.1.2.3 等效性检验 当差值的标准差为 σ, 检验功效为 1 − β,置信度为 1 − α, 差值为 ϵ = µtest − µreference, 样本容量为 nc = (zα/2+zβ )2σ2(1+1/k) (ϵ−|δ|)2 ,nt = kn2,k 为 实验组/对照组即 k = nt nc 。 例为研究某地正常成年男、女末稍血液的红细胞的差别,据文献报道, 男性红细胞均数为 465 万/mm3 ,女性红细胞均数为 422 万/mm3,标准 差为 52 万/mm3,1:1 平行对照设计,取双侧 α = 0.05,β = 0.1,界值为 10mmHg,进行等效性设计,要抽查多少人才能发现男女间红细胞的差别? n <- TwoSampleMean.Equivalence(0.05,0.1,52,1,10,43) n ## [1] 54 每组样本量为 53 人。若实验组和对照组方差齐性采用 Pooled 合 并方差 (Pooled varance) 计算样本量;若两组方差不齐,则使用 Welch– Satterthwaite 方程对自由度进行近似的方法计算样本量。 5.1.3 两组交叉设计(Two-Sample Crossover Design) 两组交叉设计的样本量估计公式也适用配对设计、交叉配对设计和随机 区组配对设计。#### 显著性性检验当差值的标准差为 σ, 检验功效为 1−β, 置信度为 1 − α, 差值为 ϵ = µtest − µreference, 样本容量为 n = (zα/2+zβ )2σ2 m 2ϵ2 。 例 AAA 药品和对照药品治疗高血压,患者先服用对照药品 1 个月,洗 脱 2 周,再服用 AAA 1 个月,另一组反之。如果 AAA 能够比对照药品平 均多降低收缩压 5mmHg(差值),则认为有推广价值。预试验差值标准差 为 10。选用 ￿=0.05,Power=90%, 双侧显著性检验,需要多少样本含量? 126TwoSampleCrossOver.Equality(0.05,0.1,10,5) ## [1] 21 5.1.3.1 非劣效/优效性检验 当差值的标准差为 σ, 检验功效为 1 − β,置信度为 1 − α, 差值为 ϵ = µtest − µreference, 样本容量为 n = (zα+zβ )2σ2 m 2(ϵ−δ)2 。 例 AAA 药品和对照药品治疗高血压,患者先服用对照药品 1 个月,洗 脱 2 周,再服用 AAA 1 个月,另一组反之。如果 AAA 能够比对照药品平 均多降低收缩压 5mmHg(差值),则认为有推广价值。预试验差值标准差 为 10。选用 ￿=0.05,Power=90%, 界值为 1, 双侧非劣效检验,需要多少样本 含量? TwoSampleCrossOver.NIS(0.05,0.1,10,-1,5) ## [1] 12 5.1.3.2 等效性检验 当差值的标准差为 σ, 检验功效为 1 − β,置信度为 1 − α, 差值为 ϵ = µtest − µreference, 样本容量为 n = n = (zα+zβ/2)2σ2 m 2(ϵ−|δ|)2 。 例 AAA 药品和对照药品治疗高血压,患者先服用对照药品 1 个月,洗 脱 2 周,再服用 AAA 1 个月,另一组反之。如果 AAA 能够比对照药品平 均多降低收缩压 5mmHg(差值),则认为有推广价值。预试验差值标准差 为 10。选用 ￿=0.05,Power=90%, 界值为 1, 双侧等效性检验,需要多少样本 含量? TwoSampleCrossOver.Equivalence(0.05,0.1,10,1,5) ## [1] 27 5.1.4 多组设计 (Multiple-Sample One-Way ANOVA) 5.1.4.1 平行设计 该设计考察的试验因素只有一个,并且该因素的水平 (组数)k ⩾ 3, 用来考察各组观察指标总体均数之间的差别是否有统计学意义。 127∆ = 1 σ2 ∑k i=1(µi − ¯µ)2, ¯µ = 1 k ∑k j=1 µj, 样本量 n = λ/∆, 其中 σ 为 标准差,k 为组数,µ1 为各组的平均数,¯µ 为各组平均数的平均数。λ 需要 查询下表。 k α = 0.01 α = 0.05 α = 0.01 α = 0.05 1 − β = 0.80 1 − β = 0.90 2 11.68 7.85 14.88 10.51 3 13.89 9.64 17.43 12.66 4 15.46 10.91 19.25 14.18 5 16.75 11.94 20.74 15.41 6 17.87 12.83 22.03 16.47 7 18.88 13.63 23.19 17.42 8 19.79 14.36 24.24 18.29 9 20.64 15.03 25.22 19.09 10 21.43 15.65 26.13 19.83 11 22.18 16.25 26.99 20.54 12 22.89 16.81 27.8 21.20 13 23.57 17.34 28.58 21.84 14 24.22 17.85 29.32 22.44 15 24.84 18.34 30.04 23.03 16 25.44 18.82 30.73 23.59 17 26.02 19.27 31.39 24.13 18 26.58 19.71 32.04 24.65 19 27.12 20.14 32.66 25.16 20 27.65 20.56 33.27 25.66 例用四种药品治疗高血压,已知四种药品降低收缩压的平均数分别是 8.25,11.75,12 和 13。各药品降低收缩压的标准差都是 3.5. 在 σ = 0.05, β = 0.1, 双侧检验,需要多少样本?查表 λ = 14.18 k <- c(2:20) dim <- c("alpha0.01beta0.2","alpha0.05beta0.2","alpha0.01beta0.1", "alpha0.05beta0.1") data <- c(11.68,13.89,15.46,16.75,17.87,18.88,19.79,20.64,21.43, 12822.18,22.89,23.57, 24.22,24.84,25.44,26.02,26.58,27.12,27.65,7.85,9.64, 10.91,11.94,12.83,13.63, 14.36,15.03,15.65,16.25,16.81,17.34,17.85,18.34,18.82, 19.27,19.71,20.14, 20.56, 14.88,17.43,19.25,20.74,22.03,23.19,24.24,25.22, 26.13,26.99,27.80, 28.58,29.32,30.04,30.73,31.39,32.04,32.66,33.27,10.51, 12.66,14.18,15.41, 16.47,17.42,18.29,19.09,19.83,20.54,21.20,21.84,22.44, 23.03,23.59,24.13,24.65,25.16,25.66 ) z <- array(data,c(19,4),dimnames<-list(k,dim)) delta<- function(mu,sigma){ mu0 <- mean(mu) return(sum((mu-mu0)^2)/sigma^2) } MutiSampleMean <- function(alpha, beta, sigma, k, mu){ lambda <- z[k-1,paste(paste("alpha",alpha,sep = ""), paste("beta",beta,sep = ""), sep = "")] n <- lambda/delta(mu,sigma) } (MutiSampleMean(0.05,0.1,3.5,4,c(8.25,11.75,12,13))) ## [1] 13 每组研究至少需要 14 名。 5.1.4.2 两两比较设计 试验组为 2 个或以上,且设有对照的试验设计,主要观察指标为计量资 料。当标准差为 σ, 检验功效为 1 − β,置信度为 1 − α, 差值为 ϵ = µiµj 取 129最小值,τ 的配对对比,样本量为 nij = 2(zα/(2τ))+zβ )2σ2 ϵ2 ij 。使用 TrialSize 包中 的 OneWayANOVA.pairwise() 进行计算。 例试验药两剂量的降低收缩压的平均数分别 30 和 35,对照的降低收 缩压的平均数为 20,两剂量降低收缩压的标准差分别是 5.3 和 4.2, 进行 1: 1:1 的平行对照实验,在 α = 0.05,β = 0.1,问需要多大的样本容量? n1 <- OneWayANOVA.pairwise(0.05, 0.1, 2, 5.3,(30-20)) n2 <- OneWayANOVA.pairwise(0.05, 0.1, 2, 4.2,(35-20)) n <- max(n1,n2) n ## [1] 7 每组需要 7 个例。 5.1.4.3 Williams 设计 (Multiple-Sample Williams Design) 当交叉试验可使用的时期数与处理数相同时,采用广义拉丁方以尽 量少的受试者来均衡一阶延滞作用的交叉设计为 Williams 设计。常见的 Williams 设计有三组设计(一个 6×3 的交叉设计)和四组设计(一个 4*4 的交叉设计)。当试验组是奇数,设计结果是 2k»k 交叉设计,当试验组是 偶数,设计结果 k»k 交叉设计。 5.1.4.3.1 显著性检验 标准差为 σ, 检验功效为 1 − β,置信度为 1 − α,k 为组数,ϵ 为两组的 差值,样本量 n = (zα/2+zβ )σ2 d kϵ2 例用三种药品治疗高血压,预实验已知三种药品(A、B、C) 降 低 收 缩 压 分 别 为 8.25,11.75,12, 各药品降低收缩压的标准差均为 3.5。williams 设计为三交叉对照实验,三交叉的处理顺序排列组合为 ABC,ACB,BAC,BCA,CAB,CBA 共 6 个序列,α = 0.05,β = 0.1, 双侧显 著性检验,需要多少样本? n1 <- MeanWilliamsDesign.Equality(0.05,0.1,3.5,6,(8.25-11.25)) n2 <- MeanWilliamsDesign.Equality(0.05,0.1,3.5,6,(8.25-12)) n3 <- MeanWilliamsDesign.Equality(0.05,0.1,3.5,6,(11.75-12)) 130n <- max(n1,n2,n3) n ## [1] 343 研究的每个序列至少需要 343 例。 5.1.4.3.2 非劣效/优效性检验 标准差为 σ, 检验功效为 1 − β,置信度为 1 − α,k 为组数,ϵ 为两组的 差值,δ 为界值,样本量 n = (zα+zβ )σ2 d k(ϵ−δ)2 例用三种药品治疗高血压,预实验已知三种药品(A、B、C) 降 低 收 缩 压 分 别 为 8.25,11.75,12, 各药品降低收缩压的标准差均为 3.5。williams 设计为三交叉对照实验,三交叉的处理顺序排列组合为 ABC,ACB,BAC,BCA,CAB,CBA 共 6 个序列,界值为 5,α = 0.05,β = 0.1, 双侧显著性检验,需要多少样本? n1 <- MeanWilliamsDesign.NIS(0.05,0.1,3.5,6,-5,(8.25-11.25)) n2 <- MeanWilliamsDesign.NIS(0.05,0.1,3.5,6,-5,(8.25-12)) n3 <- MeanWilliamsDesign.NIS(0.05,0.1,3.5,6,-5,(11.75-12)) n <- max(n1,n2,n3) n ## [1] 11 研究的每个序列至少需要 12 例。 5.1.4.3.3 等效性检验 标准差为 σ, 检验功效为 1 − β,置信度为 1 − α,k 为组数,ϵ 为两组的 差值,δ 为界值,样本量 n = (zα+zβ/2)σ2 d k(δ−|ϵ|)2 例用三种药品治疗高血压,预实验已知三种药品(A、B、C) 降 低 收 缩 压 分 别 为 8.25,11.75,12, 各药品降低收缩压的标准差均为 3.5。williams 设计为三交叉对照实验,三交叉的处理顺序排列组合为 ABC,ACB,BAC,BCA,CAB,CBA 共 6 个序列,界值为 5,α = 0.05,β = 0.1, 双侧等效性检验,需要多少样本? 131n1 <- MeanWilliamsDesign.Equivalence(0.05,0.1,3.5,6,5,(8.25-11.25)) n2 <- MeanWilliamsDesign.Equivalence(0.05,0.1,3.5,6,5,(8.25-12)) n3 <- MeanWilliamsDesign.Equivalence(0.05,0.1,3.5,6,5,(11.75-12)) n <- max(n1,n2,n3) n ## [1] 14 研究的每个序列至少需要 14 例。 5.2 率比较的样本量估计 (Large Sample Tests for Propor- tions) 5.2.1 单组设计 (One-Sample Design) 5.2.1.1 显著性检验 当总体率为 p, 检验功效为 1 − β,置信度为 1 − α, 差值为 ϵ, 样本容量 为 n = (zα/2+zβ )2p(1−p) ϵ2 。 例用传统的方法治疗运动负胫骨结节股骺损伤的有效率约为 85%,现 采用小刚针做胫骨结节股骺穿刺,估计有效率为 95%,在 α = 0.05,β = 0.1, 双侧显著性检验,问需要多大的样本容量? OneSampleProportion.Equality(0.05,0.1,0.95,(0.95-0.85)) ## [1] 50 研究需要 50 例。OneSampleProportion.Equality() 函数中的 delta 相 当于样本计算公式的 ϵ。 5.2.1.2 非劣效/优效性检验 当总体率为 p, 检验功效为 1 − β,置信度为 1 − α, 差值为 ϵ,界值 δ, 样本容量为 n = (zα+zβ )2p(1−p) (ϵ−δ)2 。 例用传统的方法治疗运动负胫骨结节股骺损伤的有效率约为 85%,现 采用小刚针做胫骨结节股骺穿刺,估计有效率为 95%, 界值为 5%,在 α = 0.05,β = 0.1,双侧非劣效检验,问需要多大的样本容量? 132OneSampleProportion.NIS2 <- function (alpha, beta, p, delta, margin) { n <- (qnorm(1 - alpha) + qnorm(1 - beta))^2 * p * (1 - p)/(margin-delta)^2 n } OneSampleProportion.NIS2(0.05,0.1,0.95,-0.05,(0.95-0.85)) ## [1] 18 研究需要 19 例。TrialSize 的作者在 OneSampleProportion.NIS() 函数 中 delta 和 margin 代表的意义,与样本量计算公式有不相符之处,但可以 得到正确结果 OneSampleProportion.NIS2(0.05,0.1,0.95,(0.95-0.85),-0.05) 。 5.2.1.3 等效性检验 当总体率为 p, 检验功效为 1 − β,置信度为 1 − α, 差值为 ϵ,界值 δ, 样本容量为 n = (zα+zβ/2)2p(1−p) (ϵ−|δ|)2 。 例用传统的方法治疗运动负胫骨结节股骺损伤的有效率约为 85%,现 采用小刚针做胫骨结节股骺穿刺,估计有效率为 95%, 界值为 5%,在 α = 0.05,β = 0.1,双侧等效性检验,问需要多大的样本容量? OneSampleProportion.Equivalence2 <- function(alpha, beta, p, delta, margin) { n <- (qnorm(1 - alpha) + qnorm(1 - beta/2))^2 * p * (1 - p)/(delta - abs(margin))^2 n } OneSampleProportion.Equivalence2(0.05,0.1,0.95,0.05,(0.95-0.85)) ## [1] 206 研究需要 206 例。TrialSize 的作者在 OneSampleProportion.NIS() 函数 中 delta 和 margin 代表的意义,与样本量计算公式有不相符之处,但可以得到 正确结果 OneSampleProportion.Equivalence(0.05,0.1,0.95,(0.95-0.85),0.05) 1335.2.2 两组平行设计 (Two-Sample Parallel Design) 5.2.2.1 显著性检验 p1 为第一组 (试验组) 的率,p2 为第二组(对照组)的率,差值为 ϵ,样 本容量为 n2 = (zα/2+zβ )2 ϵ2 [ p1(1−p1) k + p2(1 − p2)],n1 = kn2 例用两种药物对糖尿病患者进行康复治疗,经初步观察发现甲药的有效 率为 70%,乙药 (对照) 的有效率为 90%,现进行进一步 1:1 显著行性设计 在 α = 0.05,β = 0.1,问需要多大的样本容量? TwoSampleProportion.Equality(0.05,0.1,0.7,0.9,1,(0.7-0.9)) ## [1] 79 每组需要 78 例,TwoSampleProportion.Equality() 函数中的 delta 相 当于样本计算公式的 ϵ。 5.2.2.2 非劣效/优效性检验 p1 为第一组 (试验组) 的率,p2 为第二组(对照组)的率,差值为 ϵ,δ 为界值,样本容量为 n2 = (zα+zβ )2 (ϵ−δ)2 [ p1(1−p1) k + p2(1 − p2)],n1 = kn2 例用两种药物对糖尿病患者进行康复治疗,经初步观察发现甲药的有效 率为 70%,乙药 (对照) 的有效率为 90%,现进行进一步 1:1 非劣效设计,界 值为 5%,在 α = 0.05,β = 0.1,问需要多大的样本容量? TwoSampleProportion.NIS2 <- function (alpha, beta, p1, p2, k, delta, margin) { n2 <- (qnorm(1 - alpha) + qnorm(1 - beta))^2 * (p1 * (1 - p1)/k + p2 * (1 - p2))/(margin-delta)^2 n1 <- k * n2 n1 } TwoSampleProportion.NIS2(0.05,0.1,0.7,0.9,1,-0.05,(0.7-0.9)) ## [1] 114 134每组需要 114 例,TrialSize 的作者在 TwoSampleProportion.NIS() 函数 中 delta 和 margin 代表的意义,与样本量计算公式有不相符之处,但可以得 到正确结果 TwoSampleProportion.NIS2(0.05,0.1,0.7,0.9,1,(0.7-0.9),-0.05). 5.2.2.3 等效性检验 p1 为第一组 (试验组) 的率,p2 为第二组(对照组)的率,差值为 ϵ,δ 为界值,样本容量为 n2 = (zα+zβ/2)2 (δ−|ϵ|)2 [ p1(1−p1) k + p2(1 − p2)],n1 = kn2 例用两 种药物对糖尿病患者进行康复治疗,经初步观察发现甲药的有效率为 70%, 乙药 (对照) 的有效率为 90%,现进行进一步 1:1 等效性设计,界值为 5%, 在 α = 0.05,β = 0.1,问需要多大的样本容量? TwoSampleProportion.Equivalence2 <- function (alpha, beta, p1, p2, k, delta, margin) { n2 <- (qnorm(1 - alpha) + qnorm(1 - beta/2))^2 * (p1 * (1 - p1)/k + p2 * (1 - p2))/(delta- abs(margin))^2 n1 <- k * n2 n1 } TwoSampleProportion.Equivalence2(0.05,0.1,0.7,0.9,1,0.05,(0.7-0.9)) ## [1] 144 每组需要 144 例,TrialSize 的作者在 TwoSampleProportion.Equivalence() 函数中 delta 和 margin 代表的意义,与样本量计算公式有不相符之处,beta 也未除以 2. 5.2.3 两组交叉设计 (Two-Sample Crossover Design) 5.2.3.1 显著性检验 σ 为两组率的差的标准差,ϵ 为试验组率-对照组率,样本容量为 n = (zα/2+zβ )2σ2 d 2ϵ2 例实验药和对照药品治疗中风,患者先服用对照药品 1 个月,洗脱 2 周,再服用试验药 1 个月,另一组反之。如果试验药能够比对照药品的有 135效率高 20%(差值),则认为有推广价值。预试验差值标准差为 10。选用 α = 0.05,Power=90%, 双侧显著性检验,需要多少样本含量? TwoSamplePropCrossOver.Equality <- function (alpha, beta, sigma, margin) { n <- (qnorm(1 - alpha/2) + qnorm(1 - beta))^2 * sigma^2/2*(margin^2) n } TwoSamplePropCrossOver.Equality(0.05,0.1,10,0.2) ## [1] 21 每组需要 21 例. 5.2.3.2 非劣效/优效性检验 σ 为率的标准差,样本容量为 n = (zα+zβ )2σ2 d 2(ϵ−δ)2 例实验药和对照药品治疗中风,患者先服用对照药品 1 个月,洗脱 2 周,再服用试验药 1 个月,另一组反之。如果试验药能够比对照药品的有 效率高 20%(差值),则认为有推广价值。预试验差值标准差为 10。选用 α = 0.05,Power=90%, 界值为 10%,双侧非劣效检验,需要多少样本含量? TwoSamplePropCrossOver.NIS <- function (alpha, beta, sigma, delta,margin) { n <- (qnorm(1 - alpha) + qnorm(1 - beta))^2 * sigma^2/2*(margin-delta)^2 n } TwoSamplePropCrossOver.NIS(0.05,0.1,10,-0.1,0.2) ## [1] 39 每组需要 38 例。 1365.2.3.3 等效性检验 σ 为率的标准差,样本容量为 n = (zα+zβ/2)2σ2 d 2(δ−|ϵ|)2 例实验药和对照药品治疗中风,患者先服用对照药品 1 个月,洗脱 2 周,再服用试验药 1 个月,另一组反之。如果试验药能够比对照药品的有 效率高 20%(差值),则认为有推广价值。预试验差值标准差为 10。选用 α = 0.05,Power=90%, 界值为 10%,双侧等效性检验,需要多少样本含量? TwoSamplePropCrossOver.Equivalence <- function (alpha, beta, sigma, delta,margin) { n <- (qnorm(1 - alpha) + qnorm(1 - beta/2))^2 * sigma^2/2*(delta-abs(margin))^2 n } TwoSamplePropCrossOver.Equivalence(0.05,0.1,10,-0.1,0.2) ## [1] 49 每组需要 49 例。 5.2.4 多组设计 (One-Way Analysis of Variance) 在试验因素只有一个,且该因素的水平 k ⩾ 3 时,为多组平行对照设计, 又称单因素多水平设计(ANOVA)。 5.2.4.1 两两比较 试验组为 2 个或以上,且设有对照的试验设计,主要观察指标为计数资 料。检验功效为 1 − β,置信度为 1 − α, 差值为 ϵ = µiµj 取最小值,样本量 为 nij = (zα/(2τ))+zβ )2[p1(1−p1)+p2(1−p2)] ϵ2 ij ,n = maxnij。上述公式适用了多组 平行对照设计。 例试验药两剂量的有效率分别 30% 和 35%,对照的有效率为 20%,进 行 1:1:1 的平行对照实验,在在 α = 0.05,β = 0.1,问需要多大的样本容 量? 137n1 <- OneWayANOVA.PairwiseComparison(0.05,0.1,2,0.3,0.2,(0.3-0.2)) n2 <- OneWayANOVA.PairwiseComparison(0.05,0.1,2,0.35,0.2,(0.35-0.2)) n <- max(n1,n2) n ## [1] 459 每组需要 459 例。 5.2.4.2 Williams 设计 (Williams Design) 5.2.4.3 显著性检验 σ 为标准差,a 为组数,ϵ 为率差,样本容量为 n = (zα/2+zβ )2σ2 d aϵ2 。 例一个新型药品的两个剂量组与安慰剂进行临床试验,预计两个剂量组 的有效率分别为 60% 和 65%,安慰剂的有效率为 20%,研究者感兴趣是第 一剂量组与安慰剂的差别,其率差的标准差为 50%,Williams 三交叉设计, 在 α = 0.05,β = 0.1,双侧差异性检验,需要多少样本? PorpWilliamsDesign.Equality <- function (alpha, beta, sigma, a, margin) { n <- (qnorm(1 - alpha/2) + qnorm(1 - beta))^2 * sigma^2/(a * margin^2) n } PorpWilliamsDesign.Equality(0.05,0.1,0.5,6,(0.6-0.2)) ## [1] 2.7 每个研究需要至少 3 个病例。 5.2.4.4 非劣效/优效性检验 σ 为标准差,a 为组数,ϵ 为率差,a 为组数, 样本容量为 n = (zα+zβ )2σ2 d a(ϵ−δ)2 。 138例一个新型药品的两个剂量组与安慰剂进行临床试验,预计两个剂量组 的有效率分别为 60% 和 65%,安慰剂的有效率为 20%,研究者感兴趣是第 一剂量组与安慰剂的差别,其率差的标准差为 50%,Williams 三交叉设计, 在 α = 0.05,β = 0.1,界值为 5%,双侧非劣效检验,需要多少样本? PropWilliamsDesign.NIS <- function (alpha, beta, sigma, a, delta, margin) { n <- (qnorm(1 - alpha) + qnorm(1 - beta))^2 * sigma^2/(a * (margin - delta)^2) n } PropWilliamsDesign.NIS (0.05,0.1,0.5,6,-0.05,(0.6-0.2)) ## [1] 1.8 每个研究需要至少 2 个病例。 5.2.4.5 等效性检验 σ 为标准差,a 为组数,ϵ 为率差,a 为组数, 样本容量为 n = (zα+zβ/2)2σ2 d a(δ−|ϵ|)2 。 例一个新型药品的两个剂量组与安慰剂进行临床试验,预计两个剂量组 的有效率分别为 60% 和 65%,安慰剂的有效率为 20%,研究者感兴趣是第 一剂量组与安慰剂的差别,其率差的标准差为 50%,Williams 三交叉设计, 在 α = 0.05,β = 0.1,界值为 5%,双侧等效性检验,需要多少样本? PropWilliamsDesign.Equivalence <- function (alpha, beta, sigma, a, delta, margin) { n <- (qnorm(1 - alpha) + qnorm(1 - beta/2))^2 * sigma^2/(a * (delta-abs(margin ))^2) n } PropWilliamsDesign.Equivalence (0.05,0.1,0.5,6,0.05,(0.6-0.2)) 139## [1] 3.7 每个研究需要至少 4 个病例。 5.2.5 相对危险度平行设计 (Relative Risk—Parallel Design) 两样本 (两组) 平行对照设计,基于相对危险度,通常用比值比或优势 比(odds radtio,OR)表示 OR = pt/(1−pt) pc/(1−pc),t 为试验组,c 为对照组。比 值比大于 1 说明对结局有影响,比值比等于 1 说明对结局的影响没有区别。 5.2.5.1 显著性检验 OR 为 比 值 比,pT 试 验 组 率,pC 为 对 照 粗 率, 样 本 量 nC = (zα/2+zβ )2 log2(OR) ( 1 κpT(1−pT) + 1 κpC(1−pC) ) ,κ = nT/nC 例研究新型抗血小板药 预防脑梗死再发的作用,和阿司匹林进行对照, 以相对危险度为主要评价 指标。预实验显示,新药能够预防 20% 的脑梗死再发,阿司匹林能够预防 10% 的脑梗死再发。在 α = 0.05,β = 0.1,1:1 双侧显著性检验,需要多少 病例? OR <- (0.2/(1-0.2))/(0.1/(1-0.1)) RelativeRisk.Equality(0.05,0.1,OR,1,0.2,0.1) ## [1] 277 试验组和对照组均需要 277 例。 5.2.5.2 非劣效/优效性检验 OR 为比值比,pT 试验组率,pC 为对照粗率,δ 为界值,样本量 nC = (zα+zβ )2 (log(OR)−δ)2 ( 1 κpT(1−pT) + 1 pC(1−pC) ) 例研究新型抗血小板药预防脑梗死再发 的作用,和阿司匹林进行对照,以相对危险度为主要评价指标。预实验显示, 新药能够预防 20% 的脑梗死再发,阿司匹林能够预防 10% 的脑梗死再发。 在 α = 0.05,β = 0.1,1:1 双侧非劣效检验,界值为 10%,需要多少病例? OR <- (0.2/(1-0.2))/(0.1/(1-0.1)) RelativeRisk.NIS(0.05,0.1,OR,1,0.2,0.1,-0.1) ## [1] 179 试验组和对照组均需要 179 例。 1405.2.5.3 等效性检验 OR 为比值比,pT 试验组率,pC 为对照粗率,δ 为界值, 样本量 nC = (zα+zβ/2)2 (δ−log(OR))2 ( 1 κpT(1−pT) + 1 pC(1−pC) )−1 例研究新型抗血小板药预防脑梗死再发的作用,和阿司匹林进行对照, 以相对危险度为主要评价指标。预实验显示,新药能够预防 20% 的脑梗死 再发,阿司匹林能够预防 10% 的脑梗死再发。在 α = 0.05,β = 0.1,1:1 双 侧等效性检验,界值为 10%,需要多少病例? OR <- (0.2/(1-0.2))/(0.1/(1-0.1)) RelativeRisk.Equivalence(0.05,0.1,OR,1,0.2,0.1,0.1) ## [1] 372 试验组和对照组均需要 372 例。 5.2.6 相对危险度交叉设计 (Relative Risk—Crossover Design) 交叉设计与随机平行对照设计相比,需要的样本量较少,但该设计的前 提是所治疗疾病在停药后基本会回复到用药前的状态,中间停药时间(洗脱 期)的长度基本清楚。 5.2.6.1 显著性检验 OR 为比值比,σ2 d 为差值的标准差。样本量为 n = (zα/2+zβ )2σ2 d log2(OR) 例某新型药品治疗头痛后 7 日再发率为 20%,标准治疗头痛后 7 日再 发率为 10%,以相对为危险度为主要评价指标, 标准差为 50%,两组交叉对 照 1:1 设计,在在 α = 0.05,β = 0.1,1:1 双侧显著性检验,需要多少病 例? OR <- (0.2/(1-0.2))/(0.1/(1-0.1)) RelativeRiskCrossOver.Equality <- function (alpha, beta, sigma, or) { n <- (qnorm(1 - alpha/2) + qnorm(1 - beta))^2 * sigma^2/(log(or))^2 n } RelativeRiskCrossOver.Equality(0.05,0.1,0.5,OR) 141## [1] 4 每组至少需要 4 例,TrialSize 包中 RelativeRiskCrossOver.Equality() 函数在 sigma 处有误,没有取平方。 5.2.6.2 非劣效/优效性检验 OR 为比值比,σ2 d 为差值的标准差,δ 为界值。样本量为 n = (zα+zβ )2σ2 d [log2(OR)−δ]2 例某新型药品治疗头痛后 7 日再发率为 20%,标准治疗头痛后 7 日再 发率为 10%,以相对为危险度为主要评价指标,两组交叉对照 1:1 设计, 在在 α = 0.05,β = 0.1,1:1 双侧非劣效性检验,界值为 10%,需要多少病 例? OR <- (0.2/(1-0.2))/(0.1/(1-0.1)) RelativeRiskCrossOver.NIS <- function (alpha, beta, sigma, or,delta) { n <- (qnorm(1 - alpha) + qnorm(1 - beta))^2 * sigma^2/(log(or) - delta)^2 n } RelativeRiskCrossOver.NIS(0.05,0.1,0.5,OR,-0.1) ## [1] 2.6 每组至少需要 3 例,TrialSize 包中 RelativeRiskCrossOver.NIS() 函数 在 sigma 处有误,没有取平方。 5.2.6.3 等效性检验 OR 为比值比,σ2 d 为差值的标准差,δ 为界值。样本量为 n = (zα+zβ/2)2σ2 d (δ−|log2(OR)|)2 例某新型药品治疗头痛后 7 日再发率为 20%,标准治疗头痛后 7 日再 发率为 10%,以相对为危险度为主要评价指标,两组交叉对照 1:1 设计, 在 α = 0.05,β = 0.1,1:1 双侧等效性检验,界值为 10%,需要多少病例? OR <- (0.2/(1-0.2))/(0.1/(1-0.1)) RelativeRiskCrossOver.Equivalence <- function (alpha, beta, 142sigma, or, delta) { n <- (qnorm(1 - alpha) + qnorm(1 - beta/2))^2 * sigma^2/(delta- abs(log(or)))^2 n } RelativeRiskCrossOver.Equivalence(0.05,0.1,0.5,OR,0.1) ## [1] 5.4 每组至少需要 3 例,TrialSize 包中 RelativeRiskCrossOver.Equivalence() 函数在 sigma 处有误,没有取平方。 5.3 计数资料的精确检验 (Exact Tests for Proportions) 5.3.1 二项分布(Binomial Test) 二项分布检验常用于但组设计情况,其样本量估计方法适合较小样本计 数资料的精确检验。二项分布检验样本量和临界值(Critical Value r)的估 算表如下,在 α = 0.05,P1 − P0 = 0.15 时,查下表,1 − β = 0.80 为第三和 第四列,1 − β = 0.90 为第五和第六列。 P0 P1 r n r n 0.05 0.20 3 27 4 38 0.10 0.25 7 40 9 55 0.15 0.30 11 48 14 64 0.20 0.35 16 56 21 77 0.25 0.40 21 62 27 83 0.30 0.45 26 67 35 93 0.35 0.50 30 68 41 96 0.40 0.55 35 71 45 94 0.45 0.60 38 70 52 98 0.50 0.65 41 69 54 93 0.55 0.70 45 70 58 92 0.60 0.75 43 62 58 85 143P0 P1 r n r n 0.65 0.80 41 55 55 75 0.70 0.85 39 49 54 69 0.75 0.90 38 45 46 55 0.80 0.95 27 30 39 44 在 α = 0.10,P1 − P0 = 0.15 时,查下表,1 − β = 0.80 为第三和第四列, 1 − β = 0.90 为第五和第六列。 P0 P1 r n r n 0.05 0.20 2 21 3 32 0.10 0.25 5 31 6 40 0.15 0.30 8 37 11 53 0.20 0.35 12 44 16 61 0.25 0.40 15 46 20 64 0.30 0.45 19 50 26 71 0.35 0.50 21 49 30 72 0.40 0.55 24 50 35 75 0.45 0.60 28 53 39 75 0.50 0.65 31 53 41 72 0.55 0.70 31 49 44 71 0.60 0.75 32 47 43 64 0.65 0.80 33 45 44 61 0.70 0.85 29 37 41 53 0.75 0.90 25 30 33 40 0.80 0.95 22 25 28 32 在 α = 0.05,P1 − P0 = 0.20 时,查下表,1 − β = 0.80 为第三和第四列, 1 − β = 0.90 为第五和第六列。 P0 P1 r n r n 0.05 0.25 2 16 3 25 0.10 0.30 5 25 6 33 144P0 P1 r n r n 0.15 0.35 7 28 9 38 0.20 0.40 11 35 14 47 0.25 0.45 13 36 17 49 0.30 0.50 16 39 21 53 0.35 0.55 19 41 24 53 0.40 0.60 22 42 28 56 0.45 0.65 24 42 30 54 0.50 0.70 23 37 32 53 0.55 0.75 25 37 33 50 0.60 0.80 26 36 32 45 0.65 0.85 24 31 32 42 0.70 0.90 23 28 30 37 0.75 0.95 20 23 25 29 0.80 1.00 13 14 13 14 在 α = 0.10,P1 − P0 = 0.20 时,查下表,1 − β = 0.80 为第三和第四列, 1 − β = 0.90 为第五和第六列。 P0 P1 r n r n 0.05 0.25 2 16 2 20 0.10 0.30 3 18 4 25 0.15 0.35 5 22 7 32 0.20 0.40 7 24 10 36 0.25 0.45 9 26 13 39 0.30 0.50 12 30 15 39 0.35 0.55 1 3 29 19 44 0.40 0.60 15 30 20 41 0.45 0.65 1 6 29 24 44 0.50 0.70 17 28 23 39 0.55 0.75 19 29 25 39 0.60 0.80 17 24 25 36 0.65 0.85 16 21 24 32 145P0 P1 r n r n 0.70 0.90 17 21 20 25 0.75 0.95 13 15 17 20 0.80 1.00 10 11 10 11 例预试验中某新型抗肿瘤药品治疗某癌症的治愈率为 30%,标准治疗 的治愈率为 10%,单组设计,二项分布检验,在 α = 0.05,β = 0.1,需要多 少病例? p <- seq(0.05,0.80,by=0.05) dim <- c("beta0.2r","beta0.2n","beta0.1r","beta0.1n") dim3 <- c("p0.15alpha0.05","p0.15alpha0.10","p0.20alpha0.05","p0.20alpha0.10") data<- c(3,7,11,16,21,26,30,35,38,41,45,43,41,39,38,27,27,40,48, 56,62,67,68,71,70,69, 70,62,55,49,45,30,4,9,14,21,27,35,41,45,52,54,58,58, 55,54,46,39,38,55,64,77, 83,93,96,94,98,93,92,85,75,69,55,44,2,5,8,12,15,19, 21,24,28,31,31,32,33,29, 25,22,21,31,37,44,46,50,49,50,53,53,49,47,45,37,30, 25,3,6,11,16,20,26,30,35, 39,41,44,43,44,41,33,28,32,40,53,61,64,71,72,75, 75,72,71,64,61,53,40,32,2,5, 7,11,13,16,19,22,24,23,25,26,24,23,20,13,16,25, 28,35,36,39,41,42,42,37,37, 36,31,28,23,14,3,6,9,14,17,21,24,28,30,32,33, 32,32,30,25,13,25,33,38,47,49, 53,53,56,54,53,50,45,42,37,29,14,2,3,5,7,9, 12,13,15,16,17,19,17,16,17,13, 10,16,18,22,24,26,30,29,30,29,28,29,24,21,21, 15,11,2,4,7,10,13,15,19,20,24, 23,25,25,24,20,17,10,20,25,32,36,39,39,44, 41,44,39,39,36,32,25,20,11) 146z <- array(data,c(16,4,4),dimnames<-list(p,dim,dim3)) BinProp <- function(alpha, beta,p0,p1){ col1<- paste(paste("beta",beta,sep=""),"n",sep="") col2 <- paste(paste("beta",beta,sep=""),"r",sep="") row <- paste(paste("p",format(p1-p0,digits = 2,nsmall = 2),sep = ""), paste("alpha",alpha,sep = ""),sep="") c(n=z[which(p==p0),col1,row],r=z[which(p==p0),col2,row]) } BinProp(0.05,0.1,0.1,0.3) ## n r ## 33 6 需要 33 个病例,临界值为 6。 5.3.2 Fisher’s 精确检验 (Fisher’s Exact Test) 在两组平行对照设计中,当四格表中有理论数小于 5, 或者总观察数小 于 40 时,需要 Fisher‘s 精确检验。样本含量的精确估计需要查询下表获得 检验水平为 0.05 或为 0.1, 把握度为 0.8 或 0.9 时,不同率差的样本量。率 差为 0.25 时,查询下表 p1 p2 alpha0.10beta0.20 alpha0.10beta0.10 alpha0.05beta0.20 alpha0.05beta0.10 0.05 0.30 25 33 34 42 0.10 0.35 31 41 39 52 0.15 0.40 34 48 46 60 0.20 0.45 39 52 49 65 0.25 0.50 40 56 54 71 0.30 0.55 41 57 55 72 0.35 0.60 41 57 56 77 0.40 0.65 41 57 56 77 0.45 0.70 41 57 55 72 0.50 0.75 40 56 54 71 147p1 p2 alpha0.10beta0.20 alpha0.10beta0.10 alpha0.05beta0.20 alpha0.05beta0.10 0.55 0.80 39 52 49 65 0.60 0.85 34 48 46 60 0.65 0.90 31 41 39 52 0.70 0.95 25 33 34 42 率差为 0.30 时,查询下表 p1 p2 alpha0.10beta0.20 alpha0.10beta0.10 alpha0.05beta0.20 alpha0.05beta0.10 0.05 0.35 20 26 25 33 0.10 0.40 23 32 30 39 0.15 0.45 26 35 34 45 0.20 0.50 28 39 36 47 0.25 0.55 29 40 37 51 0.30 0.60 29 40 41 53 0.35 0.65 33 40 41 53 0.40 0.70 29 40 41 53 0.45 0.75 29 40 37 51 0.50 0.80 28 39 36 47 0.55 0.85 26 35 34 45 0.60 0.90 23 32 30 39 率差为 0.35 时,查询下表 p1 p2 alpha0.10beta0.20 alpha0.10beta0.10 alpha0.05beta0.20 alpha0.05beta0.10 0.05 0.40 16 21 20 25 0.10 0.45 19 24 24 31 0.15 0.50 20 28 26 34 0.20 0.55 23 29 27 36 0.25 0.60 24 29 30 36 0.30 0.65 24 33 31 40 0.35 0.70 24 33 31 40 0.40 0.75 24 29 30 36 148p1 p2 alpha0.10beta0.20 alpha0.10beta0.10 alpha0.05beta0.20 alpha0.05beta0.10 0.45 0.80 23 29 27 36 0.50 0.85 20 28 26 34 0.55 0.90 19 24 24 31 0.60 0.95 16 21 20 25 例预试验中某新型抗肿瘤药品治疗某癌症的治愈率为 35%,标准治疗的 治愈率为 10%,两组平行对照 1:1 设计,双侧差异性检验,在 α = 0.05,β = 0.1,需要多少病例? dim1 <- c("p1","p2","alpha0.10beta0.20","alpha0.10beta0.10", "alpha0.05beta0.20","alpha0.05beta0.10") p <- seq(1:14) data1 <-c(0.05,0.10,0.15,0.20,0.25,0.30,0.35,0.40,0.45, 0.50,0.55,0.60,0.65,0.70, 0.30,0.35,0.40,0.45,0.50,0.55,0.60,0.65,0.70, 0.75,0.80,0.85,0.90,0.95, 25,31,34,39,40,41,41,41,41,40,39,34,31,25, 33,41,48,52,56,57,57,57,57, 56,52,48,41,33,34,39,46,49,54,55,56,56,55, 54,49,46,39,34,42,52,60,65, 71,72,77,77,72,71,65,60,52,42) p0.25 <- array(data1,c(14,6),dimnames<-list(p,dim1)) p <- seq(1:12) data2 <- c(0.05,0.10,0.15,0.20,0.25,0.30,0.35,0.40,0.45, 0.50,0.55,0.60,0.35,0.40, 0.45,0.50,0.55,0.60,0.65,0.70,0.75,0.80,0.85, 0.90,20,23,26,28,29,29, 33,29,29,28,26,23,26,32,35,39,40,40,40,40,40, 39,35,32,25,30,34,36, 37,41,41,41,37,36,34,30,33,39,45,47,51,53, 53,53,51,47,45,39) 149p0.30 <- array(data2,c(12,6),dimnames<-list(p,dim1)) p <- seq(1:12) data3 <- c(0.05,0.10,0.15,0.20,0.25,0.30,0.35,0.40,0.45, 0.50,0.55,0.60,0.40,0.45, 0.50,0.55,0.60,0.65,0.70,0.75,0.80,0.85,0.90, 0.95,16,19,20,23,24,24,24, 24,23,20,19,16,21,24,28,29,29,33,33,29,29,28, 24,21,20,24,26,27,30,31, 31,30,27,26,24,20,25,31,34,36,36,40,40,36, 36,34,31,25) p0.35 <- array(data3,c(12,6),dimnames<-list(p,dim1)) z <- list(p0.25=p0.25,p0.30=p0.30,p0.35=p0.35) FisherTest <- function(alpha,beta,p1,p2){ table <- paste("p",format(p2-p1,digits = 2,nsmall = 2),sep="") row <- as.numeric(which(z[[table]][,1]==p1)) col <- paste(paste("alpha",alpha,sep=""), paste("beta",format(beta,nsmall=2), sep=""),sep="") z[[table]][row,col] } FisherTest(0.05,0.1,0.10,0.35) ## [1] 52 每组是少需要 52 例。 5.3.3 单组优化多阶段设计 (Optimal Multiple-Stage Designs for Single Arm Trials) 5.3.3.1 最优化两阶段设计(Optimal Two-Stage Designs) 该设计中,当出现了一定数量的失败后,容许实验结束。该设计的的样 本量可以通过查询下表获得。 150data <- read.table("OptimalTwoStageDesigns",header = T) panderOptions('table.split.table',140)# 改变默认 80 的宽度 panderOptions('digits', 2) pander(data) p0 p1 alpha beta Or1_n1 Or_n Mr1_n1 Mr_n 0.05 0.2 0.1 0.1 0/12 3/37 0/13 3/32 0.05 0.2 0.05 0.2 0/10 3/29 0/13 3/27 0.05 0.2 0.05 0.1 1/21 4/41 1/29 4/38 0.1 0.25 0.1 0.1 2/21 7/50 2/27 6/40 0.1 0.25 0.05 0.2 2/18 7/43 2/22 7/40 0.1 0.25 0.05 0.1 2/21 10/66 3/31 9/55 0.2 0.35 0.1 0.1 5/27 16/63 6/33 15/58 0.2 0.35 0.05 0.2 5/22 19/72 6/31 15/53 0.2 0.35 0.05 0.1 8/37 22/83 8/42 21/77 0.3 0.45 0.1 0.1 9/30 29/82 16/50 25/69 0.3 0.45 0.05 0.2 9/27 30/81 16/46 25/65 0.3 0.45 0.05 0.1 13/40 40/110 27/77 33/88 0.4 0.55 0.1 0.1 16/38 40/88 18/45 34/73 151p0 p1 alpha beta Or1_n1 Or_n Mr1_n1 Mr_n 0.4 0.55 0.05 0.2 11/26 40/84 28/59 34/70 0.4 0.55 0.05 0.1 19/45 49/104 24/62 45/94 0.5 0.65 0.1 0.1 18/35 47/84 19/40 41/72 0.5 0.65 0.05 0.2 15/28 48/83 39/66 40/68 0.5 0.65 0.05 0.1 22/42 60/105 28/57 54/93 0.6 0.75 0.1 0.1 21/34 47/71 25/43 43/64 0.6 0.75 0.05 0.2 17/27 46/67 18/30 43/62 0.6 0.75 0.05 0.1 21/34 64/95 48/72 57/84 0.7 0.85 0.1 0.1 14/20 45/59 15/22 40/52 0.7 0.85 0.05 0.2 14/19 46/59 16/23 39/49 0.7 0.85 0.05 0.1 18/25 61/79 33/44 53/68 0.8 0.95 0.1 0.1 5/7 27/31 5/7 27/31 0.8 0.95 0.05 0.2 7/9 26/29 7/9 26/29 0.8 0.95 0.05 0.1 16/19 37/42 31/35 35/40 0.05 0.25 0.1 0.1 0/9 2/24 0/13 2/20 152p0 p1 alpha beta Or1_n1 Or_n Mr1_n1 Mr_n 0.05 0.25 0.05 0.2 0/9 2/17 0/12 2/16 0.05 0.25 0.05 0.1 0/9 3/30 0/15 3/25 0.1 0.3 0.1 0.1 1/12 5/35 1/16 4/25 0.1 0.3 0.05 0.2 1/10 5/29 1/15 5/25 0.1 0.3 0.05 0.1 2/18 6/35 2/22 6/33 0.2 0.4 0.1 0.1 3/17 10/37 3/19 10/36 0.2 0.4 0.05 0.2 3/13 12/43 4/18 10/33 0.2 0.4 0.05 0.1 4/19 15/54 5/24 13/45 0.3 0.5 0.1 0.1 7/22 17/46 7/28 15/39 0.3 0.5 0.05 0.2 5/15 18/46 6/19 16/39 0.3 0.5 0.05 0.1 8/24 24/63 7/24 21/53 0.4 0.6 0.1 0.1 7/18 22/46 11/28 20/41 0.4 0.6 0.05 0.2 7/16 23/46 17/34 20/39 0.4 0.6 0.05 0.1 11/25 32/66 12/29 27/54 0.5 0.7 0.1 0.1 11/21 26/45 11/23 23/39 153p0 p1 alpha beta Or1_n1 Or_n Mr1_n1 Mr_n 0.5 0.7 0.05 0.2 8/15 26/43 12/23 23/37 0.5 0.7 0.05 0.1 13/24 35/61 14/27 32/53 0.6 0.8 0.1 0.1 6/11 26/38 18/27 14/35 0.6 0.8 0.05 0.2 7/11 30/43 8/13 25/35 0.6 0.8 0.05 0.1 12/19 37/53 15/26 32/45 0.7 0.9 0.1 0.1 6/9 22/28 11/16 20/25 0.7 0.9 0.05 0.2 4/6 22/27 19/23 21/26 0.7 0.9 0.05 0.1 11/15 29/36 13/18 26/32 例一新型抗肿瘤药品进行二期临床试验,标准治疗的有效率为 20%,如 果新型药品的有效率达 40%,则认为有临床价值。最优化两阶段设计,在 α = 0.05,β = 0.1,需要多少病例? OptimalTwoStageDesigns <- function(alphap,betap,p0p,p1p){ data <- read.table("OptimalTwoStageDesigns",header = T) data%>>% subset(p0==p0p)%>>% subset(p1==p1p)%>>% subset(alpha==alphap)%>>% subset(beta==betap)%>>% return() } 154OptimalTwoStageDesigns(0.05,0.1,0.20,0.40) ## p0 p1 alpha beta Or1_n1 Or_n Mr1_n1 Mr_n ## 36 0.2 0.4 0.05 0.1 4/19 15/54 5/24 13/45 第一阶段供需 19 例,其中 4 例有效,则可以进行第二阶段的试验。第 二阶段需继续做 5 例,达到 24 例,如果至少 5 例有效,则可进行进一步的 研究。 5.3.3.2 灵活两阶段设计(Flexible Two-Stage Designs) 该设计对两个阶段的病例数给出多个选择,优化灵活两阶段设计样本量 和界值可查询下表。 data <- read.csv("OptimalFlexibleTwoStage.csv",header=T) for(i in 1:length(data$p0)){ if(is.na(data$p0[i])==T){ data$p0[i] <- data$p0[i-1] data$p1[i] <- data$p1[i-1] } } panderOptions('digits', 2) panderOptions('table.split.table',500) #panderOptions('table.alignment.default','left') #panderOptions('table.split.cells',40) pander(data,justify = c('center','center','center', 'center','center','center')) p0 p1 alpha beta ri_ni Rj_Nj 0.05 0.2 0.1 0.1 0/15-16,1/17-22 2/30-31,3/32-37 0.05 0.2 0.05 0.2 0/10-12,1/13-17 3/27-34 155p0 p1 alpha beta ri_ni Rj_Nj 0.05 0.2 0.05 0.1 1/17-24 4/41-46,5/47-48 0.1 0.25 0.1 0.1 2/19-25,3/26 6/44-45,7/46-51 0.1 0.25 0.05 0.2 1/13-15,2/16-20 6/40,7/41-45,8/46-47 0.1 0.25 0.05 0.1 2/21-24,3/25-28 9/57-61,10/62-64 0.2 0.35 0.1 0.1 6/28-31,7/32-35 15/62,16/63-65,17/66- 68,18/69 0.2 0.35 0.05 0.2 4/18-21,5/22-24,6/25 17/62-64,18/65-69, 0.2 0.35 0.05 0.2 6/31,7/32-34,8/35-38 22/82-85,23/86-89 0.3 0.45 0.1 0.1 9/31,10/32-33,11/34- 37,12/38 27/75-77,28/78- 80,29/81-82 0.3 0.45 0.05 0.2 7/23,8/24-25,9/26- 29,10/30 27/73,28/74-76,29/77- 78,30/79-80 0.3 0.45 0.05 0.2 11/35-36,12/37- 39,13/40-42 36/98-99,37/100- 102,38/103-104,39/105 0.4 0.55 0.1 0.1 12/30-31,13/32- 33,14/34-35,15/36-37 37/80-81,38/82- 84,39/85-86,40/87 0.4 0.55 0.05 0.2 11/25-26,12/27- 29,13/30-31,14/32 37/78,38/79-80,39/81- 82,40/83-85 156p0 p1 alpha beta ri_ni Rj_Nj 0.4 0.55 0.05 0.1 16/38-39,17/40- 41,18/42-44,19/45 49/104-105,50/106- 107,51/108-109,52/110- 111 0.5 0.65 0.1 0.1 15/30,16/31-32,17/33- 34,18/35-36,19/37 44/78-79,45/80- 81,46/82-83,47/84,48/85 0.5 0.65 0.05 0.2 12/23,13/24-25,14/26- 27,15/28-29,16/30 45/77-78,46/79- 80,47/81-82,48/83,49/84 0.5 0.65 0.05 0.1 21/40,22/41-42,23/43- 44,24/45-46,25/47 59/103-104,60/105- 106,61/107,62/108- 109,63/110 0.6 0.75 0.1 0.1 16/27,17/28,18/29- 30,19/31- 32,20/33,21/34 44/67,45/68,46/69- 70,47/71,48/72,49/73-74 0.6 0.75 0.05 0.2 14/22-23,15/24,16/25 46/68,47/69,48/70-71 0.6 0.75 0.05 0.1 20/32-33,21/34,22/36- 36,23/37/24/38-39 61/90-91,62/92,63/93- 94,64/95,65/96-97 0.7 0.85 0.1 0.1 13/19,14/20,15/21,16/22- 23,17/24,18/25-26 40/53,41/54,42/55,43/56,44/57- 58,45/59,46/60 0.7 0.85 0.05 0.2 9/13,10/14,11/15,12/16- 17,13/18,14/19,15/20 44/56- 57,45/58,46/59,47/60,48/61- 62,49/63 157p0 p1 alpha beta ri_ni Rj_Nj 0.7 0.85 0.05 0.1 17/24,18/26,19/26,20/27- 28,21/29,22/30,23/31 57/73-74,58/75,59/76- 77,60/78,61/79,62/80 0.8 0.95 0.1 0.1 8/10,9/11,10/12- 13,11/14,12/15,13/16,14/17 24/28,25/29,26/30,27/31,28/32,29/33,30/34- 35 0.8 0.95 0.05 0.2 7/9,8/10,9/11,10/12, 11/13,12/14,13/15,14/16 25/28,26/29,27/30,28/31- 32, 29/33,30/34,31/35 0.8 0.95 0.05 0.1 10/12,11/13- 14,12/15,13/16, 14/17,15/18,16/19 35/40,36/41,37/42,38/43,39/44, 40/45-46,41/47 0.05 0.25 0.1 0.1 0/8-13,1/14-15 1/18,2/19-25 0.05 0.25 0.05 0.2 0/5-10,1/11-12 2/17-22,3/23-24 0.05 0.25 0.05 0.1 0/8-13,1/14-15 2/24,3/25-31 0.1 0.3 0.1 0.1 1/11-17,2/18 3/24,4/25-28,5/29-31 0.1 0.3 0.05 0.2 1/8-12,2/13-15 4/26,5/27-32,6/33 0.1 0.3 0.05 0.1 1/12-14,2/15-19 6/36-39,7/40-43 0.2 0.4 0.1 0.1 2/14,3/15-17,4/18-21 9/35-36,10/37-38,11/39- 42 0.2 0.4 0.05 0.2 2/10-12,3/13-15,4/16- 17 10/33-35,11/36-40 158p0 p1 alpha beta ri_ni Rj_Nj 0.2 0.4 0.05 0.1 4/18-20,5/21-24,6/25 13/48,14/49-51,15/52-55 0.3 0.5 0.1 0.1 4/14-16,5/17-19,6/20- 21 15/40-41,16/42- 44,17/45-46,18/47 0.3 0.5 0.05 0.2 3/11,4/12-14,5/15- 16/6/17-18 16/40-41,16/42- 44,18/45-46,18/47 0.3 0.5 0.05 0.1 6/19-20,7/21-23,8/24- 26 21/55,22/56-58,23/59- 60,24/61-62 0.4 0.6 0.1 0.1 6/15-16,7/17- 19,8/20,9/21-22 21/44-45,22/46- 47,23/48-49,24/50-51 0.4 0.6 0.05 0.2 5/12-13,6/14,7/15- 16,8/17-19 22/44-45,23/46- 47,24/48-49,25/50,26/51 0.4 0.6 0.05 0.1 8/20,9/21-22,10/23- 24,11/25-26,12/27 28/58,29/59-60,30/61- 62,31/63,32/64-65 0.5 0.7 0.1 0.1 7/15,8/16- 17,9/18,10/19- 20,11/21,12/22 24/41- 42,25/43/44,26/45,27/46- 47,28/48 0.5 0.7 0.05 0.2 5/10,6/11-12,7/13- 14,8/15,9/16-17 25/42,26/43-44,27- 45,28/46-47,29/48,30/49 0.5 0.7 0.05 0.1 10/19-20,11/21,12/22- 23,13/24-25,14/26 33/55-56,34/57- 58,35/59,36/60-61,37/62 159p0 p1 alpha beta ri_ni Rj_Nj 0.6 0.8 0.1 0.1 7/12,8/13- 14,9/15,10/16- 17,11/18,12/19 24/35- 36,25/37,26/38,27/39- 40,28/41,29/42 0.6 0.8 0.05 0.2 5/8-9,6/10,7/11,8/12- 13,9/14-15 25/35- 36,26/37,27/38,28/39- 40,29/41,30/42 0.6 0.8 0.05 0.1 11/17-18,12/19,13/20- 21,14/22,15/23,16/24 34/48-49,35/50- 51,36/52,37/53-54,38/55 0.7 0.9 0.1 0.1 6/9,7/10,8/11,9/12- 13,10/14,11/15-16 18/23,19/24,20/25- 26,21/27,22/28,23/29,24/30 0.7 0.9 0.05 0.2 4/6,5/7,6/8,7/9,8/10- 11,9/12,10/13 22/27,23/28- 29,24/30,25/31,26/32- 33,27/34 0.7 0.9 0.05 0.1 7/10,8/11,9/12- 13,10/14,11/15,12/16,13/17 27/34/28/35,29/36,30/37- 38,31/39,32/40,33/41 # 调整对齐方式 例一新型抗肿瘤药品进行二期临床试验,标准治疗的有效率为 20%,如 果新型药品的有效率达 40%,则认为有临床价值。优化灵活两阶段设计,在 α = 0.05,β = 0.1,需要多少病例? OptimalFlexibleTwoStageDesigns <- function(alphap,betap,p0p,p1p){ data <- read.csv("OptimalFlexibleTwoStage.csv",header=T) for(i in 1:length(data$p0)){ 160if(is.na(data$p0[i])==T){ data$p0[i] <- data$p0[i-1] data$p1[i] <- data$p1[i-1] } } data%>>% subset(p0==p0p)%>>% subset(p1==p1p)%>>% subset(alpha==alphap)%>>% subset(beta==betap)%>>% return() } OptimalFlexibleTwoStageDesigns(0.05,0.1,0.20,0.40) ## p0 p1 alpha beta ri_ni Rj_Nj ## 36 0.2 0.4 0.05 0.1 4/18-20,5/21-24,6/25 13/48,14/49-51,15/52-55 该研究第一阶段需要 18-20 个病例,如果至少 4 例有效,则可进行第二 阶段试验。第二阶段继续做 28 ~ 30 个病例,总数达到 48 例。如果 13 例 有效,则可进行进一步研究。 极小灵活两阶段设计样本量和界值可查询下表。 data <- read.csv("MinimaxFlexibleTwoStage.csv",header=T) for(i in 1:length(data$p0)){ if(is.na(data$p0[i])==T){ data$p0[i] <- data$p0[i-1] data$p1[i] <- data$p1[i-1] } } panderOptions('digits', 2) panderOptions('table.split.table',500) pander(data,justify = c('center','center','center', 'center','center','center')) 161p0 p1 alpha beta ri_ni Rj_Nj 0.05 0.2 0.1 0.1 0/16-22,1/23 2/26-28,3/29-33 0.05 0.2 0.05 0.2 0/10-17 2/23,2/24-30 0.05 0.2 0.05 0.1 0/22-27,1/28-29 3/33-34,4/35-40 0.1 0.25 0.1 0.1 1/25-27,2/28-32 5/37,6/38-42,7/43-44 0.1 0.25 0.05 0.2 1/22-24,2/25-29 6/33-37,7/38-40 0.1 0.25 0.05 0.1 2/25-29,3/30-32 8/49-52,9/53-56 0.2 0.35 0.1 0.1 6/37-39,7/40-42,8/43- 440 14/54-55,15/56- 59,16/60-61 0.2 0.35 0.05 0.2 6/28,6/29-31,7/32-35 14/50-51,15/52- 54,16/55-57 0.2 0.35 0.05 0.1 8/41-45,9/46-48 19/71-72,20/73- 74,21/75-78 0.3 0.45 0.1 0.1 11/43,12/44-46.13/47- 48,14/49-50 23/64,24/65-67,25/68- 69,26/70-71 0.3 0.45 0.05 0.2 10/36,11/37,12/38- 39,13/40-43 23/60,24/61-63,25/64- 65,26/66-67 0.3 0.45 0.05 0.1 15/50-52,16/53- 55,17/56-57 32/85-86,33/87- 89,34/90-91,35/92 162p0 p1 alpha beta ri_ni Rj_Nj 0.4 0.55 0.1 0.1 16/43-44,17/45- 46,18/47,19/48-49,20/50 32/69-70,33/71,34/72- 73,35/74-75,36/76 0.4 0.55 0.05 0.2 13/34-35,14/36,15/37- 39,16/40-41 32/65-66,33/67- 68,34/69-70,35/71,36/72 0.4 0.55 0.05 0.1 23/60-61,24/62- 63,25/64-65,26/66-67 43/91,44/92- 93,45/94,46/95- 96,47/97-98 0.5 0.6 0.1 0.1 19/41,20/42-43,21/44- 45,22/57-57,23/48 38/67,39/68-69,40/70- 71,41/72,42/73-74 0.5 0.6 0.05 0.2 16/33,17/34-35,18/36- 37,19/38-39,20/40 38/64-65,39/66,40/67- 68,41/69,42/70-71 0.5 0.6 0.05 0.1 26/53,27/54- 55,28/56,29/57,30/58- 59,31/60 52/89-90,53/91- 92,54/93-94,55/95,56/96 0.6 0.75 0.1 0.1 22/38-39,23/40,24/41- 42,25/43,26/44-45 40/60,41/61,42/62- 63,43/64,44/65-66,45/67 0.6 0.75 0.05 0.2 18/31,19/32,20/33- 34,21/35,22/36-37,23/38 40/57-58,41/59,42/60- 61,43/62,44/63-64 0.6 0.75 0.05 0.1 23/39,24/40-41,25/42- 43,26/44,27/45,28/46 54/80,55/81,56/82,57/83- 84,58/85,59/86-87 163p0 p1 alpha beta ri_ni Rj_Nj 0.7 0.85 0.1 0.1 19/28- 29,20/30,21/31,22/32,23/33- 34,24/35 36/46- 47,37/48,38/49,39/50- 51,40/52,41/53 0.7 0.85 0.05 0.2 18/25,19/26,20/27- 28,21/29,22/30,23/31,24/32 36/45,37/46- 47,38/48,39/49,40/50- 51,41/52 0.7 0.85 0.05 0.1 26/38,27/39,28/40,29/41,30/42- 43,31/44/32/45 48/62,49/63,50/64,51/65,52/66,53/67,54/68- 69 0.8 0.95 0.1 0.1 9/12,10/13,11/14,12/15,13/16,14/17,15/18,16/1923/26,24/27- 28,25/29,26/30,27/31,28/32,29/33 0.8 0.95 0.05 0.2 6/8,7/9,8/10,9/11,10/12- 13,11/14,12/15 23/26,24/27,25/28,26/29,27/30,28/31,29/32,30/33 0.8 0.95 0.05 0.1 22/26,23/27,24/28,25/29,26/30,27/31,28/32,29/3331/35,32/36,33/37,34/38,35/39- 40,36/41,37/42 0.05 0.25 0.1 0.1 0/8-15 1/17,2/18-24 0.05 0.25 0.05 0.2 0/6-12,1/13 2/14-21 0.05 0.25 0.05 0.1 0/10-16,1/17 2/21-22,3/23-28 0.1 0.3 0.1 0.1 0/11-13,1/14-18 3/22-23,4/24-26,5/27-29 0.1 0.3 0.05 0.2 0/11-14,1/15-18 3/19,4/20-22,5/23-26 164p0 p1 alpha beta ri_ni Rj_Nj 0.1 0.3 0.05 0.1 1/17-20,2/21-23,3/24 5/28-30,6/31-35 0.2 0.4 0.1 0.1 3/22-23,4/24,5/25- 27,6/28-29 8/30-31,9/32/33,10/34- 37 0.2 0.4 0.05 0.2 2/14,3/15-18,4/19-21 9/28-31,10/32-34,11/35 0.2 0.4 0.05 0.1 5/27-29,11/40,12/41- 42,6/30-32,7/33-34 13/43-45,14/46-47 0.3 0.5 0.1 0.1 6/24-25,7/26- 29,8/30,9/31 13/35,14/36-37,15/38- 40,16/41-42 0.3 0.5 0.05 0.2 5/18-19,6/20-22,14/33- 35,15/36-37,7/23- 24,8/25 16/38-39,17/40 0.3 0.5 0.05 0.1 7/27,8/28-29,19/47- 49,20/50-51,9/30- 31,10/32-34 21/52-53,22/54 0.4 0.6 0.1 0.1 8/23-24,9/25- 26,10/27,11/28-29,12/30 18/37-38,19/39- 40,20/41,21/42-43,22/44 0.4 0.6 0.05 0.2 6/18,7/19-20,8/21- 22,9/23,10/24-25 18/35-36,19/37,20/38- 39,21/40,22/41-42 0.4 0.6 0.05 0.1 10/26-27,11/28,12/29- 31,13/32-33 25/50-51,26/52,27/53- 54,28/55-56,29/57 165p0 p1 alpha beta ri_ni Rj_Nj 0.5 0.7 0.1 0.1 8/18,9/19- 20,10/21,11/22- 23,12/24,13/25 21/36,22/37- 38,23/39,24/40- 41,25/42-43 0.5 0.7 0.05 0.2 7/15,8/16-17,9/18- 19,10/20,11/21,12/22 21/34,22/35-36,23/37- 38,24/39,25/40,26/41 0.5 0.7 0.05 0.1 14/30-31,15/32,16/33- 34,17/35,18/36,19/37 18/47,29/48,30/49- 50,31/51,32/52-53,33/54 0.6 0.8 0.1 0.1 9/17- 18,10/19,11/20,12/21,13/22- 23,14/24 21/30- 31,22/32,23/33,24/34- 35,25/36,26/37 0.6 0.8 0.05 0.2 6/11,7/12-13,8/14,9/15- 16,10/17,11/18 21/29,22/30- 31,23/32,24/33,25/34- 35,26/36 0.6 0.8 0.05 0.1 11/19,12/20- 21,13/22,14/23,15/24-26 29/41,30/42- 43,31/44,32/45,33/46- 47,34/48 0.7 0.9 0.1 0.1 5/8,6/9,7/10- 11,8/12,9/13,10/14-15 17/22,18/23,19/24,20/25,21/26,22/27- 28,23/29 0.7 0.9 0.05 0.2 5/8,6/9,7/10,8/11,9/12- 13,10/14,11/15 17/21,18/22,19/23,20/24,21/25,22/26- 27,23/28 0.7 0.9 0.05 0.1 8/12,9/13,10/14,11/15,12/16- 17,13/18,14/19 24/30,35/31,26/32,27/33,28/34- 35,29/36,30/37 166p0 p1 alpha beta ri_ni Rj_Nj 例一新型抗肿瘤药品进行二期临床试验,标准治疗的有效率为 20%,如 果新型药品的有效率达 40%,则认为有临床价值。优化灵活两阶段设计,在 α = 0.05,β = 0.1,需要多少病例? MinimaxFlexibleTwoStageDesigns <- function(alphap,betap,p0p,p1p){ data <- read.csv("MinimaxFlexibleTwoStage.csv",header=T) for(i in 1:length(data$p0)){ if(is.na(data$p0[i])==T){ data$p0[i] <- data$p0[i-1] data$p1[i] <- data$p1[i-1] } } data%>>% subset(p0==p0p)%>>% subset(p1==p1p)%>>% subset(alpha==alphap)%>>% subset(beta==betap)%>>% return() } MinimaxFlexibleTwoStageDesigns(0.05,0.1,0.20,0.40) ## p0 p1 alpha beta ri_ni ## 36 0.2 0.4 0.05 0.1 5/27-29,11/40,12/41-42,6/30-32,7/33-34 ## Rj_Nj ## 36 13/43-45,14/46-47 该研究第一阶段需要 27-29 个病例,如果至少 5 例有效,则可进行第二 阶段试验。第二阶段继续做 16 个病例,总数达到 43-45 例。如果 13 例有 效,则可进行进一步研究。 1675.3.3.3 优化三阶段设计(Optimal Three-Stage Designs) 该设计的基本模式和两阶段相同。其样本含量和临界值,Ensign 等可 查询下表 data <- read.csv("OptimalThreeStageDesignsEnsign.csv",header=T) for(i in 1:length(data$p0)){ if(is.na(data$p0[i])==T){ data$p0[i] <- data$p0[i-1] data$p1[i] <- data$p1[i-1] } } panderOptions('digits', 2) panderOptions('table.split.table',500) pander(data) p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.05 0.2 0.1 0.1 0/12 1/25 3/38 0.05 0.2 0.05 0.2 0/10 2/24 3/31 0.05 0.2 0.05 0.1 0/14 2/29 4/4 0.1 0.25 0.1 0.1 0/11 3/29 7/50 0.1 0.25 0.05 0.2 0/9 3/25 7/43 0.1 0.25 0.05 0.1 0/13 3/27 10/66 0.15 0.3 0.1 0.1 0/12 4/28 11/55 0.15 0.3 0.05 0.2 0/9 5/27 12/56 168p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.15 0.3 0.05 0.1 0/13 6/35 16/77 0.2 0.35 0.1 0.1 0/11 7/34 16/63 0.2 0.35 0.05 0.2 0/6 6/28 18/67 0.2 0.35 0.05 0.1 0/9 10/44 23/88 0.25 0.4 0.1 0.1 0/8 8/32 23/76 0.25 0.4 0.05 0.2 0/6 7/26 24/75 0.25 0.4 0.05 0.1 0/9 11/41 30/95 0.3 0.45 0.1 0.1 0/7 13/41 28/79 0.3 0.45 0.05 0.2 0/7 9/27 31/84 0.3 0.45 0.05 0.1 0/9 14/43 38/104 0.35 0.5 0.1 0.1 0/9 12/34 33/81 0.35 0.5 0.05 0.2 0/5 12/31 37/88 0.35 0.5 0.05 0.1 0/8 17/45 45/108 0.4 0.55 0.1 0.1 0/11 16/38 40/88 0.4 0.55 0.05 0.2 0/5 14/32 40/84 169p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.4 0.55 0.05 0.1 0/10 19/45 49/104 0.45 0.6 0.1 0.1 0/6 15/34 40/78 0.45 0.6 0.05 0.2 0/5 12/25 47/90 0.45 0.6 0.05 0.1 0/6 20/42 59/114 0.5 0.65 0.1 0.1 0/5 16/32 46/84 0.5 0.65 0.05 0.2 0/5 12/25 47/90 0.5 0.65 0.05 0.1 0/6 20/42 59/114 0.55 0.7 0.1 0.1 0/7 19/34 46/75 0.55 0.7 0.05 0.2 0/5 15/26 48/76 0.55 0.7 0.05 0.1 0/5 23/40 64/96 0.6 0.75 0.1 0.1 0/5 21/34 47/71 0.6 0.75 0.05 0.2 0/5 13/21 49/72 0.6 0.75 0.05 0.1 0/5 14/23 90/98 0.65 0.8 0.1 0.1 0/5 17/26 47/66 0.65 0.8 0.05 0.2 0/5 12/18 49/67 170p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.65 0.8 0.05 0.2 0/5 8/13 74/78 0.7 0.85 0.1 0.1 0/5 14/20 45/59 0.7 0.85 0.05 0.2 0/5 14/19 46/59 0.7 0.85 0.05 0.1 0/5 12/17 68/72 0.75 0.9 0.1 0.1 0/5 16/21 36/44 0.75 0.9 0.05 0.2 0/5 10/13 40/48 0.75 0.9 0.05 0.1 0/5 8/11 55/57 0.8 0.95 0.1 0.1 0/5 5/7 27/31 0.8 0.95 0.05 0.2 0/5 7/9 26/29 0.8 0.95 0.05 0.1 0/5 8/10 44/45 0.05 0.25 0.1 0.1 0/9 1/19 2/25 0.05 0.25 0.05 0.2 0/7 1/15 3/26 0.05 0.25 0.05 0.1 0/9 1/22 3/30 0.1 0.3 0.1 0.1 0/10 2/19 4/26 0.1 0.3 0.05 0.2 0/6 2/17 5/29 0.1 0.3 0.05 0.1 0/9 3/22 7/45 0.15 0.35 0.1 0.1 0/9 2/16 7/33 171p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.15 0.35 0.05 0.2 0/5 3/17 9/41 0.15 0.35 0.05 0.1 0/9 4/23 10/44 0.2 0.4 0.1 0.1 0/8 3/16 11/42 0.2 0.4 0.05 0.2 0/5 4/17 12/43 0.2 0.4 0.05 0.1 0/9 4/23 15/54 0.25 0.45 0.1 0.1 0/6 6/23 14/44 0.25 0.45 0.05 0.2 0/5 5/17 16/48 0.25 0.45 0.05 0.1 0/7 6/22 20/61 0.3 0.5 0.1 0.1 0/6 6/20 17/46 0.3 0.5 0.05 0.2 0/5 5/15 19/49 0.3 0.5 0.05 0.1 0/8 8/24 24/63 0.35 0.55 0.1 0.1 0/6 7/20 20/47 0.35 0.55 0.05 0.2 0/6 8/20 19/42 0.35 0.55 0.05 0.1 0/5 10/26 29/67 0.4 0.6 0.1 0.1 0/5 8/20 22/46 0.4 0.6 0.05 0.2 0/5 7/16 24/48 0.4 0.6 0.05 0.1 0/5 9/22 30/61 0.45 0.65 0.1 0.1 0/5 10/21 26/50 0.45 0.65 0.05 0.2 0/5 7/15 24/43 0.45 0.65 0.05 0.1 0/5 15/30 32/59 172p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.5 0.7 0.1 0.1 0/5 11/21 26/45 0.5 0.7 0.05 0.2 0/5 8/15 26/43 0.5 0.7 0.05 0.1 0/5 12/23 34/57 0.55 0.75 0.1 0.1 0/5 10/18 26/41 0.55 0.75 0.05 0.2 0/5 9/15 28/43 0.55 0.75 0.05 0.1 0/5 10/18 35/54 0.6 0.8 0.1 0.1 0/5 6/11 26/38 0.6 0.8 0.05 0.2 0/5 7/11 30/43 0.6 0.8 0.05 0.1 0/5 12/19 37/53 0.65 0.85 0.1 0.1 0/5 10/15 25/34 0.65 0.85 0.05 0.2 0/5 10/14 25/33 0.65 0.85 0.05 0.2 0/5 10/15 33/44 0.7 0.9 0.1 0.1 0/5 6/9 22/28 0.7 0.9 0.05 0.2 0/5 4/6 22/27 0.7 0.9 0.05 0.1 0/5 11/15 29/36 0.75 0.95 0.1 0.1 0/5 6/8 16/19 0.75 0.95 0.05 0.2 0/5 9/11 19/22 0.75 0.95 0.05 0.1 0/5 7/9 24/28 Chen 扩展的样本量和临床界值可查询下表 173data <- read.csv("OptimalThreeStageDesignsChen.csv",header = T) for(i in 1:length(data$p0)){ if(is.na(data$p0[i])==T){ data$p0[i] <- data$p0[i-1] data$p1[i] <- data$p1[i-1] } } panderOptions('digits', 2) panderOptions('table.split.table',500) pander(data) p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.05 0.2 0.1 0.1 0/13 1/22 3/37 0.05 0.2 0.05 0.2 0/10 1/19 3/30 0.05 0.2 0.05 0.1 0/14 2/29 4/43 0.1 0.25 0.1 0.1 1/17 3/29 7/50 0.1 0.25 0.05 0.2 1/13 3/24 8/53 0.1 0.25 0.05 0.1 1/17 4/34 10/66 0.15 0.3 0.1 0.1 2/20 5/33 11/55 0.15 0.3 0.05 0.2 2/15 6/33 13/62 0.15 0.3 0.05 0.1 3/23 8/46 16/77 174p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.2 0.35 0.1 0.1 3/21 8/37 17/68 0.2 0.35 0.05 0.2 3/17 9/37 18/68 0.2 0.35 0.05 0.1 5/27 11/49 23/88 0.25 0.4 0.1 0.1 4/20 10/39 24/80 0.25 0.4 0.05 0.2 4/17 12/42 25/79 0.25 0.4 0.05 0.1 6/26 15/54 32/103 0.3 0.45 0.1 0.1 6/24 14/44 28/79 0.3 0.45 0.05 0.2 5/18 14/41 31/84 0.3 0.45 0.05 0.1 8/29 19/57 38/104 0.35 0.5 0.1 0.1 7/23 18/49 34/84 0.35 0.5 0.05 0.2 6/19 17/43 34/80 0.35 0.5 0.05 0.1 9/28 23/60 45/108 0.4 0.55 0.1 0.1 7/21 19/46 38/83 0.4 0.55 0.05 0.2 7/19 19/43 39/82 0.4 0.55 0.05 0.1 12/31 28/64 54/116 175p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.45 0.6 0.1 0.1 12/28 27/56 43/85 0.45 0.6 0.05 0.2 8/19 21/42 45/86 0.45 0.6 0.05 0.1 13/30 29/60 58/112 0.5 0.65 0.1 0.1 10/22 25/48 48/86 0.5 0.65 0.05 0.2 8/17 21/39 49/85 0.5 0.65 0.05 0.1 14/29 34/63 62/109 0.55 0.7 0.1 0.1 13/25 25/44 47/77 0.55 0.7 0.05 0.2 7/14 23/39 49/78 0.55 0.7 0.05 0.1 15/28 36/61 65/105 0.6 0.75 0.1 0.1 11/20 26/42 57/71 0.6 0.75 0.05 0.2 8/14 23/36 52/77 0.6 0.75 0.05 0.1 14/24 36/56 70/105 0.65 0.8 0.1 0.1 11/18 27/40 49/69 0.65 0.8 0.05 0.2 8/13 27/38 52/72 0.65 0.8 0.05 0.2 16/25 35/50 66/92 176p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.7 0.85 0.1 0.1 14/20 18/37 45/59 0.7 0.85 0.05 0.2 4/7 11/16 44/56 0.7 0.85 0.05 0.1 12/18 28/38 58/75 0.75 0.9 0.1 0.1 10/14 23/29 38/47 0.75 0.9 0.05 0.2 9/12 21/26 39/47 0.75 0.9 0.05 0.1 10/14 23/29 55/67 0.8 0.95 0.1 0.1 5/7 16/19 30/35 0.8 0.95 0.05 0.2 2/3 16/19 35/40 0.8 0.95 0.05 0.1 6/8 24/28 41/47 0.05 0.25 0.1 0.1 0/9 1/18 2/26 0.05 0.25 0.05 0.2 0/8 1/13 2/19 0.05 0.25 0.05 0.1 0/10 1/17 3/30 0.1 0.3 0.1 0.1 0/10 2/19 4/26 0.1 0.3 0.05 0.2 0/6 2/17 5/29 0.1 0.3 0.05 0.1 1/13 3/23 7/45 0.15 0.35 0.1 0.1 1/12 3/21 7/33 0.15 0.35 0.05 0.2 1/9 4/21 8/35 177p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.15 0.35 0.05 0.1 2/15 5/27 11/51 0.2 0.4 0.1 0.1 1/10 6/26 11/43 0.2 0.4 0.05 0.2 1/8 5/22 11/38 0.2 0.4 0.05 0.1 3/17 7/30 14/50 0.25 0.45 0.1 0.1 3/16 7/25 13/41 0.25 0.45 0.05 0.2 2/10 6/20 16/48 0.25 0.45 0.05 0.1 4/18 10/33 19/58 0.3 0.5 0.1 0.1 3/13 9/28 17/46 0.3 0.5 0.05 0.2 3/11 7/21 18/46 0.3 0.5 0.05 0.1 4/16 11/32 23/60 0.35 0.55 0.1 0.1 6/18 13/33 20/48 0.35 0.55 0.05 0.2 3/10 9/23 21/47 0.35 0.55 0.05 0.1 6/18 15/38 27/62 0.4 0.6 0.1 0.1 7/18 9/26 22/46 0.4 0.6 0.05 0.2 3/9 10/23 23/46 0.4 0.6 0.05 0.1 6/16 17/38 32/66 0.45 0.65 0.1 0.1 5/13 13/27 26/50 0.45 0.65 0.05 0.2 3/8 10/20 29/54 0.45 0.65 0.05 0.1 6/15 17/34 34/63 0.5 0.7 0.1 0.1 4/10 12/24 26/45 0.5 0.7 0.05 0.2 4/9 13/23 29/49 178p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.5 0.7 0.05 0.1 7/15 19/34 38/65 0.55 0.75 0.1 0.1 5/11 12/21 27/43 0.55 0.75 0.05 0.2 6/11 14/23 28/43 0.55 0.75 0.05 0.1 7/14 16/27 36/56 0.6 0.8 0.1 0.1 6/11 14/22 29/43 0.6 0.8 0.05 0.2 5/9 12/48 28/40 0.6 0.8 0.05 0.1 6/11 19/29 38/55 0.65 0.85 0.1 0.1 5/9 13/19 25/34 0.65 0.85 0.05 0.2 5/8 13/18 27/36 0.65 0.85 0.05 0.1 6/10 16/23 35/47 0.7 0.9 0.1 0.1 5/8 11/15 22/28 0.7 0.9 0.05 0.2 3/5 10/13 25/31 0.7 0.9 0.05 0.1 6/9 16/21 31/39 0.75 0.95 0.1 0.1 3/5 6/8 16/19 0.75 0.95 0.05 0.2 1/2 9/11 19/22 0.75 0.95 0.05 0.1 6/8 13/16 24/28 例一新型抗肿瘤药品进行二期临床试验,标准治疗的有效率为 20%, 如果新型药品的有效率达 40%,则认为有临床价值。优化三阶段设计,在 α = 0.05,β = 0.1,需要多少病例? 179OptimalThreeStageDesignsEnsign<- function(alphap,betap,p0p,p1p){ data <- read.csv("OptimalThreeStageDesignsEnsign.csv",header = T) for(i in 1:length(data$p0)){ if(is.na(data$p0[i])==T){ data$p0[i] <- data$p0[i-1] data$p1[i] <- data$p1[i-1] } } data%>>% subset(p0==p0p)%>>% subset(p1==p1p)%>>% subset(alpha==alphap)%>>% subset(beta==betap)%>>% return() } OptimalThreeStageDesignsChen <- function(alphap,betap,p0p,p1p){ data <- read.csv("OptimalThreeStageDesignsChen.csv",header = T) for(i in 1:length(data$p0)){ if(is.na(data$p0[i])==T){ data$p0[i] <- data$p0[i-1] data$p1[i] <- data$p1[i-1] } } data%>>% subset(p0==p0p)%>>% subset(p1==p1p)%>>% subset(alpha==alphap)%>>% 180subset(beta==betap)%>>% return() } OptimalThreeStageDesignsEnsign(0.05,0.1,0.20,0.40) ## p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 ## 60 0.2 0.4 0.05 0.1 0/9 4/23 15/54 OptimalThreeStageDesignsChen(0.05,0.1,0.20,0.40) ## p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 ## 60 0.2 0.4 0.05 0.1 3/17 7/30 14/50 依据 Ensign 法,该研究第一阶段需要 9 名病例,如果是少有 1 例有效, 则可以进行第二阶段研究。第二阶段继续做 14 例,达到 23 例,如果至少 4 例有效,则可以进行第三阶段的研究。第三阶段继续做 31 例,达到 54 例, 如果至少有 15 例有效,则可进行进一步研究。Chen 法的结果解释类似。 极小三阶段设计需要的样本两最小,其样本含量和临界值可查询下表 data <- read.csv("MinimaxThreeStageDesignsChen.csv",header = T) for(i in 1:length(data$p0)){ if(is.na(data$p0[i])==T){ data$p0[i] <- data$p0[i-1] data$p1[i] <- data$p1[i-1] } } panderOptions('digits', 2) panderOptions('table.split.table',500) pander(data) 181p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.05 0.2 0.1 0.1 0/18 1/26 3/32 0.05 0.2 0.05 0.2 0/14 1/20 3/27 0.05 0.2 0.05 0.1 0/23 1/30 4/38 0.1 0.25 0.1 0.1 1/23 3/33 6/40 0.1 0.25 0.05 0.2 1/17 3/30 7/40 0.1 0.25 0.05 0.1 1/21 4/39 9/55 0.15 0.3 0.1 0.1 2/23 5/36 11/53 0.15 0.3 0.05 0.2 2/19 6/36 11/48 0.15 0.3 0.05 0.1 4/35 8/51 14/64 0.2 0.35 0.1 0.1 5/30 9/45 15/58 0.2 0.35 0.05 0.2 3/22 7/35 15/53 0.2 0.35 0.05 0.1 16/65 19/72 20/74 0.25 0.4 0.1 0.1 6/31 11/46 20/64 0.25 0.4 0.05 0.2 7/30 12/42 20/60 0.25 0.4 0.05 0.1 9/47 17/67 27/83 182p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.3 0.45 0.1 0.1 7/29 16/51 25/69 0.3 0.45 0.05 0.2 8/29 14/42 25/65 0.3 0.45 0.05 0.1 12/46 25/73 33/88 0.35 0.5 0.1 0.1 12/39 20/57 30/72 0.35 0.5 0.05 0.2 10/33 18/48 29/66 0.35 0.5 0.05 0.1 11/36 22/60 40/94 0.4 0.55 0.1 0.1 10/30 19/48 34/73 0.4 0.55 0.05 0.2 13/33 30/63 34/70 0.4 0.55 0.05 0.1 20/55 32/77 45/94 0.45 0.6 0.1 0.1 18/41 35/69 38/74 0.45 0.6 0.05 0.2 13/32 25/53 38/70 0.45 0.6 0.05 0.1 26/58 47/90 50/95 0.5 0.65 0.1 0.1 19/40 24/64 41/72 0.5 0.65 0.05 0.2 18/36 36/62 40/68 0.5 0.65 0.05 0.1 19/43 34/67 54/93 183p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.55 0.7 0.1 0.1 23/43 36/60 42/68 0.55 0.7 0.05 0.2 18/33 41/64 42/66 0.55 0.7 0.05 0.1 23/43 42/84 45/89 0.6 0.75 0.1 0.1 19/35 30/50 43/64 0.6 0.75 0.05 0.2 19/32 40/58 42/61 0.6 0.75 0.05 0.1 18/46 50/75 57/84 0.65 0.8 0.1 0.1 22/33 26/41 43/60 0.65 0.8 0.05 0.2 16/26 27/40 41/55 0.65 0.8 0.05 0.2 25/41 37/56 55/75 0.7 0.85 0.1 0.1 15/22 18/37 40/52 0.7 0.85 0.05 0.2 11/17 16/24 39/49 0.7 0.85 0.05 0.1 13/20 31/42 43/68 0.75 0.9 0.1 0.1 11/17 22/29 33/40 0.75 0.9 0.05 0.2 8/12 16/21 33/39 0.75 0.9 0.05 0.1 12/17 23/30 45/54 184p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.8 0.95 0.1 0.1 1/3 17/20 26/30 0.8 0.95 0.05 0.2 7/9 16/19 26/29 0.8 0.95 0.05 0.1 16/20 31/35 35/40 0.05 0.25 0.1 0.1 0/13 1/18 2/20 0.05 0.25 0.05 0.2 0/12 1/15 2/16 0.05 0.25 0.05 0.1 0/15 1/21 3/25 0.1 0.3 0.1 0.1 0/12 1/16 4/25 0.1 0.3 0.05 0.2 0/11 2/19 5/25 0.1 0.3 0.05 0.1 0/14 2/22 6/33 0.15 0.35 0.1 0.1 1/13 3/22 7/32 0.15 0.35 0.05 0.2 1/12 3/19 7/28 0.15 0.35 0.05 0.1 1/16 4/28 9/38 0.2 0.4 0.1 0.1 2/16 5/26 10/36 0.2 0.4 0.05 0.2 2/13 5/22 10/33 0.2 0.4 0.05 0.1 2/16 6/28 13/45 0.25 0.45 0.1 0.1 3/18 8/31 13/39 0.25 0.45 0.05 0.2 3/15 6/23 13/36 0.25 0.45 0.05 0.1 4/21 9/35 17/45 0.3 0.5 0.1 0.1 6/26 11/35 15/39 185p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.3 0.5 0.05 0.2 3/13 8/24 16/39 0.3 0.5 0.05 0.1 5/20 12/36 21/53 0.35 0.55 0.1 0.1 2/11 10/27 18/42 0.35 0.55 0.05 0.2 4/14 9/24 18/39 0.35 0.55 0.05 0.1 10/34 17/45 24/53 0.4 0.6 0.1 0.1 5/17 9/26 20/41 0.4 0.6 0.05 0.2 4/12 11/25 21/41 0.4 0.6 0.05 0.1 7/20 17/39 27/54 0.45 0.65 0.1 0.1 6/16 13/29 22/41 0.45 0.65 0.05 0.2 6/15 12/24 22/39 0.45 0.65 0.05 0.1 15/32 28/51 29/53 0.5 0.7 0.1 0.1 7/17 14/28 23/39 0.5 0.7 0.05 0.2 7/16 13/25 23/37 0.5 0.7 0.05 0.1 8/18 18/34 32/53 0.55 0.75 0.1 0.1 13/23 22/35 24/38 0.55 0.75 0.05 0.2 8/15 14/23 24/36 0.55 0.75 0.05 0.1 12/22 21/35 32/49 0.6 0.8 0.1 0.1 8/15 14/22 24/35 0.6 0.8 0.05 0.2 9/15 23/32 24/34 0.6 0.8 0.05 0.1 15/26 24/37 32/45 0.65 0.85 0.1 0.1 4/8 11/17 23/31 186p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 0.65 0.85 0.05 0.2 6/10 13/18 23/30 0.65 0.85 0.05 0.2 16/24 28/37 30/40 0.7 0.9 0.1 0.1 5/9 13/18 20/25 0.7 0.9 0.05 0.2 4/7 19/23 20/25 0.7 0.9 0.05 0.1 5/9 12/17 26/32 0.75 0.95 0.1 0.1 3/5 6/8 16/19 0.75 0.95 0.05 0.2 6/8 14/16 17/20 0.75 0.95 0.05 0.1 9/12 19/22 22/26 例一新型抗肿瘤药品进行二期临床试验,标准治疗的有效率为 20%, 如果新型药品的有效率达 40%,则认为有临床价值。极小三阶段设计,在 α = 0.05,β = 0.1,需要多少病例? MinimaxThreeStageDesignsChen <- function(alphap,betap,p0p,p1p){ data <- read.csv("MinimaxThreeStageDesignsChen.csv",header = T) for(i in 1:length(data$p0)){ if(is.na(data$p0[i])==T){ data$p0[i] <- data$p0[i-1] data$p1[i] <- data$p1[i-1] } } data%>>% subset(p0==p0p)%>>% subset(p1==p1p)%>>% 187subset(alpha==alphap)%>>% subset(beta==betap)%>>% return() } MinimaxThreeStageDesignsChen(0.05,0.1,0.20,0.40) ## p0 p1 alpha beta S1_r1_n1 S2_r2_n1n2 S3_r3_n1n2n3 ## 60 0.2 0.4 0.05 0.1 2/16 6/28 13/45 该研究第一阶段需要 16 名病例,如果是少有 2 例有效,则可以进行第 二阶段研究。第二阶段继续做 12 例,达到 28 例,如果至少 6 例有效,则 可以进行第三阶段的研究。第三阶段继续做 17 例,达到 45 例,如果至少 有 13 例有效,则可进行进一步研究。 5.3.3.4 多组灵活设计(Flexible Designs for Multiple-Arm Trials) 该设计需要事先规定一个有临床意义的界值 [−δ, δ],如果率的差值大于 δ ,那么,率大的组被选择,如果率的差值小于或者等于 δ,在选择过长中 就需要考虑其他因素。此种设计,不是比较各组之间和好坏,而是尽可能正 确的选择出优势治疗的存在,以便进一步研究。两组灵活设计的样本量,在 δ = 0.05 ρ = 0 or ρ = 0.5 可查询下表,λ 为预先指定的阈值。 data <- read.csv("FlexibleDesignsforTwoArm.csv",header = T) pander(data) p1 p2 Lambda0.9rho0 Lambda0.8 Lambda0.9rho0.5 0.05 0.2 32 13 16 0.1 0.25 38 15 27 0.15 0.3 0.53 17 31 188p1 p2 Lambda0.9rho0 Lambda0.8 Lambda0.9rho0.5 0.2 0.35 57 19 34 0.25 0.4 71 31 36 0.3 0.45 73 32 38 0.35 0.5 75 32 46 0.4 0.55 76 33 47 例一新型抗肿瘤药品与现有标准治疗对照进行二期临床试验,如果新 型药品的有效率达 35%,标准治疗有效率为 20%,两组灵活设计,在 δ = 0.05,ρ = 0,λ = 0.90 需要多少病例? FlexibleDesignsforTwoArm <- function(p1p,p2p){ data <- read.csv("FlexibleDesignsforTwoArm.csv",header = T) data%>>% subset(p1==p1p)%>>% subset(p2==p2p)%>>% return() } FlexibleDesignsforTwoArm(0.20,0.35) ## p1 p2 Lambda0.9rho0 Lambda0.8 Lambda0.9rho0.5 ## 4 0.2 0.35 57 19 34 每组至少需要 57 例。 多组灵活设计,在 δ = 0.05 λ = 0.8 or λ = 0.9 可查询下表,λ 为预先指 定的阈值 189data <- read.csv("FlexibleDesignsforMultipleArm.csv",header = T) pander(data) lambda epsilon rho0r3 rho0r4 rho0.5r3 rho0.5r4 0.8 0.2 18 31 13 16 0.8 0.3 38 54 26 32 0.8 0.4 54 73 31 39 0.8 0.5 58 78 34 50 0.9 0.2 39 53 30 34 0.9 0.3 77 95 51 59 0.9 0.4 98 119 68 78 0.9 0.5 115 147 73 93 例一新型抗肿瘤药品与两个标准治疗对照进行二期临床试验,预计新型 药品比对照的有效率高 30%(ϵ = 0.3),三组灵活设计,在 δ = 0.05,ρ = 0, λ = 0.90 需要多少病例? FlexibleDesignsforMultipleArm<- function(lambdap,epsilonp){ data <- read.csv("FlexibleDesignsforMultipleArm.csv",header = T) data%>>% subset(lambda==lambdap)%>>% subset(epsilon==epsilonp)%>>% return() } FlexibleDesignsforMultipleArm(0.9,0.3) ## lambda epsilon rho0r3 rho0r4 rho0.5r3 rho0.5r4 ## 6 0.9 0.3 77 95 51 59 每组至少需要 77 例。 1905.4 拟合优度和列联表检验的样本量估计(Tests for Goodness- of-Fit and Contingency Tables) 临床试验中,当计数资料的指标有多个类别,而不是二分类时,适合的检 验方法通常为拟合优度检验、独立性检验(也称列联表检验)和 categorical shift 检验。 5.4.1 拟合优度检验 (Tests for Goodness-of-Fit),样本含量估算公式 n = δα,β [∑r k=1 (pk−pk,0)2 pk,0 ]−1 ,pk 为实验组每个分类的率,pk,0 为文献中每个分类的的率,δα,β 通过 Fr−1(χ2 α,r−1|δ) = β 计算,δ = limn→∞ ∑r k=1 n(pk−pk,0)2 pk,0 ,r 为分类的个数。 例一探索性临床试验(pilot study),研究一降压药的临床疗效。预试 验表明该药治疗高血压的显效率、进步率和无效率分别玩儿 20%,60% 和 20%。文献报道,现有降压药的显效率、进步率和无效率分别为 25%,45% 和 30%。单组设计,在 α = 0.05, β = 0.2 时,双侧差异性检验,需要多少样 本量? gof.Pearson(0.05,0.2,c(0.2,0.6,0.2),c(0.25,0.45,0.30),3) ## [1] 103 该研究需要 104 例。 5.4.2 单层独立性检验 (Test for Independence—Single Stratum) 对于没有分层的 r×c 列联表数据(two-way),即单程列连数据,在进 行样本量估计常用以下两种方法。 5.4.2.1 Pearson’s Test Pearson 检验的样本量计算公式如下, n = δα,β [∑r i=1 ∑c j=1 (pij −pipj )2 pipj ]−1 ,δα,β 通过 F(r−1)(c−1)(χ2 α,(r−1)(c−1))|δ) = β 191计算,δ = limn→∞ ∑r i=1 ∑c j=1 n(pij −pi.p.j )2 pi.pj. ,r 代表横向分类数据的个数,c 代表 纵向分类数据的个数。 例一新型降压要与对照药进行探索行临床试验,其结果如下 分组 无效有 效显 效 试验组 2 7 1 对照组 2 5 3 为验证差别的存在,设计较大规模的临床实验,两组平行 1:1 对照,在 α = 0.05, β = 0.2 时,双侧差异性检验,需要多少样本量? gof.Pearson.twoway <- function (alpha, beta, trt, ctl, r, c) { p.ij <- rbind(trt, ctl)/(sum(trt) + sum(ctl)) b = 0 noncen = 0 for (i in 1:1000){ b[i + 1] <- pchisq(qchisq(alpha, df = (r-1)*(c-1), ncp = 0, lower.tail = FALSE), df = (r-1)*(c-1), ncp = i/100) noncen = rbind(noncen, c(i, b[i], b[i + 1])) } delta = noncen[which(noncen[, 2] > beta & noncen[, 3] < beta)]/100 n <- delta * (as.numeric(chisq.test(p.ij)$statistic))^-1 return(n) } gof.Pearson.twoway(0.05, 0.2, c(0.2,0.7,0.1), c(0.2,0.5,0.3), 2, 3) ## Warning in chisq.test(p.ij): Chi-squared approximation may be incorrect ## [1] 145 192该研究每组需要 145 例。TrialSize 包中 gof.Pearson.twoway() 方法对 自由度计算有误。 5.4.2.2 似然比检验 (Likelihood Ratio Test) 似然比检验的样本量计算公式等价于 Pearson 检验样本量计算公式。 5.4.3 多层独立性检验 (Test for Independence—Multiple Strata) 多中心临床实验不仅可以保障实验结果的可重复性和代表性,而且也有 利于受试着在期望时间内入选。多中心临床实验属于多层列联表数据,当反 映率是二分类资料时,CMH 检验(Cochran-Mantel-Haenszel Test)是常用 的检验方法。 分组 0 1 合计 处理 1 nh,10 nh,11 nh,1. 处理 2 nh,20 nh,21 nh,2. 合计 nh,.0 nh,.1 nh,.. 其样本含量估计公式: δ = lim ∑H h=1 πh(ph,11−ph,1.ph,.1)√∑H h=1 πhph,1.ph,2.ph,.0ph,.1 , n = (zα/2 + zβ)2 δ2 ,nh,ij 是在第 h 层(中心),经 i 处理后,出现 j 反应的个数,ph,ij 是在 h 层(中心),经 i 处理后,出现 j 反应的率,πh = nh/n。此方法只使用于 多中心临床实验中治疗反应数据是二分类的情况,对于多分类的数据,其样 本量估算公式目前还没有可靠的方法。现在主要把 p×r×c 表合并成 r*c 表, 用单层列联表样本量公式进行估算。 例一新型抗肿瘤药与安慰剂对照进行小规模多中心探索性临床试验,主 要目标是观察不良时间的发生率,其结果如下 分层 分组 反应无 反应有 合计 1 试验组 0.35 0.15 0.50 193分层 分组 反应无 反应有 合计 对照组 0.25 0.25 0.50 2 试验组 0.30 0.20 0.50 对照组 0.20 0.30 0.50 3 试验组 0.40 0.10 0.50 对照组 0.20 0.30 0.50 4 试验组 0.35 0.15 0.50 对照组 0.15 0.35 0.50 基于以上数据,研究者希望设计一个较大规模的临床实验,两组平行 1: 1 对照设计,每个分层的样本数量相同,即 π = 1/4,在 α = 0.05, β = 0.2 时,双侧差异性检验,需要多少样本量? CMH.Equality <- function(alpha,beta,p,h){ pi <- 1/h numerator <- function(p){ sum <- pi*(p[1,2]-rowSums(p)[1]*colSums(p)[2]) } denominator <- function(p){ sum <- pi*rowSums(p)[1]*rowSums(p)[2]*colSums(p)[1]*colSums(p)[2] } delta <- abs(sum(sapply(p,numerator))/sqrt(sum(sapply(p,denominator)))) n <- (qnorm(1 - alpha/2) + qnorm(1 - beta))^2 /(delta)^2 n } p1 <- rbind(c(0.35,0.15),c(0.25,0.25)) p2 <- rbind(c(0.30,0.20),c(0.20,0.30)) p3 <- rbind(c(0.40,0.10),c(0.20,0.30)) p4 <- rbind(c(0.35,0.15),c(0.15,0.35)) 194p<-list(p1=p1,p2=p2,p3=p3,p4=p4) CMH.Equality(0.05,0.2,p,4) ## [1] 85 该研究每组需要 85 例。 5.4.4 类别转换检验 (Categorical Shift Test) 临床试验中,研究试验先后二分类的数据的变化情况,通常采用 McNe- mar 检验和 Stuart-Maxwell 检验。 5.4.4.1 McNemar 检验 对于下表,McNemar 检验所需的样本两计算公式 n = [zα/2(φ + 1) + zβ √ (φ + 1)2 − (φ − 1)2πDiscordant]2 (φ − 1)2πDiscordant ,φ = p01/p10,πDiscordant = p01 + p10。p01 = P(xi1=0,xi2=1),p10 = P(xi1 = 1, xi2 = 1)。 治疗前 治疗后阳性 治疗后阴性 合计 阳性 n00 n01 n0. 阴性 n10 n11 n1. 合计 n.0 n01 n.. 例某降血糖药物在餐前和餐后分别擦亮血糖值,根据临床预试验结果, 治疗后有 50%(p10 = 0.5)低血糖患者转为正常,而 20%(p01 = 0.2)正 常血糖转为低血糖,在 α = 0.05, β = 0.2 时,双侧差异性检验,需要多少样 本量? (McNemar.Test(0.05, 0.2, c(0.2/0.5), c(0.5+0.2))) ## [1] 59 该研究至少需要 59 患者。 1955.4.4.2 Stuart-Maxwell 检验 McNemar 检验适合于二分类变量前后的比较,对于多分类变量,需要 使用 Stuart-Maxwell 检验。其样本量计算公式如下: n = δα,β [∑ i beta & noncen[, 3] < beta)]/100 temp <-array(0,c(r,r)) for (j in 1:r) { for (i in 1:j) { temp[i,j] <- (p.ij[i, j] - p.ji[j, i])^2/(p.ij[i, j] + p.ji[j, i]) } } n <- delta*sum(temp)^-1 n } alpha <- 0.05 beta <- 0.2 p.ij <- rbind(c(3, 4, 4), c(2, 3, 3), c(1, 2, 3))/25 p.ji <- rbind(c(3, 4, 4), c(2, 3, 3), c(1, 2, 3))/25 r <- 3 Stuart.Maxwell.Test(alpha,beta, p.ij, p.ji, r) ## [1] 102 该研究至少需要 102 例。TrialSize 包中 Stuart.Maxwell.Test() 方法对 自由度计算有误。 1975.4.5 残留效应检验 (Carry-Over Effect Test) 残留效应是由于上一阶段的处理由于效应除去时间不足或其他原因干 扰了下一阶段的处理效果,产生残留效应主要是由于第一阶段导致耐药性而 产生的撤退效应、心理效应和患者身体状况因用药而改变所导致的遗留效 应。在一些时候,研究者需要知道药物残留效应。其样本量估计公式如下: n = (zα/2 + zβ)2(σ2 1 + σ2 2) γ2 σ1 为 AB 顺序的标准差,σ2 为 BA 顺序的标准差,γ 为 AB 和 BA 顺序残 留效应的差值。 例根据预试验得到 A、B 两种药物交叉设计的参数,γ 为 0.89,σ1 为 2.3,σ2 为 2.4, 为证实这一残留效应在,研究着设计一个临床试验,在 α = 0.05, β = 0.2 时,需要多少样本量? (Carry.Over(0.05,0.2,2.3^2,2.4^2,0.89)) ## [1] 109 该研究至少需要 109 例。 5.5 时间事件(生存分析)的样本量计算 (Time-to-Event) 临床实验中,某些试验的结果并不是均数和有效率或治愈率,而是某种 医学事件的发生时间,如果某项治疗能够阻止或延缓这些事件的发生,便认 为治疗是有效。从观察到事件发生的时间称为事件发生时间 (time-to-event), 如果研究的是终点是死亡,那么事件发生时间成为生存时间 (survial time)。 除了生存结局作为判定标准以外,只要能让病人存活时间延长,这种治疗 也应当是被认为有效的。基本概念有:事件(Event)指研究中规定的生存 研究的终点,在研究开始之前就已经制定好。根据研究性质的不同,事件 可以是患者的死亡、疾病的复发、仪器的故障等。生存时间 (Survival time) 指从某一起点到事件发生所经过的时间。生存是一个广义的概念,不仅仅 指医学中的存活,也可以是肿瘤手术到复发和接触毒物到毒性反应等。删 失(Sensoring)指由于所关心的事件没有被观测到或者无法观测到,以至 于生存时间无法记录的情况。常由两种情况导致:(1)失访;(2)在研究 终止时,所关心的事件还未发生。生存概率 (survival probability):表示某 198单位时段开始时存活的个体到该时段结束时仍存活的可能性大小。生存率 (survival rate):指研究对象经历个时段后仍存活的概率,即生存时间大于 等于的概率,用 P(T ⩾ t) 表示。生存函数(Survival distribution function) 又叫累积生存率,表达式为 St = P(T > t), 其中 T 为生存时间,该函数的 意义是生存时间大于时间点 t 的概率。t=0 时 S(t)=1,随着 t 的增加 S(t) 递减(严格的说是不增),1-S(t) 为累积分布函数,表示生存时间 T 不超过 t 的概率, 其近似等于生存时间长于 t 的患者数/患者总数,生存函数在某时 点的函数值就是生存率。死亡概率函数:简称为死亡概率,常用 F(t) 表示。 代表一个观察对象从开始观察到时间 t 为止的死亡概率,它与生存函数的关 系为 F(t)=1 - S(t)。风险率函数 (hazard function) 指 t 时刻尚存活的研 究对象死于 t 时刻后一瞬间的概率,为条件概率, 用 h(t) = lim ∆→0 n(t)−n(t+∆t) n(t)∆t 表示,T 为观察对象的生存时间,n(t) 为 t 时刻的生存人数,n(t + ∆t) 为 t + ∆t 时刻的生存人数,它与生存函数、死亡密度函数的关系为 h (t)= f (t) / S(t)。 5.5.1 基于指数模型的生存分析 (Exponential Model) 生存时间是指从某个起始事件开始到某个终点事件的发生 (出现反应) 所经历的时间。一般不服从正态分布,有时近似服从指数分布、Weibull 分 布、Gompertz 分布等,多数情况下往往不服从任何规则的分布类型。 5.5.1.1 显著性检验 在假定服从指数分布的情况下,检验两组终点指标 (生存率) 的差异有 无显著性。显著性检验样本量计算公式为: n2 = (zα/2 + zβ)2 (λ1 − λ2)2 [ σ2(λ1) k + σ2(λ2) ] 其中 k = n1 n2 , σ2(λi) = γ2 i [ 1 + λe−λiT(1−e(λi−γ)T0 ) (λi−γ)(1−e−λT0 ) ]−1 n1 为第一组样本量,n2 为第二组样本量,k 为第一组样本量和第二组样本 量的比值,λ1 为第一组风险率,λ2 为第二组风险率,σ 为标准差,T 预期 临床试验所用时间,即临床试验自启动至结束所用时间,可以月或年为单位, T0 预期受试者全部入组所用时间 (与 T 保持一致即可)。 例假设研究两种移植方法对恶性淋巴瘤转化成白血病时间的影响。其 中一组用同种异体移植,另一组用大剂量化疗后的自身骨髓移植。观察时 199间持续 3 年(T = 3T0 = 1)。假设两组风险率分别为 1(λ1)和 2(λ2)。在 α = 0.05, β = 0.2 时,显著性检验,需要多少样本量? TwoSampleSurvival.Equality(0.05,0.2,1,2,1,3,1,0.00001) ## [1] 1.1 ## [1] 4 ## [1] 40 每组至少需要 40 例。 5.5.1.2 非劣效/优效性检验 在假定服从指数分布的情况下, 检验两组终点(生存率)的差异是否非 劣于/优于设定的界值。非劣效/优效性检验样本量计算公式为: n2 = (zα + zβ)2 (ϵ − δ)2 [ σ2(λ1) k + σ2(λ2) ] 其中 k = n1 n2 , σ2(λi) = γ2 i [ 1 + λe−λiT(1−e(λi−γ)T0 ) (λi−γ)(1−e−λT0 ) ]−1 n1 为第一组样本量,n2 为第二组样本量,k 为第一组样本量和第二组样本 量的比值,λ1 为第一组风险率,λ2 为第二组风险率,σ 为标准差,T 预期 临床试验所用时间,即临床试验自启动至结束所用时间,可以月或年为单位, T0 预期受试者全部入组所用时间 (与 T 保持一致即可),ϵ 为第一组和第二组 风险率之差。 例假设研究两种移植方法对恶性淋巴瘤转化成白血病时间的影响。其 中一组用同种异体移植,另一组用大剂量化疗后的自身骨髓移植。观察时 间持续 3 年(T = 3T0 = 1)。假设两组风险率分别为 1(λ1)和 2(λ2)。在 α = 0.05, β = 0.2 时,优效性检验,界值 0.2,需要多少样本量? TwoSampleSurvival.NIS(0.05,0.2,1,2,1,3,1,0.00001,0.2) ## [1] 1.1 ## [1] 4 ## [1] 50 每组至少需要 50 例。 2005.5.1.3 等效性检验 在假定服从指数分布的情况下, 检验两组终点(生存率)的等效性,等 效性检验检验样本量计算公式为: n2 = (zα + zβ/2)2 (δ − |ϵ|)2 [ σ2(λ1) k + σ2(λ2) ] 其中 k = n1 n2 , σ2(λi) = γ2 i [ 1 + λe−λiT(1−e(λi−γ)T0 ) (λi−γ)(1−e−λT0 ) ]−1 n1 为第一组样本量,n2 为第二组样本量,k 为第一组样本量和第二组样本 量的比值,λ1 为第一组风险率,λ2 为第二组风险率,σ 为标准差,T 预期 临床试验所用时间,即临床试验自启动至结束所用时间,可以月或年为单位, T0 预期受试者全部入组所用时间 (与 T 保持一致即可)。 例假设研究两种移植方法对恶性淋巴瘤转化成白血病时间的影响。其 中一组用同种异体移植,另一组用大剂量化疗后的自身骨髓移植。观察时 间持续 3 年(T = 3T0 = 1)。假设两组风险率分别为 1(λ1)和 2(λ2)。在 α = 0.05, β = 0.2 时,等效性检验,界值 0.5,需要多少样本量? TwoSampleSurvival.Equivalence(0.05,0.2,1,2,1,3,1,0.00001,0.5) ## [1] 1.1 ## [1] 4 ## [1] 176 每组至少需要 176 例 5.5.2 基于 Cox 比例风险模型的生存分析 不直接考察生存函数与协变量 (影响因素) 的关系,而是用风险函数作 为因变量。 h(t) = h0(t)exp(β1X1 + β2X2 + ... + βmXm) 将风险函数表达为基准风险率函数和相应协变量函数的乘积。Cox 模型的 参数估计不依赖于基准风险率函数的分布类型,是一种半参数的模型,但必 须满足比例风险假定(PH 假定),任何两个个体的风险函数及基准风险函 数之比,即风险比(HR)保持一个恒定的比例,与时间 t 无关。模型中协 变量的效应不随时间改变而改变。协变量是否满足 PH 假定,最简单的方法 是观察按该变量分组的生存曲线,若生存曲线交叉,提示不满足 PH 假定。 2015.5.2.1 显著性检验 两组平行对照设计,基于 Cox 比例风险模型进行生存分析,检验两组 终点的差异有无显著性, 其样本量计算公式: n = (z1−α/2 + z1−β)2 log2(b)p1p2d p1, p2 分别代表第一组和第二组的风险率,b 为两组的风险比,d 代表观察 到规定事件的比率。 例一临床试验用来比较一个新的治疗方法和传统治疗方法对延 缓 烧 伤 患 者 局 部 感 染 的 作 用。 预 试 验 中, 传 统 方 法 和 新 方 法 的 风 险 比 为 2(b=log(2)),80% 的患者将被观察到局部感染 (d=0.8), 在 α = 0.05, β = 0.2p1 = p2 = 0.5 时,两组 1:1 平行对照,显著性检 验,需要多少样本量? Cox.Equality <- function (alpha, beta, loghr, p1, p2, d) { n = (qnorm(1-alpha/2) + qnorm(1 - beta))^2/(log(loghr)^2 * p1 * p2 * d) n } Cox.Equality(0.05,0.2,2,0.5,0.5,0.8) ## [1] 82 每组至少需要 82 例。Sample Size Calculations in Clinical Research 书 中对样本量公式有误(z1−α/2,z1−β 在书中错写为 zα/2, zβ),导致 TrialSize 包中 Cox.Equality() 函数计算错误。 5.5.2.2 非劣效/优效性检验 两组平行对照设计,基于 Cox 风险比例模型进行生存分析,检验两组 终点(生存率)的差异是否非劣于/优于设定的界值。 n = (z1−α + z1−β)2 log2(b − δ)p1p2d p1, p2 分别代表第一组和第二组的风险率,b 为两组的风险比,d 代表观察 到规定事件的比率,δ 代表具有临床意义的界值。 202例一临床试验用来比较一个新的治疗方法和传统治疗方法对延 缓 烧 伤 患 者 局 部 感 染 的 作 用。 预 试 验 中, 传 统 方 法 和 新 方 法 的 风 险 比 为 2(b=log(2)),80% 的患者将被观察到局部感染 (d=0.8), 在 α = 0.05, β = 0.2p1 = p2 = 0.5 时,两组 1:1 平行对照,优效性检 验,界值为 0.5,需要多少样本量? Cox.NIS <- function (alpha, beta, loghr, p1, p2, d, margin) { n = (qnorm(1-alpha) + qnorm(1 - beta))^2/ ((log(loghr) - margin)^2 * p1 * p2 * d) n } Cox.NIS(0.05,0.2,2,0.5,0.5,0.8,0.5) ## [1] 829 每组至少需要 829 例。Sample Size Calculations in Clinical Research 书中对样本量公式有误(z1−α,z1−β 在书中错写为 zα, zβ) 5.5.2.3 等效性检验 两组平行对照设计,基于 Cox 风险比例模型进行生存分析,检验两组 终点(生存率)的等效性。 n = (z1−α + z1−β/2)2 log2(δ − |b|)p1p2d p1, p2 分别代表第一组和第二组的风险率,b 为两组的风险比,d 代表观察 到规定事件的比率,δ 代表具有临床意义的界值。 例一临床试验用来比较一个新的治疗方法和传统治疗方法对延 缓 烧 伤 患 者 局 部 感 染 的 作 用。 预 试 验 中, 传 统 方 法 和 新 方 法 的 风 险 比 为 2(b=log(2)),80% 的患者将被观察到局部感染 (d=0.8), 在 α = 0.05, β = 0.2p1 = p2 = 0.5 时,两组 1:1 平行对照,等效性检 验,需要多少样本量? 203Cox.Equivalence <- function (alpha, beta, loghr, p1, p2, d, margin) { n = (qnorm(1-alpha) + qnorm(1 - beta/2))^2/ ((margin - abs(log(loghr)))^2 * p1 * p2 * d) n } Cox.Equivalence(0.05,0.2,2,0.5,0.5,0.8,0.5) ## [1] 1148 每组至少需要 1148 例。Sample Size Calculations in Clinical Research 书中对样本量公式有误(z1−α,z1−β/2 在书中错写为 zα, zβ/2) 5.5.3 基于 Logrank 检验的生存分析 也称为时序检验,是在无效假设成立的前提下,根据两种处理不同生 存时间的期初观察人数和理论死亡概率计算出的理论死亡数(期望死亡数) 应该与实际死亡数相差不大;如果相差较大,则无效假设不成立,可以认 为两条生存曲线间的差异有统计学意义。非劣效/优效性检验和等效性检 验样本量估计困难,显著性其样本量估计公式如下 n = 2d p1+p2 , 其中 d = (z1−α/2+z1−β )2( ∑N i=1 w2 i ρiηi) ( ∑N i=1 wiρiγi)2 。wi 分别为 1,ni, √ ni 时,对应 Log-rank、Wilcoxon 和 Tarone-Ware 检验。 例一为期 2 年的某心血管药物的临床试验(Lakatos 1998),假设试验 组年风险率为 1(年事件发生率为 1 − e−1), 对照组年风险率为 0.5(年 事件发生率为 1 − e−0.5), 年失访率为 3%,年不依从率为 4%,对照组有 5% 患者选择了其他与试验组类似的治疗(drop-in)。试验组的总事件发生 率 83.7%,对照组总事件发生率 62.7%。 Logrank.test <- function(alpha, beta, k, year, loss, herate, hcrate, noncompliance, dropin, pe, pc) { eeventrate <- 1 - exp(-herate) ceventrate <- 1 - exp(-hcrate) 204e <- matrix(c(0, 0, 1, 0)) c <- matrix(c(0, 0, 0, 1)) transition <- function(x, k) { 1 -(1 - x)^(1/k) } T <- matrix(c(1, 0, 0, 0, 0, 1, 0, 0, transition(loss, k), transition(eeventrate, k), 1 - transition(noncompliance, k) - transition(eeventrate, k) - transition(loss, k), transition(noncompliance, k), transition(loss, k), transition(ceventrate, k), transition(dropin, k), 1 - transition(loss, k) - transition(ceventrate, k) - transition(dropin, k)), nrow = 4) for (i in 1:(k * year)) { tempe <- list(T %^% i %*% e) tempc <- list(T %^% i %*% c) if (i == 1){ E <- tempe C <- tempc phi <- 1 eta <- phi/(1 + phi)^2 theta <- herate/hcrate gamma <- phi * theta/(1 + phi * theta) - phi/(1 + phi) rho <- (E[[i]][2] + C[[i]][2])/(pe + pc) ##￿ } else { E <- append(E, tempe) C <- append(C, tempc) phi <- append(phi, (E[[i - 1]][3] + E[[i - 1]][4])/(C[[i - 1]][3] + C[[i - 1]][4])) ##￿ eta <- append(eta, phi[i]/(1 + phi[i])^2) ##￿ 205theta <- append(theta, log(1 -(E[[i]][2]- E[[i - 1]][2]))/ log(1 -(C[[i]][2]- C[[i - 1]][2]))) ##￿ gamma <- append(gamma, phi[i] * theta[i]/ (1 + phi[i] * theta[i]) - phi[i]/(1 + phi[i])) rho <- append(rho, ((E[[i]][2]- E[[i - 1]][2]) + (C[[i]][2]- C[[i - 1]][2]))/(pe + pc)) ##￿ } } t <- seq(from = 1/k, to = year, by = 1/k) numerator <- 0 denominator <- 0 for (i in 1:(k * year)) { numerator = numerator + rho[i] * eta[i] denominator = denominator + rho[i] * gamma[i] } d <- (qnorm(1 - alpha/2) + qnorm(1 - beta))^2 * numerator/denominator^2 n <- 2 * d/(pe + pc) n } Logrank.test(0.05, 0.2, 10, 2, 0.03, 1, 0.5, 0.04, 0.05, 0.627, 0.837) ## [1] 454 两组共需要 454 例。Sample Size Calculations in Clinical Research 书 中对 θ 和 γ 的计算有误,矩阵 T 也有两个数字顺序反了! 5.6 成组序贯设计 (Group Sequential Methods) 传统的随机对照临床试验设计,要求试验开始前确定样本量, 并且只有 当所有的受试者均完成入组之后才能进行数据的统计分析。序贯设计是一 206种节省样本的设计方法,通常事先不固定样本含量,而是按照受试者进入试 验的次序,做一个(或者一个阶段)试验便进行一次分析,一旦发现达到预 期结果,立即停止试验。序贯试验比较适合临床研究,因为临床研究的患者 都是陆续到医院,可以一次纳入研究进行分析。这种逐个纳入受试对象,纳 入一个便分析一个,下一个是否试验需要看上一个结果,花费时间较长,不 适用急性传染病的研究,也不适用与显效迟缓的慢性病研究。成组序贯设 计允许在试验过程中对已累积数据进行期中分析, 评价试验药物的有效性和 安全性, 若已累积数据有足够证据说明试验药物有效或无效则可提前结束试 验。与传统的试验设计方法相比, 成组序贯设计具有更强的灵活性; 由于期 中分析为提前结束试验提供了可能性, 成组序贯试验往往可以节约试验样本 量, 缩短试验周期,节约资金, 而且更符合伦理学的要求。此外, 从试验管理 的角度来讲, 成组序贯设计对数据的期中评价也可使研究者和监察员尽早发 现试验中存在的问题, 有利于改善试验质量。 实际中采用较多成组序贯试验是分阶段试验,分阶段分析。要求将整个 试验划分成 k 个连续的阶段,每个阶段内都有 2n 个受试者加入试验,并被 随机分配到实验组和对照组,每个处理组均为 n 个。当第 i(i ⩽ k)个阶段 试验结束后,把 1 到 i 阶段实验结果累计进行统计分析,如果拒绝 H0, 即 可结束试验,否则继续下一阶段试验。如果到最后第 k 个阶段结束后,仍不 能拒绝 H0,则可接受 H0。成组序贯试验适用于多个地区同时进行的多中心 临床试验,每隔一定时间将累积的资料进行统计分析,如果效果显著可以提 前结束试验,能有效节省样本量和成本,但需要在方案中事先确定期中分析 的次数和时间,不可在研究过程中修改,而且在双盲试验中应分批揭盲,以 免影响后期的研究。 成组序贯试验中需要多次重复的显著性检验,这种检验将增加 I 类错 误的概率,使得总显著水平上升。为使得总显著水平等于期望的 α,需要将 每个阶段的显著行水平进行调整,调整后的显著性水平成为名义性显著水 平 (norminal significance level),用 α′ 表示。各种方法的界值在 R 中可通 过 GroupSeq 包中的 groupseq(mode=“c”) 或者 groupseq(mode=“g”) 方法 获得。 成组序贯设计中有两种概念的时间点划分方式, 一种是日历时间 (Cal- endar time), 另一种是信息时间 (Information time)。日历时间是以试验持 续时间的进度来决定何时进行期中分析; 信息时间的含义是指在某一观察时 点观察到的样本量占计划总样本量的百分比, 以可观察到的信息量来决定何 207时进行期中分析, 例如三阶段成组序贯试验预计死亡 600 例, 可在观察到死 亡人数 300 例、450 例和 600 例, 即信息时间为 0.5、0.75 和 1 时进行统计 描述。对于生存资料, 因为生存时间是生存分析的主要指标, 故应该使用信 息时间来划分时间点, 具体计算是用某时观察到的死亡数与期望总死亡数的 比值 tk = κ/K 来估计。 5.6.1 Pocock’s Test 该法对每一阶段均采用相同的临界值和名义显著水平,下表列出了不同 阶段的统计量,如 5 个阶段的显著水平为 0.05 的成组序贯设计,每一阶段 均采用临界值 2.413,每一阶段名义显著水平小于 0.02,才能拒绝 H0 data <- read.csv("Cp.csv",header = T) panderOptions('digits', 4) pander(data) K alpha0.01 alpha0.05 alpha0.10 1 2.576 1.96 1.645 2 2.772 2.178 1.875 3 2.873 2.289 1.992 4 2.939 2.361 2.067 5 2.986 2.413 2.122 6 3.023 2.453 2.164 7 3.053 2.485 2.197 8 3.078 2.512 2.225 9 3.099 2.535 2.249 10 3.117 2.555 2.27 11 3.133 2.572 2.288 12 3.147 2.588 2.304 15 3.182 2.626 2.344 20 3.225 2.672 2.392 K 期 Pocock 检验的样本量计算,首先根据没有期中分析的设计计算固 208定样本量,然后乘以 Rp(K, α, β)。固定样本量计算公式如下 nfixed = (z1−α/2 + z1−β)2(σ2 1 + σ2 2) (µ1 − µ2)2 ,Rp 可查询下表: data <- read.csv("Rp.csv",header = T) panderOptions('digits', 4) pandoc.table(data, use.hyphening = TRUE, split.cells =8,justify = 'center') ## ## --------------------------------------------------------------------------------- ## k alpha0.- alpha0.- alpha0.- alpha0.- alpha0.- alpha0.- ## 01beta0.20 05beta0.20 10beta0.20 01beta0.10 05beta0.10 10beta0.10 ## --- ------------ ------------ ------------ ------------ ------------ ------------ ## 1 1 1 1 1 1 1 ## ## 2 1.092 1.11 1.121 1.084 1.1 1.11 ## ## 3 1.137 1.166 1.184 1.125 1.151 1.166 ## ## 4 1.166 1.202 1.224 1.152 1.183 1.202 ## ## 5 1.187 1.229 1.254 1.17 1.207 1.228 ## ## 6 1.203 1.249 1.277 1.185 1.225 1.249 ## ## 7 1.216 1.265 1.296 1.197 1.239 1.266 ## ## 8 1.226 1.279 1.311 1.206 1.252 1.28 ## ## 9 1.236 1.291 1.325 1.215 1.262 1.292 ## ## 10 1.243 1.301 1.337 1.222 1.271 1.302 209## ## 11 1.25 1.31 1.348 1.228 1.279 1.312 ## ## 12 1.257 1.318 1.357 1.234 1.287 1.32 ## ## 15 1.272 1.338 1.381 1.248 1.305 1.341 ## ## 20 1.291 1.363 1.411 1.264 1.327 1.367 ## --------------------------------------------------------------------------------- 例一 5 期的比较某药及安慰剂疗效临床成组序贯试验,根据预试验总 体的标准差为 2(σ2 = σ2 1 = σ2 2 = 4),µT − µP = 1, 在 α = 0.05, β = 0.10 时,Pocock 设计,每期需要多少病例? Pocock.Test <- function(alpha, beta, sigma1, sigma2, mu, k) { nfixed <- (qnorm(1 - alpha/2) + qnorm(1 - beta))^2 * (sigma1^2 + sigma2^2)/(mu)^2 data <- read.csv("Rp.csv", header = T) col <- paste(paste("alpha", alpha, sep = ""), paste("beta", format(beta, nsmall = 2), sep = ""), sep = "") rp <- as.matrix(data)[k, col] nmax <- rp * nfixed n <- nmax/k n } Pocock.Test(0.05, 0.1, 2, 2, 1, 5) ## alpha0.05beta0.10 ## 20 每期至少需要 20 例。 2105.6.2 O’Brien and Fleming 检验 该法对不同阶段采用不同的临界值,早期阶段临界值设定较高,越到后 期临界值越低。该法早期阶段较为保守,除非 P 值特别小,否则早期通常 难以拒绝 H0,但最后一个阶段 P 值接近总的检验水平。下表列出了每阶段 最后一阶段的临界值,比如 5 阶段最后一阶段的临界值值为 2.040, 前 4 阶 段可采用差表,其值分别为 4.562,3.226,2.634 和 2.281,5 个阶段对应的名 义显著水平可用 2*(1-pnorm()) 方法求出。 data <- read.csv("Cb.csv",header = T) panderOptions('digits', 4) pandoc.table(data, use.hyphening = TRUE, split.cells =8, justify = 'center') ## ## --------------------------------- ## K al- al- al- ## pha0.01 pha0.05 pha0.10 ## --- --------- --------- --------- ## 1 2.576 1.96 1.645 ## ## 2 2.58 1.977 1.678 ## ## 3 2.595 2.004 1.71 ## ## 4 2.609 2.024 1.733 ## ## 5 2.621 2.04 1.751 ## ## 6 2.631 2.053 1.765 ## ## 7 2.64 2.063 1.776 ## ## 8 2.648 2.072 1.786 ## 211## 9 2.654 2.08 1.794 ## ## 10 1.66 2.087 1.801 ## ## 11 2.665 2.092 1.807 ## ## 12 2.67 2.098 1.813 ## ## 15 2.681 2.11 1.826 ## ## 20 2.695 2.126 1.842 ## --------------------------------- K 期 O’Brien and Fleming’s 检验的样本量计算,首先根据没有期中分 析的设计计算固定样本量,然后乘以 Rb(K, α, β)。固定样本量计算公式如下 nfixed = (z1−α/2 + z1−β)2(σ2 1 + σ2 2) (µ1 − µ2)2 ,Rb 可查询下表: data <- read.csv("Rb.csv",header = T) panderOptions('digits', 4) pandoc.table(data, use.hyphening = TRUE, split.cells =8,justify = 'center') ## ## --------------------------------------------------------------------------------- ## k alpha0.- alpha0.- alpha0.- alpha0.- alpha0.- alpha0.- ## 01beta0.20 05beta0.20 10beta0.20 01beta0.10 05beta0.10 10beta0.10 ## --- ------------ ------------ ------------ ------------ ------------ ------------ ## 1 1 1 1 1 1 1 ## ## 2 1.001 1.008 1.016 1.001 1.007 1.014 ## ## 3 1.007 1.017 1.027 1.006 1.016 1.025 ## 212## 4 1.011 1.024 1.035 1.01 1.022 1.032 ## ## 5 1.015 1.028 1.04 1.014 1.026 1.037 ## ## 6 1.017 1.032 1.044 1.016 1.03 1.041 ## ## 7 1.019 1.035 1.047 1.018 1.032 1.044 ## ## 8 1.021 1.037 1.049 1.02 1.034 1.046 ## ## 9 1.022 1.038 1.051 1.021 1.036 1.048 ## ## 10 1.024 1.04 1.053 1.022 1.037 1.049 ## ## 11 1.025 1.041 1.054 1.023 1.039 1.051 ## ## 12 1.026 1.042 1.055 1.024 1.04 1.052 ## ## 15 1.028 1.045 1.058 1.026 1.042 1.054 ## ## 20 1.03 1.047 1.061 1.029 1.045 1.057 ## --------------------------------------------------------------------------------- 例一 5 期的比较某药及安慰剂疗效临床成组序贯试验,根据预试验总 体的标准差为 2(σ2 = σ2 1 = σ2 2 = 4),µT − µP = 1, 在 α = 0.05, β = 0.10 时,O’Brien and Fleming’s 设计,每期需要多少病例? OBF.Test <- function(alpha, beta, sigma1, sigma2, mu, k) { nfixed <- (qnorm(1 - alpha/2) + qnorm(1 - beta))^2 * (sigma1^2 + sigma2^2)/(mu)^2 data <- read.csv("Rb.csv", header = T) col <- paste(paste("alpha", alpha, sep = ""), paste("beta", format(beta, 213nsmall = 2), sep = ""), sep = "") rb <- as.matrix(data)[k, col] nmax <- rb * nfixed n <- nmax/k n } OBF.Test(0.05, 0.1, 2, 2, 1, 5) ## alpha0.05beta0.10 ## 17 每期至少需要 17 例。 5.6.3 Wang and Tsiatis 检验 该法是对 Pocock 和 O’Brien and Fleming’s 法的推广,其界值形状主 要取决 ρ 和 τ 参数,当 ρ = 0, τ = 0 时,就是 Pocock 法,当 ρ = 0.5, τ = 0 时, 就是 O’Brien and Fleming’s 法。下表列出了每阶段的临界值 data <- read.csv("Cwt.csv",header = T) panderOptions('digits', 4) pandoc.table(data, use.hyphening = TRUE, split.cells =8,justify = 'center') ## ## --------------------------------------- ## k delta0.10 delta0.25 delta0.40 ## --- ----------- ----------- ----------- ## 1 1.96 1.96 1.96 ## ## 2 1.994 2.038 2.111 ## ## 3 2.026 2.083 2.186 ## ## 4 2.05 2.113 2.233 214## ## 5 2.068 2.136 2.267 ## ## 6 2.083 2.154 2.292 ## ## 7 2.094 2.168 2.313 ## ## 8 2.104 2.18 2.329 ## ## 9 2.113 2.19 2.343 ## ## 10 2.12 2.199 2.355 ## ## 11 2.126 2.206 2.366 ## ## 12 2.132 2.213 2.375 ## ## 15 2.146 2.229 2.397 ## ## 20 2.162 2.248 2.423 ## --------------------------------------- K 期 Wang and Tsiatis 检验的样本量计算,首先根据没有期中分析的 设计计算固定样本量,然后乘以 Rwt(K, α, β, ∆)。固定样本量计算公式如下 nfixed = (z1−α/2 + z1−β)2(σ2 1 + σ2 2) (µ1 − µ2)2 ,Rwt 可查询下表: data <- read.csv("Rwt.csv", header = T) panderOptions("digits", 4) pandoc.table(data, use.hyphening = TRUE, split.cells = 8, justify = "center") ## ## --------------------------------------------------------------------------------- 215## k delta0.- delta0.- delta0.- delta0.- delta0.- delta0.- ## 01beta0.20 05beta0.20 10beta0.20 01beta0.10 05beta0.10 10beta0.10 ## --- ------------ ------------ ------------ ------------ ------------ ------------ ## 1 1 1 1 1 1 1 ## ## 2 1.016 1.038 1.075 1.014 1.034 1.068 ## ## 3 1.027 1.054 1.108 1.025 1.05 1.099 ## ## 4 1.035 1.065 1.128 1.032 1.059 1.117 ## ## 5 1.04 1.072 1.142 1.037 1.066 1.129 ## ## 6 1.044 1.077 1.152 1.041 1.071 1.138 ## ## 7 1.047 1.081 1.159 1.044 1.075 1.145 ## ## 8 1.05 1.084 1.165 1.046 1.078 1.151 ## ## 9 1.052 1.087 1.17 1.048 1.081 1.155 ## ## 10 1.054 1.089 1.175 1.05 1.083 1.159 ## ## 11 1.055 1.091 1.178 1.051 1.085 1.163 ## ## 12 1.056 1.093 1.181 1.053 1.086 1.166 ## ## 15 1.059 1.097 1.189 1.055 1.09 1.172 ## ## 20 1.062 1.101 1.197 1.058 1.094 1.18 ## --------------------------------------------------------------------------------- 例一 5 期的比较某药及安慰剂疗效临床成组序贯试验,根据预试验总 体的标准差为 2(σ2 = σ2 1 = σ2 2 = 4),µT − µP = 1, 在 α = 0.05, β = 0.10 216时,Wang and Tsiatis 设计,每期需要多少病例? WT.Test <- function(alpha, beta, sigma1, sigma2, mu, k, delta) { nfixed <- (qnorm(1 - alpha/2) + qnorm(1 - beta))^2 * (sigma1^2 + sigma2^2)/(mu)^2 data <- read.csv("Rwt.csv", header = T) col <- paste(paste("delta", format(delta, nsmall = 2), sep = ""), paste("beta", format(beta, nsmall = 2), sep = ""), sep = "") rwt <- as.matrix(data)[k, col] nmax <- rwt * nfixed n <- nmax/k n } WT.Test(0.05, 0.1, 2, 2, 1, 5, 0.05) ## delta0.05beta0.10 ## 18 每期至少需要 18 例。 5.6.4 Inner Wedge 检验 上述三种成组序贯方法均可以在拒绝 H0 接受 H1 时停止试验,也就是 说试验药如果有效时即可停止试验。Inner Wedge 方法是一种接受 H0 时, 停止试验,即试验药无效时即可停止试验的一种方法。 K 期 Inner Wedge 检验的样本量计算,首先根据没有期中分析的设计 计算固定样本量,然后乘以 Rw(K, α, β, ∆)。固定样本量计算公式如下 nfixed = (z1−α/2 + z1−β)2(σ2 1 + σ2 2) (µ1 − µ2)2 ,Rw 可查询下表: 217data <- read.csv("Rw.csv",header = T) panderOptions('digits', 4) pander(data) alpha beta delta K Cw1 Cw2 Rw 0.05 0.2 -0.5 1 1.96 0.842 1 0.05 0.2 -0.5 2 1.949 0.867 1.01 0.05 0.2 -0.5 3 1.933 0.901 1.023 0.05 0.2 -0.5 4 1.929 0.919 1.033 0.05 0.2 -0.5 5 1.927 0.932 1.041 0.05 0.2 -0.5 10 1.928 0.964 1.066 0.05 0.2 -0.5 15 1.931 0.979 1.078 0.05 0.2 -0.5 20 1.932 0.988 1.087 0.05 0.2 -0.25 1 1.96 0.842 1 0.05 0.2 -0.25 2 1.936 0.902 1.026 0.05 0.2 -0.25 3 1.932 0.925 1.04 0.05 0.2 -0.25 4 1.93 0.953 1.059 0.05 0.2 -0.25 5 1.934 0.958 1.066 0.05 0.2 -0.25 10 1.942 0.999 1.102 218alpha beta delta K Cw1 Cw2 Rw 0.05 0.2 -0.25 15 1.948 1.017 1.12 0.05 0.2 -0.25 20 1.952 1.027 1.131 0.05 0.2 0 1 1.96 0.842 1 0.05 0.2 0 2 1.935 0.948 1.058 0.05 0.2 0 3 1.95 0.955 1.075 0.05 0.2 0 4 1.953 0.995 1.107 0.05 0.2 0 5 1.958 1.017 1.128 0.05 0.2 0 10 1.98 1.057 1.175 0.05 0.2 0 15 1.991 1.075 1.198 0.05 0.2 0 20 1.998 1.087 1.212 0.05 0.2 0.25 1 1.96 0.842 1 0.05 0.2 0.25 2 1.982 1 1.133 0.05 0.2 0.25 3 2.009 1.059 1.199 0.05 0.2 0.25 4 2.034 1.059 1.219 0.05 0.2 0.25 5 2.048 1.088 1.252 0.05 0.2 0.25 10 2.088 1.156 1.341 219alpha beta delta K Cw1 Cw2 Rw 0.05 0.2 0.25 15 2.109 1.18 1.379 0.05 0.2 0.25 20 2.122 1.195 1.4 0.05 0.1 -0.5 1 1.96 1.282 1 0.05 0.1 -0.5 2 1.96 1.282 1 0.05 0.1 -0.5 3 1.952 1.305 1.01 0.05 0.1 -0.5 4 1.952 1.316 1.016 0.05 0.1 -0.5 5 1.952 1.326 1.023 0.05 0.1 -0.5 10 1.958 1.351 1.042 0.05 0.1 -0.5 15 1.963 1.363 1.053 0.05 0.1 -0.5 20 1.967 1.37 1.06 0.05 0.1 -0.25 1 1.96 1.282 1 0.05 0.1 -0.25 2 1.957 1.294 1.006 0.05 0.1 -0.25 3 1.954 1.325 1.023 0.05 0.1 -0.25 4 1.958 1.337 1.033 0.05 0.1 -0.25 5 1.96 1.351 1.043 0.05 0.1 -0.25 10 1.975 1.379 1.071 220alpha beta delta K Cw1 Cw2 Rw 0.05 0.1 -0.25 15 1.982 1.394 1.085 0.05 0.1 -0.25 20 1.988 1.403 1.094 0.05 0.1 0 1 1.96 1.282 1 0.05 0.1 0 2 1.958 1.336 1.032 0.05 0.1 0 3 1.971 1.353 1.051 0.05 0.1 0 4 1.979 1.381 1.075 0.05 0.1 0 5 1.99 1.385 1.084 0.05 0.1 0 10 2.013 1.428 1.127 0.05 0.1 0 15 2.026 1.447 1.148 0.05 0.1 0 20 2.034 1.458 1.16 0.05 0.1 0.25 1 1.96 1.282 1 0.05 0.1 0.25 2 2.003 1.398 1.1 0.05 0.1 0.25 3 2.037 1.422 1.139 0.05 0.1 0.25 4 2.058 1.443 1.167 0.05 0.1 0.25 5 2.073 1.477 1.199 0.05 0.1 0.25 10 2.119 1.521 1.261 221alpha beta delta K Cw1 Cw2 Rw 0.05 0.1 0.25 15 2.14 1.551 1.297 0.05 0.1 0.25 20 2.154 1.565 1.316 例一 5 期的比较某药及安慰剂疗效临床成组序贯试验,根据预试验 总体的标准差为 1(σ2 = σ2 1 = σ2 2 = 1),µT − µP = 0.2,∆ = 0.25, 在 α = 0.05, β = 0.20 时,Inner Wedge 设计,每期需要多少病例? InnerWedge.Test <- function(alphap,betap,sigma1,sigma2,mu,kp,deltap){ nfixed <- (qnorm(1-alphap/2) + qnorm(1 - betap))^2* (sigma1^2+sigma2^2)/(mu)^2 data <- read.csv("Rw.csv",header = T) data%>>% subset(beta==betap)%>>% subset(alpha==alphap)%>>% subset(K==kp)%>>% subset(delta==deltap)%>>% subset(select=c(Rw))*nfixed/kp } InnerWedge.Test (0.05,0.20,1,1,0.2,5,0.25) ## Rw ## 29 98 每期至少需要 98 例。 5.6.5 率比较的样本量估计 基于率比较的样本量计算与均值比较的样本量计算基本过程类似,固定 样本量计算公式略有不同,公式如下 nfixed = (z1−α/2 + z1−β)2(p1(1 − p1) + p2(1 − p2)) (p1 − p2)2 222。 例一 5 期的比较某药及安慰剂疗效临床成组序贯试验,根据预试验总 体的试验药的有效率为 60%,安慰剂的有效率为 50%, 在 α = 0.05, β = 0.20 时,分别进行 Pocock、O’Brien and Fleming’s 和 Wang and Tsitis(∆ = 0.1) 设计,每期各需要多少病例? Pocock.Test.Binary <- function(alpha, beta, p1, p2, k) { nfixed <- (qnorm(1 - alpha/2) + qnorm(1 - beta))^2 * (p1 * (1 - p1) + p2 * (1 - p2))/(p1 - p2)^2 data <- read.csv("Rp.csv", header = T) col <- paste(paste("alpha", alpha, sep = ""), paste("beta", format(beta, nsmall = 2), sep = ""), sep = "") rp <- as.matrix(data)[k, col] nmax <- rp * nfixed n <- nmax/k n } Pocock.Test.Binary(0.05, 0.2, 0.6, 0.5, 5) ## alpha0.05beta0.20 ## 95 OBF.Test.Binary <- function(alpha, beta, p1, p2, k) { nfixed <- (qnorm(1 - alpha/2) + qnorm(1 - beta))^2 * (p1 * (1 - p1) + p2 * (1 - p2))/(p1 - p2)^2 data <- read.csv("Rb.csv", header = T) col <- paste(paste("alpha", alpha, sep = ""), paste("beta", format(beta, nsmall = 2), sep = ""), sep = "") rb <- as.matrix(data)[k, col] nmax <- rb * nfixed n <- nmax/k 223n } OBF.Test.Binary(0.05, 0.2, 0.6, 0.5, 5) ## alpha0.05beta0.20 ## 79 WT.Test.Binary <- function(alpha, beta, p1, p2, k, delta) { nfixed <- (qnorm(1 - alpha/2) + qnorm(1 - beta))^2 * (p1 * (1 - p1) + p2 * (1 - p2))/(p1 - p2)^2 data <- read.csv("Rwt.csv", header = T) col <- paste(paste("delta", format(delta, nsmall = 2), sep = ""), paste("beta", format(beta, nsmall = 2), sep = ""), sep = "") rwt <- as.matrix(data)[k, col] nmax <- rwt * nfixed n <- nmax/k n } WT.Test.Binary(0.05, 0.2, 0.6, 0.5, 5, 0.1) ## delta0.10beta0.20 ## 88 Pocock、O’Brien and Fleming’s 和 Wang and Tsitis(∆ = 0.1) 设计,每 期各需要各需要 95 例、79 例和 88 例 5.6.6 时间事件数据(生存分析) 对于生存数据资料, 由于其资料的特殊性, 如数据参数分布状态不明、截 尾数据的存在、脱落病例处理的特殊性及受试者入组情况的影响等, 该类型 试验的样本量估计一直是临床试验中样本量估计问题中的难点。以时间事 224件为试验结果的成组序贯设计,为简单起见,仅 Cox 比例风险模型为例。固 定样本量计算公式, Ifixed = (z1−α/2 + z1−β)2 θ2 , 最大样本计算公式 Imax = Ifixed × RB(K, α, β) , 样本量为 nd = Imax Ik 。 例一 5 期的比较某抗癌药及安慰剂疗效的成组序贯试验,以时间事件 为试验结果,根据预试验 θ = 0.405, 在 α = 0.05, β = 0.20 时,每期各需要 多少病例? Cox.Test <- function(alpha, beta, theta, k) { Ifixed <- (qnorm(1 - alpha/2) + qnorm(1 - beta))^2/theta^2 data <- read.csv("Rb.csv", header = T) col <- paste(paste("alpha", alpha, sep = ""), paste("beta", format(beta, nsmall = 2), sep = ""), sep = "") rb <- as.matrix(data)[k, col] Imax <- Ifixed * rb nd <- Imax/0.25 #theta 接近零,对每一期,riA,k ￿ riB,k,Ik 近似于 0.25dk nd } Cox.Test(0.05, 0.2, 0.405, 5) ## alpha0.05beta0.20 ## 197 每期各需要 197 例,实际应用中还需根据删失、风险等因素进行调整。 2255.6.7 α 消耗函数 常用的成组序贯试验有以下几种: Pocock 法 (常数界值)、O’Brien- Fleming 法 (非常数界值) 和成组序贯可信区间法等。虽然这几种方法都 能根据期中分析次数制定检验临界值, 达到控制 I 类错误的目的, 但是都严 格依赖期中分析计划, 需要在完成固定数目的患者随访之后进行, 因此缺乏 灵活性, 在实际应用中有一定的局限性。α 消耗函数法则弥补了这一局限,α 消耗函数法根据信息比例 (information fraction) 分配 I 类错误, 从而在控 制 I 类错误的前提下, 不再依赖固定的期中分析频率和间隔, 更具有灵活性。 信息比例指的是期中分析时收集到的试验信息量占试验结束时预期全部试 验信息量的比例。最常用的是 Lan 和 DeMets 在 1983 年提出的 ￿ 消耗函 数法;1990 年 Hwang 等提出了 γ 族 α 消耗函数法。采用 Pocock (1977) 或 O’Brian-Fleming (1979) 等的方法,应计划好期间分析的时间及次数,并据此 定义提早停止试验的边界点 (boundary)。若停止试验原则采用 Lan-DeMets (1994) 之 α 消耗函数,则可以不预先设定时间及次数。 α 消耗函数是随信息时间递增函数,当信息时间为 0 时,α 消耗函数的 值为 0, 在信息时间为 1 时,α 消耗函数的值为 α。通常以 α(s) 代表在 s 信 息时间时,α 消耗函数的取值,该值表示在 s 信息时间时希望消耗的 I 类错 误的概率。对一给定的 α 消耗函数和一系列的标准统计量 Zkk = 1, ..., K, 相应的边界值 ckk = 1, ..., K,有下面关系 P(|Z1| < c1, ..., |Zk−1| < ck−1, |Zk| ≥ ck) = α( k K) − α(k − 1 K) 常见的 α 消耗函数如下 函数名 函数 O’Brien-Fleming α1(s) = 2 { 1 − Φ(zα/2 √ s) } Pocock α2(s) = αlog[1 + (e − 1)s] Lan-DeMets-Kim α3(s) = αsρ, ρ > 0 Hwang-Shih α4(s) = α [ (1 − eζs)/(1 − e−ζ) ] , ζ ̸= 0 R 语言 ldbounds 包中 bounds() 函数可以计算 α 消耗函数的界值。5 阶段 O’Brien Fleming 方法的消耗函数的界值可如下获得 226options(digits = 4) time <- seq(0.2, 1, length = 5) obf.bd <- bounds(time, iuse = c(1, 1), alpha = c(0.025, 0.025)) summary(obf.bd) ## ## Lan-DeMets bounds for a given spending function ## ## n = 5 ## Overall alpha: 0.05 ## ## Type: Two-Sided Symmetric Bounds ## Lower alpha: 0.025 ## Upper alpha: 0.025 ## Spending function: O'Brien-Fleming ## ## Boundaries: ## Time Lower Upper Exit pr. Diff. pr. ## 1 0.2 -4.8769 4.8769 1.0777e-06 1.0777e-06 ## 2 0.4 -3.3569 3.3569 7.8830e-04 7.8723e-04 ## 3 0.6 -2.6803 2.6803 7.6161e-03 6.8278e-03 ## 4 0.8 -2.2898 2.2898 2.4424e-02 1.6807e-02 ## 5 1.0 -2.0310 2.0310 5.0000e-02 2.5576e-02 plot(obf.bd) time 为信息时间,iuse 为 1 表示 O’Brien Fleming 方法,为 2 表示 Pocock 方法,为 3 表示 power family 方法,为 4 表示 Hwang-Shih-DeCani family 方法。asf 为指定的消耗函数,在 iuse 为 5 时 alpha 为 I 类错误概率, phi 为选择 power family 方法和 Hwang-Shih-DeCani family 方法时,选择 的 ρ 值和 ζ 值。ztrun 为选择的截取向量,默认为 c(-8,8)。 类似的 5 阶段 Opower family 方法的消耗函数的界值可如下获得 227Sequential boundaries using the Lan−DeMets method Time −4 −2 0 2 4 0.2 0.4 0.6 0.8 1.0 图 21: 228options(digits = 4) power.bd <- bounds(time, iuse = c(3,3), phi = c(2,2), alpha = c(0.025, 0.025)) summary(power.bd) ## ## Lan-DeMets bounds for a given spending function ## ## n = 5 ## Overall alpha: 0.05 ## ## Type: Two-Sided Symmetric Bounds ## Lower alpha: 0.025 ## Upper alpha: 0.025 ## Spending function: Power Family: alpha * t^phi ## ## Boundaries: ## Time Lower Upper Exit pr. Diff. pr. ## 1 0.2 -3.0902 3.0902 0.002 0.002 ## 2 0.4 -2.7141 2.7141 0.008 0.006 ## 3 0.6 -2.4727 2.4727 0.018 0.010 ## 4 0.8 -2.2798 2.2798 0.032 0.014 ## 5 1.0 -2.1140 2.1140 0.050 0.018 plot(power.bd) 结果中第一列 Time 为信息时间,第二列为 Lower 低界值,第三列 Upper 为高界值,Exit pr 为名义的 α 值可据此判断是否结束试验,Diff. pr. 为本 阶段与上一阶段 α 值的差异。 5.6.8 样本量再估计 在某些成组序贯试验的期中分析时,需要根据累计的数据对样本量进 行再估计,应当注意盲目的进行再估计有可能造成偏移。Shih 等提出完成 229Sequential boundaries using the Lan−DeMets method Time −2 0 2 0.2 0.4 0.6 0.8 1.0 图 22: 23050% 样本两后,以率为观察结果的随机双盲样本量再估计方法, 估计公式如 下: n = (z1−α/2 + z1−β)2( ˆp1(1 − ˆp1) + ˆp2(1 − ˆp2)) ∆2 ,∆ = | ˆp1 − ˆp2|, ˆp1 = π ˆθ1−(1−π) ˆθ2 2π−1 , ˆp2 = π ˆθ2−(1−π) ˆθ1 2π−1 。 例两中心的临床实验,A 中心以 60% 的概率将病人分配到试验组,B 中心以 40% 的概率将病人分配到试验组,整个试验以 40% 的概率将病人分 配到试验组,已完成的 50% 样本量的期中分析,A 中心的有效率为 60%,B 中心的有效率为 50%,请在 α = 0.05, β = 0.10 时重新估计下一阶段所需样 本量。 根据 0.4p1 + 0.6p2 = 0.6 和 0.6p1 + 0.4p2 = 0.5, 可 p1 = 0.3, p2 = 0.8 GroupSeqReEstimation <- function(alpha, beta, p1, p2) { n <- (qnorm(1 - alpha/2) + qnorm(1 - beta))^2 * (p1 * (1 - p1) + p2 * (1 - p2))/(p1 - p2)^2 n } GroupSeqReEstimation(0.05, 0.1, 0.3, 0.8) ## [1] 15.55 重新估计样本量后,共计所需 32 例。 5.7 变异性比较的样本量估计 (Comparing Variabilities) 变异性通常分为个体内变异和个体间变异两类,个体内变异指在相同的 试验条件下,同一个体多次重复测量值之间存在的差异。个体间变异指不同 个体间由于异质性而存在的差异。 5.7.1 重复平行对照设计 5.7.1.1 显著性检验 显著性检验的样本量需从下面公式中, σ2 WT σ2 WR = F1−β,n(m−1),n(m−1) Fα/2,n(m−1),n(m−1) 231解出 n,σ2 WT 和 σ2 WR 分别表示 T 和 R 的个体内标准差,T(test drug) 和 R(reference drug)分别表示测试药物和参比药物,T 和 R 组的样本量相同 均为 n。 例设计一个 2 组每个个体重复 3 次的平行对照实验,根据预试验,T 组 的个体内标准差为 0.3,R 组个体内标准差为 0.45, 在 α = 0.05, β = 0.20 时, 1:1 显著性设计,需要多少样本量? ISV.Equality <- function(alpha, beta, sigma1, sigma2, m) { ratio = sigma1/sigma2 n = 0 for (i in 1:1000){ ratio.f = qf(p = (1 - beta), i * (m - 1), i * (m - 1), lower.tail = FALSE)/qf(alpha/2, i * (m - 1), i * (m - 1), lower.tail = FALSE) if (round(ratio, digits = 2) == round(ratio.f, digits = 2)) { n = i } } n } ISV.Equality(0.05, 0.2, 0.3, 0.45, 3) ## [1] 102 需要 102 例。 5.7.1.2 非劣性/优效性 非劣性/优效性检验的样本量需从下面公式中, σ2 WT δ2σ2 WR = F1−β,n(m−1),n(m−1) Fα,n(m−1),n(m−1) 解出 n,σ2 WT 和 σ2 WR 分别表示 T 和 R 的个体内标准差,T(test drug) 和 R(reference drug)分别表示测试药物和参比药物,T 和 R 组的样本量相同 均为 n,delta 为界值。 232例设计一个 2 组每个个体重复 3 次的平行对照实验,根据预试验,T 组 的个体内标准差为 0.3,R 组个体内标准差为 0.45, 在 α = 0.05, β = 0.20 时, 1:1 非劣性设计,在界值为-1.1 时需要多少样本量? ISV.NIS <- function(alpha, beta, sigma1, sigma2, m, margin) { ratio = sigma1/(sigma2 * margin^2) n = 0 for (i in 1:1000){ ratio.f = qf(p = (1 - beta), i * (m - 1), i * (m - 1), lower.tail = FALSE)/qf(alpha, i * (m - 1), i * (m - 1), lower.tail = FALSE) if (round(ratio, digits = 2) == round(ratio.f, digits = 2)) { n = i } } n } ISV.NIS(0.05, 0.2, 0.3, 0.45, 3,-1.1) ## [1] 36 需要 36 例。 5.7.1.3 等效性 等效性检验的样本量需从下面公式中, δ2σ2 WT σ2 WR = Fβ/2,n(m−1),n(m−1) F1−α,n(m−1),n(m−1) 解出 n,σ2 WT 和 σ2 WR 分别表示 T 和 R 的个体内标准差,T(test drug) 和 R(reference drug)分别表示测试药物和参比药物,T 和 R 组的样本量相同 均为 n,delta 为界值。 例设计一个 2 组每个个体重复 3 次的平行对照实验,根据预试验,T 组 的个体内标准差为 0.3,R 组个体内标准差为 0.45, 在 α = 0.05, β = 0.20 时, 1:1 等效性设计,在界值为 2 时需要多少样本量? 233ISV.Equivalence <- function(alpha, beta, sigma1, sigma2, m, margin) { ratio = margin^2 * sigma1/sigma2 n = 0 for (i in 1:1000){ ratio.f = qf(beta/2, i * (m - 1), i * (m - 1), lower.tail = FALSE)/qf(1 - alpha, i * (m - 1), i * (m - 1), lower.tail = FALSE) if (round(ratio, digits = 1) == round(ratio.f, digits = 1)) { n = i } } n } ISV.Equivalence(0.05, 0.2, 0.3, 0.45, 3, 2) ## [1] 18 需要 18 例。 5.7.2 简单随机效应模型 根据 Quan 和 Shih 提出的随机效应模型,可以到处方差的估计公式 σ∗2 i = 1 2m ˆCV 2 i + ˆCV 4 i 5.7.2.1 显著性检验 显著性检验样本量计算公式如下 n = (σ∗2 T + σ∗2 R)(z1−α + z1−β)2 (CVT − CVR)2 ,CVT,CVR 分别为 T 和 R 组的变异度,σ∗2 T, σ∗2 R 分别为 T 和 R 组方差。 例设计一个 2 组每个个体重复 2 次的平行对照实验,根据预试验,治 疗组的变异度为 50%, 对照组变异度 70%, 在 α = 0.05, β = 0.20 时,1:1 显著性设计,需要多少样本量? 234ISCV.Equality <- function(alpha, beta, CVt, CVr, m) { sigma1 = 1/(2 * m) * CVt^2 + CVt^4 sigma2 = 1/(2 * m) * CVr^2 + CVr^4 n = (sigma1 + sigma2) * (qnorm(1 - alpha) + qnorm(1 - beta))^2/(CVt - CVr)^2 n } ISCV.Equality(0.05, 0.2, 0.7, 0.5, 2) ## [1] 75.37 需要 75 例。 5.7.2.2 非劣性/优效性检验 非劣性/优效性检验样本量计算公式如下 n = (σ∗2 T + σ∗2 R)(z1−α + z1−β)2 (CVT − CVR − δ)2 ,CVT,CVR 分别为 T 和 R 组的变异度,σ∗2 T, σ∗2 R 分别为 T 和 R 组方差,δ 为界值。 例设计一个 2 组每个个体重复 2 次的平行对照实验,根据预试验,治 疗组的变异度为 50%, 对照组变异度 70%, 在 α = 0.05, β = 0.20 时,1:1 非劣性设计,界值为 0.1,需要多少样本量? ISCV.NIS <- function(alpha, beta, CVt, CVr, m, margin) { sigma1 = 1/(2 * m) * CVt^2 + CVt^4 sigma2 = 1/(2 * m) * CVr^2 + CVr^4 n = (sigma1 + sigma2) * (qnorm(1 - alpha) + qnorm(1 - beta))^2/ (CVt - CVr - margin)^2 n } ISCV.NIS(0.05, 0.2, 0.7, 0.5, 2,-0.1) 235## [1] 33.5 需要 33 例。 5.7.2.3 等效性检验 非劣性/优效性检验样本量计算公式如下 n = (σ∗2 T + σ∗2 R)(z1−α + z1−β)2 (δ − |CVT − CVR|)2 ,CVT,CVR 分别为 T 和 R 组的变异度,σ∗2 T, σ∗2 R 分别为 T 和 R 组方差,δ 为界值。 例设计一个 2 组每个个体重复 2 次的平行对照实验,根据预试验,治 疗组的变异度为 50%, 对照组变异度 70%, 在 α = 0.05, β = 0.20 时,1:1 等效性设计,界值为 0.1,需要多少样本量? ISCV.Equivalence <- function(alpha, beta, CVt, CVr, m, margin) { sigma1 = 1/(2 * m) * CVt^2 + CVt^4 sigma2 = 1/(2 * m) * CVr^2 + CVr^4 n = (sigma1 + sigma2) * (qnorm(1 - alpha) + qnorm(1 - beta))^2/(margin - abs(CVt - CVr))^2 n } ISCV.Equivalence(0.05, 0.2, 0.7, 0.5, 2, 0.1) ## [1] 301.5 需要 301 例。 5.7.3 个体间变异的比较 除了比较个体内变异和变异度外,实际工作中也需要比较个体间的变 异。临床试验中,对个体进行重复测量通常难以实施,但测量不同处理的个 体间变异和总变异却有实际应用价值。平行对照设计中估计变异的方法为 修正大样本方法 (modified large sample, MLS) ,交叉设计中,由于不满足 独立性的要求,需要对 MLS 方法进行扩展。 2365.7.3.1 平行可重复设计 5.7.3.1.1 显著性检验 显著性检验样本量计算公式如下, n = σ∗2(z1−α/2 + z1−β)2 (σ2 BT − σ2 BR)2 , 其中 σ∗2 = 2 [ (σ2 BT + σ2 WT m )2 + (σ2 BR + σ2 WR m )2 + σ4 WT m2(m−1) + σ4 WR m2(m−1) ] 例设计一个 2 组每个个体重复 3 次的平行对照实验,根据预试验,T 组 和 R 组的个体间标准差分别为 0.3,0.4,T 组和 R 组的个体内标准差分别为 0.2,0.3, 在 α = 0.05, β = 0.20 时,1:1 显著性设计,需要多少样本量? InterSV.Equality <- function(alpha, beta, vbt, vwt, vbr, vwr, m) { sigma = 2 *(vbt^2 + vwt^2/m)^2 + (vbr^2 + vwr^2/m)^2 + vwt^4/(m^2 * (m - 1)) + vwr^4/(m^2 *(m - 1)) n = sigma * (qnorm(1 - alpha/2) + qnorm(1 - beta))^2/(vbt^2 - vbr^2)^2 n } InterSV.Equality(0.05, 0.2, 0.3, 0.2, 0.4, 0.3, 3) ## [1] 92.9 需要 93 例。 5.7.3.2 非劣性/优效性检验 样本量计算公式如下非劣性/优效性检验 n = σ∗2(z1−α + z1−β)2 (σ2 BT − δ2σ2 BR)2 , 其中 σ∗2 = 2 [ (σ2 BT + σ2 WT m )2 + δ4(σ2 BR + σ2 WR m )2 + σ4 WT m2(m−1) + δ4σ4 WR m2(m−1) ] 例设计一个 2 组每个个体重复 3 次的平行对照实验,根据预试验,T 组 和 R 组的个体间标准差分别为 0.3,0.4,T 组和 R 组的个体内标准差分别为 0.2,0.3, 在 α = 0.05, β = 0.20 时,1:1 非劣性设计,需要多少样本量? 237InterSV.NIS <- function(alpha, beta, vbt, vwt, vbr, vwr, m, margin) { sigma = 2 *((vbt^2 + vwt^2/m)^2 + margin^4 *(vbr^2 + vwr^2/m)^2 + vwt^4/(m^2 *(m - 1)) + margin^4 * vwr^4/(m^2 *(m - 1))) n = sigma * (qnorm(1 - alpha) + qnorm(1 - beta))^2/(vbt^2 - margin^2 * vbr^2)^2 n } InterSV.NIS(0.05, 0.2, 0.3, 0.2, 0.4, 0.3, 3,-1.1) ## [1] 74.05 需要 74 例。 5.7.3.3 交叉可重复设计 5.7.3.3.1 显著性检验 显著性检验样本量计算公式如下, ns = σ∗2(z1−α/2 + z1−β)2 (σ2 BT − σ2 BR)2 , 其中 σ∗2 = 2 [ (σ2 BT + σ2 WT m )2 + (σ2 BR + σ2 WR m )2 − 2ρ2σ2 BT σ2 BR + σ4 WT m2(m−1) + σ4 WR m2(m−1) ] 例设计一个 2 组每个个体重复 2 次的交叉对照实验 (ABAB,BABA), 根据预试验,T 组和 R 组的个体间标准差分别为 0.3,0.4,T 组和 R 组的个 体内标准差分别为 0.2,0.3, 在 α = 0.05, β = 0.20, ρ = 0.75 时,1:1 显著性 设计,需要多少样本量? InterSV.Cross.Equality <- function(alpha, beta, vbt, vwt, vbr, vwr, m, rho) { sigma = 2 *((vbt^2 + vwt^2/m)^2 + (vbr^2 + vwr^2/m)^2 - 2 * rho^2 * vbt^2 * vbr^2 + vwt^4/(m^2 *(m - 1)) + vwr^4/(m^2 *(m - 1))) ns = sigma * (qnorm(1 - alpha) + qnorm(1 - beta))^2/(vbt^2 - vbr^2)^2 238ns } InterSV.Cross.Equality(0.05, 0.2, 0.3, 0.2, 0.4, 0.3, 2, 0.75) ## [1] 101.8 总计需要 102 例,由于 ns = n1 + n2 − 2,每组大约需要 52 例。 5.7.3.4 非劣性/优效性检验 样本量计算公式如下非劣性/优效性检验 ns = σ∗2(z1−α + z1−β)2 (σ2 BT − δ2σ2 BR)2 , 其中 σ∗2 = 2 [ (σ2 BT + σ2 WT m )2 + δ4(σ2 BR + σ2 WR m )2 − 2δ2ρ2σ2 BT σ2 BR + σ4 WT m2(m−1) + δ4σ4 WR m2(m−1) ] 例设计一个 2 组每个个体重复 2 次的交叉对照实验 (ABAB,BABA), 根据预试验,T 组和 R 组的个体间标准差分别为 0.3,0.4,T 组和 R 组的个 体内标准差分别为 0.2,0.3, 在 α = 0.05, β = 0.20, ρ = 0.75 时,1:1 非劣性 设计,需要多少样本量? InterSV.Cross.NIS <- function(alpha, beta, vbt, vwt, vbr, vwr, m, margin, rho) { sigma = 2 *((vbt^2 + vwt^2/m)^2 + margin^4 *(vbr^2 + vwr^2/m)^2 - 2 * margin^2 * rho^2 * vbt^2 * vbr^2 + vwt^4/(m^2 *(m - 1)) + margin^4 * vwr^4/(m^2 *(m - 1))) ns = sigma * (qnorm(1 - alpha) + qnorm(1 - beta))^2/(vbt^2 - margin^2 * vbr^2)^2 ns } InterSV.Cross.NIS(0.05, 0.2, 0.3, 0.2, 0.4, 0.3, 2,-1.1, 0.75) ## [1] 66.12 总计需要 66 例,由于 ns = n1 + n2 − 2,每组大约需要 29 例。 2395.7.4 总体变异的比较 总体变异的估计可从标准的 2×2 交叉/平行设计或者重复的 2×2m 的 交叉/平行设计中获得。 5.7.4.1 无重复的平行对照试验 5.7.4.1.1 显著性检验 显著性检验样本量计算公式需要解下公式 σ2 TT σ2 TR = F1−β,n−1,n−1 Fα/2,n−1,n−1 ,其中 σTT 和 σTR 为 T 组和 R 组的方差。 例设计一无重复的平行对照的临床试验,根据预试验,T 组和 R 组的 方差分别为 0.55 和 0.75, 在 α = 0.05, β = 0.20 时,显著性设计需要多少样 本量? Variabilities.Parallel.Equality <- function(alpha, beta, vtt, vtr) { ratio = vtt^2/vtr^2 n = 0 for (i in 2:1000){ ratio.f = qf(p = (1 - beta), i - 1, i - 1, lower.tail = FALSE)/qf(alpha/2, i - 1, i - 1,, lower.tail = FALSE) if (round(ratio, digits = 2) == round(ratio.f, digits = 2)) { n = i } } n } Variabilities.Parallel.Equality(0.05, 0.2, 0.55, 0.75) ## [1] 87 每组需要 87 例。 2405.7.4.1.2 非劣性/优效性检验 非劣性/优效性检验样本量计算公式需要解下公式 σ2 TT δ2σ2 TR = F1−β,n−1,n−1 Fα,n−1,n−1 ,其中 σTT 和 σTR 为 T 组和 R 组的方差,delta 为界值。 例设计一无重复的平行对照的临床试验,根据预试验,T 组和 R 组的 方差分别为 0.55 和 0.75, 在 α = 0.05, β = 0.20 时,非劣性设计,在界值为 1.1 时,需要多少样本量? Variabilities.Parallel.NIS <- function(alpha, beta, vtt, vtr, margin) { ratio = vtt^2/margin^2 * vtr^2 n = 0 for (i in 2:1000){ ratio.f = qf(p = (1 - beta), i - 1, i - 1, lower.tail = FALSE)/qf(alpha, i - 1, i - 1,, lower.tail = FALSE) if (round(ratio, digits = 2) == round(ratio.f, digits = 2)) { n = i } } n } Variabilities.Parallel.NIS(0.05, 0.2, 0.55, 0.75,-1.1) ## [1] 8 每组需要 8 例。 5.7.4.1.3 等效性检验 等效性检验样本量计算公式需要解下公式 δ2σ2 TT σ2 TR = Fβ/2,n−1,n−1 F1−α,n−1,n−1 ,其中 σTT 和 σTR 为 T 组和 R 组的方差,delta 为界值。 241例设计一无重复的平行对照的临床试验,根据预试验,T 组和 R 组的 方差分别为 0.55 和 0.75, 在 α = 0.05, β = 0.20 时,等效性设计,在界值为 1.8 时,需要多少样本量? Variabilities.Parallel.Equivalence <- function(alpha, beta, vtt, vtr, margin) { ratio = margin^2 * vtt^2/vtr^2 n = 0 for (i in 2:1000){ ratio.f = qf(beta/2, i - 1, i - 1, lower.tail = FALSE)/qf(p = (1 - alpha), i - 1, i - 1,, lower.tail = FALSE) if (round(ratio, digits = 1) == round(ratio.f, digits = 1)) { n = i } } n } Variabilities.Parallel.Equivalence(0.05, 0.2, 0.55, 0.75, 1.8) ## [1] 138 每组需要 138 例。 5.7.4.2 重复的平行对照试验 5.7.4.2.1 显著性检验 显著性检验样本量计算公式如下, n = σ∗2(z1−α/2 + z1−β)2 (σ2 TT − σ2 TR)2 , 其中 σ∗2 = 2 [ (σ2 BT + σ2 WT m )2 + (σ2 BR + σ2 WR m )2 + (m−1)σ4 WT m2 + (m−1)σ4 WR m2 ] 例设计一个 3 组每个个体重复 3 次的平行对照实验,根据预试验,T 组 和 R 组的个体间标准差分别为 0.3,0.4,T 组和 R 组的个体内标准差分别为 0.2,0.3, 在 α = 0.05, β = 0.20 时,1:1 显著性设计,需要多少样本量? 242Variabilities.Parallel.Rep.Equality <- function(alpha, beta, vbt, vwt, vbr, vwr, m) { sigma = 2 *((vbt^2 + vwt^2/m)^2 + (vbr^2 + vwr^2/m)^2 + (m - 1)* vwt^4/m^2 + (m - 1)* vwr^4/m^2) n = sigma * (qnorm(1 - alpha/2) + qnorm(1 - beta))^2/ (vbt^2 + vwt^2 -(vbr^2 + vwr^2))^2 n } Variabilities.Parallel.Rep.Equality(0.05, 0.2, 0.3, 0.2, 0.4, 0.3, 3) ## [1] 53.34 需要 53 例。 5.7.4.3 非劣性/优效性检验 样本量计算公式如下非劣性/优效性检验 n = σ∗2(z1−α + z1−β)2 (σ2 TT − δ2σ2 TR)2 , 其中 σ∗2 = 2 [ (σ2 BT + σ2 WT m )2 + δ4(σ2 BR + σ2 WR m )2 + (m−1)σ4 WT m2 + δ4 (m−1)σ4 WR m2 ] 例设计一个 3 组每个个体重复 3 次的平行对照实验,根据预试验,T 组 和 R 组的个体间标准差分别为 0.3,0.4,T 组和 R 组的个体内标准差分别为 0.2,0.3, 在 α = 0.05, β = 0.20 时,1:1 非劣性设计,需要多少样本量? Variabilities.Parallel.Rep.NIS <- function(alpha, beta, vbt, vwt, vbr, vwr, m, margin) { sigma = 2 *((vbt^2 + vwt^2/m)^2 + margin^4 *(vbr^2 + vwr^2/m)^2 + (m - 1)* vwt^4/(m^2) + margin^4 *(m - 1)* vwr^4/(m^2)) n = sigma * (qnorm(1 - alpha) + qnorm(1 - beta))^2/(vbt^2 + vwt^2 - margin^2 *(vbr^2 + vwr^2))^2 n } Variabilities.Parallel.Rep.NIS(0.05, 0.2, 0.3, 0.2, 0.4, 0.3, 3,-1.1) 243## [1] 27.64 需要 28 例。 5.7.4.4 标准 2×2 交叉设计 5.7.4.4.1 显著性检验 显著性检验样本量计算公式如下, ns = σ∗2(z1−α/2 + z1−β)2 (σ2 TT − σ2 TR)2 , 其中 σ∗2 = 2(σ4 TT + σ4 TR − 2ρ2σ2 BT σ2 BR) 例设计一个 2×2 的标准交叉对照实验,根据预试验,T 组和 R 组的 个体间标准差分别为 0.3,0.4,T 组和 R 组的个体内标准差分别为 0.2,0.3, 在 α = 0.05, β = 0.20ρ = 1 时,1:1 显著性检验设计,需要多少样本量? Variabilities.Cross.Equality <- function(alpha, beta, vbt, vwt, vbr, vwr, rho) { sigma = 2 *((vbt^2 + vwt^2)^2 + (vbr^2 + vwr^2)^2 - 2 * rho^2 * vbt^2 * vbr^2) ns = sigma * (qnorm(1 - alpha) + qnorm(1 - beta))^2/ (vbt^2 + vwt^2 -(vbr^2 + vwr^2))^2 ns } Variabilities.Cross.Equality(0.05, 0.2, 0.3, 0.2, 0.4, 0.3, 1) ## [1] 43.45 由于 ns = n1 + n2 − 2, 每组需 23 例。 5.7.4.5 非劣性/优效性检验 样本量计算公式如下非劣性/优效性检验 ns = σ∗2(z1−α + z1−β)2 (σ2 TT − δ2σ2 TR)2 244, 其中 σ∗2 = 2(σ4 TT + δ4σ4 TR − 2δ2ρ2σ2 BT σ2 BR) 例设计一个 2×2 的标准交叉对照实验,根据预试验,T 组和 R 组的 个体间标准差分别为 0.3,0.4,T 组和 R 组的个体内标准差分别为 0.2,0.3, 在 α = 0.05, β = 0.20ρ = 1 时,1:1 非劣性检验设计,在界值为 1.1 的情况下 需要多少样本量? Variabilities.Cross.NIS <- function(alpha, beta, vbt, vwt, vbr, vwr, margin, rho) { sigma = 2 *((vbt^2 + vwt^2)^2 + margin^4 * (vbr^2 + vwr^2)^2 - 2 * margin^2 * rho^2 * vbt^2 * vbr^2) ns = sigma * (qnorm(1 - alpha) + qnorm(1 - beta))^2/ (vbt^2 + vwt^2 - margin^2 *(vbr^2 + vwr^2))^2 ns } Variabilities.Cross.NIS(0.05, 0.2, 0.3, 0.2, 0.4, 0.3,-1.1, 1) ## [1] 30.57 由于 ns = n1 + n2 − 2, 每组需 16 例。 5.7.4.6 重复 2×2m 交叉设计 5.7.4.6.1 显著性检验 n = σ∗2(z1−α/2 + z1−β)2 (σ2 TT − σ2 TR)2 , 其中 σ∗2 = 2 [ (σ2 BT + σ2 WT m )2 + (σ2 BR + σ2 WR m )2 − 2ρ2σ2 BT σ2 BR + (m−1)σ4 WT m2 + (m−1)σ4 WR m2 ] 例设计一个 2 组每个个体重复 2 次的交叉对照实验 (ABAB,BABA), 根据预试验,T 组和 R 组的个体间标准差分别为 0.3,0.4,T 组和 R 组的个 体内标准差分别为 0.2,0.3, 在 α = 0.05, β = 0.20, ρ = 0.75 时,1:1 显著性 设计,需要多少样本量? 245Variabilities.Cross.Rep.Equality <- function(alpha, beta, vbt, vwt, vbr, vwr, m, rho) { sigma = 2 *((vbt^2 + vwt^2/m)^2 + (vbr^2 + vwr^2/m)^2 - 2 * rho^2 * vbt^2 * vbr^2 + (m - 1)* vwt^4/m^2 + (m - 1)* vwr^4/m^2) ns = sigma * (qnorm(1 - alpha/2) + qnorm(1 - beta))^2/(vbt^2 + vwt^2 - (vbr^2 + vwr^2))^2 ns } Variabilities.Cross.Rep.Equality(0.05, 0.2, 0.3, 0.2, 0.4, 0.3, 2, 0.75) ## [1] 43.99 由于 ns = n1 + n2 − 2, 每组需 23 例。 5.7.4.7 非劣性/优效性检验 非劣性/优效性检验样本量计算公式如下 n = σ∗2(z1−α + z1−β)2 (σ2 TT − δ2σ2 TR)2 , 其中 σ∗2 = 2 [ (σ2 BT + σ2 WT m )2 + δ4(σ2 BR + σ2 WR m )2 − 2δ2ρ2σ2 BT σ2 BR + (m−1)σ4 WT m2 + δ4 (m−1)σ4 WR m2 ] 例设计一个 2 组每个个体重复 2 次的交叉对照实验 (ABAB,BABA), 根据预试验,T 组和 R 组的个体间标准差分别为 0.3,0.4,T 组和 R 组的个 体内标准差分别为 0.2,0.3, 在 α = 0.05, β = 0.20, ρ = 0.75 时,1:1 非劣性 设计,需要多少样本量? Variabilities.Cross.Rep.NIS <- function(alpha, beta, vbt, vwt, vbr, vwr, m, margin, rho) { sigma = 2 *((vbt^2 + vwt^2/m)^2 + margin^4 * (vbr^2 + vwr^2/m)^2 - 2 * margin^2 * rho^2 * vbt^2 * vbr^2 + (m - 1)* vwt^4/(m^2) + 246margin^4 *(m - 1)* vwr^4/(m^2)) ns = sigma * (qnorm(1 - alpha) + qnorm(1 - beta))^2/(vbt^2 + vwt^2 - margin^2 *(vbr^2 + vwr^2))^2 ns } Variabilities.Cross.Rep.NIS(0.05, 0.2, 0.3, 0.2, 0.4, 0.3, 2,-1.1, 0.75) ## [1] 23.85 由于 ns = n1 + n2 − 2, 每组需 13 例。 5.8 生物等效性 (Bioequivalence) 生物利用度 (bioavailability) 指药物吸收进入血液循环的程度和速度。 通常它的吸收程度是用血浆药物浓度与时间曲线下的面积(AUC)表示的, 不管曲线下的形状如何,曲线下面积越大,表示吸收越完全。而吸收速度是 以用药后所能达到的最高血药浓度(峰浓度,Cmax)与达到最高血药浓度 的时间(达峰时间,Tmax)比值。一般认为静脉注射的生物利用度是 100%, 如果把静脉注射 (iv) 与血管外给药 (ev) 的 AUC 值进行比较,并计算后者 的生物利用度,即为绝对生物利用度。同一给药途径下,对不同制剂进行比 较,即为相对生物利用度。 生物等效性 (bioequivalence, BE) 是指统一种药物的不同制剂在相同实 验条件下,给予相同剂量,其吸收程度和速度没有显著的差异,主要用于评 价仿制药 (generic drug) 与专利药 (brand-name drug) 是否相当。FDA 规 定, 例如仿制药与标准药, 天然药与化学药, 口服药与针剂, 长效药与短效药, 某药低剂量与高剂量的比较需要用生物等效性方法来评价。FDA 规定, 若仿 制药品与注册药品间具有生物等效性, 申报过程可按缩略申报程序进行, 而 不需要按新药申报程序进行, 避免了耗时、昂贵的 I、II、III 期临床试验,所 以生物等效性在新药临床试验中占有重要的地位。 生物等效性与药剂等效性 (pharmaceutical eqivalents) 不同,药剂等效 性是指统一药物相同剂量制成同一剂型,但非活性成分不一定相同,在含量、 纯度、均度等符合同一规定标准的制剂。药剂等效性没有反映药物制剂在体 247内的情况。生物等效性均以试验品与参考品作比较, 二者应有相似的剂量形 式, 并且它们在生物体内吸收的速率和延缓 (吸收率和吸收度) 没有显著的 差别。目前关于生物等效性的实验设计与分析是基于以下假设的:两药物 的吸收率和吸收度相同即认为生物等效, 它们的治疗效果也应是相同的。吸 收率和吸收度是通过测量药代动力学响应, 如 AUC 和 Cmax 而得到的。因 此生物等效性应该是对于这些观测值所在总体分布而言的, 当它是正态分布 或对数正态分布时, 只要比较均数和变异就可以了。也就是说, 要看生物利 用度是否是等效的, 需要把这些利用度数值作为总体参数在两种配方中的样 本作统计推断。1996 年 Chinchilli 给出 3 个关于生物等效性定义群体生物 等效性 (population bioequivalence, PBE): 对于两药物有关的概率分布函数 而言是生物等效性; 平均生物等效性 (average bioequivalence, ABE): 对于两 药物有关的概率分布函数的均数或中位数而言是生物等效性; 个体生物等效 性 (individual bioequivalence, IBE): 对于总体中大部分个体而言是生物等 效性。ABE 虽然保证平均效应相同,但不一定保证效应的变异度相同,即两 总体的均值相同,但方差不一定相同。PBE 能保证使用 T 药物和使用 R 药 物所得效应,不仅其平均值相同,而且效应的变异度相同,即两总体的边缘 分布相同。PBE 虽保证其边缘分布相同,但对每个个体而言,使用 T 药物 和使用 R 药物所得效应不一定相同。即个体与药物可能存在交互作用。IBE 对每个个体而言,使用 T 药物和使用 R 药物所得效应值接近。从等效的程 度看,IBE>PBE>ABE。从应用角度看,两个具有个体生物等效性的药物, 具有药物可交替性 (switchability), 即某患者在服用某药物一段时间后,如 果改用另一个与之具有个体等效性的药物,可以得到相同的效果。具有群体 生物等效性的药物,具有处方可选择性 (prescribability), 即医生在给患者初 次开药时可以任意选用,这对该类患者的群体来说效应是相同的。基于以上 考虑,美国 FDA 较为提倡 PBE 和 IBE。 5.8.1 平均生物等效性 标准 2(顺序)×2(时期) 交叉试验,即两种处理 T 和 R, 则将受试对象随 机分为两组, 第一组在第一时期接受 T 处理, 在第二时期接受 R 处理, 实验 顺序为 TR; 第二组则相反, 在第一时期接受 R 处理, 在第二时期接受 T 处 理, 实验顺序为 RT。平均生物等效性基于 2×2 交叉设计的样本量可用如下 公式进行估计 n = (z1−α + z1−β/2)2σ2 1,1 2(δ − |ϵ|)2 248, 其中 δ 为平均等效界值在 ln(8/10) 到 ln(10/8) 之间,σ1,1 为个体内标准 差,ϵ 为 T 和 R 的差值。 例某研究者预设计一个 2×2 交叉设计的、比较某种药物的吸入剂和皮 下注射剂差异的平均生物等效性试验,根据药代动力学的预试验,个体内标 准差为 0.4,平均等效界值为 ln(10/8) 约为 0.2231,差值为 0.05,σ = 0.4,, 在 α = 0.05, β = 0.20 时,需要多少样本量? (ABE(0.05,0.2,0.4,0.223,0.05)) ## [1] 20.98 每组需要 21 例。 5.8.2 群体生物等效性 群体生物等效性基于 2×2 交叉设计的样本量可用如下公式进行估计 n = ζ(z1−α + zβ)2 λ2 , 其中 ζ = 2δ2σ2 1,1 + σ4 TT + (1 + a)2σ4 TR − 2(1 + a)ρ2σ2 TT σ2 TR,δ 为界值, σ2 a,b = σ2 D + aσ2 WT + bσ2 WT,ρ 为个体间相关系数,a 为 1.74,δ 为 AUC 值的 平均差。 例某研究者预设计一个 2×2 交叉设计的、比较某种药物的吸入剂和 皮下注射剂差异的群体生物等效性试验,根据药代动力学的预试验 σ1,1 = 0.2, σtt = √ 0.17, σtr = √ 0.17, σbt = 0.4, σbr = 0.4, ρ = 0.75, a = 1.74, δ = 0.00, λ = −0.2966 , 在 α = 0.05, β = 0.20 时,需要多少样本量? PBE(0.05,0.2,0.2,sqrt(0.17),sqrt(0.17),0.4,0.4,0.75,1.74,0.00,-0.2966) ## [1] 11.73 每组需要 12 例。 5.8.3 个体生物等效性 个体生物等效性基于 2×4 交叉设计 (TRTR,RTRT) 的样本量可用如 下公式 ˆγ + √ ˆU + √ ˆU1−β ≤ 0 249, 其中 U = [ (|ˆδ| + t0.05,n1+n2−2 ˆσ0.5,0.5 2 √ 1 n1 + 1 n2 )2 − ˆδ2 ]2 +ˆσ4 0.5,0.5( n1 + n2 − 2 χ2 0.95,n1+n2−2 − 1)2 +0.52 ˆσ4 WT( n1 + n2 − 2 χ2 0.95,n1+n2−2 − 1)2 +(1.5 + θIBE)2 ˆσ4 WT( n1 + n2 − 2 χ2 0.05,n1+n2−2 − 1)2 , γ = δ2 + σ2 D + σ2 WT − σ2 WR − θIBEmax { σ0, σ2 WR } , σ2 a,b = σ2 D + aσ2 WT + bσ2 WR ,σ2 WT, σ2 WR 分别为 T、R 效应的个体内方差,σ2 BT, σ2 BR 分别为 T、R 效应 的个体间方差,δ 为 T 和 R 效应的差值,σ2 D 为个体与药物的交互作用。 例某研究者预设计一个 2×4 交叉设计的、比较某种药物的吸入剂和 皮下注射剂差异的个体生物等效性试验,根据药代动力学的预试验 σBT = 0.1, σBR = 0.4, σWT = 0.6, σWR = 0.4, δ = 0, a = b = 0.5, θIBE = 5.11, ρ = 0.75 , 在 α = 0.05, β = 0.20 时,需要多少样本量? IBE <- function(alpha, beta, delta, sigmaBT, sigmaBR, sigmaWT, sigmaWR, a, b, thetaIBE, rho) { sigmaD <- sqrt(sigmaBT^2 + sigmaBR^2 - 2 * rho * sigmaBT * sigmaBR) Sigma <- function(sigmaD, sigmaWT, sigmaWR, a, b) { Sigma = sigmaD^2 + a * sigmaWT^2 + b * sigmaWR^2 } U <- function(n, alpha, beta, delta, sigmaD, sigmaWT, sigmaWR, a, b, thetaIBE) { U = ((abs(delta) + qt(alpha, 2 * n - 2)* Sigma(sigmaD, sigmaWT, sigmaWR, 0.5, 0.5)/2 * sqrt(2/n))^2 - delta^2)^2 + Sigma(sigmaD, sigmaWT, sigmaWR, 0.5, 0.5)^4 * ((2 * n - 2)/qchisq(1 - alpha, 2502 * n - 2)- 1)^2 + 0.5^2 * sigmaWT^4 *((2 * n - 2)/qchisq(1 - alpha, 2 * n - 2)- 1)^2 + (1.5 + thetaIBE)^2 * sigmaWR^4 * ((2 * n - 2)/qchisq(alpha, 2 * n - 2)- 1)^2 } gamma = delta^2 + sigmaD^2 + sigmaWT^2 - sigmaWR^2 - thetaIBE * sigmaWR^2 n <- 0 for (i in 2:1000){ bound = gamma + sqrt(U(i, alpha, 0.05, delta, sigmaD, sigmaWT, sigmaWR, a, b, thetaIBE)) + sqrt(U(i, alpha, beta, delta, sigmaD, sigmaWT, sigmaWR, a, b, thetaIBE)) if (round(bound, digits = 2) == 0){ n = i } } n } IBE(0.05, 0.2, 0, 0.1, 0.4, 0.6, 0.4, 0.5, 0.5, 5.11, 0.75) ## [1] 69 每组需要 69 例,与 Sample Size Calculation in Clinical Research 书中 的计算结果有差异。 5.8.4 体外实验法 体外实验法的样本量可用如下公式 ˆζ + √ ˆU + √ ˆU1−β ≤ 0 251进行估算, 其中 U = [ (|ˆδ| + z0.05 √ s2 BT mT + s2 BR mR )2 − ˆδ2 ]2 +s4 BT( mT − 1 χ2 0.95,mT −1 − 1)2 +(1 − n−1 T)2s4 WT( mT(nT − 1) χ2 0.95,mT(nT −1) − 1)2 +(1 + θBE)2s4 BR( mR − 1 χ2 0.05,mR−1 − 1)2+ (1 + cθBE)2(1 − n−1 R)2s4 WR( mR(nR − 1) χ0.05,mR(nR−1) − 1) , ζ = δ2 + σ2 T − σ2 R − θBEmax { σ2 0, σ2 R, } ,σ2 WT, σ2 WR 分别为 T、R 效应的个体内方差,σ2 BT, σ2 BR 分别为 T、R 效应 的个体间方差,δ 为 T 和 R 效应的差值。 例某研究者预设计一个无重复的平行对照的体外实验法,根据药代动力 学的预试验 σBT = 0.5, σBR = 0.5, σWT = 0.5, σWR = 0.5, δ = 0, a = b = 0.5, θBE = 15 , 在 α = 0.05, β = 0.20 时,需要多少样本量? Vitro.BE <- function(alpha, beta, delta, sigmaBT, sigmaBR, sigmaWT, sigmaWR, thetaBE) { U <- function(m, n, alpha, beta, delta, sigmaBT, sigmaBR, sigmaWT, sigmaWR, thetaBE) { U = ((abs(delta) + qnorm(alpha) * sqrt(sigmaBT^2/m + sigmaBR^2/m))^2 - delta^2)^2+(sigmaBT^2 + sigmaWT^2)^2 * ((m - 1)/qchisq(1 - alpha, m - 1)- 1)^2 +(1 + thetaBE)^2 * (sigmaBR^2 + sigmaWR^2)^2 *((m - 1)/ qchisq(alpha, m - 1)- 1)^2 } sigmaT = sqrt(sigmaBT^2 + sigmaWT^2) sigmaR = sqrt(sigmaBR^2 + sigmaWR^2) gamma = delta^2 + sigmaT^2 - sigmaR^2 - thetaBE * sigmaR^2 252n <- 0 for (i in 2:1000){ bound = gamma + sqrt(U(i, 1, alpha, 0.05, delta, sigmaBT, sigmaBR, sigmaWT, sigmaWR, thetaBE)) +sqrt(U(i, 1, alpha, beta, delta, sigmaBT, sigmaBR, sigmaWT, sigmaWR, thetaBE)) if (round(bound, digits = 2) == 0){ n = i } } n } Vitro.BE(0.05, 0.2, 0, 0.5, 0.5, 0.5, 0.5, 1) ## [1] 42 每组需要 42 例 5.9 剂量反应研究 (Dose Response Studies) II 期临床试验目的在于对新药的安全性和有效性进行初步评价,并通 过对剂量反应关系的研究,为 III 期临床实验给药剂量方案的制定提供依 据。实际中,I 期临床试验的剂量反应关系关注安全性,II 期临床试验的剂 量反应关系关注有效性。剂量反应关系研究主要包括:确认不同剂量组之 间是否存在剂量反应关系,剂量反应关系曲线的形状如何,最佳剂量应该为 多少?剂量反映关系的研究通常采用随机平行对照设计,通过测量方差来证 明药物的有效性,通过 Williams 方法比较实验组和对照组的最小有效剂量 (MED),通过模型来证明剂量反应关系,通过最大耐受剂量(MTD)说明 最优剂量。 2535.9.1 计量资料(Continuous Response) 基于线性对比法的样本量可根据 N = [ (z1−α+z1−β )σ ε ]2 k∑ i=0 c2 i fi 进行估计,σ 为标准差,ε = ∑k i=0 ciui,ci 为分组情况,但应使得 ∑ ci = 0,ui 为各组相对于基线提高的百分率。 例为某药物设计一个 4 组平行对照剂量反应试验,其中有 1 个对照组, 3 个试验组(剂量分别为 20mg, 40mg,60mg),根据预实验,σ = 0.22, c0 = 6, c1 = 1, c2 = 2, c3 = 3, u0 = 0.05, u1 = 0.12, u2 = 0.14, u3 = 0.16, 在 α = 0.05, β = 0.20 时,需要多少样本量? mui=c(0.05,0.12,0.14,0.16) ci=c(-6,1,2,3) (Dose.Response.Linear(alpha=0.05,beta=0.2, sigma=0.22,mui=mui,ci=ci,fi=1/4)) ## [1] 177.9 每组需要 44.5 例。 5.9.2 二分类变量(Binary Response) 结果为二分类的样本量可根据 N ≥ [ z1−α √∑k i=0 c2 i fi ¯p(1−¯p)+z1−β √∑k i=0 c2 i fi pi(1−pi) ε ]2 进行估计,ε = ∑k i=0 cipi,ci 为分组情况,但应使得 ∑ ci = 0,pi 为各组的反 应率。 例为某药物设计一个 4 组平行对照剂量反应试验,其中有 1 个对照组, 3 个试验组(剂量分别为 20mg, 40mg,60mg),根据预实验,σ = 0.22, c0 = 6, c1 = 1, c2 = 2, c3 = 3, p0 = 0.05, p1 = 0.12, p2 = 0.14, p3 = 0.16, 在 α = 0.05, β = 0.20 时,需要多少样本量? 254pi=c(0.05,0.12,0.14,0.16); ci=c(-6,1,2,3); (Dose.Response.binary(alpha=0.05,beta=0.2,pi=pi,ci=ci,fi=1/4)) ## [1] 336.7 每组需要 84.25 例。 5.9.3 时间事件数据(Time-to-Event Endpoint) 分析结果为时间事件样本量可根据 N ≥ [ z1−ασ0 √∑k i=0 c2 i fi +z1−β √∑k i=0 c2 i fi σi ε ]2 进行估计,其中 σ2(λi) = λ2 i [ 1 + e−λiT(1−eλiT0 ) T0λi ]−1 ,T0 为试验的纳入时间, T 为整个试验时间,ci 为分组情况,但应使得 ∑ ci = 0。 例某抗肿瘤药物进行 II 期临床实验,设计 1 个对照组,1 个低剂量组, 1 个高剂量组和 1 个联合治疗组,研究结果为患者的生存时间。假定试验 的纳入时间为 9 个月,总实验时间为 16 个月,估计四组的中位生存时间 为 14,20,22 和 24 个月(相应的风险率为 0.0495/月,0.0347/月,0.0315/月和 0.0289/月)。在 α = 0.05, β = 0.20 时,需要多少样本量? Ti=c(14,20,22,24); ci=c(-6,1,2,3); (Dose.Response.time.to.event(alpha=0.05,beta=0.2, T0=9,T=16,Ti=Ti,ci=ci,fi=1/4)) ## [1] 411.8 每组需要 103 例。 5.9.4 最小有效剂量(MED) 基于 Williams 检验的最小有效剂量样本量可根据 n = 2σ2[tk(α) + zβ]2 ∆2 255进行计算,tk(α) 依赖于自由度。 例某研究者设计一个 Williams 方法检测最小有效计量的剂量反映实验, 根据预试验 σ = 0.22, t3(α) = 1.75, ∆ = 0.11, 在 α = 0.05, β = 0.20 时,需 要多少样本量? (Dose.Min.Effect(0.05,0.2,1.75,0.22,0.11)) ## [1] 53.73 每组需要 54 例。 5.9.5 Cochran-Armitage 趋势检验 Cochran-Armitage 趋势检验样本量可根据 n = n∗ 4 [ 1 + √ 1 + 2∆ An∗ 0 ]2 进行计算,其中 n∗ { z1−α √ k(k2 − 1)pd + z1−β √∑ b2 i piqi }2 ,bi = i − 0.5k, D = ∑ bipi。pi 为每组的反应率,A = ∑ ripi(di − ˆ(d)), p = 1/N ∑ nipi, q = 1 − p, ri = ni/n0 例某研究者设计一个 4 组 Cochran-Armitage 趋势检测的剂量反映实 验,根据预试验 p1 = 0.1, p2 = 0.3, p3 = 0.5, p4 = 0.7, d1 = 1, d2 = 2, d3 = 3, d4 = 4, n1 = n2 = n3 = n4 = 10, 在 α = 0.05, β = 0.20∆ = 1 时,需要多 少样本量? pi=c(0.1,0.3,0.5,0.7) di=c(1,2,3,4) ni=c(10,10,10,10) Cochran.Armitage.Trend(alpha=0.05,beta=0.2,pi=pi,di=di,ni=ni,delta=1) ## [1] 7.468 每组需要 7 例。 2565.9.6 爬坡试验 (Dose Escalation Trials) 多数抗肿瘤药物的治疗指数很窄,为避免较高的起始剂量可能出现严 重毒性,过低的起始剂量造成的试验周期延长和资源浪费,通常使用爬坡试 验的方法。根据各剂量组人数分配策略变化,非参数的爬坡试验设计又被 称为 “M+N” 试验设计或 “A+B” 试验设计。全部受试者被随机分配至若干 组,每组均包含若干名受试者。同组的受试者服用相同剂量水平的受试药 物。按照随机分配方案逐组进入试验的流程,各组内受试者服用且只服用一 次某剂量水平的受试药物。不论是否探测到预期的药物响应,均记录其药 物响应结果。当在某一剂量水平药物响应人数满足整体试验停止的条件时, 整体试验过程结束并获得探索的目标剂量。在探索剂量限制性毒性 (DLT, dose limiting toxicity) 和最大耐受剂量(MTD,maximum tolerable dose) 时以爬坡试验 “3+3” 设计应用为广泛,即每次进入试验过程的一组受试者 都是 3 名,某剂量水平最多 6 名受试者服用药物。爬坡试验设计整体剂量爬 升规则又可以分为 TER 策略(traditional escalation rules)与 STER 策略 (strict traditional escalation rules)两种不同的剂量爬升策略。TER 策略 与 STER 策略的最大区别仅仅在于:当在 xj 剂量水平探测到受试药物毒 性响应时,遵循 TER 剂量爬升策略的 ￿ 期临床试验并不允许在 xj−1 剂量 水平继续纳入受试者进行试验,而要求直接停止试验,此时认为剂量水平 xj 为预期的目标剂量水平。而遵循 STER 剂量爬升规则的临床试验则要求在 xj−1 剂量水平继续纳入受试者进行试验,以观察 xj−1 剂量水平受试者整体 的毒性反应,从而才能推断目标剂量。相对于 TER 规则而言,遵循 STER 规则的 ￿ 期临床试验获得的目标剂量更加保守,使得目标剂量被高估的可能 性降低。在评价研发药物安全性、探索药物毒性指标 MTD 的 ￿ 期临床试验 中,这一点就显得更加重要,使得 STER 规则的应用更加广泛。 A+B TER 策略设计的样本量可依据 Nj = n−1∑ i=0 NjiP ∗ i 进行估计,其中 Nji =    AP j 0 +(A+B)Qj 0 P j 0 +Qj 0 if j < i + 1 A(1−P j 0 −P j 1 )+(A+B)(P j 1 −Qj 0) 1−P j 0 −Qj 0 if j = i + 1 0 if j > i + 1 257, P j 0 = C−1∑ k=0 ( A k ) pk j (1 − pj)A−k , Qj 0 = D∑ k=C E−k∑ m=0 ( A k ) pk j (1 − pj)A−k ( B m ) pm j (1 − pj)B−m , P ∗ n = n∏ j=1 (P j 0 + Qj 0) 。 A+B STER 策略设计的样本量可依据 Nj = NjnP ∗ n + n−1∑ i=0 n∑ k=i+1 NjikPik 进行估计,其中 Njik =    AP j 0 +(A+B)Qj 0 P j 0 +Qj 0 if j < i A + B if i ≤ j < k A(1−P j 0 −P j 1 )+(A+B)(P j 1 −Qj 0) 1−P j 0 −Qj 0 if j = k 0 if j > k , P ∗ i = n∑ k=i+1 pik , pik = (Qi 0 + Qi 0)(1 − P k 0 − Qk 0)   i−1∏ j=1 (P j 0 + Qj 0)   k−1∏ j=i+1 Qj 2 , P ∗ n = n∏ j=1 (P j 0 + Qj 0) 。 例爬坡试验 “3+3” 设计,根据预试验某抗肿瘤药物 7 种剂量 (10 15 23 34 51 76 114) 的剂量限制性毒性分别为 0.01 0.014 0.025 0.056 0.177 0.594 0.963,请估计每种剂量的样本量? 258DLT=c(0.01,0.014,0.025,0.056,0.177,0.594,0.963) # 3+3 TER 策略设计 AB.withoutDescalation(A=3,B=3,C=1,D=1,E=1,DLT=DLT) ## [1] 3.081e+00 3.122e+00 3.232e+00 3.658e+00 3.533e+00 2.449e-01 9.619e-06 # 3+3 STER 策略设计 AB.withDescalation(A=3,B=3,C=1,D=1,E=1,DLT=DLT) ## [1] 5.31263 6.36180 7.49008 8.26563 7.34913 3.16896 0.02163 5.10 微阵列研究 (Microarray Studies) 微阵列数据样本含量较小,而变量数非常多,传统的 t 检验和 Wilcoxon 检验在应用时需要进行调整,为克服多重比较的问题,按控制指标可分为控 制 FWER(family-wise error rate , 族错误率), 控制 FDR(fasle discover rate ,“错误发现率”) 等; 按控制的操作程序可分为: 单步 (single-step) 法, 逐步 (step-wise) 法, 基于再抽样 (resampling -based) 的方法等; 按学派主要分为 频率学派方法和 Bayes 学派的方法等。 多重检验是传统的多重比较概念的推广,通过对同一问题的多变量反复 检验来验证 H0 假设,该假设是一系列的假设 (a family of hypotheses), 并 非单一假设,如任意基因的组间表达无差异。 5.10.1 错误发现率 (False Discovery Rate) 设同时对 m 个假设进行检验,其中 m0 个是正确的,R 表示检验结果 为阳性的假设个数,具体如下表 不拒绝 H0 拒 绝 H0 合 计 H0 为真 UV m0 H1 为真 TS m − m0 合计 m-R R m 其中,m 在假设检验前已知,R 是可观察的随机变量,而 U、V、S、T 259是不可观察的随机变量,FDR 的定义为 FDR =    E(V/R) if R ̸= 0 if R = 0 , 即为拒绝 H0 的结果中错误这所占的比例。FDR 设计,单侧固定效应检验 样本量估计公式为 n = [ (zα∗ +zβ∗ )2 a1a2δ2 ] + 1 其中 α∗ = r1f m0(1−f),β∗ = 1 − r1/m1,a2 = 1 − a1。f 为错误发现率,r1 为是实 际拒绝的数量,ak 为两组分配比,m 为测试基因的总数,m1 为预后基因的 数量,δj 预后基因效应的大小。单侧可变效应检验需解 h(n) = 0 这个方程,其中 h(n) = ∑ j∈M1 Φ(zα∗ −δj √ na1a2)−r1,a∗ = r1f/m0(1 − f)。 例设计一个 4000 个候选基因的微阵列 (m=4000) 研究,预计两组之间 有 40(m1=40) 个不同表达的基因, 实际拒绝基因数约为 24(r1=40),单侧固 定效应设计,预计错误发现率为 0.01, 在 δ = 1, a1 = a2 = 0.5 时,需要多少 样本量? OneSide.fixEffect(m=4000,m1=40,delta=1,a1=0.5,r1=24,fdr=0.01) ## [1] 68 每组需要 34 例。 例 设 计 一 个 4000 个 候 选 基 因 的 微 阵 列 (m=4000) 研 究, 预 计 两 组 之 间 有 40(m1=40) 个 不 同 表 达 的 基 因, 实 际 拒 绝 基 因 数 约 为 24(r1=40), 单 侧 可 变 效 应 设 计, 预 计 错 误 发 现 率 为 0.01,δj =   1 if 1 ≤ i ≤ 20 1/2 if 21 ≤ i ≤ 40 ,, a_{1}=a_{2}=0.5$ 时,需要多少样本量? delta=c(rep(1,40/2),rep(1/2,40/2)) OneSide.varyEffect(100,150,4000,40,delta,0.5,24,0.01) ## $s1 ## [1] 147.7 260## ## $s2 ## [1] 148.4 ## ## $`h(s1)` ## [1] -0.03677 ## ## $`h(s2)` ## [1] 0.02012 每组需要 74 例。 双侧固定效应检验样本量估计公式为 n = [ (zα∗/3+zβ∗ )2 a1a2δ2 ] + 1 , 其中其中 α∗ = r1f m0(1−f),β∗ = 1 − r1/m1。双侧可变效应检验需解 h(n) = 0 这 个 方 程, 其 中 h(n) = ∑ j∈M1 Φ(zα∗/2 − |δ|j √ na1a2) − r1,a∗ = r1f/m0(1 − f)。 例设计一个 4000 个候选基因的微阵列 (m=4000) 研究,预计两组之间 有 40(m1=40) 个不同表达的基因, 实际拒绝基因数约为 24(r1=40),双侧固 定效应设计,预计错误发现率为 0.01, 在 δ = 1, a1 = a2 = 0.5 时,需要多少 样本量? TwoSide.fixEffect(m=4000,m1=40,delta=1,a1=0.5,r1=24,fdr=0.01) ## [1] 73 每组需要 36.5 例。 例 设 计 一 个 4000 个 候 选 基 因 的 微 阵 列 (m=4000) 研 究, 预 计 两 组 之 间 有 40(m1=40) 个 不 同 表 达 的 基 因, 实 际 拒 绝 基 因 数 约 为 24(r1=40), 双 侧 可 变 效 应 设 计, 预 计 错 误 发 现 率 为 0.01,δj =   1 if 1 ≤ i ≤ 20 1/2 if 21 ≤ i ≤ 40 ,, a_{1}=a_{2}=0.5$ 时,需要多少样本量? 261delta=c(rep(1,40/2),rep(1/2,40/2)) TwoSide.varyEffect(s1=100,s2=200,m=4000,m1=40, delta=delta,a1=0.5,r1=24,fdr=0.01) ## $s1 ## [1] 163.3 ## ## $s2 ## [1] 164.1 ## ## $`h(s1)` ## [1] -0.01349 ## ## $`h(s2)` ## [1] 0.03742 每组需要 82 例。 5.11 非参数检验 (Nonparametrics) 非参数检验不依赖参数进行的假设检验。适用于未知分布型、偏态资 料、等级性资料等的假设检验。非参数检验在应用上无严格的限制条件,适 用范围广,对数据的要求不像参数检验那样严格。 5.11.1 单组位置检验 (One-Sample Location Problem) 单组位置检验样本量估计公式为 n = (z1−α/2 √ 12 + z1−β √ p3 + 4p4 − 4p3 2)2 1/4 − p2 , 其中 p2 = P(|zi| >= |zj|, zi > 0),p3 = P(|zi| >= |zj1|, |zi| >= |zj2|, zi > 0),p4 = P(|zj1| >= |zi| >= |zj2| >= 0, zi > 0)。 例某预防更年期骨质疏松症药物, 进行单组位置检验,根据 5 例的预试 验,p2 = 0.3, p3 = 0.4, p4 = 0.05, 在 α = 0.05, β = 0.20 时,需要多少样本 量? 262(Nonpara.One.Sample(0.05,0.2,0.3,0.4,0.05)) ## [1] 382.7 需要 383 例。 5.11.2 两组位置检验 (Two-Sample Location Problem) 两组位置检验样本量估计公式为 n2 = (z1−α/2 √ κ(κ + 1)/12 + z1−β √ κ2(p2 − p2 1) + κ(p3 − p2 1))2 κ2(1/2 − p1)2 , 其中 n1 = κn2,p1 = P(yi > xi),p2 = P(yi ≥ xj1 ∼ and ∼ yi ≥ xj2),p3 = P(yi1 ≥ xj ∼ and ∼ yi2 ≥ xj)。 例某降低胆固醇药物,进行两组平行对照位置检验,根据预试验,p2 = 0.7, p3 = 0.8, p4 = 0.8,在 α = 0.05, β = 0.20 时,需要多少样本量? (Nonpara.Two.Sample(0.05,0.2,1,0.7,0.8,0.8)) ## [1] 53.5 需要 53 例。 5.11.3 独立性检验 (Test for Independence) 独立性检验样本量估计公式为 n = 4(z1−α/3 + z1−β √ 2p2 − 1 − (2p1 − 1)2)2 (2p1 − 1)2 ,其中 p1 = P((x1 −x2)(y1 −y2) > 0),p2 = P((x1 −x2)(y1 −y2)(x1 −x3)(y1 − y3) > 0)。 例某预试验中观察到,随着 x 变量增大,y 变量也有增大的趋势,设 计一临床试验,以验证以上猜想。根据预试验,p1 = 0.6, p2 = 0.7,在 α = 0.05, β = 0.20 时,需要多少样本量? 263(Nonpara.Independ(0.05,0.2,0.6,0.7)) ## [1] 134.2 需要 134 例。 5.12 其他研究 (Sample Size Calculation in Other Areas) 5.12.1 QT/QTc QT 间期是指心室去极化和复极化的时程,即 QRS 波群的起点到 T 波 恢复到基线时终点的时程。心脏复极化延迟将产生特殊的心脏电生理环境, 这种环境下,容易发生心律失常,最常见的是引发尖端扭转型室性心动过速 (TdP),但也可发生其它类型室性快速心律失常。由于 QT 间期延长的程 度可被看作是一个致心律失常危险性的相对的生物标记,通常 QT 间期延 长与 TdP 之间存在一种定性关系,对于那些可能引发 QT 间期延长的药物 更是如此。由于 QT 间期与心率呈负相关,因此,常规通过各种公式将测 得的 QT 间期校正为较少心率依赖的 QTc 间期。然而,尚不明确心律失常 的发生与 QT 间期或 QTc 绝对值增加之间是否存在必然联系。大多数引发 TdP 的药物都可明显引起 QT/QTc 间期的延长(后称作 QT/QTc)。由于 QT/QTc 间期延长是与提高发现心律失常敏感性有关的心电图表现,因此, 新药在上市前进行充分的安全性评价应包括详细描述其对 QT/QTc 间期影 响的特点。 5.12.1.1 平行对照设计 平行对照设计样本量估计公式为 n = 2(z1−α/2 + z1−β)2 δ2 (ρ + 1 − ρ K) ,其中 ρ = σ2 s /(σ2 s +σ2 e ),K 为每个个体重复的次数,δ = d/(σ2 s +σ2 e ),σs 为个 体间变异 (between subject variance),σe,σe 为个体内变异 (between subject variance),d 为临床差异。 例某非抗心律失常药物进行全面的心电图平行对照研究,以明确对 QT/QTc 间期影响。根据预试验 ρ = 0.8, δ = 0.5, 每个个体重复 3 次, 在 α = 0.05, β = 0.20 时,需要多少样本量? 264QT.parallel(0.05,0.2,0.8,3,0.5) 每组需要 54 例。 5.12.1.2 交叉对照设计 交叉对照设计样本两估计公式为 n = (z1−α/2 + z1−β)2 δ2 − γ(z1−α + z1−β)2 (ρ + 1 − ρ K) ,其中 ρ = σ2 s /(σ2 s + σ2 e ),K 为每个个体重复的次数,δ = d/(σ2 s + σ2 e ),σs 为 个体间变异,σe,σe 为个体内变异,d 为临床差异,γ = σ2 p/(σ2 s + σ2 e ),σ2 p 为交 叉设计的额外变异。 例某非抗心律失常药物进行全面的心电图交叉对照研究,以明确对 QT/QTc 间期影响。根据预试验 ρ = 0.8, δ = 0.5γ = 0.002, 每个个体重 复 3 次,在 α = 0.05, β = 0.20 时,需要多少样本量? QT.crossover(0.05,0.2,0.8,3,0.5,0.002) 每组需要 29 例。 5.12.1.3 有协变量平行对照设计 有协变量平行对照设计样本量估计公式为 n = (z1−α/2 + z1−β)2 δ2 [ (v1−v2)2 τ 2 1 +τ 2 2 + 2 ] (ρ + 1 − ρ K) ,其中 ρ = σ2 s /(σ2 s + σ2 e ),K 为每个个体重复的次数,δ = d/(σ2 s + σ2 e ),σs 为 个体间变异,σe,σe 为个体内变异,d 为临床差异,v1, v2 分别为第一组和第 二组的均数,τ1, τ2 分别为第一组和第二组的方差。 例某非抗心律失常药物进行全面的心电图平行对照研究,已知该药 Cmax 对 QT/QTc 间期有影响,以明确对 QT/QTc 间期影响。根据预试 验 ρ = 0.8, δ = 0.5, 每个个体重复 3 次, 第一组和第二的均数均为 1, 方差分 别为 4,5,在 α = 0.05, β = 0.20 时,需要多少样本量? QT.PK.parallel(0.05,0.2,0.8,3,0.5,1,1,4,5) 每组需要 54 例。 2655.12.1.4 有协变量交叉对照设计 有协变量交叉对照设计样本量估计公式为 n = (z1−α/2 + z1−β)2 δ2 − γ(z1−α + z1−β)2 [ (v1−v2)2 τ 2 1 +τ 2 2 + 1 ] (ρ + 1 − ρ K) ,其中 ρ = σ2 s /(σ2 s + σ2 e ),K 为每个个体重复的次数,δ = d/(σ2 s + σ2 e ),σs 为 个体间变异,σe,σe 为个体内变异,d 为临床差异,γ = σ2 p/(σ2 s + σ2 e ),σ2 p 为交 叉设计的额外变异,v1, v2 分别为第一组和第二组的均数,τ1, τ2 分别为第一 组和第二组的方差。 例某非抗心律失常药物进行全面的心电图交叉对照研究,已知该药 Cmax 对 QT/QTc 间期有影响,以明确对 QT/QTc 间期影响。根据预试 验 ρ = 0.8, δ = 0.5γ = 0.002, 每个个体重复 3 次, 第一组和第二的均数均为 1, 方差分别为 4,5,在 α = 0.05, β = 0.20 时,需要多少样本量? QT.PK.crossover(0.05,0.2,0.8,3,0.5,0.002,1,1,4,5) 每组需要 29 例。 5.12.2 非随机化临床试验中的倾向得分 非随机化实验中,对象的分配依赖于对象基线协变量 (covariates)。例 如病人是否会得到降血脂药物治疗,可能受到很多因子的影响(如中风严重 程度、中风类型、有无其他血管性危险因子,甚至是年龄、性别、社经地位 等),当这些因子也同时会影响预后时,它们就是潜在的干扰因子。如果有 治疗和没有治疗的病人,其基本特性是不同的,两组就无法直接比较预后。 倾向性得分分析中倾向得分 (propensity score) 则是一个机率(0~1),代表 一个病人在其既有的基本特性(或干扰因子)下,得到药物治疗的机会。倾 向得分关注对象在基本特性和有无药物治疗的关系,企图再造一个类似随机 分配的情境。在随机试验中,每一个受试者得到治疗的倾向得分应该是 0.5。 在非随机的观察性研究,倾向得分就会因病人的基本特性而异。最常见的倾 向得分来自 logistic 回归模型:将得到治疗与否当作是因变量,把基本特性 的各个因子当作是自变量。倾向得分方法已经被广泛的应用到这些非随机 对照试验中来降低由于混杂因素导致的选择性偏倚, 从而保证组间基线数据 的均衡可比。 2665.12.2.1 权重分层分析法 (WMH,weighted Mantel-Haenszel) 权重分层分析法样本量估计公式为 n = (σ0z1−α/2 + σ0z1−β)2 δ2 , 其中 δ = (1 − ϕ) ∑J j=1 wjajbj1bj2 pj1qj1 qj1+ϕpj1 ,σ2 1 = ∑J j=1 w2 j ajbj1bj2(bj2pj1qj1 + bj1pj2qj2),σ2 0 = ∑J j=1 w2 j ajbj1bj2(bj1pj1 + bj2pj2)(bj1qj1 + bj2qj2),ϕ = pj2qj1/(pj1qj2),J 为层数,a 为每层的样本数占总样本数的比例 aj = nj/n, bjk = njk/nj k 为 1,2 代表采取的处理方式,假设以 1 组为对照 bj1 +bj2 = 2, p1 为 j 层 k 处理的概率。 例某药物与传统药物对照的临床试验,主要评价指标为心血管事件,对 基线变量进行组间均衡性检验发现基线变量在试验药和对照药是不均衡的, 设计层数为 5 的临床试验,根据预试验,每层的样本数占总样本数的比例为 0.15 0.15 0.2 0.25 0.25,每层中处理组的分配比例分别为 0.4 0.4 0.5 0.6 0.6, 每层中出现反应的概率分别为 0.5 0.6 0.7 0.8 0.9,在 α = 0.05, β = 0.20ϕ = 2 时,权重分层分析设计需要多少样本量? a=c(0.15,0.15,0.2,0.25,0.25) b=c(0.4,0.4,0.5,0.6,0.6) p1=c(0.5,0.6,0.7,0.8,0.9) (Propensity.Score.strata(alpha=0.05,beta=0.2,J=5,a,b,p1,phi=2)) ## [1] 446.2 需要 446 例。 5.12.2.2 非分层分析法 非分层分析法样本量估计公式为 ˜n = ( ˜σ0z1−α/2 + ˜σ1z1−β)2 (p1 − p2)2 ,δ = ∑J j=1 ajbj1bj2(pj1 − pj2),σ2 1 = ∑J j=1 ajbj1bj2(bj2pj1qj1 + bj1pj2qj2),σ2 0 =∑J j=1 ajbj1bj2(bj1pj1 + bj2pj2)(bj1qj1 + bj2qj2)J 为层数,a 为每层的样本数 占总样本数的比例 aj = nj/n,bjk = njk/nj k 为 1,2 代表采取的处理方式, 假设以 1 组为对照 bj1 + bj2 = 2,p1 为 j 层 k 处理的概率。 267例某药物与传统药物对照的临床试验,主要评价指标为心血管事件,对 基线变量进行组间均衡性检验发现基线变量在试验药和对照药是不均衡的, 设计层数为 5 的临床试验,根据预试验,每层的样本数占总样本数的比例为 0.15 0.15 0.2 0.25 0.25,每层中处理组的分配比例分别为 0.4 0.4 0.5 0.6 0.6, 每层中出现反应的概率分别为 0.5 0.6 0.7 0.8 0.9,在 α = 0.05, β = 0.20ϕ = 2 时,非分层分析设计需要多少样本量? a=c(0.15,0.15,0.2,0.25,0.25) b=c(0.4,0.4,0.5,0.6,0.6) p1=c(0.5,0.6,0.7,0.8,0.9) (Propensity.Score.nostrata(alpha=0.05,beta=0.2,J=5,a,b,p1,phi=2)) ## [1] 1150 需要 1150 例。 5.12.3 重复测量方差分析 (ANOVA with Repeated Measures) 重复测量设计的方差分析可以是同一条件下进行的重复测度,也可以 是不同条件下的重复测量,可以考察:(1) 各种处理之间是否存在显著性差 异;(2) 被试之间的差异;(3) 各种处理与被试分组之间的交互作用。在平行对 照设计的临床试验中,主要用于评价有效性和安全性。重复测量方差分析样 本量估计公式为 n ≥ 2σ∗2(z1−α/2 + z1−β) ∆2 ,σ∗2 为各组分的方差总和。 例某治疗多发性硬化 (MS) 药物与传统药物在实验动物身上进行平行 对照试验,每只实验动物记录 3 次重复的疾病得分,根据预试验 σ∗2 = 1.25, ∆ = 1.5,在 α = 0.05, β = 0.20 时,需要多少样本量? (ANOVA.Repeat.Measure(0.05,0.2,1.25,1.5,3)) ## [1] 14.54 需要 15 例。 2685.12.4 生存质量 (Quality of Life,QOL) 由于慢性非传染病较难治愈,很难采用治愈率来评价治疗效果,生存率 的作用也有限(明显提高其生存时间较为困难),因此采用生存质量作为新 药的评价的项目。生存质量分析样本量估计公式为 nδ = c(z1−α/2 + zδ) ϵ2 , nϕ = c ∆ − η(z1/2+1/2ϕ + z1−1/2α) ,取两个样本量计算公式计算结果的最大值,其中 ϵ 差值,c 为常数。 例某抗癌药进行以生存质量为结果进行临床试验,根据预试验 c = 0.5, ϵ = 0.25, phi = 0.1, eta = 0.5,在 α = 0.05, β = 0.20 时,需要多少 样本量? QOL <- function (alpha, beta, c, epsilon,phi,eta) { n1 = c * (qnorm(1 - 1/2 * alpha) + qnorm(1 - beta))^2/epsilon^2 n2 = (c/(epsilon-phi)^2)*(qnorm(1/2+eta/2) + qnorm(1 - alpha/2))^2 n = max(n1, n2) n } QOL(0.05,0.1,0.5,0.25,0.1,0.5) ## [1] 154.2 需要 154 例。 5.12.5 衔接性设计 (Bridging Studies) 该设计主要评估 “族群因素”(ethnic factors)对药品的影响,提供相 关药动/药效学或疗效、安全、用法用量等临床试验数据,使得一国的临床 实验数据能够外推至其他国家,减少重复的临床试验,迅速提供病患药品, 以保障其权益。族群因素一般定义为与种族或与一群有共同特质和习性的 人相关的因素,通常分为内因性(如遗传、生理等)和外因性(如文化、环 269境)。Chow 等提出以敏感性指数(Sensitivity Index)作为指标,以外推安 慰剂平行对照试验设计的试验结果。以敏感性指数设计的样本量估计公式 为 ˜P∆ = Eδ,u [ 1 − τn−2(tn−2| ∆δ u ) − τn−2(−tn−2| ∆δ u ) ] ,Delta 为不同族群之间的敏感性指数。 例某药厂欲将某药推广至 A 国,进行平行对照的衔接性设计,以敏感 性指数作为族群因素的考核指标,根据预试验 ∆ = 2.92,SI = 0.80,在 α = 0.05 时,需要多少样本量? Sensitivity.Index <- function (alpha, deltaT,SI) { n = 3 for (i in 3:1000){ t = qt(1 - alpha/2, i - 2) p = 1 - pt(t, i - 2, deltaT) + pt(-t, i - 2, deltaT) if (round(p, digits = 2) == round(SI, digits = 2)) { n = i } } n } Sensitivity.Index(0.05,2.92,0.80) ## [1] 30 需要 30 例。 5.12.6 疫苗临床试验 (Vaccine Clinical Trials) 评价疫苗最重要的目标就是它的预防疾病的能力,通常需要大样本的安 慰剂对照设计。相对发病减少率 (ralative reduction in disease incidence,pi) 被认为是疫苗有效性评价的重要指标,π = pC −pT PC , 其中 pC 和 pT 分别代表 试验组和对照组的发病率。 2705.12.6.1 发病率较高的试验 (Reduction in Disease Incidence) 发病率较高的疫苗试验样本量可根据 n = z2 1−α/2 d2 (1 − pT pT + 1 − pc pc ) 进行估计,其中 d = z1−α/2 √ 1−pT npT + 1−PC npC 。 例一研究者计划实施一个疫苗临床试验,与安慰剂对照,主要指标选择 相对发病减少率,根据预试验,疫苗组发病率为 1%,安慰剂组发病率为 2%, 在 α = 0.05, β = 0.2 时,两组 1:1 平行对照,双侧差异性检验需要多少样 本量? options(scipen=200)# 取消科学计数 (Vaccine.RDI(0.05,0.2,0.01,0.02)) ## [1] 14213 每组需要 14213 例。 5.12.6.2 发病率极低的试验 (The Evaluation of Vaccine Efficacy with Extremely Low Disease Incidence) 发病率极低的疫苗试验样本量可根据 n = [z1−α √ θ0(1 − θ0) + z1−β √ θ(1 − θ)]2 (pT + pC)(θ − θ0)2 进行估计, 其中 θ = 1−π 1−π+nC/nT ,θ0 = 1−π0 1−π0+nC/nT 。 例一研究者计划实施一个疫苗临床试验,与安慰剂对照,主要指标选择 相对发病减少率,根据预试验,疫苗组发病率为 0.1%,安慰剂组发病率为 0.2%,θ0 = 0.5, θ = 1/3,在 α = 0.05, β = 0.2 时,两组 1:1 平行对照,双 侧差异性检验需要多少样本量? options(scipen=200) (Vaccine.ELDI(0.05,0.2,0.5,1/3,0.001,0.002)) ## [1] 17837 每组需要 17837 例。 2715.12.6.3 综合疗效评价 (Composite Efficacy Measure) 疫苗不仅能预防针对疾病的发生,也能预防针对疾病引起的感染。综合 疗效评价指标既包含了对疾病发生的评价,也包含了疾病的感染的评价。综 合疗效评价的样本量可根据 n = 1 µT pT − µRpR [ z1−α/2 √ 2µ2∗p∗(1 − p∗) + 2p∗(σ2 T + σ2 C) + z1−β √ pT(σ2 T + µ2 T(1 − pT)) + pR(σ2 R + µ2 R(1 − pR)) ]2 进行估计, 其中 µT, µC 分别为试验组和对照组的均数,σT, σC 分别为试验 组和对照组标准差。 例一研究者计划实施一个疫苗临床试验,与安慰剂对照,主要是表选择 相对发病减少率,根据预试验,µT = 0.2, µC = 0.3, pT = 0.1, pR = 0.2, σ2 T = σ2 C = 0.15,在 α = 0.05, β = 0.2 时,两组 1:1 平行对照,双侧差异性检验 需要多少样本量? (Vaccine.CEM(0.05,0.2,0.2,0.3,sqrt(0.15),sqrt(0.15),0.1,0.2)) ## [1] 450.7 每组需要 450.6865 例。 2726 假设检验 假设检验(hypothesis test),就是根据已掌握的资料对一个总体参数是 否等于某一个数值,某一随机变量是否服从某种概率分布的假设,然后根据 所取得的样本资料,利用一定的统计方法计算出有关检验的统计量,依据一 定的概率原则,以较小的风险来判断估计数值与总体数值(或估计分布与实 际分布)是否存在显著差异,是否应当接受原假设的一种检验方法。假设检 验是根据小概率事件的实际不可能性原理来推断的。假设检验中的小概率 标准称为显著性水平,用 α 表示。依据显著性水平的大小将检验统计量的所 有可能值组成的样本空间分为两个区域:否定域或拒绝域:在原假设成立 的情况下,如果检验统计量的值落在这个区域里,则否定原假设。接受域: 在原假设成立的情况下,如果检验统计量的值没有落在这个区域里,则接受 原假设。假设检验的步骤:1. 建立统计假设, 包括原假设, 备择假设。2. 确立 合适的检验统计量,确定其分布。3. 规定显著性水平 4. 根据样本观测值计 算检验,统计量的取值。5. 判断原假设是否成立。假设检验的四种情况 H0 为真 H0 为假 接受 H0 正确决策 第二类错误 β 拒绝 H0 第一类错误 α 正确决策 第一类错误,也称弃真错误, 本来是真的,却根据检验统计量的值把它 给否定了。发生这种错误的概率通常用 α 表示。第二类错误,也称取伪错 误,本来是假的,却根据检验统计量的值把它给接受了。 6.1 参数假设检验 参数假设检验,是指在总体的分布形式已知的条件下,对总体参数的某 一假设进行的检验。 6.1.1 正态总体均值的假设检验 6.1.1.1 单个总体的情况及实例 当总体分布为正态分布,总体标准差为已知时,检验所使用的检验统计 量为 z = ¯x−µ0 σ0/ √ n ∼ N(0, 1)。σ 为总体方差,µ0 为总体均数,n 为样本数,¯x 273为样本均数。在总体方差未知的情况下,用样本方差 S 代替总体 σ, 检验统 计量为 t = ¯x−µ0 S/ √ n ∼ t(n − 1) 例某药厂生产一批新的药品,规定直径为 10mm, 方差为 0.4。为了检验 机器的性能是否良好,随机抽取了 25 件产品,测得其平均长度为 9.30 9.32 10.41 9.06 10.21 9.31 9.96 9.03 10.22 9.19 10.36 9.67 10.43 10.36 9.83 10.67 10.38 9.29 9.74 9.99 9.98 9.89 9.52 9.88 9.67。假设生产的药品直径服从正态 分布,问在显著性水平 0.05 时,该机器的性能是否良好。 z.test<-function(x,sigma,alpha,u0=0,alternative="two.sided"){ n <- length(x) options(digits=4) result<-list() mean<-mean(x) z<-(mean-u0)/(sigma/sqrt(n)) p<-pnorm(z,lower.tail=FALSE) result$mean<-mean result$z<-z result$p.value<-p if(alternative=="two.sided"){ p<-2*p result$p.value<-p } else if (alternative == "greater"|alternative =="less" ){ result$p.value<-p } else return("your input is wrong") result$conf.int<- c( mean-sigma*qnorm(1-alpha/2,mean=0, sd=1, lower.tail = TRUE)/sqrt(n), mean+sigma*qnorm(1-alpha/2,mean=0, sd=1, lower.tail = TRUE)/sqrt(n)) result } 274x <- c(9.30,9.32,10.41,9.06,10.21,9.31,9.96,9.03,10.22 ,9.19,10.36,9.67,10.43,10.36,9.83,10.67,10.38,9.29, 9.74,9.99,9.98,9.89,9.52,9.88,9.67) z.test(x,0.4,0.05,10) ## $mean ## [1] 9.827 ## ## $z ## [1] -2.165 ## ## $p.value ## [1] 1.97 ## ## $conf.int ## [1] 9.670 9.984 P 值大于 0.05, 可以该机器的性能良好。 例假设上提的总体方差未知,假设生产的药品直径服从正态分布,问在 显著性水平 0.05 时,该机器的性能是否良好。 t.test(x,alternative = "two.sided",mu=10)# 总体方差未知,使用 t 检验 ## ## One Sample t-test ## ## data: x ## t = -1.8, df = 24, p-value = 0.08 ## alternative hypothesis: true mean is not equal to 10 ## 95 percent confidence interval: ## 9.629 10.025 ## sample estimates: ## mean of x ## 9.827 275P 值大于 0.05, 可以该机器的性能良好。 6.1.1.2 两个总体的情况及实例 两个总体为正态分布,方差已知, 检验所使用的检验统计量为 z = (x1−x2)−(u1−u2)√ σ2 1 n1 + σ2 1 n2 ∼ N(0, 1) 两个总体为正态分布,方差未知, 检验所使用的检验统计量为 T = (x1−x2)−(u1−u2)√ S2 n1 + S2 n2 ∼ t(n1 + n2 − 2) 例制药厂试制某种安定神经的新药,两台仪器制造药品服从正态分布, 从各自加工药品中,分别取若干个测量其直径,两组直径如下 A 组 20.5 19.8 19.7 20.4 20.1 20.0 19.0 19.9 B 组 20.7 19.8 19.5 20.8 20.4 19.6 20.2,问两 台仪器的加工精度有无显著差异? x<-c(20.5, 19.8, 19.7, 20.4, 20.1, 20.0, 19.0, 19.9) y<-c(20.7, 19.8, 19.5, 20.8, 20.4, 19.6, 20.2) t.test(x, y, var.equal=TRUE) ## ## Two Sample t-test ## ## data: x and y ## t = -0.85, df = 13, p-value = 0.4 ## alternative hypothesis: true difference in means is not equal to 0 ## 95 percent confidence interval: ## -0.7684 0.3327 ## sample estimates: ## mean of x mean of y ## 19.93 20.14 P 值大于 0.05, 可以两台仪器的加工精度无显著差异。 6.1.2 总体比例的假设检验 6.1.2.1 单样本率的检验 276样本率与总体率比较的目的,是推断该样本所代表的未知总体率 ￿ 与已 知总体率 ˆp 是否不同。当样本含量 n 足够大,且样本率 p0 和 1 − p0 均不 太小,如 np0 与 n(1 − p0) 均大于 5 时,样本率的分布近似正态分布统计量 Z = ˆp−p0√ p0(1−p0) ∼ N(0, 1)。当 np0 与 n(1 − p0) 均小于 5 时,样本率的分布 近似二项分布。 例按照以往经验,新生儿染色体异常率一般为 1%,某医院观察了当地 400 名新生儿,有一例染色体异常,问该地区新生儿染色体是否低于一般水 平? binom.test(1,400,p=0.01,alternative="less") ## ## Exact binomial test ## ## data: 1 and 400 ## number of successes = 1, number of trials = 400, p-value = 0.09 ## alternative hypothesis: true probability of success is less than 0.01 ## 95 percent confidence interval: ## 0.0000 0.0118 ## sample estimates: ## probability of success ## 0.0025 # 样本量较小时,不宜选择 prop.test(), 有警告! prop.test(1,400,p=0.01,alternative="less") ## Warning in prop.test(1, 400, p = 0.01, alternative = "less"): Chi-squared ## approximation may be incorrect ## ## 1-sample proportions test with continuity correction ## ## data: 1 out of 400, null probability 0.01 ## X-squared = 1.6, df = 1, p-value = 0.1 ## alternative hypothesis: true p is less than 0.01 277## 95 percent confidence interval: ## 0.0000 0.0131 ## sample estimates: ## p ## 0.0025 P 值大于 0.05,尚不能认为该地区新生儿染色体异常低于一般水平。 6.1.2.2 两样本率的检验 两个总体比例 ˆp1 和 ˆp1 的极大似然估计分别为近似地服从正态分布: Z = ˆp1− ˆp2√ (n1+n2)ˆp(1−ˆp)/n1n2 ,ˆp = n1 ˆp1+n2 ˆp2 n1+n2 例某综合医院随机抽取了 345 个男病例与 451 个女性病例调查吸烟的 暴露情况, 调查结果为 187 个男性病例与 76 女性病例中有吸烟的暴露, 能 否认为男、女病例吸烟的暴漏一致? s <- c(187,76) t <- c(345,451) prop.test(s,t) ## ## 2-sample test for equality of proportions with continuity ## correction ## ## data: s out of t ## X-squared = 120, df = 1, p-value <0.0000000000000002 ## alternative hypothesis: two.sided ## 95 percent confidence interval: ## 0.308 0.439 ## sample estimates: ## prop 1 prop 2 ## 0.5420 0.1685 P 值较小,可以认为男女病例的吸烟暴漏情况不同。 两个服从 Poisson 分布比率,欲检验这两个率是否不同,需要 Poisson 检验。例分别观察了两种疫苗 17877 与 16660 个受种者, 结果分别出现 2 例 和 9 例格林巴利,能否认这两种疫苗接种后发生格林巴利不一致? 278library(rateratio.test) rateratio.test(c(2,9),c(17877,16660)) ## ## Exact Rate Ratio Test, assuming Poisson counts ## ## data: c(2, 9) with time of c(17877, 16660), null rate ratio 1 ## p-value = 0.05 ## alternative hypothesis: true rate ratio is not equal to 1 ## 95 percent confidence interval: ## 0.02177 1.00055 ## sample estimates: ## Rate Ratio Rate 1 Rate 2 ## 0.2070942 0.0001119 0.0005402 library(exactci) ## Loading required package: ssanv poisson.exact(c(2,9),c(17877,16660)) ## ## Exact two-sided Poisson test (central method) ## ## data: c(2, 9) time base: c(17877, 16660) ## count1 = 2, expected count1 = 5.7, p-value = 0.05 ## alternative hypothesis: true rate ratio is not equal to 1 ## 95 percent confidence interval: ## 0.02177 1.00055 ## sample estimates: ## rate ratio ## 0.2071 279poisson.test(c(2,9),c(17877,16660)) ## ## Comparison of Poisson rates ## ## data: c(2, 9) time base: c(17877, 16660) ## count1 = 2, expected count1 = 5.7, p-value = 0.03 ## alternative hypothesis: true rate ratio is not equal to 1 ## 95 percent confidence interval: ## 0.02177 1.00055 ## sample estimates: ## rate ratio ## 0.2071 poisson.test() 检验不是 Poisson 精确检验, 参考其他两种方法在 α = 0.05 时可以认为接种两种疫苗发生格林巴利的情况基本一致。 6.2 相关性度量 独立性检验评估了变量之间的相互独立情况,如果拒绝原假设,相关性 强弱的度量通常用 phi 系数 (Phi-Coefficient) 描述 2∗2(四格表) 数据相关程 度,φ = √ x2/n,n 总频数;列联系数 (Contingency Coefficient) 主要用于大 于 2 ∗ 2 的列联表,C = √ x2 x2+n ;Cramer’s V 系数,V = √ x2 n∗min[(R−1),(C−1)] ; 可用 vcd 包中的 assocstats() 函数计算。 mytable <- xtabs(~Treatment+Improved,data=Arthritis) assocstats(mytable) ## X^2 df P(> X^2) ## Likelihood Ratio 13.530 2 0.0011536 ## Pearson 13.055 2 0.0014626 ## ## Phi-Coefficient : NA ## Contingency Coeff.: 0.367 ## Cramer's V : 0.394 280总体来说,较大的值意味着较强的相关性。vcd 包也提供了一个 kappa() 函数,可以计算混淆矩阵的 Cohen’s kappa 值以及加权的 kappa 值。(混淆 矩阵可以表示两位评判者对于一系列对象进行分类所得结果的一致程度。) 6.2.1 相关 协方差是描述 X 和 Y 相关程度的量,定义为 sxy = 1 n−1 ∑ (xi−¯x)(yi−¯y), 用于衡量两个变量的总体误差。方差是协方差的一种特殊情况,即当两个 变量是相同的情况下。相关系数是中心化与标准化后的协方差,定义为 r = sxy√ sxx √syy , 用来描述定量变量之间的关系。相关系数避免了协方差量纲的影 响,其值的大小表示关系的强弱程度(完全不相关时为 0,完全相关时为 1), 其符号(±)表明关系的方向(正相关或负相关)。有多种相关系数,其中 Pearson 积差相关系数衡量了两个定量变量之间的线性相关程度。Spearman 等级相关系数则衡量分级定序变量之间的相关程度。Kendall’s Tau 相关系 数也是一种非参数的等级相关度量。cor() 函数可以计算这三种相关系数,而 cov() 函数可用来计算协方差。Pearson 相关检验,适用于正态分布总体的 数据,如果总体不服从正态分布,可用秩相关检验。秩相关检验是在成对观 测数据的符号检验基础上发展起来的,比传统的单独用正负号的检验更加有 效。在 R 软件中,使用 rank() 函数计算秩统计量。###Pearson、Spearman 和 Kendall 相关除计算相关系数外,对相关系数是否为 0 进行统计学检验, 可以用 cor.test() 函数对 Pearson、Spearman 和 Kendall 相关系数进行统 计并完成系数的相关检验。 6.2.2 Pearson 积矩相关系数 Pearson 相关用于双变量正态分布的资料,定义为 r = 1 n−1 ∑n i=1( xi−¯x sx )( yi−¯y sy ), 反映两个变量线性相关程度的统计量。 例某医生为了探讨缺碘地区母婴 TSH 水平的关系,应用免疫放射分析 测定了 160 名孕妇(15-17 周)及分娩时脐带血 TSH 水平(mU/L),现随 机抽取 10 对数据,母血 TSH1.21 1.30 1.39 1.42 1.47 1.56 1.68 1.72 1.98 2.1, 脐血 TSH3.90 4.5 4.20 4.83 4.16 4.93 4.32 4.99 4.7 5.2,试对母血 TSH 水 平与新生儿脐带血 TSH 水平进行相关分析。 x <- c(1.21,3.90,1.30,4.50,1.39,4.20,1.42,4.83,1.47,4.16) y <- c(1.56,4.93,1.68,4.32,1.72,4.99,1.98,4.70,2.10,5.20) 281cor.test(x,y) ## ## Pearson's product-moment correlation ## ## data: x and y ## t = 10, df = 8, p-value = 0.000006 ## alternative hypothesis: true correlation is not equal to 0 ## 95 percent confidence interval: ## 0.8563 0.9920 ## sample estimates: ## cor ## 0.9654 Pearson 积差相关系数 0.96,P 值小于 0.05, 可以认为母血 TSH 水平 与新生儿脐带血 TSH 水平相关。 6.2.2.1 Spearman 秩相关检验 当 X 和 Y 相互独立时,ri 为 X 产生的秩统计量,Ri 为 Y 产生的秩统 计量,Spearman 秩相关系数为 rs = [ 1 n ∑ riRi − ( n+1 x )2]/( n2−1 12 ) $。 例两位评分员对新出生的 5 名新生儿进行 Apgar 评分,甲:6 7 8 9 10, 乙:5 6 7 8 10。试用 Spearman 秩相关检验方法检验两个评分员对等级评 定有无相关关系。 x <- c(6,7,8,9,10) y <- c(5,6,7,8,10) cor.test(x,y,method = "spearman") ## ## Spearman's rank correlation rho ## ## data: x and y ## S = 0.0000000000000044, p-value = 0.02 ## alternative hypothesis: true rho is not equal to 0 282## sample estimates: ## rho ## 1 Spearman 相关系数为 1,P 值小于 0.05,可以认为两位评分员结论有关。 6.2.2.2 Kendall 秩相关检验 从两变量是否协同(concordant)来检验变量之间的相关性,如果 (xj − xi)(yj − yi) > 0 则对子协同,如果 (xj − xi)(yj − yi) < 0 则对子不协同。 Keandall τ 相关系数 ˆτ = nd−nc C2 n ,nd 是不协同的对子数目,nc 是能够协同的 对子数目。 例欲研究体重和肺活量的关系,调查某地 10 名初中女生的体重和肺活 量如下,进行相关性检验。体重:75 95 85 70 76 68 60 66 80 88, 肺活量:2.62 2.91 2.94 2.11 2.17 1.98 2.04 2.20 2.65 2.69。 x <- c(75,95,85,70,76,68,60,66,80,88) y <- c(2.62,2.91,2.94,2.11,2.17,1.98,2.04,2.20,2.65,2.69) cor.test(x,y,method = "kendall") ## ## Kendall's rank correlation tau ## ## data: x and y ## T = 38, p-value = 0.005 ## alternative hypothesis: true tau is not equal to 0 ## sample estimates: ## tau ## 0.6889 Kendall 秩相关系数为 0.68,P 值小于 0.05,可以认为体重和肺活量是 相关的,且为正相关。 6.2.3 偏相关 偏相关是指在控制一个或多个定量变量时,另外两个定量变量之间的相 互关系。可以使用 ggm 包中的 pcor() 函数计算偏相关系数, 函数调用格式 283为:pcor(u,S) 其中的 u 是一个数值向量,前两个数值表示要计算相关系数 的变量下标,其余的数值为条件变量(即要排除影响的变量)的下标。S 为 变量的协方差阵。 例 WHO 数据集中有每 10 万人的 HIV 病人死亡率和医生的数量,试 在控制国家后,分析 HIV 死亡率和当地医生数量是否有关? who <- read.csv("WHO.csv", header = T) x<- who[,c(2,4,120,291)] y <- na.omit(x) pcor(c(2,4,1),cov(y)) ## [1] -0.6442 6.3 独立性检验 独立性检验用于两个或两个以上因素多项分类的计数资料分析,如果要 研究的两个因素 (又称自变量) 或两个以上因素之间是否具有独立性或有无 关联或有无 “交互作用” 的存在,就要应用 χ2 独立性检验。如果两个自变 量 (暂以两个自变量为例) 是独立的,即无关联,就意味对其中一个自变量 (因素) 来说,另一个自变量的多项分类次数上的变化是在取样误差的范围之 内。假如两个因素是非独立,则称这二变量之间有关联或有交互作用存在。 例 vcd 包中 Arthritis 数据集包含了关节炎的治疗情况(Treatment)、 性别(Sex)和改善情况(Improved),治疗情况和改善情况是否独立? mytable<-xtabs(~Treatment+Improved,data=Arthritis) mytable ## Improved ## Treatment None Some Marked ## Placebo 29 7 7 ## Treated 13 7 21 chisq.test(mytable) ## 284## Pearson's Chi-squared test ## ## data: mytable ## X-squared = 13, df = 2, p-value = 0.001 p 值较小,可以认为治疗情况和改善情况不独立。 对于大于 2*2 二维列联表,可以用 Fisher 精确检验 fisher.test(mytable) ## ## Fisher's Exact Test for Count Data ## ## data: mytable ## p-value = 0.001 ## alternative hypothesis: two.sided 6.3.1 Cochran-Mantel-Haenszel 检验 CMH 检验可以对一些分层变量进行调整,从而获得反应率的总体比较。 最为最为常见的应用是在多中心试验中对研究中心进行调整而进行两组率 的比较。 例 vcd 包中 Arthritis 数据集包含了关节炎的治疗情况(Treatment)、 性别(Sex)和改善情况(Improved),在性别分层的情况下治疗情况和改 善情况是否独立? mytable<-xtabs(~Treatment+Improved+Sex,data=Arthritis) mytable ## , , Sex = Female ## ## Improved ## Treatment None Some Marked ## Placebo 19 7 6 ## Treated 6 5 16 ## 285## , , Sex = Male ## ## Improved ## Treatment None Some Marked ## Placebo 10 0 1 ## Treated 7 2 5 mantelhaen.test(mytable) ## ## Cochran-Mantel-Haenszel test ## ## data: mytable ## Cochran-Mantel-Haenszel M^2 = 15, df = 2, p-value = 0.0007 P 值较小,分性别来看,治疗情况和改善情况并不独立。 6.3.1.1 以最大信息为基础的非参数探索 (MINE,Maximal Information- base Nonparametric Exploration) 该方法用网格判断数据的集中程度,集中程度用最大信息系数 (MIC, the Maximal Information Coefficient) 表示,传统的相关系数得到结果用 MIC 值同样可以得到。该方法适用于任何分布的数据类型,不要求成两变 量成直线关系。如果 MIC 值趋进于 0, 则两变量之间无关,如果 MIC 趋进 于 1, 则两变量之间有关。 例 WHO 数据集中有每 10 万人的 HIV 病人死亡率和医生的数量,试 分析 HIV 死亡率和当地医生数量是否有关? who <- read.csv("WHO.csv", header = T) plot(who$Deaths.due.to.HIV.AIDS..per.100.000.population.per.year., who$Medical_Doctors) cor.test(who$Deaths.due.to.HIV.AIDS..per.100.000.population.per.year., who$Medical_Doctors, method = "pearson") 2860 500 1000 1500 0 1 2 3 4 5 6 who$Deaths.due.to.HIV.AIDS..per.100.000.population.per.year. who$Medical_Doctors 图 23: ## ## Pearson's product-moment correlation ## ## data: who$Deaths.due.to.HIV.AIDS..per.100.000.population.per.year. and who$Medical_Doctors ## t = -4.3, df = 120, p-value = 0.00003 ## alternative hypothesis: true correlation is not equal to 0 ## 95 percent confidence interval: ## -0.5068 -0.2008 ## sample estimates: ## cor ## -0.3636 由于两变量不是线性关系,从线性相关的结果来看,相关性较差。 # 调用 MINE.jar,Java 中列以 0 开始 col1 <- which(names(who) == "Deaths.due.to.HIV.AIDS..per.100.000.population.per.year.")-1 col2 <- which(names(who) == "Medical_Doctors")-1 287source("MINE.r") MINE("WHO.csv", c(col1, col2)) MINE("WHO.csv","all.pairs")# 两两比较所有变量 whoresult <- read.csv("WHO.csv,119-vs-290,cv=0.0,B=n^0.6,Results.csv", header = T) whoresult$MIC..strength. ## [1] 0.5495 MIC 值大于 0.5, 说明两变量有一定的相关性,结合绘图的结果,两变 量有如下关系:随着医生数量的增加,HIV 的死亡率降低,但降低到一定程 度后不再继续降低。 6.3.2 趋势检验 6.3.2.1 Cox-Stuart 趋势检验 是一种不依赖与趋势结构的快速判断趋势是否存在的方法,它将数据一 分为二,形成前后数对,根据数对差值的符号进行判断,如果负值较多,说 明数据有增大趋势,如果正值较多,说明数据有减小的趋势。 例某医院传染病门诊 15 天的门诊量如下:5 9 12 18 17 16 19 20 4 3 18 16 17 15 14,试问该 15 天内的门诊量是否有下降的趋势? cox.stuart.test <- function(x) { method = "Cox-Stuart test for trend analysis" leng = length(x) apross = round(leng)%%2 if (apross == 1){ delete = (length(x) + 1)/2 x = x[-delete] } half = length(x)/2 x1 = x[1:half] x2 = x[(half + 1):(length(x))] difference = x1 - x2 288signs = sign(difference) signcorr = signs[signs != 0] pos = signs[signs > 0] neg = signs[signs < 0] if (length(pos) < length(neg)) { prop = pbinom(length(pos), length(signcorr), 0.5) names(prop) = "Increasing trend, p-value" rval <- list(method = method, statistic = prop) class(rval) = "htest" return(rval) } else { prop = pbinom(length(neg), length(signcorr), 0.5) names(prop) = "Decreasing trend, p-value" rval <- list(method = method, statistic = prop) class(rval) = "htest" return(rval) } } customers = c(5, 9, 12, 18, 17, 16, 19, 20, 4, 3, 18, 16, 17, 15, 14) cox.stuart.test(customers) ## ## Cox-Stuart test for trend analysis ## ## data: ## Decreasing trend, p-value = 0.11 P 值大于 0.05,接受原假设,可以认为该 15 天内的门诊量是没有下降 的趋势。 6.3.2.2 Cochran Armitage 趋势检验 289Cochran Armitage 趋势检验也称 χ2 趋势检验,其目的是说明某一事件 发生率是否随着原因变量不同水平的变化而呈线性趋势。 例下表表示不同年龄血液病患者真菌感染发生情况年龄发生未发生 — — — <=29 18 131 30~59 52 232 >=60 26 82 现欲比较患者年龄与真菌感染发生率之间是否存在线性趋势? s1 <- c(18, 52, 26) s2 <- c(131, 232, 82) tot = s1 + s2 prop.trend.test(s1, tot) ## ## Chi-squared Test for Trend in Proportions ## ## data: s1 out of tot , ## using scores: 1 2 3 ## X-squared = 6.3, df = 1, p-value = 0.01 P 值小于 0.05, 拒绝原假设,可以认为血液病患者年龄与真菌感染发生 率之间存在变化趋势。 6.3.2.3 t 检验 亦称 student t 检验(Student’s t test),主要是用于小样本(样本容量 小于 30)的两个平均值差异程度的检验方法。它是用 T 分布理论来推断差 异发生的概率,从而判定两个平均数的差异是否显著,t 检验适用与正态分 布资料。检验的调用格式为:t.test(y~x,data) 其中的 y 是一个数值型变量, x 是一个二分变量。调用格式或为:t.test(y1,y2) 其中的 y1 和 y2 为数值型 向量(即各组的结果变量)。可选参数 data 的取值为一个包含了这些变量 的矩阵或数据框。 6.3.2.3.1 单个样本 t 检验 单个样本 t 检验又称单样本均数 t 检验 (one sample t test), 适用于样 本均数与已知总体均数 µ0 的比较, 其比较目的是检验样本均数所代表的总 体均数 µ 是否与已知总体均数 µ0 有差别, 单样 t 检验的应用条件是总体标 290准 s 未知的小样本资料 ( 如 n<50), 且服从正态分布。单样本的 t 检验计算 公式为 t = ¯X−µ0 s/ √ x 例某地 35 名难产儿出生体重为 3.38 3.51 4.08 4.44 3.44 3.25 3.49 3.29 3.93 4.06 3.29 2.99 3.87 3.19 3.30 3.45 3.50 3.52 3.01 3.80 3.20 3.64 3.85 4.09 3.53 3.93 3.29 3.70 4.13 3.81 2.96 4.44 3.98 2.82 4.23,一般婴儿出生体重 µ0 3.30(大规模调查获得),问相同否? weight <- c(3.38,3.51,4.08,4.44,3.44,3.25,3.49,3.29,3.93, 4.06,3.29,2.99,3.87,3.19,3.30,3.45,3.50,3.52, 3.01,3.80,3.20,3.64,3.85,4.09,3.53,3.93,3.29, 3.70,4.13,3.81,2.96,4.44,3.98,2.82,4.23) shapiro.test(weight) # 正态性检验 ## ## Shapiro-Wilk normality test ## ## data: weight ## W = 0.97, p-value = 0.6 t.test(weight,alternative = "two.side",mu=3.30) ## ## One Sample t-test ## ## data: weight ## t = 4.4, df = 34, p-value = 0.0001 ## alternative hypothesis: true mean is not equal to 3.3 ## 95 percent confidence interval: ## 3.466 3.756 ## sample estimates: ## mean of x ## 3.611 P 值小于 0.05, 可以认为两地的出生体重有差异。 2916.3.2.3.2 配对样本均数 t 检验 配对样本均数 t 检验简称配对 t 检验 (paired t test), 又称非独立两样 本均数 t 检验, 适用于配对设计计量资料均数的比较, 其比较目的是检验两 相关样本均数所代表的未知总体均数是否有差别。配对设计 (paired design) 是将受试对象按某些重要特征相近的原则配成对子,每对中的两个个体随机 地给予两种处理。应用配对设计可以减少实验的误差和控制非处理因素,提 高统计处理的效率。配对 t 检验的公式为 t = ¯d sd/ √ n 配对设计处理分配方式 主要有三种情况:￿ 两个同质受试对象分别接受两种处理,如把同窝、同性 别和体重相近的动物配成一对,或把同性别和年龄相近的相同病情病人配 成一对;￿ 同一受试对象或同一标本的两个部分,随机分配接受两种不同处 理;￿ 自身对比 (self-contrast)。即将同一受试对象处理(实验或治疗)前后 的结果进行比较,如对高血压患者治疗前后、运动员体育运动前后的某一生 理指标进行比较。 例某单位研究饮食中缺乏 VE 与肝中 VA 的关系,将同种属的大白鼠 按性别相同,年龄、体重相近者配成对子,共 8 对,并将每对中的两头动物 随机分到正常饲料组和 VE 缺乏组,过一定时期将其处死,测得肝中 VA 的 含量。问不同饲料组大白鼠肝中 VA 的含量有无差别? 大白鼠对号 1 2 3 4 5 6 7 8 正常饲料组 3550 2000 3000 39 50 3800 3750 3450 3050 VE 缺乏组 2450 2400 1800 3200 32 50 2700 2500 1750 normal <- c(3550,2000,3000,3950,3800,3750,3450,3050) ve <- c(2450,2400,1800,3200,3250,2700,2500,1750) t.test(normal,ve,paired = T) ## ## Paired t-test ## ## data: normal and ve ## t = 4.2, df = 7, p-value = 0.004 ## alternative hypothesis: true difference in means is not equal to 0 ## 95 percent confidence interval: 292## 355.8 1269.2 ## sample estimates: ## mean of the differences ## 812.5 P 值小于 0.05, 可以认为不同饲料组大白鼠中 VA 含量有差异。 6.3.2.3.3 两独立样本 t 检验 两独立样本 t 检验 (two independent samples t-test),又称成组 t 检验, 适用于完全随机设计的两样本均数的比较, 其目的是检验两样本所来自总体 的均数是否相等。完全随机设计是将受试对象随机地分配到两组中,每组对 象分别接受不同的处理,分析比较处理的效应。或分别从不同总体中随机抽 样进行研究。两独立样本 t 检验要求两样本所代表的总体服从正态分布且 两总体方差相等, 即方差齐性 (homogeneity of variance, homoscedasticity)。 若两总体方差不等, 即方差不齐,可采用 t’ 检验, 或进行变量变换, 或用秩 和检验方法处理。t = ¯x1− ¯x2√ s2/n1+s2/n2 ,s2 = (n1−1)s2 1+(n2−1)s2 2 n1+n2−2 例 25 例糖尿病患者随机分成两组,甲组单纯用药物治疗,乙组采用药 物治疗合并饮食疗法,二个月后测空腹血糖 (mmol/L) 甲组 8.4 10.5 12 12 13.9 15.3 16.7 18 18.7 20.7 21.1 15.2 乙组 5.4 6.4 6.4 7.5 7.6 8.1 11.6 12.0 13.4 13.5 14.8 15.6 18.7,假设两组方差齐,问两种疗法治疗后患者血糖值是 否相同? x <- c(8.4,10.5,12,12,13.9,15.3,16.7,18,18.7,20.7,21.1,15.2) y <- c(5.4,6.4,6.4,7.5,7.6,8.1,11.6,12.0,13.4,13.5,14.8,15.6,18.7) shapiro.test(x) ## ## Shapiro-Wilk normality test ## ## data: x ## W = 0.97, p-value = 0.9 shapiro.test(y) ## 293## Shapiro-Wilk normality test ## ## data: y ## W = 0.93, p-value = 0.3 t.test(x,y,var.equal = T) ## ## Two Sample t-test ## ## data: x and y ## t = 2.6, df = 23, p-value = 0.01 ## alternative hypothesis: true difference in means is not equal to 0 ## 95 percent confidence interval: ## 0.9444 7.7800 ## sample estimates: ## mean of x mean of y ## 15.21 10.85 tIndDf <- data.frame(DV=c(x, y), IV=factor(rep(c("f","m"), c(length(x),length(y))))) t.test(DV ~ IV, var.equal=TRUE, data=tIndDf) P 值小于 0.05, 可以认为两种疗法治疗后患者血糖值不相同。 2947 回归分析 因变量是分类的,则为分类分析,因变量是连续的,称为回归分析。回 归分析通过建立函数表达式,用一个或者多个自变量的变化解释或预测因变 量,常用于描述、探索和检验自变量和因变量之间因果关系,根据自变量的 变化预测因变量的取值。通常按照自变量的个数划分为一元回归和多元回 归。按照函数表达式的形式,分为线性回归和非线性回归。 7.1 一元线性回归 假设有两个变量 X 和 Y,X 为自变量,Y 为因变量。则一元线性回归 模型的基本结构形式为 Y = β0 + β1X + ε 。ε 是误差项,表示未知或不易测量的随机因素对因变量影响的总和。β0 为 回归的常数,β1 为回归系数,它表示增加和减少一个单位时,Y 的平均变化 量。线性回归就是根据已经观测到的样本数据,应用最小二乘法获得对 β0 和 β1 的估计,进而得到回归方程。由于参数估计时并不知道是否存在线性 关系,回归方程在应用前需要完成对回归方程的检验,即对回归模型的系数 是否为零进行检验。常用 t 检验、F 检验和相关系数检验评价回归方程的回 归系数是否为 0。线性回归应用有四个前提条件:线性、独立、正态和方差 齐性。线性指自变量和因变量在散点图大致呈直线趋势。独立性值观察值之 间应相互独立。正态性指残差应符合正态分布。方差齐性指在自变量取值范 围内,对于自变量的取值,因变量都有相同的方差。 例某医生分别采用盐析法和结合法测定正常皮肤中胶原蛋白的含量。盐 析法只能部分提纯,结合法较为复杂单精确。该医生欲寻求找盐析法和结合 法之间的关系,以便通过盐析法预测结合法的测定值。 编号 盐析法 结合法 1 6.8 546 2 7.8 553 3 8.7 562 4 8.7 563 5 8.9 570 6 9.5 575 295编号 盐析法 结合法 7 10.1 581 8 10.2 605 9 10.3 607 10 10.4 621 11 11.1 624 12 12.4 626 13 13.3 632 14 13.1 640 15 13.2 656 做散点图,观察是否存在线性关系。由于线性回归的条件(线性、正态 性、方差齐性和独立性)是通过残差来完成的,可先建立回归方程,然后通 过回归诊断来完成线性回归条件的检验。线性条件可通过散点图直接观察。 y <- c(546,553,562,563,570,575,581,605,607,621, 624,626,632,640,656) x <- c(6.8,7.8,8.7,8.7,8.9,9.5,10.1,10.2,10.3, 10.4,11.1,12.4,13.3,13.1,13.2) df <- as.data.frame(cbind(x,y)) #ggplot(df,aes(x,y))+geom_point()+stat_smooth(method = "lm") plot(x,y) 2967 8 9 10 11 12 13 560 580 600 620 640 660 x y 通过散点图,可以发现二者近似直线关系,符合线性条件。 对数据进行线性回归分析。 model <- lm(y~x) #~ 左边为响应变量,右边为各个预测变量,预测变量之间用 + 符号分隔 summary(model) ## ## Call: ## lm(formula = y ~ x) ## ## Residuals: ## Min 1Q Median 3Q Max ## -15.14 -8.37 -3.82 9.43 21.94 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) 426.63 15.92 26.8 0.00000000000092 *** ## x 16.58 1.52 10.9 0.00000006425836 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## 297## Residual standard error: 11.4 on 13 degrees of freedom ## Multiple R-squared: 0.902, Adjusted R-squared: 0.894 ## F-statistic: 119 on 1 and 13 DF, p-value: 0.0000000643 结果中 Coefficients 是参数估计的结果。结果显示,截距项和回归系统均 有统计学意义。模型简单评价 R2 为 0.9017,校正决定系数 R2 adj 为 0.9841。决 定系数越大表明自变量对因变量的解释程度越高。F 检验检验所有的预测变 量预测响应变量是否都在某个几率水平之上,结果表明 (F=119.2,P=6.426e- 08), 方程总体有统计学意义。残差的标准误则可认为模型用自变量预测因变 量的平均误差。所建立的方程为 Y=426.625+16.580×X 对估计值做出区间 估计 confint(model) ## 2.5 % 97.5 % ## (Intercept) 392.2 461.01 ## x 13.3 19.86 plot(df$x,df$y) abline(model) 7 8 9 10 11 12 13 560 580 600 620 640 660 df$x df$y ### 模型评价 2987.1.0.1 回归诊断 主要包括三方面:(1)误差项是否满足独立性、等方差性和正态性,选 择模型是否合适。(2)是否存在异常样本,回归分析的结果是否对某些样本 依赖过重,即回归模型是否具备稳定性。(3)自变量之间是否存在高度相 关,即是否有多重共线性问题存在。 par(mfrow=c(2,2)) plot(model) 540 560 580 600 620 640 −10 10 Fitted values Residuals Residuals vs Fitted 10 13 11 −1 0 1 −1 1 Theoretical Quantiles Standardized residuals Normal Q−Q 10 13 11 540 560 580 600 620 640 0.0 0.8 Fitted values S t a n d a r d i z e d r e s i d u a l s Scale−Location 10 1311 0.00 0.10 0.20 −1 1 Leverage Standardized residuals Cook's distance 0.5 0.5 1 Residuals vs Leverage 13 15 10 图 24: par(mfrow=c(1,1)) 标准方法正态性当预测变量值固定时,因变量成正态颁,则残差图也应 是一个均值为 0 的正态颁。正态 Q-Q 图是在正态颁对应的值上,标准化残 差的概率图,若满足正态假设,则图上的点应该落在 45 度角的直线上,若 不是,则违反了正态性假设。第二幅 Normal QQ-plot 图中数据点分布趋于 一条直线, 说明残差是服从正态分布的。 独立性无法从图中分辨因变量值是否相互独立,只能从收集的数据中验 299证。本例中适用结合法进行测量时,无理由相信一个测量结果会影响另外一 次的测量。 线性若因变量与自变量线性相关,则残差值与预测(拟合)值就没有 系统关联,若存在关系,则说明可能城要对回归模型进行调整。第一幅图 Residual vs fitted 为拟合值 y 对残差的图形, 可以看出, 数据点都基本均匀 地分布在直线 y=0 的两侧, 无明显趋势,满足线性假设。 方差齐性若满足不变方差假设,则在第三幅图位置尺度图(Scale- Location Graph)中,水平线周围的点应随机分布,Scale-Location 图显示 了标准化残差 (standardized residuals) 的平方根的分布情况,最高点为残 差最大值点。第三副图显示基本符合方差齐性的要求。 第四幅图(Residuals vs Leverage)提供了单个观测点的信息,从图中 可以鉴别离群点、高高杆值点和强影响点。 改进方法 正态性通过对残差正态性检验予以证实。 model <- lm(y~x) shapiro.test(residuals(model)) ## ## Shapiro-Wilk normality test ## ## data: residuals(model) ## W = 0.93, p-value = 0.3 正态性检验结果表明 W 值为 0.9299,P 值为 0.2716, 残差符合正态分 布。 独立性判断因变量(或残差)最好的方法时依据收集数据的方式的先 验知识。lmtest 包提供了 dwtest 检验函数,car 包提供了 Durbin-Watson 检验的函数,都能够检验误差序列的相关性。 dwtest(model) ## ## Durbin-Watson test ## 300## data: model ## DW = 1, p-value = 0.007 ## alternative hypothesis: true autocorrelation is greater than 0 #durbinWatsonTest(model) 本例结果 P 值比较显著,但根据先验知识,并不能否定因变量的独立 性。 线性可通过成分残差图 (component plus residual plot) 即偏残差图 (partial residual plot),判断因变量与自变量之间是否呈非线性关系,也 可以看是否不同于已设定线性模型的系统偏差,图形可用 car 包中 crPlots() 函数绘制。图形存在非线性,则说明可能对预测变量的函数形式建模不够充 分. crPlots(model) 7 8 9 10 11 12 13 −40 −20 0 20 40 60 x Component+Residual(y) 图形呈现线性,建模比较充分。car 包中提供了一个 linearHypothesis() 函 数可以自动的进行线性假设检验, 比图形更为精准。根据对模型的设定,这 个函数既可以用一般的方法或调整后的协方差矩阵进行 F 或 Wald 检验。 linearHypothesis(model, "x=0")#x 的系数是否为 0 ## Linear hypothesis test 301## ## Hypothesis: ## x = 0 ## ## Model 1: restricted model ## Model 2: y ~ x ## ## Res.Df RSS Df Sum of Sq F Pr(>F) ## 1 14 17250 ## 2 13 1696 1 15554 119 0.000000064 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 # tests Beta1 = Beta2 #linear.hypothesis(fit,"x1 = x2") # Tests Beta0 = Beta1 = Beta2= 1 #linear.hypothesis(fit,c("(Intercept)", "x1","x2"),rep(1,3)) # Tests Beta0 = Beta1 = Beta2 = 0 #linear.hypothesis(fit,c("(Intercept)", "x1","x2"),rep(0,3)) # Tests Beta1 = Beta2 = 0 #linear.hypothesis(fit,c("x1","x2"),rep(0,2)) P 值小于 0.05,可以认为 x 的系数不为 0。 方差齐性通过以因变量为 x 轴,学生化残差为 y 轴做残差图,进行判 断。 plot(predict(model),rstudent(model)) 302540 560 580 600 620 640 −1 0 1 2 predict(model) rstudent(model) 所有的学生化残差均在 ±2 在范围内波动,没有明显的上升或下降趋势,可 以认为符合方差齐性。还通过自变量与残差绝对值的等级相关检验来判断。 spearman.test(x,abs(residuals(model))) #R 中 pspearman 包中的 spearman. ## Warning in spearman.test(x, abs(residuals(model))): Cannot compute exact p- ## values with ties ## ## Spearman's rank correlation rho ## ## data: x and abs(residuals(model)) ## S = 290, p-value = 0.08 ## alternative hypothesis: true rho is not equal to 0 ## sample estimates: ## rho ## 0.4736 #test 函数可以完成斯皮尔曼等级相关检验 #cor.test(x,abs(residuals(model)),method="spearman") # 或者用 cor.test() 303自变量与残差绝对值的等级相关系数为 0.0745,P 值大于 0.05,无统计 学意义,可以认为残差方差齐性。 car 包提供了两个有用的函数,可判断误差方差是否恒定,ncvTest() 函数 生成一个计分检验,零假设为误差方差不变, 备择假设为误差方差随着拟合 值水平的变化而变化。若检验显著,择说明存在异方差性。spreadLevelPlot() 函数创建一个添加了最佳拟合曲线的散点图,展示标准化残差绝对值与拟合 值的关系。 ncvTest(model) ## Non-constant Variance Score Test ## Variance formula: ~ fitted.values ## Chisquare = 0.4274 Df = 1 p = 0.5133 spreadLevelPlot(model) 540 560 580 600 620 640 0.5 1.0 1.5 Spread−Level Plot for model Fitted Values Absolute Studentized Residuals 图 25: ## ## Suggested power transformation: -2.524 304计分检验结果不显著,说明满足方差齐性的假设。通过水平分布图,可 以看到其中的点在水平的最佳拟合曲线周围呈水平随机分布。若违反了该 假设,将会呈现一个非水平的曲线。 线性模型假设的综合验证 gvlma(model) ## ## Call: ## lm(formula = y ~ x) ## ## Coefficients: ## (Intercept) x ## 426.6 16.6 ## ## ## ASSESSMENT OF THE LINEAR MODEL ASSUMPTIONS ## USING THE GLOBAL TEST ON 4 DEGREES-OF-FREEDOM: ## Level of Significance = 0.05 ## ## Call: ## gvlma(x = model) ## ## Value p-value Decision ## Global Stat 2.156 0.707 Assumptions acceptable. ## Skewness 0.494 0.482 Assumptions acceptable. ## Kurtosis 0.556 0.456 Assumptions acceptable. ## Link Function 0.329 0.567 Assumptions acceptable. ## Heteroscedasticity 0.778 0.378 Assumptions acceptable. Global Stat 给模型假设提供了一个单独的综合检验(通过/不通过),本 例中,可以看到数据满足线性回归模型所有的统计假设(P=0.7071)。同时 还对偏度 (Skewness)、峰度 (Kurtosis)、连接函数 (Link function) 和异方差 性 (Heteroscedasticity) 进行了评价。 3057.1.0.2 影响分析 是探查对估计有异常影响的数据,如果一个样本不服从某个模型,其余 数据服从这个模型,则称该样本点为强影响点。影响分析就是区分这样的样 本数据。 7.1.0.2.1 离群点 指那些模型预测效果不佳的观测点,通常有很大的、或正或负的残差, 正残差说明模型低估了响应值,负残差说明高佑了响应值。 outlierTest(model) #Bonferroni 离群点检验 ## ## No Studentized residuals with Bonferonni p < 0.05 ## Largest |rstudent|: ## rstudent unadjusted p-value Bonferonni p ## 10 2.291 0.04088 0.6132 qqPlot(model,labels=row.names(df), id.method = "identify",simulate=T,main="QQPlot")#car 包 −2 −1 0 1 2 −1 0 1 2 QQPlot t Quantiles Studentized Residuals(model) outlierTest()函数是根据单个最大(或正或负)残差值的显著性来判断是 306否有离群点,若不显著,则说明数据集中没有离群点,若显著,则必须删除 该离群点,然后再检验是否还有其他离群点存在。qqPlot 图中落在置信区 间带外的点可被认为时离群点。本例中未发现有离群点。 7.1.0.2.2 高杠杆值点 是与其他预测变量有关的离群点,即它们是由许多异常的预测变量组 合起来的,与响应变量值没有关系。高杠杆值的观测点可通过帽子矩阵的值 (hat statistic)判断。对于一个给定的数据集,帽子均值为 p/n,其中 p 是 模型估计的参数数目(包含截距项),n 是样本量。一般来说,若观测点的 帽子值大于帽子均值的 2 或 3 倍,则可认定为高杠杆值点。 hat.plot<-function(fit){ p<-length(coefficients(fit)) n<-length(fitted(fit)) plot(hatvalues(fit),main="Index Plot of Hat Values") abline(h=c(2,3)*p/n,col="red",lty=2) identify(1:n,hatvalues(fit),names(hatvalues(fit))) } hat.plot(model) ## integer(0) 此图中可以看到 1 号点是高杠杆值点。 7.1.0.2.3 强影响点 强影响点,即对模型参数估计值影响有些比例失衡的点。例如,当移除 模型的一个观测点时模型会发生巨大的改变,那么需要检测一下数据中是否 存在强影响点。Cook 距离,或称为 D 统计量。Cook’s D 值大于 4/(n-k-1), 则表明它是强影响点,其中 n 为样本量大小,k 是预测变量数目(有助于鉴 别强影响点,但并不提供关于这些点如何影响模型的信息)。 plot(model,which=4) 3072 4 6 8 10 12 14 0.10 0.15 0.20 0.25 Index Plot of Hat Values Index hatvalues(fit) 图 26: 2 4 6 8 10 12 14 0.00 0.10 0.20 0.30 Obs. number Cook's distance lm(y ~ x) Cook's distance 13 1510 Cook 距离 (Cook’s distance) 图显示了对回归的影响点。根据 Cook 距离, 13 号点可能是个强影响点。 帽子统计量、DFFITS 准测、Cook 统计量和 COVRATIO 准则在 R 软 308件可分别通过 hatvalues(),dffits(),cooks.distance() 和 covration() 函数计算。 influence.measures() 可对一次获得这四个统计量的结果。影响分析综合分 析 influencePlot(model) 0.10 0.15 0.20 0.25 −1 0 1 2 Hat−Values Studentized Residuals 1 10 13 图 27: ## StudRes Hat CookD ## 1 0.671 0.28317 0.3047 ## 10 2.291 0.06684 0.3764 ## 13 -1.593 0.22573 0.5752 #car 包中的 influencePlot()函数,可将离群点、 # 杠杆点和强影响点的信息整合到一幅图形中 influence.measures(model) ## Influence measures of ## lm(formula = y ~ x) : ## ## dfb.1_ dfb.x dffit cov.r cook.d hat inf 309## 1 0.4003 -0.368762759919745609 0.422 1.521 0.09286 0.2832 * ## 2 -0.1133 0.100538393379184701 -0.127 1.409 0.00872 0.1771 ## 3 -0.2217 0.183612872605902866 -0.289 1.187 0.04281 0.1119 ## 4 -0.1956 0.161969624722812039 -0.255 1.215 0.03370 0.1119 ## 5 -0.0910 0.073382815332062645 -0.125 1.276 0.00843 0.1013 ## 6 -0.1305 0.091113148081497355 -0.239 1.141 0.02934 0.0780 ## 7 -0.0924 0.033228045651556445 -0.324 1.001 0.05083 0.0674 ## 8 0.0523 -0.011408301566413894 0.222 1.125 0.02522 0.0668 ## 9 0.0427 0.000000000000000144 0.230 1.115 0.02703 0.0667 ## 10 0.0825 0.031525163015612340 0.613 0.609 0.14165 0.0668 ## 11 -0.0732 0.137454519602210584 0.361 1.000 0.06253 0.0780 ## 12 0.1404 -0.173040504566062986 -0.236 1.300 0.02929 0.1446 ## 13 0.6230 -0.722088166442589219 -0.860 1.033 0.33083 0.2257 ## 14 0.1294 -0.151492443546711320 -0.184 1.445 0.01821 0.2052 ## 15 -0.3898 0.453979197801305467 0.546 1.257 0.14826 0.2153 纵坐标超过 2 或小于-2 的州可被认为是离群点,水平轴超过 0.2 或 0.3 的 州有高杠杆值(通常为预测值的组合)。圆圈大小与影响成比例,圆圈很大的 点可能是对模型估计造成的不成比例影响的强影响点。influence.measures() 的 inf 用 × 标注异常值。 7.1.1 共线性,条件数 本例只有一个自变量,不涉及。 7.1.2 预测新值及其置信区间 把预测变量数据保存为一个数据框,调用 predict 函数,将数据框做为 参数。 preds <- data.frame(x=14) # 默认 0.95 的置信水平,可通过 level 改变 predict(model,newdata = preds,interval = "prediction") ## fit lwr upr ## 1 658.7 630.5 687 3107.1.3 改进措施 model2 <- lm(y~x,subset=-1) gvlma(model2) ## ## Call: ## lm(formula = y ~ x, subset = -1) ## ## Coefficients: ## (Intercept) x ## 420.1 17.2 ## ## ## ASSESSMENT OF THE LINEAR MODEL ASSUMPTIONS ## USING THE GLOBAL TEST ON 4 DEGREES-OF-FREEDOM: ## Level of Significance = 0.05 ## ## Call: ## gvlma(x = model2) ## ## Value p-value Decision ## Global Stat 4.485 0.344 Assumptions acceptable. ## Skewness 0.600 0.439 Assumptions acceptable. ## Kurtosis 0.360 0.548 Assumptions acceptable. ## Link Function 2.614 0.106 Assumptions acceptable. ## Heteroscedasticity 0.911 0.340 Assumptions acceptable. influence.measures(model2) ## Influence measures of ## lm(formula = y ~ x, subset = -1) : ## ## dfb.1_ dfb.x dffit cov.r cook.d hat inf ## 2 -0.0447 0.0410 -0.0486 1.575 0.00129 0.2455 * 311## 3 -0.2319 0.2028 -0.2801 1.294 0.04113 0.1502 ## 4 -0.1993 0.1743 -0.2407 1.321 0.03068 0.1502 ## 5 -0.0766 0.0659 -0.0964 1.359 0.00504 0.1341 ## 6 -0.1506 0.1193 -0.2330 1.204 0.02831 0.0968 ## 7 -0.1288 0.0790 -0.3191 1.041 0.04993 0.0761 ## 8 0.0877 -0.0483 0.2480 1.123 0.03137 0.0742 ## 9 0.0763 -0.0355 0.2529 1.113 0.03248 0.0729 ## 10 0.1620 -0.0554 0.6536 0.569 0.15525 0.0719 ## 11 -0.0490 0.1069 0.3587 0.998 0.06170 0.0784 ## 12 0.1555 -0.1875 -0.2589 1.309 0.03533 0.1502 ## 13 0.7317 -0.8307 -0.9866 0.975 0.41740 0.2455 ## 14 0.1725 -0.1977 -0.2404 1.473 0.03094 0.2211 ## 15 -0.3708 0.4228 0.5078 1.337 0.13056 0.2330 提示 2 号点也是是个异常值。 model3 <- lm(y~x,subset=c(-1,-2)) gvlma(model3) ## ## Call: ## lm(formula = y ~ x, subset = c(-1, -2)) ## ## Coefficients: ## (Intercept) x ## 421.0 17.1 ## ## ## ASSESSMENT OF THE LINEAR MODEL ASSUMPTIONS ## USING THE GLOBAL TEST ON 4 DEGREES-OF-FREEDOM: ## Level of Significance = 0.05 ## ## Call: ## gvlma(x = model3) ## 312## Value p-value Decision ## Global Stat 5.487 0.2409 Assumptions acceptable. ## Skewness 0.490 0.4840 Assumptions acceptable. ## Kurtosis 0.508 0.4760 Assumptions acceptable. ## Link Function 4.099 0.0429 Assumptions NOT satisfied! ## Heteroscedasticity 0.390 0.5324 Assumptions acceptable. influence.measures(model3) ## Influence measures of ## lm(formula = y ~ x, subset = c(-1, -2)) : ## ## dfb.1_ dfb.x dffit cov.r cook.d hat inf ## 3 -0.2902 0.2616 -0.335 1.379 0.0590 0.1973 ## 4 -0.2505 0.2258 -0.289 1.410 0.0444 0.1973 ## 5 -0.0997 0.0889 -0.119 1.447 0.0077 0.1751 ## 6 -0.1891 0.1594 -0.262 1.251 0.0361 0.1220 ## 7 -0.1722 0.1261 -0.338 1.065 0.0564 0.0893 ## 8 0.1177 -0.0821 0.255 1.158 0.0334 0.0859 ## 9 0.1062 -0.0694 0.257 1.145 0.0340 0.0830 ## 10 0.2387 -0.1422 0.664 0.583 0.1612 0.0806 ## 11 -0.0175 0.0695 0.345 1.018 0.0577 0.0802 ## 12 0.1462 -0.1748 -0.248 1.336 0.0327 0.1529 ## 13 0.7307 -0.8209 -0.979 1.007 0.4137 0.2594 ## 14 0.1677 -0.1901 -0.233 1.520 0.0292 0.2318 ## 15 -0.3759 0.4241 0.512 1.373 0.1334 0.2453 删除 1、2 观测值后,模型的影响分析的结果变得更好。但应该对删除 观测点的方法谨慎,因为收集数据的异常点可能是最有意义东西,除非确定 数据点时记录错误或者没有相关遵守规程。 7.2 多元线性回归 例2 某项 “冠状动脉缓慢血流现象” 的影响因素的研究,以前降支、 回旋支、右冠状动脉三支血管的平均 TIMI 帧基数 (MTFC) 表示,调查的 313影响因素有年龄 (AGE, 岁)、收缩压 (SBP,mmHg)、舒张压 (DBP,mmHg)、 白细胞 (WBC,102/L), 寻找影响 MTFC 变化的因素。 age sbp dbp wbc mtfc 43 110 50 6.19 33.67 63 105 60 6.03 26.67 59 100 60 5.28 23 78 100 60 6.52 26 67 100 60 7.31 28 65 119 61 5.67 30.33 66 120 64 5.11 27 73 130 88 6.40 47 53 113 68 4.41 27.67 76 120 70 4.20 37.33 76 136 70 5.38 35.67 76 130 70 4.94 31.33 68 126 70 4.56 32.33 61 136 70 5.42 30.67 78 124 70 5.75 37.67 80 110 70 4.68 36 74 140 70 8.67 41 75 130 70 6.62 41.67 66 130 70 6.86 22 55 114 70 7.52 23.33 71 120 70 4.94 25.67 62 130 70 4.59 25 69 130 70 4.26 27 45 110 70 10.21 29 79 120 70 6.46 30.33 58 110 70 4.70 27 65 100 70 6.06 28 44 119 70 5.55 22.33 53 110 70 14.0 29.33 314age sbp dbp wbc mtfc 62 130 72 7.29 43 62 118 72 3.97 27.33 53 122 74 3.97 18.33 71 130 75 3.78 31 54 116 75 4.35 22.33 64 120 76 6.59 30 71 140 78 5.70 35.67 50 121 78 5.27 40.33 51 138 80 5.65 34.67 73 130 80 7.45 35.33 64 138 80 6.58 33.67 40 130 80 7.51 35.33 72 120 80 4.42 34 51 100 80 7.85 21 49 120 89 5.14 20.67 63 150 90 8.18 42.67 56 130 90 5.23 30.67 69 160 90 7.10 39 78 130 90 6.03 29 78 120 90 4.52 30.67 61 150 92 7.52 40 76 142 92 4.66 38 51 140 100 5.70 28.33 51 140 100 6.71 42.67 57 160 100 6.14 41 63 190 100 5.25 46 69 150 80 6.33 22.67 records <- read.table("example1") ex <- rename(records, c("V1"="age","V2"="sbp", "V3"="dbp","V4"="wbc","V5"="mtfc")) 315attach(ex) ## The following object is masked _by_ .GlobalEnv: ## ## sbp #scatterplotMatrix() 函数默认在非对角线区域绘制变量间的散点图, # 并添加平滑(loess)和线性拟合区间 scatterplotMatrix(ex,spread=F,lty.smooth=2,main="scatter plot matrix") age 100 140 180 4 6 8 12 40 60 80 100 160 sbp dbp 50 80 4 8 14 wbc 40 50 60 70 80 50 70 90 20 30 40 20 35 mtfc scatter plot matrix 绘制因变量与自变量的散点图矩阵显示 mtfc 和 wbc 线性关系不是很好。 首先做单因素的线性回归,尽管有时候单因素的分析不是必须的,其结果 也不一定可靠,但有助于初步探索自变量和因变量之间的关系。 summary(lm(mtfc~age,data = ex)) ## ## Call: ## lm(formula = mtfc ~ age, data = ex) ## 316## Residuals: ## Min 1Q Median 3Q Max ## -11.67 -5.07 -1.00 4.45 14.38 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) 21.3969 5.6281 3.80 0.00037 *** ## age 0.1622 0.0874 1.86 0.06893 . ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 6.86 on 54 degrees of freedom ## Multiple R-squared: 0.06, Adjusted R-squared: 0.0426 ## F-statistic: 3.44 on 1 and 54 DF, p-value: 0.0689 summary(lm(mtfc~sbp,data = ex)) ## ## Call: ## lm(formula = mtfc ~ sbp, data = ex) ## ## Residuals: ## Min 1Q Median 3Q Max ## -14.616 -3.224 0.177 2.728 14.441 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) 1.8328 5.8740 0.31 0.76 ## sbp 0.2364 0.0461 5.13 0.000004 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 5.8 on 54 degrees of freedom ## Multiple R-squared: 0.328, Adjusted R-squared: 0.315 317## F-statistic: 26.3 on 1 and 54 DF, p-value: 0.00000404 summary(lm(mtfc~dbp,data = ex)) ## ## Call: ## lm(formula = mtfc ~ dbp, data = ex) ## ## Residuals: ## Min 1Q Median 3Q Max ## -14.294 -4.541 0.205 3.911 12.289 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) 12.6983 5.8853 2.16 0.0354 * ## dbp 0.2502 0.0766 3.26 0.0019 ** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 6.47 on 54 degrees of freedom ## Multiple R-squared: 0.165, Adjusted R-squared: 0.149 ## F-statistic: 10.7 on 1 and 54 DF, p-value: 0.00191 summary(lm(mtfc~wbc,data = ex)) ## ## Call: ## lm(formula = mtfc ~ wbc, data = ex) ## ## Residuals: ## Min 1Q Median 3Q Max ## -12.088 -5.110 -0.597 5.387 15.060 ## ## Coefficients: 318## Estimate Std. Error t value Pr(>|t|) ## (Intercept) 27.933 3.460 8.07 0.000000000075 *** ## wbc 0.626 0.553 1.13 0.26 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 6.99 on 54 degrees of freedom ## Multiple R-squared: 0.0232, Adjusted R-squared: 0.00508 ## F-statistic: 1.28 on 1 and 54 DF, p-value: 0.263 summary(lm(mtfc~age+sbp+dbp+wbc,data = ex)) ## ## Call: ## lm(formula = mtfc ~ age + sbp + dbp + wbc, data = ex) ## ## Residuals: ## Min 1Q Median 3Q Max ## -15.301 -3.020 -0.017 2.363 12.542 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) -13.7714 8.2328 -1.67 0.1005 ## age 0.1627 0.0746 2.18 0.0339 * ## sbp 0.2081 0.0627 3.32 0.0017 ** ## dbp 0.0439 0.0933 0.47 0.6397 ## wbc 0.9133 0.4533 2.01 0.0492 * ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 5.59 on 51 degrees of freedom ## Multiple R-squared: 0.411, Adjusted R-squared: 0.365 ## F-statistic: 8.91 on 4 and 51 DF, p-value: 0.0000155 分析结果表明,单因素分析中 dbp 有统计学,而多因素分析中却没有 319统计学意义。分析自变量的相关系数 cor(ex[1:4]) ## age sbp dbp wbc ## age 1.0000 0.10516 -0.059800 -0.222747 ## sbp 0.1052 1.00000 0.691708 -0.030466 ## dbp -0.0598 0.69171 1.000000 0.003302 ## wbc -0.2227 -0.03047 0.003302 1.000000 cor.test(ex$dbp,ex$sbp) ## ## Pearson's product-moment correlation ## ## data: ex$dbp and ex$sbp ## t = 7, df = 54, p-value = 0.000000004 ## alternative hypothesis: true correlation is not equal to 0 ## 95 percent confidence interval: ## 0.5241 0.8077 ## sample estimates: ## cor ## 0.6917 相关分析结果表明 sbp 和 dbp 有明显的正相关作用,说明单因素分析 中 dbp 对因变量的作用同时包含了部分 sbp 的正向作用。在删除 dbp 变量, 继续建模。 summary(lm(mtfc~age+sbp+wbc,data = ex)) ## ## Call: ## lm(formula = mtfc ~ age + sbp + wbc, data = ex) ## ## Residuals: 320## Min 1Q Median 3Q Max ## -15.579 -3.097 -0.008 2.235 12.656 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) -12.6449 7.8184 -1.62 0.112 ## age 0.1563 0.0728 2.15 0.037 * ## sbp 0.2289 0.0443 5.17 0.0000038 *** ## wbc 0.9118 0.4499 2.03 0.048 * ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 5.54 on 52 degrees of freedom ## Multiple R-squared: 0.409, Adjusted R-squared: 0.375 ## F-statistic: 12 on 3 and 52 DF, p-value: 0.00000444 结果显示三个因素均有统计学意义,F 检验也通过了,但决定系数较低, 说明自变量对因变量的解释程度较低。查看 wbc 变量估计结果,其标准误 为 0.44 远高于 age 和 sbp 变量,计算这三个变量的变异系数。 cv <- function(x){ return(100*sd(x)/mean(x)) } cv(age) ## [1] 16.66 cv(sbp) ## [1] 13.64 cv(wbc) ## [1] 28.31 321wbc 变量的变异系数远高于其他连个变量,为减少 wbc 变量的变异,对 其进行对数变换后重新建模 fit <- lm(mtfc~age+sbp+log10(wbc),data = ex) summary(fit) ## ## Call: ## lm(formula = mtfc ~ age + sbp + log10(wbc), data = ex) ## ## Residuals: ## Min 1Q Median 3Q Max ## -15.763 -3.016 0.077 2.443 12.648 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) -18.6720 9.1717 -2.04 0.047 * ## age 0.1574 0.0721 2.18 0.034 * ## sbp 0.2247 0.0440 5.11 0.0000047 *** ## log10(wbc) 15.6553 7.0499 2.22 0.031 * ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 5.5 on 52 degrees of freedom ## Multiple R-squared: 0.417, Adjusted R-squared: 0.384 ## F-statistic: 12.4 on 3 and 52 DF, p-value: 0.00000307 gvlma(fit) ## ## Call: ## lm(formula = mtfc ~ age + sbp + log10(wbc), data = ex) ## ## Coefficients: 322## (Intercept) age sbp log10(wbc) ## -18.672 0.157 0.225 15.655 ## ## ## ASSESSMENT OF THE LINEAR MODEL ASSUMPTIONS ## USING THE GLOBAL TEST ON 4 DEGREES-OF-FREEDOM: ## Level of Significance = 0.05 ## ## Call: ## gvlma(x = fit) ## ## Value p-value Decision ## Global Stat 2.3536 0.671 Assumptions acceptable. ## Skewness 0.0138 0.907 Assumptions acceptable. ## Kurtosis 1.7085 0.191 Assumptions acceptable. ## Link Function 0.0555 0.814 Assumptions acceptable. ## Heteroscedasticity 0.5758 0.448 Assumptions acceptable. #influence.measures(fit) 所建立的模型通过回归诊断,影响分析存在异常点,但没有理由怀疑是 异常点所以予以保留。 7.2.1 多重共线性 指线性回归模型中的解释变量之间由于存在精确相关关系或高度相关 关系而使模型估计失真或难以估计准确。一般来说,由于数据的限制使得模 型设计不当,导致设计矩阵中解释变量间存在普遍的相关关系目前常用的 多重共线性诊断方法 1. 自变量的相关系数矩阵 R 诊断法:研究变量的两两 相关分析,如果自变量间的二元相关系数值很大,则认为存在多重共线性。 但无确定的标准判断相关系数的大小与共线性的关系。有时,相关系数值不 大,也不能排除多重共线性的可能。 2. 方差膨胀因子(the variance inflation factor,VIF) 诊断法:方差膨 胀因子表达式为:VIFi = 1/1 − R2 i )。其中 Ri 为自变量 xi 对其余自变量作 323回归分析的复相关系数。当 VIFi 很大时,表明自变量间存在多重共线性。 该诊断方法也存在临界值不易确定的问题,在应用时须慎重。 3. 容忍值(Tolerance,简记为 Tol)法:容忍值实际上是 VIF 的倒数, 即 Tol = 1/VIF。其取值在 0 ~ 1 之间,Tol 越接近 1,说明自变量间的共 线性越弱。在应用时一般先预先指定一个 Tol 值,容忍值小于指定值的变量 不能进入方程,从而保证进入方程的变量的相关系数矩阵为非奇异阵,计算 结果具有稳定性。但是,有的自变量即使通过了容忍性检验进入方程,仍可 导致结果的不稳定。 4. 多元决定系数值诊断法:假定多元回归模型 p 个自变量,其多元决定 系数为 R2y(X1,X2,…,Xp)。分别构成不含其中某个自变量(xi,i=1,2,…, p)的 p 个回归模型,并应用最小二乘法准则拟合回归方程,求出它们各自 的决定系数 R2 i i = 1, 2, p。如果其中最大的一个 R2k 与 R2Y 很接近,就表 明该自变量在模型中对多元决定系数的影响不大,说明该变量对 Y 总变异 的解释能力可由其他自变量代替。它很有可能是其他自变量的线性组合。因 此,该自变量进入模型后就有可能引起多重共线性问题。该方法也存在临界 值和主观判断问题。 5. 条件数与特征分析法:在自变量的观测值构成的设计矩阵 X 中,求 出变量相关系数 R 的特征值,如果某个特征值很小(如小于 0.05 ),或所 有特征值的倒数之和为自变量数目的 5 倍以上,表明自变量间存在多重共 线性关系。利用主成分分析,如果 X￿X 的特征值 RK 小于 0.05 时,RK 所对应的主成分 FK 可近似为零,表明自变量间存在 K 个多重共线性关系。 从实际经验的角度, 一般若条件数 <100, 则认为多重共线性的程度很 小, 若 100<= 条件数 <=1000, 则认为存在中等程度的多重共线性, 若条件 数 >1000, 则认为存在严重的多重共线性。kappa 大于 1000,或 vif 大于 10 说明存在多重共线性。在 R 中判断多重共线性的命令为 kappa(条件数), vif(方差膨胀因子) kappa(cor(ex)) ## [1] 7.95 vif(fit) #car 包 ## age sbp log10(wbc) ## 1.058 1.013 1.046 324sqrt(vif(fit)) > 2 ## age sbp log10(wbc) ## FALSE FALSE FALSE 一般来说 kappa 大于 1000,或 vif 大于 10 说明存在多重共线性,vif 开 平方是否大于 2,若大于 2,则存在多重共线性问题。本例中未发现存在多 重共线性。 7.2.2 模型比较 AIC(Akaike Information Criterion, 赤池信息准则) 也可以用来比较模 型, 它考虑了模型的统计拟合度以及用来拟合的参数数目。AIC 值越小的模 型要优先选择, 它说明模型用较少的参数获得了足够的拟合度。 fit2 <- lm(mtfc~age+sbp+wbc,data=ex) AIC(fit,fit2) ## df AIC ## fit 5 355.8 ## fit2 5 356.6 选择 AIC 值较小的模型 lm(mtfc~age+sbp+log10(wbc))。 尽管 log10(wbc) 回归系数最高,但并不代表 log10(wbc) 对 mtfc 的影 响最大,因为三个变量的单位不同。对于不同的单位,如果要衡量对因变量 大小的影响,需采用标准化回归系数。 lm.beta <- function(MOD) { b <- summary(MOD)$coef[-1, 1] sx <- sapply(MOD$model[-1], sd) sy <- sapply(MOD$model[1], sd) beta <- b * sx/sy return(beta) } lm.beta(fit) 325## age sbp log10(wbc) ## 0.2375 0.5441 0.2404 detach(ex) 尽管通过模型比较,获得了 lm(mtfc~age+sbp+log10(wbc)) 模型,模 型的回归诊断也能通过,但从决定系数来看自变量对因变量的解释程度并不 高。 7.3 逐步回归 实际中,影响因变量的自变量较多,对如何从自变量中选择若干个,得 到最佳的回归方程,在不同的准则下有不同的方法来获得最佳回归方程。对 于一个包含 n 个自变量的的回归问题,全部的回归模型将有 2n − 1 个。常 用的逐步方法有 “向前法”,“向后法”,“逐步法” 和 “最优子集法”。在 R 中, 通过 step() 函数的 direction = c(“both”, “backward”, “forward”) 选项分别 完成 “逐步回归法”、“向后法” 和 “向前法”。leaps 包可以完成全子集回归 法,leaps() 函数以 Cp 准则(默认)、校正 R2 和 R2 来选择全局最优模型。 例有 5 个自变量 x1 ~ x5 和 1 个因变量,请完成自变量的筛选。 x1<- c(7,1,11,11,7,11,3,1,2,21,1,11,10) x2<- c(26,29,56,31,52,55,71,31,54,47,40,66,68) x3<- c(6,15,8,8,6,9,17,22,18,4,23,9,8) x4<- c(60,52,20,47,33,22,6,44,22,26,34,12,12) y<- c(78.5,74.3,104.3,87.6,95.9,109.2,102.7,72.5, 93.1,115.9,83.8,113.3,109.4) df <- as.data.frame(cbind(x1,x2,x3,x4,y)) leapmodels <- leaps(x = cbind(x1,x2,x3,x4),y = y) plot(leapmodels$size, leapmodels$Cp) abline(0,1) cbind(leapmodels$size,leapmodels$which, leapmodels$Cp) ## 1 2 3 4 3262.0 2.5 3.0 3.5 4.0 4.5 5.0 0 50 100 200 300 leapmodels$size leapmodels$Cp 图 28: ## 1 2 0 0 0 1 138.731 ## 1 2 0 1 0 0 142.486 ## 1 2 1 0 0 0 202.549 ## 1 2 0 0 1 0 315.154 ## 2 3 1 1 0 0 2.678 ## 2 3 1 0 0 1 5.496 ## 2 3 0 0 1 1 22.373 ## 2 3 0 1 1 0 62.438 ## 2 3 0 1 0 1 138.226 ## 2 3 1 0 1 0 198.095 ## 3 4 1 1 0 1 3.018 ## 3 4 1 1 1 0 3.041 ## 3 4 1 0 1 1 3.497 ## 3 4 0 1 1 1 7.337 ## 4 5 1 1 1 1 5.000 选择 Cp 统计量最小的变量集合,本例中 Cp 统计量最小值所对应的变 量集合为 x1 和 x2。结果中 1 为选中,0 为未选中。 327subsets <- regsubsets(y~x1+x2+x3+x4,data=df) summary(subsets) ## Subset selection object ## Call: regsubsets.formula(y ~ x1 + x2 + x3 + x4, data = df) ## 4 Variables (and intercept) ## Forced in Forced out ## x1 FALSE FALSE ## x2 FALSE FALSE ## x3 FALSE FALSE ## x4 FALSE FALSE ## 1 subsets of each size up to 4 ## Selection Algorithm: exhaustive ## x1 x2 x3 x4 ## 1 ( 1 ) " " " " " " "*" ## 2 ( 1 ) "*" "*" " " " " ## 3 ( 1 ) "*" "*" " " "*" ## 4 ( 1 ) "*" "*" "*" "*" plot(subsets,scale="adjr2")# 基于调整 R 平方,不同子集大小的最佳模型 adjr2 (Intercept) x1 x2 x3 x4 0.64 0.97 0.97 0.98 图的顶部的图形便是最适合的模型,校正 R 平方值 0.98 最高,x1 和 x2 两 预测变量是最佳模型。也可以通过 Cp 统计量完成变量的选择。 328sbs<- regsubsets(y~x1+x2+x3+x4,data=df) subsets(sbs,legend=FALSE,statistic="cp", main="cp plot for all subsets regression") ## Abbreviation ## x1 x1 ## x2 x2 ## x3 x3 ## x4 x4 abline(1,1,lty=2,col="red")# 画截距项和斜率均为 1 的直线 1.0 1.5 2.0 2.5 3.0 3.5 4.0 0 20 40 60 80 120 cp plot for all subsets regression Subset Size Statistic: cp x4 x1−x2 x1−x2−x4 x1−x2−x3−x4 图 29: summary(sbs) ## Subset selection object ## Call: regsubsets.formula(y ~ x1 + x2 + x3 + x4, data = df) ## 4 Variables (and intercept) 329## Forced in Forced out ## x1 FALSE FALSE ## x2 FALSE FALSE ## x3 FALSE FALSE ## x4 FALSE FALSE ## 1 subsets of each size up to 4 ## Selection Algorithm: exhaustive ## x1 x2 x3 x4 ## 1 ( 1 ) " " " " " " "*" ## 2 ( 1 ) "*" "*" " " " " ## 3 ( 1 ) "*" "*" " " "*" ## 4 ( 1 ) "*" "*" "*" "*" Cp 图越好的模型离截距项和斜率均为 1 的直线越近,x1-x2、x1-x2-x4 和 x1-x2-x3-x4 均与直线比较接近,这三个模型根据 Cp 统计量结果类似。 fit <- lm(y~x1+x2+x3+x4,data=df) fit.step <- step(fit) # 基于 AIC ## Start: AIC=26.94 ## y ~ x1 + x2 + x3 + x4 ## ## Df Sum of Sq RSS AIC ## - x3 1 0.11 48.0 25.0 ## - x4 1 0.25 48.1 25.0 ## - x2 1 2.97 50.8 25.7 ## 47.9 26.9 ## - x1 1 25.95 73.8 30.6 ## ## Step: AIC=24.97 ## y ~ x1 + x2 + x4 ## ## Df Sum of Sq RSS AIC ## 48 25.0 ## - x4 1 10 58 25.4 330## - x2 1 27 75 28.7 ## - x1 1 821 869 60.6 summary(fit.step) ## ## Call: ## lm(formula = y ~ x1 + x2 + x4, data = df) ## ## Residuals: ## Min 1Q Median 3Q Max ## -3.092 -1.802 0.256 1.282 3.898 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) 71.648 14.142 5.07 0.00068 *** ## x1 1.452 0.117 12.41 0.00000058 *** ## x2 0.416 0.186 2.24 0.05169 . ## x4 -0.237 0.173 -1.37 0.20540 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 2.31 on 9 degrees of freedom ## Multiple R-squared: 0.982, Adjusted R-squared: 0.976 ## F-statistic: 167 on 3 and 9 DF, p-value: 0.0000000332 step() 函数通过 AIC 信息准则,删除了 x3 变量后 AIC 值最小 24.97, 得到 y ~ x1 + x2 + x4。回归系数的显著性检验水平有较大提升,但 x2 和 x4 的系数检验仍不理想。 drop1(fit.step) ## Single term deletions ## ## Model: 331## y ~ x1 + x2 + x4 ## Df Sum of Sq RSS AIC ## 48 25.0 ## x1 1 821 869 60.6 ## x2 1 27 75 28.7 ## x4 1 10 58 25.4 去掉 x4 后,AIC 值会上升到 25.42,残差的平方和会上升到 9.93,是 上升最少的。去掉 x4 后 lm.opt<-lm(y ~ x1+x2, data=df) summary(lm.opt) ## ## Call: ## lm(formula = y ~ x1 + x2, data = df) ## ## Residuals: ## Min 1Q Median 3Q Max ## -2.89 -1.57 -1.30 1.36 4.05 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) 52.5773 2.2862 23.0 0.00000000055 *** ## x1 1.4683 0.1213 12.1 0.00000026922 *** ## x2 0.6623 0.0459 14.4 0.00000005029 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 2.41 on 10 degrees of freedom ## Multiple R-squared: 0.979, Adjusted R-squared: 0.974 ## F-statistic: 230 on 2 and 10 DF, p-value: 0.00000000441 332gvlma(lm.opt) ## ## Call: ## lm(formula = y ~ x1 + x2, data = df) ## ## Coefficients: ## (Intercept) x1 x2 ## 52.577 1.468 0.662 ## ## ## ASSESSMENT OF THE LINEAR MODEL ASSUMPTIONS ## USING THE GLOBAL TEST ON 4 DEGREES-OF-FREEDOM: ## Level of Significance = 0.05 ## ## Call: ## gvlma(x = lm.opt) ## ## Value p-value Decision ## Global Stat 1.524426 0.822 Assumptions acceptable. ## Skewness 0.548421 0.459 Assumptions acceptable. ## Kurtosis 0.555911 0.456 Assumptions acceptable. ## Link Function 0.000406 0.984 Assumptions acceptable. ## Heteroscedasticity 0.419688 0.517 Assumptions acceptable. influence.measures(lm.opt) ## Influence measures of ## lm(formula = y ~ x1 + x2, data = df) : ## ## dfb.1_ dfb.x1 dfb.x2 dffit cov.r cook.d hat inf ## 1 -0.3880 -0.0625 0.3558 -0.428 1.535 0.0639 0.2512 ## 2 0.2597 -0.1375 -0.1649 0.291 1.719 0.0305 0.2619 ## 3 0.0563 -0.1000 -0.0754 -0.239 1.356 0.0202 0.1189 333## 4 -0.2993 -0.2256 0.3277 -0.439 1.491 0.0668 0.2422 ## 5 -0.0127 0.0244 -0.0480 -0.176 1.339 0.0111 0.0836 ## 6 -0.1410 0.3248 0.1961 0.742 0.488 0.1387 0.1151 ## 7 0.2147 0.2671 -0.4008 -0.495 1.867 0.0867 0.3618 ## 8 -0.4816 0.2850 0.2866 -0.558 1.327 0.1039 0.2412 ## 9 0.0288 -0.2733 0.1584 0.385 1.344 0.0510 0.1792 ## 10 -0.0239 0.8515 -0.2205 0.919 2.442 0.2903 0.5500 * ## 11 0.4911 -0.5201 -0.1450 0.769 0.781 0.1695 0.1840 ## 12 -0.1058 0.0430 0.1278 0.189 1.627 0.0131 0.1967 ## 13 0.4379 -0.0667 -0.5607 -0.744 0.949 0.1672 0.2142 sqrt(vif(lm.opt)) > 2 ## x1 x2 ## FALSE FALSE 检验结果显著,回归诊断和多重共线性均通过,影响分析中只发现有一 个异常点。因为全子集回归考虑了更多模型,全子集回归要优于逐步回归, 但当自变量个数较多时,全子集回归较慢。一般来所,变量的自动筛选应建 立在背景知识理解基础上进行,防止出现拟合效果好,但没有实际意义的模 型。 7.4 交叉验证 就是按一定比例将原始数据按照拆分成训练集和测试集,现在训练集上 获取回归方程,然后在测试集上做预测。由于测试集不涉及模型参数的选择, 该样本可获得比新数据获得更为精确的估计。k 重交叉验证中,样本被分为 k 个子样本,轮流将 k − 1 个子样本作为训练集,另外 1 个样本作为测试集。 通过获得 k 个预测方程,记录 k 个测试集的预测结果,然后求其平均值。 shrinkage<-function(fit,k=5){ require(bootstrap) theta.fit<-function(x,y){lsfit(x,y)} theta.predict<-function(fit,x){cbind(1,x)%*%fit$coef} x<-fit$model[,2:ncol(fit$model)] 334y<-fit$model[,1] results<-crossval(x,y,theta.fit,theta.predict,ngroup=k) r2<-cor(y,fit$fitted.values)^2 r2cv<-cor(y,results$cv.fit)^2 cat("Original R-square=",r2,"\n") cat(k,"Fold Cross-Validated R-square=",r2cv,"\n") cat("Change=",r2-r2cv,"\n") } fit <- lm(y~x1+x2,data=df) shrinkage(fit) ## Original R-square= 0.9787 ## 5 Fold Cross-Validated R-square= 0.962 ## Change= 0.01672 获得原始 R 平方为 0.9786, 交叉验证后的 R 平方为 0.9962(基于 Boot- Strap 方法,每次运行结果会有不同)。R 平方减少得越少,预测越精准。 7.5 相对重要性 评价自变量相对重要性,最简单的方法为比较标准化的回归系数,它表 示当其他自变量不变时,该自变量变化 1 个单位引起的因变量的变化。前 面通过 lm.beta() 函数获得了标准化的回归系数。基于相对权重的重要性测 量,是对所有可能自模型添加一个自变量引起的 R 平方平均增加量的一个 近似值,比标准化回归系数更为直观。 relweights<-function(fit,...){ R<-cor(fit$model) nvar<-ncol(R) rxx<-R[2:nvar,2:nvar] rxy<-R[2:nvar,1] svd<-eigen(rxx) evec<-svd$vectors ev<-svd$values 335delta<-diag(sqrt(ev)) lambda<-evec%*%delta%*%t(evec) lambdasq<-lambda^2 beta<-solve(lambda)%*%rxy rsquare<-colSums(beta^2) rawwgt<-lambdasq%*%beta^2 import<-(rawwgt/rsquare)*100 lbls<-names(fit$model[2:nvar]) rownames(import)<-lbls colnames(import)<-"Weight" barplot(t(import),names.arg=lbls, ylab="% of R-Square", xlab="Predictor Variables", main="Relative Importance of Predictor Variables", sub=paste("R-Square=",round(rsquare,digits=3)),...) return(import) } fit <- lm(y~x1+x2,data=df) relweights(fit,col="lightgrey") ## Weight ## x1 43.24 ## x2 56.76 可以看到 x2 解释了 56.7% 的 R 平方,x1 解释了 43.2 的平方,x2 相 比 x1 更为重要。 7.6 分位数回归 传统的线性回归模型描述了因变量的条件均值分布受自变量的影响过 程。最小二乘法是估计回归系数的最常用的方法。如果模型的随机误差项来 自均值为零、方差相同的分布,那么模型回归系数的最小二乘估计为最佳线 性无偏估计(BLUE);如果随机误差项是正态分布,那么模型回归系数的 最小二乘估计与极大似然估计一致,均为最小方差无偏估计(MVUL)。分 336x1 x2 Relative Importance of Predictor Variables R−Square= 0.979 Predictor Variables % of R−Square 0 10 20 30 40 50 图 30: 位数回归 (Quantile Regression) 利用解释变量的多个分位数(例如四分位、 十分位、百分位等)来得到被解释变量的条件分布的相应的分位数方程。与 传统的 OLS 只得到均值方程相比,它可以更详细地描述变量的统计分布。 在数据出现尖峰或厚尾的分布、存在显著的异方差等情况,传统的线性回归 模型的假设常常不被满足,最小二乘法估计将不再具有上述优良性且稳健性 非常差。最小二乘回归假定自变量只能影响因变量的条件分布的位置,但不 能影响其分布的刻度或形状的任何其他方面。分位数回归依据因变量的条 件分位数对自变量进行回归,这样得到了所有分位数下的回归模型。因此分 位数回归相比普通最小二乘回归只能描述自变量对于因变量局部变化的影 响而言,更能精确地描述自变量对于因变量的变化范围以及条件分布形状的 影响。分位数回归能够捕捉分布的尾部特征,当自变量对不同部分的因变量 的分布产生不同的影响时.例如出现左偏或右偏的情况时。它能更加全面的 刻画分布的特征,从而得到全面的分析,而且其分位数回归系数估计比 OLS 回归系数估计更稳健。 例 quantreg 包中自带数据集 engel 描述了食物支出与家庭收入之间关 系,其数据格式如下,请完成分位数回归。 337data(engel,package = "quantreg") pander(head(engel)) income foodexp 420.2 255.8 541.4 311 901.2 485.7 639.1 403 750.9 495.6 945.8 633.8 # 进行分位数回归 fit = rq(foodexp ~ income, tau = c(0.1,0.25,0.5,0.75,0.9), data = engel,method = "br") summary(fit) ## ## Call: rq(formula = foodexp ~ income, tau = c(0.1, 0.25, 0.5, 0.75, ## 0.9), data = engel, method = "br") ## ## tau: [1] 0.1 ## ## Coefficients: ## coefficients lower bd upper bd ## (Intercept) 110.1416 79.8875 146.1887 ## income 0.4018 0.3421 0.4508 ## ## Call: rq(formula = foodexp ~ income, tau = c(0.1, 0.25, 0.5, 0.75, ## 0.9), data = engel, method = "br") ## ## tau: [1] 0.25 ## 338## Coefficients: ## coefficients lower bd upper bd ## (Intercept) 95.4835 73.7861 120.0985 ## income 0.4741 0.4203 0.4943 ## ## Call: rq(formula = foodexp ~ income, tau = c(0.1, 0.25, 0.5, 0.75, ## 0.9), data = engel, method = "br") ## ## tau: [1] 0.5 ## ## Coefficients: ## coefficients lower bd upper bd ## (Intercept) 81.4822 53.2591 114.0116 ## income 0.5602 0.4870 0.6020 ## ## Call: rq(formula = foodexp ~ income, tau = c(0.1, 0.25, 0.5, 0.75, ## 0.9), data = engel, method = "br") ## ## tau: [1] 0.75 ## ## Coefficients: ## coefficients lower bd upper bd ## (Intercept) 62.3966 32.7449 107.3136 ## income 0.6440 0.5802 0.6904 ## ## Call: rq(formula = foodexp ~ income, tau = c(0.1, 0.25, 0.5, 0.75, ## 0.9), data = engel, method = "br") ## ## tau: [1] 0.9 ## ## Coefficients: ## coefficients lower bd upper bd ## (Intercept) 67.3509 37.1180 103.1740 339## income 0.6863 0.6494 0.7422 # 通过设置参数 se,可以得到系数的假设检验 summary(fit, se = "nid") ## ## Call: rq(formula = foodexp ~ income, tau = c(0.1, 0.25, 0.5, 0.75, ## 0.9), data = engel, method = "br") ## ## tau: [1] 0.1 ## ## Coefficients: ## Value Std. Error t value Pr(>|t|) ## (Intercept) 110.14157 29.39768 3.74661 0.00023 ## income 0.40177 0.04024 9.98420 0.00000 ## ## Call: rq(formula = foodexp ~ income, tau = c(0.1, 0.25, 0.5, 0.75, ## 0.9), data = engel, method = "br") ## ## tau: [1] 0.25 ## ## Coefficients: ## Value Std. Error t value Pr(>|t|) ## (Intercept) 95.48354 21.39237 4.46344 0.00001 ## income 0.47410 0.02906 16.31729 0.00000 ## ## Call: rq(formula = foodexp ~ income, tau = c(0.1, 0.25, 0.5, 0.75, ## 0.9), data = engel, method = "br") ## ## tau: [1] 0.5 ## ## Coefficients: ## Value Std. Error t value Pr(>|t|) ## (Intercept) 81.48225 19.25066 4.23270 0.00003 340## income 0.56018 0.02828 19.81032 0.00000 ## ## Call: rq(formula = foodexp ~ income, tau = c(0.1, 0.25, 0.5, 0.75, ## 0.9), data = engel, method = "br") ## ## tau: [1] 0.75 ## ## Coefficients: ## Value Std. Error t value Pr(>|t|) ## (Intercept) 62.39659 16.30538 3.82675 0.00017 ## income 0.64401 0.02324 27.71244 0.00000 ## ## Call: rq(formula = foodexp ~ income, tau = c(0.1, 0.25, 0.5, 0.75, ## 0.9), data = engel, method = "br") ## ## tau: [1] 0.9 ## ## Coefficients: ## Value Std. Error t value Pr(>|t|) ## (Intercept) 67.35087 22.39538 3.00736 0.00292 ## income 0.68630 0.02849 24.08853 0.00000 plot(fit) 3410.2 0.4 0.6 0.8 60 100 140 (Intercept) 0.2 0.4 0.6 0.8 0.40 0.55 income tau 表示计算多个分位点的分位数回归结果,如 tau = c(0.25,0.5,0.75) 是同 时计算 25%、50%、75% 分位数下的回归结果。method:进行拟合的方法, 取值包括:默认值 “br”,表示 Barrodale & Roberts 算法的修改版;“fn”, 针对大数据可以采用的 Frisch–Newton 内点算法;“pfn”,针对特别大数据, 使用经过预处理的 Frisch–Newton 逼近方法;“fnc”,针对被拟合系数特殊 的线性不等式约束情况;“lasso” 和 “scad”,基于特定惩罚函数的平滑算法 进行拟合。se = “rank”: 按照 Koenker(1994) 的排秩方法计算得到的置信 区间,默认残差为独立同分布。注意的是,上下限是不对称的。se=”iid”: 假设残差为独立同分布,用 KB(1978)的方法计算得到近似的协方差矩 阵。se = “nid”: 表示按照 Huber 方法逼近得到的估计量。se=”ker”: 采用 Powell(1990) 的核估计方法。se=”boot”: 采用 bootstrap 方法自助抽样的 方法估计系数的误差标准差。 7.6.1 穷人和富人的消费比较 data(engel,package = "quantreg") #tau 不再 [0,1] 时,表示按最细分位点划分 z=rq(foodexp~income,tau=-1,data = engel) x.poor=quantile(income,0.1)#10% 分位点的收入,穷人 342x.rich=quantile(income,0.9)#90% 分位点的收入,富人 ps=z$sol[1,] # 每个分位点的 tau 值 qs.poor=c(c(1,x.poor)%*%z$sol[4:5,]) # 穷人的消费估计值 qs.rich=c(c(1,x.rich)%*%z$sol[4:5,]) # 富人的消费估计值 par(mfrow=c(1,2)) # type=”n”表示初始化图形区域,但不画图 plot(c(ps,ps),c(qs.poor,qs.rich),type="n", xlab=expression(tau), ylab="quantile") plot(stepfun(ps,c(qs.poor[1],qs.poor)), do.points=F, add=T) plot(stepfun(ps,c(qs.poor[1],qs.rich)), do.points=F, add=T, col.hor="gray", col.vert="gray") ps.wts = ( c(0,diff(ps)) + c(diff(ps),0) )/2 ap = akj(qs.poor, z=qs.poor, p=ps.wts) ar = akj(qs.rich, z=qs.rich, p=ps.wts) plot(c(qs.poor,qs.rich), c(ap$dens, ar$dens), type="n", xlab="Food Expenditure", ylab="Density") lines(qs.rich,ar$dens,col="gray") lines(qs.poor,ap$dens,col="black") legend("topright", c("poor","rich"), lty=c(1,1), col=c("black","gray")) par(mfrow=c(1,1)) 穷人和富人的食品消费支出有明显的不同,穷人在不同分位点食品消费 支出差别不大,富人不同分位点食品消费支出差别较大。右图表示,穷人消 费支出集中于 400 左右,富人消费支出集中于 800 ~ 1200。 7.6.2 模型比较 3430.0 0.2 0.4 0.6 0.8 1.0 5000 10000 15000 τ quantile 5000 10000 0.0000 0.0004 0.0008 0.0012 Food Expenditure Density poor rich 图 31: # 比较不同分位点下,收入对食品支出的影响机制是否相同 fit1 = rq(foodexp ~ income, tau = 0.25, data = engel) fit2 = rq(foodexp ~ income, tau = 0.5, data = engel) fit3 = rq(foodexp ~ income, tau = 0.75, data = engel) anova(fit1,fit2,fit3) ## Quantile Regression Analysis of Deviance Table ## ## Model: foodexp ~ income ## Joint Test of Equality of Slopes: tau in { 0.25 0.5 0.75 } ## ## Df Resid Df F value Pr(>F) ## 1 2 703 15.6 0.00000024 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 P 值远小于 0.05,故不同分位点下收入对食品支出的影响机制不同。 不同分位点拟合曲线比较 344plot(engel$income,engel$foodexp,cex=0.25,type = "n", xlab = "Household Income",ylab = "Food Expenditure") points(engel$income,engel$foodexp,cex=0.5,col="blue") abline(rq(foodexp~income,tau = 0.5,data=engel),col="blue") abline(lm(foodexp~income,data=engel),lty=2,col="red") taus=c(0.1,0.25,0.75,0.9) for(i in 1:length(taus)){ abline(rq(foodexp~income,tau=taus[i],data = engel),col="gray") } 1000 2000 3000 4000 5000 500 1000 1500 2000 Household Income Food Expenditure 图 32: 7.6.3 残差形态检验 # 位值漂移模型:不同分位点估计结果之间的斜率相同或相近,截距不同 KhmaladzeTest(foodexp ~ income, data = engel, taus = seq(.05,.95,by = .01),nullH = "location") ## taus: 0.05 0.06 0.07 0.08 0.09 0.1 0.11 0.12 0.13 0.14 0.15 0.16 0.17 0.18 0.19 0.2 0.21 0.22 0.23 0.24 0.25 0.26 0.27 0.28 0.29 0.3 0.31 0.32 0.33 0.34 0.35 0.36 0.37 0.38 0.39 0.4 0.41 0.42 0.43 0.44 0.45 0.46 0.47 0.48 0.49 0.5 0.51 0.52 0.53 0.54 0.55 0.56 0.57 0.58 0.59 0.6 0.61 0.62 0.63 0.64 0.65 0.66 0.67 0.68 0.69 0.7 0.71 0.72 0.73 0.74 0.75 0.76 0.77 0.78 0.79 0.8 0.81 0.82 0.83 0.84 0.85 0.86 0.87 0.88 0.89 0.9 0.91 0.92 0.93 0.94 0.95 ## $nullH 345## [1] "location" ## ## $Tn ## [1] 1.515 ## ## $THn ## [1] 1.515 ## ## attr(,"class") ## [1] "KhmaladzeTest" KhmaladzeTest(foodexp ~ income, data = engel, taus = seq(.05,.95,by = .01),nullH = "location",se="ker") ## taus: 0.05 0.06 0.07 0.08 0.09 0.1 0.11 0.12 0.13 0.14 0.15 0.16 0.17 0.18 0.19 0.2 0.21 0.22 0.23 0.24 0.25 0.26 0.27 0.28 0.29 0.3 0.31 0.32 0.33 0.34 0.35 0.36 0.37 0.38 0.39 0.4 0.41 0.42 0.43 0.44 0.45 0.46 0.47 0.48 0.49 0.5 0.51 0.52 0.53 0.54 0.55 0.56 0.57 0.58 0.59 0.6 0.61 0.62 0.63 0.64 0.65 0.66 0.67 0.68 0.69 0.7 0.71 0.72 0.73 0.74 0.75 0.76 0.77 0.78 0.79 0.8 0.81 0.82 0.83 0.84 0.85 0.86 0.87 0.88 0.89 0.9 0.91 0.92 0.93 0.94 0.95 ## $nullH ## [1] "location" ## ## $Tn ## [1] 1.336 ## ## $THn ## [1] 1.336 ## ## attr(,"class") ## [1] "KhmaladzeTest" # 位置-尺度漂移模型:不同分位点估计结果斜率和截距都不同 KhmaladzeTest(foodexp ~ income, data = engel, taus = seq(.05,.95,by = .01),nullH = "location-scale") ## taus: 0.05 0.06 0.07 0.08 0.09 0.1 0.11 0.12 0.13 0.14 0.15 0.16 0.17 0.18 0.19 0.2 0.21 0.22 0.23 0.24 0.25 0.26 0.27 0.28 0.29 0.3 0.31 0.32 0.33 0.34 0.35 0.36 0.37 0.38 0.39 0.4 0.41 0.42 0.43 0.44 0.45 0.46 0.47 0.48 0.49 0.5 0.51 0.52 0.53 0.54 0.55 0.56 0.57 0.58 0.59 0.6 0.61 0.62 0.63 0.64 0.65 0.66 0.67 0.68 0.69 0.7 0.71 0.72 0.73 0.74 0.75 0.76 0.77 0.78 0.79 0.8 0.81 0.82 0.83 0.84 0.85 0.86 0.87 0.88 0.89 0.9 0.91 0.92 0.93 0.94 0.95 ## $nullH 346## [1] "location-scale" ## ## $Tn ## [1] 0.7097 ## ## $THn ## [1] 0.7097 ## ## attr(,"class") ## [1] "KhmaladzeTest" KhmaladzeTest(foodexp ~ income, data = engel, taus = seq(.05,.95,by = .01),nullH = "location-scale",se="ker") ## taus: 0.05 0.06 0.07 0.08 0.09 0.1 0.11 0.12 0.13 0.14 0.15 0.16 0.17 0.18 0.19 0.2 0.21 0.22 0.23 0.24 0.25 0.26 0.27 0.28 0.29 0.3 0.31 0.32 0.33 0.34 0.35 0.36 0.37 0.38 0.39 0.4 0.41 0.42 0.43 0.44 0.45 0.46 0.47 0.48 0.49 0.5 0.51 0.52 0.53 0.54 0.55 0.56 0.57 0.58 0.59 0.6 0.61 0.62 0.63 0.64 0.65 0.66 0.67 0.68 0.69 0.7 0.71 0.72 0.73 0.74 0.75 0.76 0.77 0.78 0.79 0.8 0.81 0.82 0.83 0.84 0.85 0.86 0.87 0.88 0.89 0.9 0.91 0.92 0.93 0.94 0.95 ## $nullH ## [1] "location-scale" ## ## $Tn ## [1] 0.6225 ## ## $THn ## [1] 0.6225 ## ## attr(,"class") ## [1] "KhmaladzeTest" Tn 表示模型整体检验,THn 表示每个自变量的检验。位值漂移模型的 Tn 值比位置-尺度漂移模型的 Tn 值大,拒绝位值漂移模型的概论较大,位 值-尺度漂移模型更加合适。 7.6.4 分位数回归的分解 分位数分解法对各个影响因素进行分解分析 347# MM2005 分位数分解的函数 MM2005 = function(formu,taus, data, group, pic=F){ # furmu 为方程,如 foodexp~income # taus 为不同的分位数 # data 总的数据集 # group 分组指标,是一个向量,用于按行区分 data # pic 是否画图,如果分位数比较多,建议不画图 engel1 = data[group==1,] engel2 = data[group==2,] # 开始进行分解 fita = summary( rq(formu, tau = taus, data = engel1 ) ) fitb = summary( rq(formu, tau = taus, data = engel2 ) ) tab = matrix(0,length(taus),4) colnames(tab) = c(" 分位数"," 总差异"," 回报影响"," 变量影响") rownames(tab) = rep("",dim(tab)[1]) for( i in 1:length(taus) ){ ya = cbind(1,engel1[,names(engel1)!=formu[[2]]] ) %*% fita[[i]]$coef[,1] yb = cbind(1,engel2[,names(engel2)!=formu[[2]]] ) %*% fitb[[i]]$coef[,1] # 这里以 group==1 为基准模型,用 group==2 的数据计算反常规模型拟合值 ystar = cbind(1,engel2[,names(engel2)!=formu[[2]]] ) %*% fita[[i]]$coef[,1] ya = mean(ya) yb = mean(yb) ystar = mean(ystar) tab[i,1] = fita[[i]]$tau tab[i,2] = yb - ya # 回报影响,数据相同,模型不同:模型机制的不同所产生的差异 tab[i,3] = yb - ystar # 变量影响,数据不同,模型相同:样本点不同产生的差异 tab[i,4] = ystar - ya } # 画图 348if( pic ){ attach(engel) windows(5,5) plot(income, foodexp, cex=0.5, type="n", main=" 两组分位数回归结果比较") points(engel1, cex=0.5, col=2) points(engel2, cex=0.5, col=3) for( i in 1:length(taus) ){ abline( fita[[i]], col=2 ) abline( fitb[[i]], col=3 ) } detach(engel) } # 输出结果 tab } data(engel,package = "quantreg") group = c(rep(1,100),rep(2,135)) # 取前 100 个为第一组,后 135 个第二组 taus = c(0.05,0.25,0.5,0.75,0.95)# 需要考察的不同分位点 MM2005(foodexp~income, taus, data = engel, group=group, pic=F) ## 分位数 总差异 回报影响 变量影响 ## 0.05 -30.452 -72.36 41.91 ## 0.25 -2.017 -46.20 44.18 ## 0.50 30.941 -23.24 54.18 ## 0.75 43.729 -15.76 59.49 ## 0.95 52.779 -11.30 64.08 3498 广义线性模型 广义线性模型(GLM)是正态线性模型的直接推广,使用于连续数据 和离散数据。广义线性模型通过链接函数,将因变量的期望与线性自变量相 联系,通过误差函数描述误差的分布,使得许多线性模型的方法能被用于一 般的问题。下表为广义线性模型中常见的链接函数和误差函数。 连接函数 典型误差函数 恒等 xT β = E(y) 正态分布 对数 xT β = lnE(y) Poisson 分布 Logit xT β = logitE(y) 二项分布 逆 xT β = 1 E(y) Gamma 分布 R 中常用的分布族和连接函数见下表 分布族 连接函数 默认连接函数 binomial logit,probit,cloglog link=“logit” gaussian identity link=“identity” Gamma identity,inverse,log link=“inverse” inverse.gaussian 1/muˆ2 link=“1/muˆ2”“ poisson identity,log,sqrt link=“log”“ quasi logit,probit,cloglog,identity, link=“identity”,variance=“constant” inverse,log,1/muˆ2,sqrt R 中通过 glm(formula, family=family.generator,data=data.frame) 函 数用来做广义线性回归。正态分布族的使用方法:glm(formula, family = gaussian(link = identity),data = data.frame) , link 指定了连接函数,正态 分布族的连接函数缺省值是恒等的,link = identity 可以不写。分布族缺省值 是正态分布,family = gaussian 也可以不写。glm(formula,data=data.frame) 与 lm(formula,data=data.frame) 等价。本章重点关注常用的两种模型:Lo- gistic 回归和 Poisson 回归。 3508.1 Logistic 回归 因变量为二分类或多分类时,Logistics 回归是非常重要的模型。Logistics 回归由于对资料的正态性和方差齐性不做要求、对自变量类型也不做要求 等,使得 Logistic 回归模型在医学研究各个领域被广泛用,可探索某疾病的 危险因素,根据危险因素预测某疾病发生的概率,等等。例如,想探讨胃癌 发生的危险因素,可以选择两组人群,一组是胃癌组,一组是非胃癌组,两 组人群肯定有不同的体征和生活方式等。这里的因变量就是是否胃癌,即 “是” 或 “否”,为两分类变量,自变量就可以包括很多了,例如年龄、性别、 饮食习惯、幽门螺杆菌感染等。自变量既可以是连续的,也可以是分类的。 通过 logistic 回归分析,就可以大致了解到底哪些因素是胃癌的危险因素。 Logistics 回归模型的表达形式为 logit(P) = ln(P 1 − P) = β0 + β1X1 + β2X2 + ··· + βpXp P 为暴露于某种状态下的结局概率。logit(P) 是一种变量变换方式,表示 对 P 进行 logit 变换。betai 为偏回归系数,表示在其他自变量不变的条件 下,Xi 每变化一个单位 logit(P) 的估计值。对 P 进行了 logit(P) 变换后, ln(P 1−P) 的值可以取任意值。Logistics 回归是通过最大似然估计(maximum likelihood estimation,MLE)求解常数项和偏回归系数, 基本思想时当从总 体中随机抽取 n 个样本后,最合理的参数估计量应该使得这 n 个样本观测 值的概率最大。最大似然法的基本思想是先建立似然函数与对数似然函数, 再通过使对数似然函数最大求解相应的参数值,所得到的估计值称为参数的 最大似然估计值。 在 R 语言中,进行 logistic 回归的命令是通过广义线性模型进行的:fm <- glm(formula, family = binomial(link = logit),data=data.frame) 。Logistic 回归的基本方法是极大似然方法,其前提是样本较大。在样本量较小、数据 结构较偏时,可以用精确 Logistic 回归(Exact logistic regression)来解决 这一问题,该方法通过建立条件似然函数,进一步求出参数的充分统计量的 分布函数。随着计算方法的发展和优化,也出现了使用马尔可夫链蒙特卡罗 算法来模拟精确 Logistic 回归。R 语言中的 elrm 包就可以实现这种算法。 glm() 拟合二项模型时对于因变量,如果是向量,则假定操作二元(binary) 数据,因此要求是 0/1 向量。如果因变量是双列矩阵,则假定第一列为试验 成功的次数第二列为试验失败的次数。如果因变量是因子,则第一水平作为 失败 (0) 考虑而其他的作为 ‘成功’(1) 考虑。 3518.1.1 单因素 Logistics 回归 某项研究观察一种基因对于胃癌的诊断价值,选择了 115 名胃癌患者 和 115 名非胃癌患者,检测他们的基因表达状态,欲分析该基因对胃癌是否 有一定的诊断价值。 胃癌 基因 + 基因- 是 50 65 否 4 111 本例研究的因变量为二分类变量,分析基因的影响可以用 χ2 和 Logis- tics 回归。 x<-c(50, 4, 65, 111) dim(x)<-c(2,2) chisq.test(x,correct = FALSE) ## ## Pearson's Chi-squared test ## ## data: x ## X-squared = 51, df = 1, p-value = 0.0000000000008 P 值较小,可以认为该基因对胃癌的诊断具有统计学意义。 # 将表转化为扁平格式 table2flat <- function(mytable){ df <- as.data.frame(mytable) rows <- dim(df)[1] cols <- dim(df)[2] x <- NULL for(i in 1:rows){ for(j in 1:as.integer(as.character(df$Freq[i]))){ row <- df[i,c(1:(cols-1))] x <- rbind(x,row) 352} } row.names(x) <- c(1:dim(x)[1]) return(x) } gene <- rep(c(1,0),times=2) cancer <- rep(c("0","1"),each=2) Freq <- c(50,4,65,111) mytable <- as.data.frame(cbind(gene,cancer,Freq)) mydata <- table2flat(mytable) # 绘制条件密度图,查看线性关系 cdplot(cancer~gene,data=mydata) gene cancer 1.2 1.4 1.6 1.8 0 1 0.0 0.2 0.4 0.6 0.8 1.0 图 33: fit.glm<- glm(cancer~gene,family = binomial, data = mydata) summary(fit.glm) ## 353## Call: ## glm(formula = cancer ~ gene, family = binomial, data = mydata) ## ## Deviance Residuals: ## Min 1Q Median 3Q Max ## -2.592 0.266 0.266 1.068 1.068 ## ## Coefficients: ## Estimate Std. Error z value Pr(>|z|) ## (Intercept) 3.323 0.509 6.53 0.000000000066 *** ## gene1 -3.061 0.543 -5.64 0.000000016875 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## (Dispersion parameter for binomial family taken to be 1) ## ## Null deviance: 250.70 on 229 degrees of freedom ## Residual deviance: 192.19 on 228 degrees of freedom ## AIC: 196.2 ## ## Number of Fisher Scoring iterations: 6 8.1.1.1 回归诊断 8.1.1.1.1 拟合优度(goodness of fit) 拟合优度度量的是预测值和观测值之间的总体一致性。但是在评价模 型时,实际上测量的是预测值和观测值之间的差别,也就是实际上检测的是 模型预测的 “劣度” 不是” 优度 “,即拟合不佳检验(lack of fit test)常用的 两个指标是 Hosmer-Lemeshow 指标(HL)和信息测量指标(information measure)(IM). Hosmer Lemeshow 拟合优度指标 (通常简写为 H-L), 对应 的统计假设 H0 是预测值概率和观测值之间无显著差异,所以如果 HL 指标 显示较大的 P-value,说明统计结果不显著,因此,不能拒绝关于模型拟合 数据很好的假设,换句话说,模型很好的拟合了数据。IM 指标中比较常用 的是 AIC,在其他条件不变的情况下,较小的 AIC 值表示拟合模型较好。 3548.1.1.1.2 模型卡方统计(model chi-square statistic) 模型卡方统计检测的是模型中所包含的统计量对因变量有显著的解释 能力,也就是说所设模型比零假设模型(即只包含常数项的模型)要好,在 多元线性回归和 ANOVA 中,常用 F 检验达到目的。在 logistic 中用似然 比检验(likelihood ratio test), 相当于 F 检验。需要注意的是,模型卡方 值和拟合优度是两个完全不同的概念:模型卡方值度量的是自变量是否与 因变量的 odds 自然对数线性相关,而拟合优度度量的是预测值与观测值之 间的一致性。所以按照理想情况,最好是模型的卡方检验统计性显著而拟合 优度的统计性不显著。如果发生不一致,实践中更优先关注前者。 8.1.1.1.3 预测准确性 模型卡方统计关注的只是对于零假设模型而言,所设模型显著不显著, 它只是从总体上考虑了模型的显著性,但是所有 X 变量到底能解释多少 Y 变量的波动?这是预测准确性的问题,有两种方法:(1) 类 RSQUARE 指 标:在线性回归中,可以用 RSQUARE 来度量,显然 RSQUARE 越高说 明预测越好,在 logistic 中,也有类似的指标。logistic 中的 RSQUARE 也 有许多重要的性质:与经典的 RSQUARE 定义一致,它可以被理解为 Y 变 异中被解释的比例。(2)AUC 值 (C 统计量):拟合优度只是给出了观测值和 预测概率直接的差别程度,然后给出了一个总体评价的指标,但是在实际应 用中,往往更关心观测值和模型预测的条件事件概率的关联强度,这类指标 被称为序列相关指标,指标值越高,表示预测概率与观测反应变量直接的关 联越密切。通常用 ROC 图来和 ROC 图的曲线下面积(AUC)进行,AUC 可以定量地评价模型的效果,AUC 越大则模型效果越好。ROC 曲线下的面 积值在 1.0 和 0.5 之间。在 AUC>0.5 的情况下,AUC 越接近于 1,说明诊 断效果越好。AUC 在 0.5 ~ 0.7 时有较低准确性,AUC 在 0.7 ~ 0.9 时有 一定准确性,AUC 在 0.9 以上时有较高准确性。AUC=0.5 时,说明诊断方 法完全不起作用,无诊断价值。AUC<0.5 不符合真实情况,在实际中极少 出现。大于或等于 0.75 一般认为认为模型是可靠的。 ROC(receiver operating characteristic curve,受试者工作特征曲线) 曲线,横轴是 1-Specificity(特异度),纵轴是 Sensitivity(灵敏度)。45 度 线是作为参照(baseline model)出现的,就是说,ROC 的好坏,乃是跟 45 度线相比的。选择最佳的诊断界限值。ROC 曲线越靠近左上角, 试验的准确 性就越高。最靠近左上角的 ROC 曲线的点是错误最少的最好阈值,其假阳 性和假阴性的总数最少。两种或两种以上不同诊断试验对疾病识别能力的 355比较。在对同一种疾病的两种或两种以上诊断方法进行比较时,可将各试验 的 ROC 曲线绘制到同一坐标中,以直观地鉴别优劣,靠近左上角的 ROC 曲线所代表的受试者工作最准确。亦可通过分别计算各个试验的 ROC 曲线 下的面积 (AUC) 进行比较,哪一种试验的 AUC 最大,则哪一种试验的诊 断价值最佳。 对于 0-1 变量的二分类问题,分类的最终结果可以用表格表示为: 预测值 0 预测值 1 实际值 0 a b 实际值 1 c d 其中,d 是 “实际为 1 而预测为 1” 的样本个数,c 是 “实际为 1 而预测为 0” 的样本个数,其余依此类推。显然地,主对角线所占的比重越大,则预测 效果越佳,这也是一个基本的评价指标——总体准确率 (a+d)/(a+b+c+d)。 TPR(真阳性率、灵敏度):True Positive Rate,将实际的 1 正确地预测为 1 的概率,d/(c+d)。FPR:False Positive Rate(假阳性率,1-特异度),将实 际的 0 错误地预测为 1 的概率,b/(a+b)。TPR 与 FPR 相互影响的重要因 素就是 “阈值”。当阈值为 0 时,所有的样本都被预测为正例,因此 TPR=1, 而 FPR=1。此时的 FPR 过大,无法实现分类的效果。随着阈值逐渐增大, 被预测为正例的样本数逐渐减少,TPR 和 FPR 各自减小,当阈值增大至 1 时,没有样本被预测为正例,此时 TPR=0,FPR=0。 统计量最为关注的是 AUC 值,其次是似然卡方统计量,然后才是 HL 统计量,对 AIC 和 RSQUARE 极少关注,这一点和多元线性回归有很大的 不同,根本原因是多元线性回归是一个预测模型,目标变量的值具有实际的 数值意义;而 logistic 是一个分类模型,目标变量的值是一个分类标识,因 此更关注观测值和预测值之间的相对一致性,而不是绝对一致性。 rms 包 lrm() 函数可以计算相关统计量。 model <- lrm(cancer~gene,data=mydata) #Nagelkerke 等其他拟合优度指标 goodfit <- function(glmFit) { N <- nobs(glmFit) 356glm0 <- update(glmFit, . ~ 1) LLf <- logLik(glmFit) LL0 <- logLik(glm0) McFadden <- as.vector(1 -(LLf / LL0)) CoxSnell <- as.vector(1 - exp((2/N) * (LL0 - LLf))) Nagelkerke <- as.vector((1 - exp((2/N) * (LL0 - LLf))) / (1 - exp(LL0)^(2/N))) result <- list(McFadden=McFadden, CoxSnell= CoxSnell,Nagelkerke=Nagelkerke) return (result) } model$stats ## Obs Max Deriv Model L.R. ## 230.00000000000000000 0.00000221245670373 58.50576498474717368 ## d.f. PC ## 1.00000000000000000 0.00000000000002032 0.77830387205387208 ## Dxy Gamma Tau-a ## 0.55660774410774416 0.91049913941480209 0.20087336244541484 ## R2 Brier g ## 0.33836250645977639 0.13965973534971662 1.53711862579943825 ## gr gp ## 4.65116918579492644 0.20087335278403159 goodfit(fit.glm) ## $McFadden ## [1] 0.2334 ## ## $CoxSnell ## [1] 0.2246 ## 357## $Nagelkerke ## [1] 0.3384 AUC 值(C 统计量)为 0.778,可以认为模型比较可靠。似然比检验 结果比较显著,观测值和预测值的一致性有差异。HL 统计量, 在多因素统 计中予以计算。Deducer 包 rocplot 可以绘制 ROC 曲线并计算 AUC 值。 CoxSnellR2 系数与线性回归分析中的决定系数 R2 有相似指出,也是回归方 程对因变量变异解释程度的反应,由于 CoxSnellR2 系数取值范围不易确定, 不易直接判断拟合效果。NagelkerkeR2 系数是对 CoxSnellR2 的修正,取值 范围在 0~1 之间,越接近于 1,说明模型的拟合优度越高。但对 Logistic 回 归而言,伪决定系数不像线性回归中决定系数那么重要。 rocplot(fit.glm) AUC= 0.7783 0.00 0.25 0.50 0.75 1.00 0.00 0.25 0.50 0.75 1.00 1−Specificity Sensitivity logit (cancer ~ gene) #### 影响分析对于异常值识别仍然可用 influence.measures() 函数获得。 influencePlot(fit.glm) ## Warning in plot.window(...): relative range of values = 51 * EPS, is small ## (axis 1) 3580.008695652 0.008695652 −2 −1 0 1 Hat−Values Studentized Residuals 51 图 34: ## StudRes Hat CookD ## 51 -2.638 0.008696 0.3504 #influence.measures(fit.glm) 8.1.1.2 多重共线性 可用 vif(方差膨胀因子)进行判断,vif 开平方是否大于 2,若大于 2, 则存在多重共线性问题。 8.1.1.3 过度离散 因变量的方差大于期望的二项分布的方差,过度离散会导致奇异标准误 检验和不精确的的显著性检验。检验过度离散的一种方法是比较二项分布 模型的残差偏差与残差自由度,如果比值比 1 大很多,可以认为存在过度离 散。对过度离散的假设检验需要用 family = “quasibinomial” 再进行一次模 型拟合。 overdispersion <- function(fit.glm){ Phi <- fit.glm$deviance/fit.glm$df.residual fit.od <- glm(fit.glm$formula,family = quasibinomial, data = fit.glm$data) 359p <- pchisq(summary(fit.od)$dispersion*fit.glm$df.residual, fit.glm$df.residual,lower=F) return (list(Phi=Phi,p.value=p)) } overdispersion(fit.glm) ## $Phi ## [1] 0.8429 ## ## $p.value ## [1] 0.4504 比值在 1 附近,并且 P 值大于 0.05,不能拒绝比值为 1 的假设,可以 认为不存在过度离散。 8.1.1.4 模型参数解释 logistic.display(fit.glm) ## ## Logistic regression predicting cancer : 1 vs 0 ## ## OR(95%CI) P(Wald's test) P(LR-test) ## gene: 1 vs 0 0.05 (0.02,0.14) < 0.001 < 0.001 ## ## Log-likelihood = -96.095 ## No. of observations = 230 ## AIC value = 196.1901 exp(coef(fit.glm)) 即为 OR 值,表示自变量增加一个单位,因变量则乘 以 OR 值。OR 值具有风险的含义,在危险因素研究中具有重要意义。LR- test(likelihood ration test)为似然比检验,Wald’s test 为 Wadld 检验,P 值小于 0.05 均说明回归系数具有统计学意义,自变量与因变量有统计学联 系。OR 值大于 1,为危险因素。OR 值小于 1,为保护因素。 3608.1.2 多因素 Logistics 回归 AER 包中包含一个 Affairs 数据,记录了一组婚外情数据,其中包括参 与者性别、年龄、婚龄、是否有小孩、宗教信仰程度(5 分制,1 表示反对, 5 表示非常信仰)、学历、职业和婚姻的自我评分(5 分制,1 表示非常不幸 福,5 表示非常幸福)。 data(Affairs,package="AER") Affairs$ynaffair[Affairs$affairs > 0] <- 1 Affairs$ynaffair[Affairs$affairs==0] <- 0 Affairs$ynaffair <- factor(Affairs$ynaffair, levels=c(0,1),labels=c("No","Yes")) 与线性回归相似,bestglm 包中 bestglm 函数可以完成 logistic 回归的 全子集的自变量筛选。 Affairs <- Affairs[,c("gender","age","yearsmarried","children", "religiousness","education", "occupation","rating","ynaffair")] best.logistic <-bestglm(Affairs,family = binomial, IC = "AIC",method = "exhaustive") ## Morgan-Tatar search since family is non-gaussian. best.logistic$BestModels ## gender age yearsmarried children religiousness education occupation ## 1 TRUE TRUE TRUE FALSE TRUE FALSE FALSE ## 2 TRUE TRUE TRUE TRUE TRUE FALSE FALSE ## 3 FALSE TRUE TRUE TRUE TRUE FALSE TRUE ## 4 FALSE TRUE TRUE FALSE TRUE FALSE FALSE ## 5 FALSE TRUE TRUE TRUE TRUE FALSE FALSE ## rating Criterion ## 1 TRUE 621.9 ## 2 TRUE 622.2 ## 3 TRUE 623.3 361## 4 TRUE 623.4 ## 5 TRUE 623.4 summary(best.logistic$BestModel) ## ## Call: ## glm(formula = y ~ ., family = family, data = Xi, weights = weights) ## ## Deviance Residuals: ## Min 1Q Median 3Q Max ## -1.562 -0.750 -0.566 -0.267 2.397 ## ## Coefficients: ## Estimate Std. Error z value Pr(>|z|) ## (Intercept) 1.9476 0.6123 3.18 0.00147 ** ## gendermale 0.3861 0.2070 1.87 0.06217 . ## age -0.0439 0.0181 -2.43 0.01501 * ## yearsmarried 0.1113 0.0298 3.73 0.00019 *** ## religiousness -0.3271 0.0895 -3.66 0.00026 *** ## rating -0.4672 0.0893 -5.23 0.00000017 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## (Dispersion parameter for binomial family taken to be 1) ## ## Null deviance: 675.38 on 600 degrees of freedom ## Residual deviance: 611.86 on 595 degrees of freedom ## AIC: 623.9 ## ## Number of Fisher Scoring iterations: 4 也可用逐步法完成自变量的筛选。 362fit.full <- glm(ynaffair~gender+age+yearsmarried +children+religiousness+education+ occupation+rating,data=Affairs,family=binomial()) step(fit.full) ## Start: AIC=627.5 ## ynaffair ~ gender + age + yearsmarried + children + religiousness + ## education + occupation + rating ## ## Df Deviance AIC ## - education 1 610 626 ## - occupation 1 610 626 ## - gender 1 611 627 ## - children 1 611 627 ## 610 628 ## - age 1 616 632 ## - yearsmarried 1 618 634 ## - religiousness 1 623 639 ## - rating 1 637 653 ## ## Step: AIC=625.7 ## ynaffair ~ gender + age + yearsmarried + children + religiousness + ## occupation + rating ## ## Df Deviance AIC ## - occupation 1 610 624 ## - gender 1 611 625 ## - children 1 612 626 ## 610 626 ## - age 1 616 630 ## - yearsmarried 1 618 632 ## - religiousness 1 623 637 ## - rating 1 637 651 363## ## Step: AIC=624.1 ## ynaffair ~ gender + age + yearsmarried + children + religiousness + ## rating ## ## Df Deviance AIC ## - children 1 612 624 ## 610 624 ## - gender 1 613 625 ## - age 1 616 628 ## - yearsmarried 1 619 631 ## - religiousness 1 624 636 ## - rating 1 637 649 ## ## Step: AIC=623.9 ## ynaffair ~ gender + age + yearsmarried + religiousness + rating ## ## Df Deviance AIC ## 612 624 ## - gender 1 615 625 ## - age 1 618 628 ## - religiousness 1 626 636 ## - yearsmarried 1 626 636 ## - rating 1 640 650 ## ## Call: glm(formula = ynaffair ~ gender + age + yearsmarried + religiousness + ## rating, family = binomial(), data = Affairs) ## ## Coefficients: ## (Intercept) gendermale age yearsmarried religiousness ## 1.9476 0.3861 -0.0439 0.1113 -0.3271 ## rating ## -0.4672 364## ## Degrees of Freedom: 600 Total (i.e. Null); 595 Residual ## Null Deviance: 675 ## Residual Deviance: 612 AIC: 624 全自集和逐步法对自变量的筛选均应建立在对自变量专业考虑的基础 上进行。本例中两种方法结果类似,对其结果进行诊断。 fit <- glm(ynaffair ~ gender + age + yearsmarried + religiousness + rating, family = binomial(), data = Affairs) lrm(ynaffair ~ gender + age + yearsmarried + religiousness + rating,data=Affairs) ## ## Logistic Regression Model ## ## lrm(formula = ynaffair ~ gender + age + yearsmarried + religiousness + ## rating, data = Affairs) ## Model Likelihood Discrimination Rank Discrim. ## Ratio Test Indexes Indexes ## Obs 601 LR chi2 63.52 R2 0.149 C 0.707 ## No 451 d.f. 5 g 0.896 Dxy 0.414 ## Yes 150 Pr(> chi2) <0.0001 gr 2.451 gamma 0.416 ## max |deriv| 0.0000007 gp 0.156 tau-a 0.155 ## Brier 0.166 ## ## Coef S.E. Wald Z Pr(>|Z|) ## Intercept 1.9476 0.6123 3.18 0.0015 ## gender=male 0.3861 0.2070 1.87 0.0622 ## age -0.0439 0.0181 -2.43 0.0150 ## yearsmarried 0.1113 0.0298 3.73 0.0002 ## religiousness -0.3271 0.0895 -3.66 0.0003 ## rating -0.4672 0.0893 -5.23 <0.0001 365AUC=0.70, 模型尚可。 fit0 <- glm(formula = ynaffair ~ 1, family = binomial(), data = Affairs) anova(fit0,fit,test="Chisq") ## Analysis of Deviance Table ## ## Model 1: ynaffair ~ 1 ## Model 2: ynaffair ~ gender + age + yearsmarried + religiousness + rating ## Resid. Df Resid. Dev Df Deviance Pr(>Chi) ## 1 600 675 ## 2 595 612 5 63.5 0.0000000000023 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 模型的 likelihood-ratio 检验,P 值小于 0.05,可以认为模型的自变量 与因变量的 odds 自然对数线性相关。 Hosmer-Lemeshowz 指标 hosmerlem <- function(y, yhat, g=10){ cutyhat = cut(yhat, breaks = quantile(yhat, probs=seq(0,1,1/g)), include.lowest=TRUE) obs = xtabs(cbind(1 - y, y) ~ cutyhat) expect = xtabs(cbind(1 - yhat, yhat) ~ cutyhat) chisq = sum((obs - expect)^2/expect) P = 1 - pchisq(chisq, g - 2) return(list(chisq=chisq,p.value=P)) } hosmerlem(y=Affairs$ynaffair, yhat=fitted(fit)) ## Warning in Ops.factor(1, y): '-' not meaningful for factors ## $chisq ## [1] 601 366## ## $p.value ## [1] 0 Hosmer Lemeshow 拟合优度指标检验 P 值小于 0.05,可以认为预测值 和观测值之间差异显著。过度离散诊断 overdispersion(fit) ## $Phi ## [1] 1.028 ## ## $p.value ## [1] 0.3292 过度离散检验 P 值大于 0.05,可以认为不存在过度离散。 多重共线性 sqrt(vif(fit)) > 2 ## gendermale age yearsmarried religiousness rating ## FALSE FALSE FALSE FALSE FALSE 自变量之间不存在多重共线性。可用 influence.measures() 函数进行影 响分析,logistic.display() 对自变量进行解释。 8.1.3 稳健 Logistic 回归 robust 包中的 glmRob()函数可用来拟合稳健的广义线性模型,包括 稳健 Logistic 回归;当拟合回归模型数据出现离群点和强影响点时,便可应 用稳健 Logistic 回归。对 influence.measures(fit) 进行影响分析后,发现存 在强影响点,应用稳健 Logistic 回归。 fit.rob <- glmRob(ynaffair ~ gender + age + yearsmarried + religiousness + rating, family = binomial(), data = Affairs) summary(fit.rob) 367## ## Call: glmRob(formula = ynaffair ~ gender + age + yearsmarried + religiousness + ## rating, family = binomial(), data = Affairs) ## Deviance Residuals: ## Min 1Q Median 3Q Max ## -1.598 -0.746 -0.562 -0.263 2.416 ## ## Coefficients: ## Estimate Std. Error z value Pr(>|z|) ## (Intercept) 2.1009 0.6203 3.39 0.0007072957 ## gendermale 0.4114 0.2087 1.97 0.0487238084 ## age -0.0444 0.0184 -2.41 0.0159857816 ## yearsmarried 0.1097 0.0301 3.64 0.0002692629 ## religiousness -0.3227 0.0902 -3.58 0.0003474612 ## rating -0.5090 0.0903 -5.64 0.0000000172 ## ## (Dispersion Parameter for binomial family taken to be 1 ) ## ## Null Deviance: 833 on 600 degrees of freedom ## ## Residual Deviance: 612.1 on 595 degrees of freedom ## ## Number of Iterations: 6 ## ## Correlation of Coefficients: ## (Intercept) gendermale age yearsmarried religiousness ## gendermale 0.028916 ## age -0.644805 -0.263350 ## yearsmarried 0.316933 0.204680 -0.764118 ## religiousness -0.358601 -0.000655 0.006543 -0.170666 ## rating -0.622679 -0.059270 0.076371 0.062646 -0.003268 3688.1.4 条件 logistic 回归 条件 logistic 回归假设自变量在各配对组中对结果变量的作用是相同 的,即自变量的回归系数与配对组无关。配对设计的 Logistic 回归模型不含 常数项,参数估计是根据条件概率得到的。对病例和对照进行配比能控制影 响实验效应的主要非处理因素,可以提高统计分析的效能,通常可分为 1:1, 1:n,m:n 配对。epicalc 包中的 VC1to1 来自于验证吸烟、酗酒和橡胶行业 工作是否是食管癌的危险因素的病例对照研究。 data(VC1to1,package = "epicalc") pander(VC1to1) matset case smoking rubber alcohol 1 1 1 0 0 1 0 1 0 0 2 1 1 0 1 2 0 1 1 0 3 1 1 1 0 3 0 1 1 0 4 1 1 0 0 4 0 1 1 1 5 1 0 0 1 5 0 1 0 0 6 1 1 0 1 6 0 0 0 0 7 1 1 0 1 7 0 1 0 0 8 1 1 0 0 8 0 1 0 0 9 1 1 1 1 9 0 1 1 0 10 1 0 0 0 10 0 1 1 0 11 1 1 0 1 369matset case smoking rubber alcohol 11 0 1 0 1 12 1 1 0 0 12 0 1 0 1 13 1 1 1 0 13 0 0 0 0 14 1 1 0 1 14 0 1 0 1 15 1 1 0 1 15 0 1 0 0 16 1 1 0 1 16 0 0 0 1 17 1 1 1 1 17 0 1 0 1 18 1 1 0 1 18 0 1 0 1 19 1 0 0 0 19 0 1 0 0 20 1 1 1 1 20 0 0 0 0 21 1 1 1 1 21 0 1 1 1 22 1 0 0 1 22 0 1 1 1 23 1 1 1 1 23 0 1 1 1 24 1 1 1 1 24 0 1 0 0 25 1 0 0 0 25 0 1 1 0 26 1 1 0 1 26 0 0 0 0 370use(VC1to1) matchTab(case,smoking,strat=matset) ## ## Exposure status: smoking = 1 ## ## Total number of match sets in the tabulation = 26 ## ## Number of controls = 1 ## No. of controls exposed ## No. of cases exposed 0 1 ## 0 0 5 ## 1 5 16 ## ## Odds ratio by Mantel-Haenszel method = 1 ## ## Odds ratio by maximum likelihood estimate (MLE) method = 1 ## 95%CI= 0.29 , 3.454 case 变量 1 表示患病,0 表示未患病。matset 变量表示对子号。epicalc 包中 matchTab() 函数用以计算条件优势比(McNemar’s 优势比),表示病 例间不一致部分的计数比值,其 95% 置信区间如果包含 1,则表示变量没 有统计学意义。 fit.c <- clogit(case~smoking+alcohol+rubber+strata(matset), data=VC1to1,method = "exact") summary(fit.c) ## Call: ## coxph(formula = Surv(rep(1, 52L), case) ~ smoking + alcohol + ## rubber + strata(matset), data = VC1to1, method = "exact") ## ## n= 52, number of events= 26 ## 371## coef exp(coef) se(coef) z Pr(>|z|) ## smoking 0.0432 1.0442 0.8692 0.05 0.960 ## alcohol 1.6670 5.2963 0.8288 2.01 0.044 * ## rubber -0.6808 0.5062 0.9452 -0.72 0.471 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## exp(coef) exp(-coef) lower .95 upper .95 ## smoking 1.044 0.958 0.1901 5.74 ## alcohol 5.296 0.189 1.0435 26.88 ## rubber 0.506 1.975 0.0794 3.23 ## ## Rsquare= 0.101 (max possible= 0.5 ) ## Likelihood ratio test= 5.55 on 3 df, p=0.136 ## Wald test = 4.11 on 3 df, p=0.25 ## Score (logrank) test = 5.05 on 3 df, p=0.168 fit.c$loglik ## [1] -18.02 -15.25 survival 包中 clogit() 函数可以完成条件 Logistic 回归,结果显示模型 与空模型比较,差异无显著性。自变量 smoking 和 rubber 均无显著性差 异,自变量 alcohol 差异显著。条件 Logistic 回归模型不能得到对数似然比 和 AIC 值,但能得到条件对数似然比,以表示模型的拟合水平。 8.1.5 无序多分类 Logistic 回归 若因变量包含两个以上的无序类别(比如,已婚/寡居/离婚),便可使 用 mlogit 包中的 mlogit()函数拟合多项 Logistic 回归。epicalc 中 Ectopic 数据集,其中 outc 变量中 Deci 表示正常分娩,IA 表示发生人工流产,EP 表示发生宫外孕。hia 变量表示以前是否有 IA(人工流产史),gravi 表示怀 孕的次数。 372data(Ectopic,package = "epicalc") pander(head(Ectopic)) id outc hia gravi 1 Deli ever IA 1-2 2 Deli ever IA 3-4 3 Deli never IA 1-2 4 Deli never IA 1-2 5 Deli never IA 1-2 6 IA ever IA 1-2 ep <- Ectopic$outc=="EP" ia <- Ectopic$outc=="IA" deli <- Ectopic$outc=="Deli" mnFit <- multinom(cbind(deli,ep,ia)~hia+gravi, data=Ectopic) ## # weights: 15 (8 variable) ## initial value 794.296685 ## iter 10 value 745.073806 ## final value 744.587307 ## converged summary(mnFit) ## Call: ## multinom(formula = cbind(deli, ep, ia) ~ hia + gravi, data = Ectopic) ## ## Coefficients: ## (Intercept) hiaever IA gravi3-4 gravi>4 ## ep -1.0194 1.4913 0.4659 0.6955 373## ia -0.5088 0.3827 0.8528 1.1646 ## ## Std. Errors: ## (Intercept) hiaever IA gravi3-4 gravi>4 ## ep 0.1545 0.2217 0.2399 0.3659 ## ia 0.1309 0.2147 0.2368 0.3691 ## ## Residual Deviance: 1489 ## AIC: 1505 mlogit.display(mnFit) ## ## Outcome =cbind(deli, ep, ia); Referent group = deli ## ep ia ## Coeff./SE RRR(95%CI) Coeff./SE RRR(95%CI) ## (Intercept) -1.02/0.154*** - -0.51/0.131*** - ## hiaever IA 1.49/0.222*** 4.44(2.88,6.86) 0.38/0.215 1.47(0.96,2.23) ## gravi3-4 0.47/0.24 1.59(1,2.55) 0.85/0.237*** 2.35(1.48,3.73) ## gravi>4 0.7/0.366 2(0.98,4.11) 1.16/0.369** 3.2(1.55,6.61) ## ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual Deviance: 1489.17 ## AIC = 1505.17 vglmFitMN <- vglm(outc~hia+gravi, family=multinomial(refLevel=3), data=Ectopic) exp(VGAM::coef(vglmFitMN)) ## (Intercept):1 (Intercept):2 hiaever IA:1 hiaever IA:2 gravi3-4:1 ## 0.3608 0.6012 4.4430 1.4662 1.5935 ## gravi3-4:2 gravi>4:1 gravi>4:2 ## 2.3462 2.0047 3.2046 374dfMNL <- mlogit.data(Ectopic, choice="outc", shape="wide", varying=NULL) mlogitFit <- mlogit(outc ~ 0 | hia+gravi,, reflevel="Deli", data=dfMNL) summary(mlogitFit) ## ## Call: ## mlogit(formula = outc ~ 0 | hia + gravi, data = dfMNL, reflevel = "Deli", ## method = "nr", print.level = 0) ## ## Frequencies of alternatives: ## Deli EP IA ## 0.333 0.333 0.333 ## ## nr method ## 4 iterations, 0h:0m:0s ## g'(-H)^-1g = 4.96E-08 ## gradient close to zero ## ## Coefficients : ## Estimate Std. Error t-value Pr(>|t|) ## EP:(intercept) -1.019 0.154 -6.60 0.000000000042 *** ## IA:(intercept) -0.509 0.131 -3.89 0.00010 *** ## EP:hiaever IA 1.491 0.222 6.73 0.000000000017 *** ## IA:hiaever IA 0.383 0.215 1.78 0.07463 . ## EP:gravi3-4 0.466 0.240 1.94 0.05211 . ## IA:gravi3-4 0.853 0.237 3.60 0.00032 *** ## EP:gravi>4 0.695 0.366 1.90 0.05733 . ## IA:gravi>4 1.165 0.369 3.16 0.00160 ** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Log-Likelihood: -745 ## McFadden R^2: 0.0626 375## Likelihood ratio test : chisq = 99.4 (p.value = <0.0000000000000002) exp(mlogitFit$coefficients) ## EP:(intercept) IA:(intercept) EP:hiaever IA IA:hiaever IA EP:gravi3-4 ## 0.3608 0.6012 4.4430 1.4662 1.5935 ## IA:gravi3-4 EP:gravi>4 IA:gravi>4 ## 2.3462 2.0047 3.2046 ## attr(,"fixed") ## EP:(intercept) IA:(intercept) EP:hiaever IA IA:hiaever IA EP:gravi3-4 ## FALSE FALSE FALSE FALSE FALSE ## IA:gravi3-4 EP:gravi>4 IA:gravi>4 ## FALSE FALSE FALSE nnet 包中 multinom() 函数、VGAM 包中的 vglm() 函数、mlogit 包中 mlogit() 函数均得到了相似的结果。mlogit() 函数对数据格式于其他两个函 数的要求有所不同,其中 formula:mlogit 提供了条件 logit,多项 logit,混合 logit 多种模型,对于多项 logit 的估计模型应写为:因变量 ~0| 自变量,data: 使用 mlogit.data 函数使得数据结构符合 mlogit 函数要求。Choice:确定分 类变量是什么 Shape:如果每一行是一个观测,选择 wide,如果每一行是 表示一个选择,那么选择 long。alt.var:对于 shape 为 long 的数据,需要 标明所有的选择名称。由于 mlogit 包可以做的 logit 模型更多。 本例中是以 outc 变量的 Deli(分娩) 做为参考水平的,有人工流产史的 病例 (hia ever IA) 发生宫外孕(EP)的危险增加 4.44,有人工流产史的病 例 (hia ever IA) 发生人工流产(IA)的危险增加 1.47(置信区间包括 1,无 显著性意义)。multinom() 函数默认是第一水平,可通过 levels(Ectopic$outc) 方法查看。vglm() 和 mlogit() 函数是可以指定参考水平。 8.1.5.1 模型拟合评价 PhatCateg <- VGAM::predict(vglmFitMN, type="response") categHat <- levels(Ectopic$outc)[max.col(PhatCateg)] facHat <- factor(categHat,levels=levels(Ectopic$outc)) cTab <- xtabs(~ outc+ facHat, data=Ectopic) addmargins(cTab) 376## facHat ## outc EP IA Deli Sum ## EP 180 10 51 241 ## IA 131 29 81 241 ## Deli 83 14 144 241 ## Sum 394 53 276 723 CCR <- sum(diag(cTab)) / sum(cTab) CCR ## [1] 0.4882 上述方法可获得模型的正确分类率,本例的正确分类率为 0.4882,正确 分类率偏低。 偏差、对数似然值和 AIC 值 deviance <- VGAM::deviance(vglmFitMN) logLik<- VGAM::logLik(vglmFitMN) AIC <- VGAM::AIC(vglmFitMN) deviance ## [1] 1489 logLik ## [1] -744.6 AIC ## [1] 1505 McFadden, Cox & Snell and Nagelkerke R2 伪决定系数 vglm() 函数拟合结果并没有直接给出伪决定系数,可通过如下方法计 算相关统计量。 377vglm0 <- vglm(outc~ 1, family=multinomial(refLevel=3), data=Ectopic) LLf <- VGAM::logLik(vglmFitMN) LL0 <- VGAM::logLik(vglm0) N <- nobs(vglmFitMN) McFadden <- as.vector(1 -(LLf / LL0)) CoxSnell<- as.vector(1 - exp((2/N) * (LL0 - LLf))) Nagelkerke<- as.vector((1 - exp((2/N) * (LL0 - LLf))) / (1 - exp(LL0)^(2/N))) McFadden ## [1] 0.06258 CoxSnell ## [1] 0.1285 Nagelkerke ## [1] 0.1285 Nagelkerke 伪决定系数为 0.1285,表明自变量对因变量的解释程度不 高。 8.1.5.2 系数及模型的检验 vglm 函数结果中并没有系数及模型的检验情况。对模型的系数及其 95% 置信区间可从如下方法获得。 sumMN <- VGAM::summary(vglmFitMN) coefMN <- VGAM::coef(sumMN) zCrit <- qnorm(c(0.05/2, 1 - 0.05/2)) ciCoef <- t(apply(coefMN, 1, function(x) x["Estimate"]- zCrit*x["Std. Error"] )) coefMN ## Estimate Std. Error z value Pr(>|z|) ## (Intercept):1 -1.0194 0.1545 -6.599 0.00000000004151 378## (Intercept):2 -0.5088 0.1309 -3.888 0.00010124322357 ## hiaever IA:1 1.4913 0.2217 6.727 0.00000000001727 ## hiaever IA:2 0.3827 0.2147 1.783 0.07462647477479 ## gravi3-4:1 0.4659 0.2399 1.942 0.05210985302616 ## gravi3-4:2 0.8528 0.2368 3.601 0.00031642513328 ## gravi>4:1 0.6955 0.3659 1.901 0.05732254824813 ## gravi>4:2 1.1646 0.3691 3.155 0.00160410113394 ciCoef ## [,1] [,2] ## (Intercept):1 -0.7166 -1.322251 ## (Intercept):2 -0.2523 -0.765381 ## hiaever IA:1 1.9258 1.056838 ## hiaever IA:2 0.8034 -0.038041 ## gravi3-4:1 0.9361 -0.004255 ## gravi3-4:2 1.3169 0.388687 ## gravi>4:1 1.4126 -0.021632 ## gravi>4:2 1.8880 0.441157 似然比检验通过如下方法获得。 vglm0 <- vglm(outc~ 1, family=multinomial(refLevel=3), data=Ectopic) VGAM::lrtest(vglmFitMN, vglm0) ## Likelihood ratio test ## ## Model 1: outc ~ hia + gravi ## Model 2: outc ~ 1 ## #Df LogLik Df Chisq Pr(>Chisq) ## 1 1438 -745 ## 2 1444 -794 6 99.4 <0.0000000000000002 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 379似然比检验结果表明含有两个自变量的模型和仅有截距项的模型相比 有显著性差异。对系数的检验结果表明有人工流产史的病例 (hia ever IA) 是发生宫外孕 (EP) 危险因素。 8.1.5.3 预测分类 vglm 拟合结果可通过如下的方法得到每个分类的预测概率。 PhatCateg <- VGAM::predict(vglmFitMN, type="response") head(PhatCateg) ## EP IA Deli ## 1 0.4600 0.2530 0.2870 ## 2 0.4543 0.3678 0.1779 ## 3 0.1839 0.3064 0.5097 ## 4 0.1839 0.3064 0.5097 ## 5 0.1839 0.3064 0.5097 ## 6 0.4600 0.2530 0.2870 还可以通过如下两种方法分别得到针对 multinom()、mlogit() 每个分 类的预测概率。 predict(mnFit, type="probs") fitted(mlogitFit, outcome=FALSE) 对分类结果的预测有如下两种方法。 PhatCateg <- VGAM::predict(vglmFitMN, type="response") categHat <- levels(Ectopic$outc)[max.col(PhatCateg)] head(categHat) ## [1] "EP" "EP" "Deli" "Deli" "Deli" "EP" predCls <- predict(mnFit, type="class") head(predCls) 3808.1.6 有序多分类 Logistic 回归 若因变量是一有序的类别(比如,无效/有效/显效/控制),使用无序多 分类 Logistic 回归处理因变量,不但会丧失变量间联系的功效,而且会曲解因 变量和自变量之间的相关方式。程序包 MASS 提供 polr() 函数、ordinal 提供 clm() 函数、rms 提供 orm() 函数、VGAM 提供 vglm() 函数可以进行 ordered logit 或 probit 回归。累积 Logistic 回归模型 (cumulative logit model) 如下, logit(p(Y ≥ g)) = ln P(Y ≥g) 1−P(Y ≥g) = β0g + β1X1 + ··· + βpXp (g = 2, . . . , k)。 成比例比数比累计 Logistic 模型 (proportional-adds cumulative logit mode) 简化上述模型,使自变量 Xi 所对应的回归系数 βi 都是相等。在此假设条 件下,不同累计 Logistic 的回归线相互平行,只是截距 βi 不同。例 epicalc 中 HW93 数据集是 1993 年泰国南部钩虫感染的调查资料,其中 intense 变 量表示感染的严重程度为有序多分类变量,shoes 表示是否穿鞋,agegr 是 年龄分组。 data(HW93,package = "epicalc") intense.ord <- ordered(HW93$intense) 在自变量较多的时候,可以采用 R 中自动逐步变量筛选 step() 函数,仅 MASS 包中 polr() 函数能够支持自变量的筛选。 polrFit <- polr(intense.ord~agegr+shoes,method="logistic",data=HW93) exp(MASS:::confint.polr(polrFit)) ## Waiting for profiling to be done... ## ## Re-fitting to get Hessian ## 2.5 % 97.5 % ## agegr15-59 yrs 1.5173 3.1156 ## agegr60+ yrs 1.9134 6.7876 ## shoesyes 0.3414 0.6863 ordinal.or.display(polrFit) ## 381## Re-fitting to get Hessian ## ## Waiting for profiling to be done... ## ## Re-fitting to get Hessian ## Ordinal OR lower95ci upper95ci P value ## agegr15-59 yrs 2.169 1.517 3.116 0.0000139 ## agegr60+ yrs 3.596 1.913 6.788 0.0000407 ## shoesyes 0.485 0.341 0.686 0.0000271 VGAM 包 vglmFit <- vglm(intense.ord~agegr+shoes, family=propodds, data=HW93) VGAM 包能进行所有类型的 logistic 回归的计算,并且能进行累 计 Logistic 回归模型的平行性假设检验,其他包则不能。模型中 fam- ily=cumulative(parallel=TRUE, reverse=TRUE) 指定拟合累计 Logistic 回归模型,而且 parallel=T 指定模型按平行性假定进行拟合,该选项可简 写为 amily=propodds。 vglm(intense.ord~agegr+shoes, family=cumulative(parallel=TRUE, reverse=TRUE),data=HW93) vglm(intense.ord~agegr+shoes, family=acat(parallel=TRUE), data=HW93) vglm(intense.ord~agegr+shoes, family=sratio(parallel=TRUE), data=HW93) rms 包 ormFit <- orm(intense~agegr+shoes, data=HW93) ordinal 包 382clmFit <- clm(intense~agegr+shoes, link="logit", data=HW93) 结果显示,上述有序多分类 Logisitic 回归模型有两个截距,每一个都 是结果的一个切割点,这些截距项的值没有实际意义。年龄的系数通过两个 切割点进行了分割,两个系数均为正数表示危险度随年龄的增加而增加,穿 鞋的系数为负数表示穿鞋对两种感染水平均有保护作用。 8.1.6.1 模型评价 vglmFit <- vglm(intense.ord~agegr+shoes, family=propodds, data=HW93) PhatCateg <- VGAM::predict(vglmFit, type="response") categHat <- levels(HW93$intense)[max.col(PhatCateg)] facHat <- factor(categHat, levels=levels(HW93$intense)) cTab <- xtabs(~ intense + facHat, data=HW93) addmargins(cTab) ## facHat ## intense 0 1-1,999 2,000+ Sum ## 0 13 184 0 197 ## 1-1,999 20 329 0 349 ## 2,000+ 4 87 0 91 ## Sum 37 600 0 637 (CCR <- sum(diag(cTab)) / sum(cTab)) ## [1] 0.5369 上述方法可获得模型的正确分类率,本例的正确分类率为 0.5369,正确 分类率偏低。偏差、对数似然值和 AIC 值 deviance <- VGAM::deviance(vglmFit) logLik<- VGAM::logLik(vglmFit) AIC <- VGAM::AIC(vglmFit) deviance ## [1] 1205 383logLik ## [1] -602.5 AIC ## [1] 1215 McFadden, Cox & Snell and Nagelkerke R2 伪决定系数 vglm0 <- vglm(intense.ord~ 1, family=propodds, data=HW93) LLf <- VGAM::logLik(vglmFit) LL0 <- VGAM::logLik(vglm0) McFadden <- as.vector(1 -(LLf / LL0)) CoxSnell<- as.vector(1 - exp((2/N) * (LL0 - LLf))) Nagelkerke<- as.vector((1 - exp((2/N) * (LL0 - LLf))) / (1 - exp(LL0)^(2/N))) McFadden ## [1] 0.02556 CoxSnell ## [1] 0.04277 Nagelkerke ## [1] 0.05221 8.1.6.2 系数及模型的检验 sumOrd <- summary(vglmFit) coefOrd <- coef(sumOrd) exp(coefOrd[,1]) ## (Intercept):1 (Intercept):2 agegr15-59 yrs agegr60+ yrs shoesyes ## 1.8779 0.1256 2.1694 3.5956 0.4851 384zCrit <- qnorm(c(0.05/2, 1 - 0.05/2)) ciCoef <- t(apply(coefOrd, 1, function(x) x["Estimate"]- zCrit*x["Std. Error"] )) MASS 包建立的模型可直接使用 confint() 函数计算 OR 值及其可信区 间。 summary(polrFit) ## ## Re-fitting to get Hessian ## Call: ## polr(formula = intense.ord ~ agegr + shoes, data = HW93, method = "logistic") ## ## Coefficients: ## Value Std. Error t value ## agegr15-59 yrs 0.774 0.183 4.22 ## agegr60+ yrs 1.280 0.323 3.97 ## shoesyes -0.723 0.178 -4.06 ## ## Intercepts: ## Value Std. Error t value ## 0|1-1,999 -0.630 0.129 -4.873 ## 1-1,999|2,000+ 2.074 0.158 13.136 ## ## Residual Deviance: 1204.92 ## AIC: 1214.92 exp(cbind(OR=coef(polrFit),t(confint(polrFit)))) ## Warning in cbind(OR = coef(polrFit), t(confint(polrFit))): number of rows ## of result is not a multiple of vector length (arg 1) ## OR agegr15-59 yrs agegr60+ yrs shoesyes 385## 2.5 % 2.169 1.517 1.913 0.3414 ## 97.5 % 3.596 3.116 6.788 0.6863 ordinal 包建立的模型用 summary() 函数即可输出系数。 summary(clmFit) ## formula: intense ~ agegr + shoes ## data: HW93 ## ## link threshold nobs logLik AIC niter max.grad cond.H ## logit flexible 637 -602.46 1214.92 5(0) 1.65e-08 2.6e+01 ## ## Coefficients: ## Estimate Std. Error z value Pr(>|z|) ## agegr15-59 yrs 0.774 0.183 4.22 0.000024 *** ## agegr60+ yrs 1.280 0.323 3.97 0.000073 *** ## shoesyes -0.723 0.178 -4.06 0.000048 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Threshold coefficients: ## Estimate Std. Error z value ## 0|1-1,999 -0.630 0.129 -4.87 ## 1-1,999|2,000+ 2.074 0.158 13.14 8.1.6.3 模型比较 vglmR <- vglm(intense.ord~ shoes, family=propodds, data=HW93) VGAM::lrtest(vglmFit, vglmR) ## Likelihood ratio test ## ## Model 1: intense.ord ~ agegr + shoes ## Model 2: intense.ord ~ shoes 386## #Df LogLik Df Chisq Pr(>Chisq) ## 1 1269 -602 ## 2 1271 -615 2 25.6 0.0000028 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 VGAM::lrtest(vglmFit, vglm0) ## Likelihood ratio test ## ## Model 1: intense.ord ~ agegr + shoes ## Model 2: intense.ord ~ 1 ## #Df LogLik Df Chisq Pr(>Chisq) ## 1 1269 -602 ## 2 1272 -618 3 31.6 0.00000063 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 vglmFit 与其他两个模型比较均有显著性差异,选择 LogLik 值较大的, 还有两个自变量的模型。选择更优模型还可以比较两个模型的信息统计量 AIC 和 BIC,信息统计量小的模型更优。 AIC(vglmR) ## [1] 1237 AIC(vglm0) ## [1] 1241 AIC(vglmFit) ## [1] 1215 3878.1.6.4 平行性假设检验 为了检验平行性假设,需要建立非平行的模型,将平行性模型与非平行 性模型进行似然比检验,检验平行性假设 vglmP <- vglm(intense.ord~agegr+shoes, family=cumulative(parallel=TRUE, reverse=TRUE),data=HW93) vglmNP <- vglm(intense.ord~agegr+shoes, family=cumulative(parallel=FALSE, reverse=TRUE),data=HW93) VGAM::lrtest(vglmP, vglmNP) ## Likelihood ratio test ## ## Model 1: intense.ord ~ agegr + shoes ## Model 2: intense.ord ~ agegr + shoes ## #Df LogLik Df Chisq Pr(>Chisq) ## 1 1269 -602 ## 2 1266 -598 -3 8.05 0.045 * ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 clmP <- clm(intense~agegr+shoes, link="logit", data=HW93) clmNP <- clm(intense~shoes, nominal=~agegr, data=HW93) anova(clmP, clmNP) ## Likelihood ratio tests of cumulative link models: ## ## formula: nominal: link: threshold: ## clmP intense ~ agegr + shoes ~1 logit flexible ## clmNP intense ~ shoes ~agegr logit flexible ## ## no.par AIC logLik LR.stat df Pr(>Chisq) ## clmP 5 1215 -602 ## clmNP 7 1212 -599 6.78 2 0.034 * ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 388平行性假设检验结果表明,P 值小于 0.05,可以认为平行性假设不成 立。检验结果可用 is.parallel() 函数获得。 8.1.7 精确 Logistic 回归 例 elrm 包的 drugDat 数据集记录不同性别人群在某种药物治疗的结 果,recovered 表示恢复数量,n 表示总人数。 data(drugDat,package = "elrm") pander(drugDat) sex treatment recovered n 1 1 16 27 0 1 10 19 1 0 13 32 0 0 7 21 data(drugDat) drug.elrm=elrm(formula=recovered/n~sex+treatment, interest=~sex+treatment,iter=100000, burnIn=1000,dataset=drugDat) summary(drug.elrm) 8.2 Possion 回归 Poisson 回归的因变量是计数型的变量,自变量是连续性或类别型变量。 Poisson 回归因变量通常局限在一个固定长度时间段内进行测量(如过去一 年交通事故数),整个观测集中时间长度都是不变的。Poisson 回归主要有两 个假设,首先,具有相同特征和同时的不同对象的人时风险是同质的,其次, 当样本量越来越大时,频数的均数趋近于方差。 例 robust 包中 Breslow 癫痫数据记录了治疗初期八周内,抗癫痫药物 对癫痫发病数的影响,因变量 sumY 为随机后 8 周内癫痫发病数,自变量 治疗 Trt,年龄 Age 和治疗前 8 周的癫痫发病数 Base。 389data(breslow.dat,package="robust") opar <- par(no.readonly=T) par(mfrow = c(1,2)) attach(breslow.dat) hist(sumY,breaks = 20,xlab = "Seizure Count",main="Distribution of Seizure") boxplot(sumY~Trt,xlab="Treatment",main="Group Coomparisons") Distribution of Seizure Seizure Count Frequency 0 50 150 250 0 5 10 15 20 25 30 placebo progabide 0 50 100 200 300 Group Coomparisons Treatment 图 35: par(opar) 从图中可以清楚的看到因变量的偏移特性及可能的离群点。药物治疗 下癫痫的发病数似乎变小,且方差也变小了。 fit <- glm(sumY~Base+Age+Trt,data=breslow.dat,family = poisson()) summary(fit) ## ## Call: 390## glm(formula = sumY ~ Base + Age + Trt, family = poisson(), data = breslow.dat) ## ## Deviance Residuals: ## Min 1Q Median 3Q Max ## -6.057 -2.043 -0.940 0.793 11.006 ## ## Coefficients: ## Estimate Std. Error z value Pr(>|z|) ## (Intercept) 1.948826 0.135619 14.37 < 0.0000000000000002 *** ## Base 0.022652 0.000509 44.48 < 0.0000000000000002 *** ## Age 0.022740 0.004024 5.65 0.000000016 *** ## Trtprogabide -0.152701 0.047805 -3.19 0.0014 ** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## (Dispersion parameter for poisson family taken to be 1) ## ## Null deviance: 2122.73 on 58 degrees of freedom ## Residual deviance: 559.44 on 55 degrees of freedom ## AIC: 850.7 ## ## Number of Fisher Scoring iterations: 5 VGAM 包 vglm() 方法获得类似结果 vglmFit <- vglm(sumY~Base+Age+Trt, family=poissonff, data=breslow.dat) summary(vglmFit) 结果输出了偏差、回归参数、标准误和参数为 0 的检验。 8.2.1 拟合优度检验 检验建立 Poisson 模型的拟合优度 391poisgof(fit) ## $results ## [1] "Goodness-of-fit test for Poisson assumption" ## ## $chisq ## [1] 559.4 ## ## $df ## [1] 55 ## ## $p.value ## [1] 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000001203 P 值较小,表明模型的拟合优度较差。 8.2.2 模型的系数及解释 exp(coef(fit)) ## (Intercept) Base Age Trtprogabide ## 7.0204 1.0229 1.0230 0.8584 Base、Age、Trt 和截距项检验均显示有意义,在保持其他变量不变,年 龄增加 1 岁,癫痫发病数将乘以 1.023。一单位的 Trt 变化(从安慰剂到治 疗组),癫痫发病数将乘以 0.86, 也就是说治疗组想对于安慰剂组发病数下 降了。危险比的 95% 置信区间可通过 idr.display(fit) ## ## Poisson regression predicting sumY ## ## crude IDR(95%CI) adj. IDR(95%CI) ## Base (cont. var.) 1.02 (1.02,1.02) 1.02 (1.02,1.02) 392## ## Age (cont. var.) 0.99 (0.98,1) 1.02 (1.01,1.03) ## ## Trt: progabide vs placebo 0.93 (0.85,1.01) 0.86 (0.78,0.94) ## ## P(Wald's test) P(LR-test) ## Base (cont. var.) < 0.001 < 0.001 ## ## Age (cont. var.) < 0.001 < 0.001 ## ## Trt: progabide vs placebo 0.001 0.001 ## ## Log-likelihood = -421.3535 ## No. of observations = 59 ## AIC value = 850.7071 8.2.3 过度离散 与 Logistic 回归类似,如果残差的偏差和和残差的自由度之比大于 1, 那么表明存在过度离散。Poisson 分布的方差和均数相等,当因变量的方差 比预测方差大时,Poisson 分布可能会发生过度离散。过度离散可能会对结 果的解释造成影响,可能会得到很小的标准误和置信区间,并且显著性检验 也比较宽松。发生过度离散可能是遗漏了某个重要变量或者是计数事件并 不独立。过度离散检验可用 qcc 包的 qcc.overdispersion.test() 方法。 qcc.overdispersion.test(breslow.dat$sumY,type = "poisson") ## ## Overdispersion test Obs.Var/Theor.Var Statistic p-value ## poisson data 62.87 3646 0 P 值小于 0.05, 表明确实存在过度离散。通过用 family=“quasipoisson” 替换 family=“poisson”, 以完成对过度离散数据的拟合。 393fit.od <- glm(sumY~Base+Age+Trt,data=breslow.dat, family = quasipoisson()) summary(fit.od) ## ## Call: ## glm(formula = sumY ~ Base + Age + Trt, family = quasipoisson(), ## data = breslow.dat) ## ## Deviance Residuals: ## Min 1Q Median 3Q Max ## -6.057 -2.043 -0.940 0.793 11.006 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) 1.94883 0.46509 4.19 0.0001 *** ## Base 0.02265 0.00175 12.97 <0.0000000000000002 *** ## Age 0.02274 0.01380 1.65 0.1051 ## Trtprogabide -0.15270 0.16394 -0.93 0.3557 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## (Dispersion parameter for quasipoisson family taken to be 11.76) ## ## Null deviance: 2122.73 on 58 degrees of freedom ## Residual deviance: 559.44 on 55 degrees of freedom ## AIC: NA ## ## Number of Fisher Scoring iterations: 5 VGAM 包 vglm() 方法获得类似结果 394vglm <- vglm(sumY~Base+Age+Trt, family=quasipoissonff, data=breslow.dat) summary(vglm) 使用类 Poisson 方法估计的参数与 Poisson 相同,但标准误变大。当考 虑过度离散,Base、Trt 和 Age 均没有显著意义。 8.2.4 异方差一致的标准误差 可通过如下方法获得 hcSE <- vcovHC(fit, type="HC0") coeftest(fit, vcov=hcSE) ## ## z test of coefficients: ## ## Estimate Std. Error z value Pr(>|z|) ## (Intercept) 1.94883 0.36515 5.34 0.000000094 *** ## Base 0.02265 0.00124 18.33 < 0.0000000000000002 *** ## Age 0.02274 0.01158 1.96 0.05 * ## Trtprogabide -0.15270 0.17111 -0.89 0.37 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 8.2.5 时间段变化的 Poisson 回归 当观测时间长度不同时,可以拟合时间段变化的 Poisson 回归模型,次 住假设结果变量是比率。为分析比率,数据中需包含一个记录每个观测时 间长度的变量 (如 time)。然后模型将从 ln(λ) = β0 + ∑p j=1 βjXj 修改为 ln ( λ time ) = β0 + ∑p j=1 βjXj。为拟合新模型,需要使用 glm() 函数中的 offset 选项。假设 Breslow 中有一个 time 变量,记录了病人随机分组后监 测时间长度的变化,拟合模型如下 395fit <- glm(sumY~Base+Age+Trt,data=breslow.dat,offset=log(time), family = poisson()) vglmFit <- vglm(sumY~Base+Age+Trt,offset=log(time), family=poissonff, data=breslow.dat) 8.2.6 零膨胀的 Poisson 回归 当因变量中,0 计数的数目比 Poisson 回归预测的数据多时,即总体的 一个子群体无任何被计数的行为时,就可能发生这种问题。 set.seed(123) N <- 200 sigma <- matrix(c(4,2,-3, 2,16,-1,-3,-1,8), byrow=TRUE, ncol=3) mu <- c(-3, 2, 4) XY <- rmvnorm(N, mean=mu, sigma=sigma) Y <- round(XY[ , 3]- 1.5) Y[Y < 0] <- 0 dfCount <- data.frame(X1=XY[ , 1], X2=XY[ , 2], Y) ziFitP <- zeroinfl(Y ~ X1 + X2 | 1, dist="poisson", data=dfCount) vglm(Y ~ X1 + X2, family=zipoissonff, data=dfCount) ## Call: ## vglm(formula = Y ~ X1 + X2, family = zipoissonff, data = dfCount) ## ## Coefficients: ## (Intercept):1 (Intercept):2 X1 X2 ## 0.45686 1.88675 -0.21698 -0.00207 ## ## Degrees of Freedom: 400 Total; 396 Residual ## Log-likelihood: -402.4 3968.2.7 稳健 Poisson 回归 influence.measures() 对拟合的模型完成影响分析后,如存在离群点和 强影响点,可用 robust 包中 glmRob() 方法拟合稳健广义线性模型。 fit.rob <- glmRob(sumY~Base+Age+Trt, family = poisson(), data=breslow.dat) summary(fit.rob) ## ## Call: glmRob(formula = sumY ~ Base + Age + Trt, family = poisson(), ## data = breslow.dat) ## Deviance Residuals: ## Min 1Q Median 3Q Max ## -42.2705 -1.6237 0.0441 0.8243 9.0263 ## ## Coefficients: ## Estimate Std. Error z value Pr(>|z|) ## (Intercept) 1.8692 0.24163 7.74 0.00000000000001027902 ## Base 0.0374 0.00415 9.03 0.00000000000000000017 ## Age 0.0095 0.00745 1.27 0.20232126927763213753 ## Trtprogabide -0.2801 0.09616 -2.91 0.00358167431570754428 ## ## (Dispersion Parameter for poisson family taken to be 1 ) ## ## Null Deviance: 11983 on 58 degrees of freedom ## ## Residual Deviance: 2939 on 55 degrees of freedom ## ## Number of Iterations: 4 ## ## Correlation of Coefficients: ## (Intercept) Base Age ## Base -0.4065 ## Age -0.9118 0.1142 397## Trtprogabide 0.0133 -0.4316 -0.0833 8.2.8 负二项回归 (Negative binomial regression) Poisson 回归假定因变量是均数和方差相等,如果出现方差比均数大,就 会形成过度离散,Poisson 回归会低估预测变量的标准误。当过度离散比较 明显时,指定误差项服从负二项分布,得到的负二项回归系数与 Poisson 回 归相同,但标准误更大,结果的解释与 Poisson 回归相同。 例 epicalc 包 DHF99 数据集是一实地调查的滋生蚊子幼虫的水容器 的数据,因变量 containers 是有蚊子幼虫滋生的容器的频数,education 和 viltype 是可能对因变量有影响的自变量。 data(DHF99,package="epicalc") opar <- par(no.readonly=T) par(mfrow = c(1,2)) attach(DHF99) ## The following object is masked from package:robustbase: ## ## education hist(containers,breaks = 20) boxplot(containers~viltype) par(opar) qcc.overdispersion.test(DHF99$containers,type = "poisson") ## ## Overdispersion test Obs.Var/Theor.Var Statistic p-value ## poisson data NA NA NA 因变量的偏移特性比较明显, 因变量有缺失值,Poisson 回归的过度离 散情况不能够检验。 负二项回归拟合用 MASS 包中 glm.nb() 方法 398Histogram of containers containers Frequency 0 2 4 6 8 10 0 50 100 150 200 250 rural urban slum 0 2 4 6 8 10 图 36: glmFitNB <- glm.nb(containers ~ education + viltype, data=DHF99) summary(glmFitNB) ## ## Call: ## glm.nb(formula = containers ~ education + viltype, data = DHF99, ## init.theta = 0.3014602889, link = log) ## ## Deviance Residuals: ## Min 1Q Median 3Q Max ## -0.799 -0.756 -0.596 -0.347 2.929 ## ## Coefficients: ## Estimate Std. Error z value Pr(>|z|) ## (Intercept) -0.74170 0.21168 -3.50 0.00046 *** ## educationSecondary 0.00761 0.48730 0.02 0.98754 ## educationHigh school 0.17765 0.48557 0.37 0.71447 399## educationBachelor 0.13730 0.56876 0.24 0.80925 ## educationOther -0.00267 0.49474 -0.01 0.99570 ## viltypeurban -1.96517 0.52766 -3.72 0.00020 *** ## viltypeslum -0.67842 0.42813 -1.58 0.11306 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## (Dispersion parameter for Negative Binomial(0.3015) family taken to be 1) ## ## Null deviance: 175.25 on 298 degrees of freedom ## Residual deviance: 156.46 on 292 degrees of freedom ## (1 observation deleted due to missingness) ## AIC: 434 ## ## Number of Fisher Scoring iterations: 1 ## ## ## Theta: 0.3015 ## Std. Err.: 0.0768 ## ## 2 x log-likelihood: -418.0450 VGAM 包中 vglm() 方法如下 vglmFitNB <- vglm(containers ~ education + viltype, family=negbinomial, data=DHF99) summary(vglmFitNB) 8.2.9 拟合优度检验 检验建立负二项回归模型的拟合优度 poisgof(glmFitNB) ## $results 400## [1] "Goodness-of-fit test for Poisson assumption" ## ## $chisq ## [1] 156.5 ## ## $df ## [1] 292 ## ## $p.value ## [1] 1 P 值较大,表明模型的拟合优度较好。 8.2.10 模型的系数及解释 exp(coef(glmFitNB)) ## (Intercept) educationSecondary educationHigh school ## 0.4763 1.0076 1.1944 ## educationBachelor educationOther viltypeurban ## 1.1472 0.9973 0.1401 ## viltypeslum ## 0.5074 viltype 的 P 值小于 0.05, 意义比较显著,结果解释与 Poisson 回归类 似。对于自变量的选择可以采用 step() 和 AIC 值。 8.2.11 零膨胀的负二项回归回归 与 Poisson 回归类似,因变量中 0 计数的频数较多时,应采用零膨胀的 负二项回归回归 ziFitNB <- zeroinfl(containers ~ education + viltype | 1, dist="negbin", data=DHF99) summary(ziFitNB) 401## ## Call: ## zeroinfl(formula = containers ~ education + viltype | 1, data = DHF99, ## dist = "negbin") ## ## Pearson residuals: ## Min 1Q Median 3Q Max ## -0.444 -0.430 -0.366 -0.234 9.493 ## ## Count model coefficients (negbin with log link): ## Estimate Std. Error z value Pr(>|z|) ## (Intercept) -0.74078 0.22394 -3.31 0.00094 *** ## educationSecondary 0.00771 0.48697 0.02 0.98737 ## educationHigh school 0.17777 0.48707 0.36 0.71513 ## educationBachelor 0.13700 0.56096 0.24 0.80705 ## educationOther -0.00295 0.51323 -0.01 0.99542 ## viltypeurban -1.96513 0.53059 -3.70 0.00021 *** ## viltypeslum -0.67853 0.42889 -1.58 0.11363 ## Log(theta) -1.19790 0.27327 -4.38 0.000012 *** ## ## Zero-inflation model coefficients (binomial with logit link): ## Estimate Std. Error z value Pr(>|z|) ## (Intercept) -7.05 80.42 -0.09 0.93 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Theta = 0.302 ## Number of iterations in BFGS optimization: 63 ## Log-likelihood: -209 on 9 Df VGAM 包中 vglm() 方法如下,此方法的自变量不能为分类变量。 vglm(containers ~ village, family=zinegbinomial, data=DHF99) 出用 AIC 比较模型外,Quang Vuong 提出如果一个模型比另一个模型 402更接近真实的函数,那么从这个模型得到的每个个体的对数似然值也应该显 著的大于从另一个模型得到的每个个体的对数似然值。pscl 包 vuong() 方 法实现了 Vuong 检验。 vuong(ziFitNB, glmFitNB) ## Vuong Non-Nested Hypothesis Test-Statistic: ## (test-statistic is asymptotically distributed N(0,1) under the ## null that the models are indistinguishible) ## ------------------------------------------------------------- ## Vuong z-statistic H_A p-value ## Raw -0.1572 model2 > model1 0.44 ## AIC-corrected -1015.9390 model2 > model1 <0.0000000000000002 ## BIC-corrected -2895.3608 model2 > model1 <0.0000000000000002 Vuong 检验的统计量则成标准的 N(0, 1) 正态分布。Vuong 值大于 1.96, 则模型 1 好于模型 2,小于-1.96,则结论相反。Vuong Test = -0.15 表明两 个模型同样地接近真实函数。 4039 广义加性模型 加性模型是一种非参数模型,模型中每一个加性项使用单个光滑函数来 估计,每一个加性项中可以解释因变量如何随的自变量变化而变化。广义加 性模型时广义线性模型的扩展, g(µ) = s0 + s1(x1) + s2(x2) + ··· + sp(xp) η = s0 + p∑ i=1 si(Xi) 其中 η 为线性预测值,si 是非参数光滑函数,也可是光滑样条函数、核函数 或者局部回归光滑函数,通过 backfitting 算法获得。模型不需要因变量对 自变量的任何假设,由随机部分、加性部分及连接两者的连接函数 g(.) 组 成。因变量的分布属于指数分布族、二项分布、Poisson 分布、Gamma 分布 等。半参数广义加性模型,其形式为: g(µ) = s0 + Xβ + p∑ i=1 si(Xi) 。加性模型的拟合是通过一个迭代过程(向后拟合算法)对每个预测变量 进行样条平滑。其算法要在拟合误差和自由度之间进行权衡最终达到最优。 例 robust 包中 Breslow 癫痫数据记录了治疗初期八周内,抗癫痫药物 对癫痫发病数的影响,因变量 sumY 为随机后 8 周内癫痫发病数,年龄 Age 和治疗前 8 周的癫痫发病数 Base。 data(breslow.dat,package="robust") model=gam(sumY~s(Base)+s(Age),data=breslow.dat, family = poisson()) par(mfrow=c(1,2)) plot(model,se=T,resid=T,pch=16) par(mfrow=c(1,1)) 上图显示的是各预测变量的偏残差图,表示了各预测变量对响应变量 的独立影响,纵轴括号中的数字表示 EDF(estimated degrees of freedom), 如果估计自由度为 1,即是线性关系。 40450 100 150 −1 0 1 2 3 Base s(Base,8.44) 20 25 30 35 40 −1 0 1 2 3 Age s(Age,8.04) 图 37: summary(model) ## ## Family: poisson ## Link function: log ## ## Formula: ## sumY ~ s(Base) + s(Age) ## ## Parametric coefficients: ## Estimate Std. Error z value Pr(>|z|) ## (Intercept) 3.1072 0.0308 101 <0.0000000000000002 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Approximate significance of smooth terms: ## edf Ref.df Chi.sq p-value ## s(Base) 8.44 8.88 1457.8 < 0.0000000000000002 *** 405## s(Age) 8.04 8.74 92.5 0.0000000000013 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## R-sq.(adj) = 0.923 Deviance explained = 87.3% ## UBRE = 4.1639 Scale est. = 1 n = 59 从报告可以观察到各预测变量的 EDF 值,后面的 P 值表示平滑函数 是否显著的减少了模型误差。伪判定系数 R-sq 显示了模型的解释能力为 92.3%。 model=gam(sumY~s(Base,k = 9)+s(Age,k=12),data=breslow.dat,family = poisson()) summary(model) ## ## Family: poisson ## Link function: log ## ## Formula: ## sumY ~ s(Base, k = 9) + s(Age, k = 12) ## ## Parametric coefficients: ## Estimate Std. Error z value Pr(>|z|) ## (Intercept) 3.1043 0.0309 100 <0.0000000000000002 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Approximate significance of smooth terms: ## edf Ref.df Chi.sq p-value ## s(Base) 7.76 7.97 1188 <0.0000000000000002 *** ## s(Age) 9.65 10.60 102 <0.0000000000000002 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## R-sq.(adj) = 0.92 Deviance explained = 87.4% 406## UBRE = 4.173 Scale est. = 1 n = 59 K 的最小值是 3,最大值是 17,为 3、4 的时候都是直线,K 越大,曲 线原来越平滑,再大时,曲线就出现了一些弯曲,说明更精准了。 9.1 交互作用 考虑到 Base 和 Age 之间,可能有交互作用,采用 s(Base,Age) 方法 data(breslow.dat,package="robust") model=gam(sumY~s(Base,Age),data=breslow.dat,family = poisson()) summary(model) ## ## Family: poisson ## Link function: log ## ## Formula: ## sumY ~ s(Base, Age) ## ## Parametric coefficients: ## Estimate Std. Error z value Pr(>|z|) ## (Intercept) 3.1038 0.0309 100 <0.0000000000000002 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Approximate significance of smooth terms: ## edf Ref.df Chi.sq p-value ## s(Base,Age) 26.2 28.4 2135 <0.0000000000000002 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## R-sq.(adj) = 0.903 Deviance explained = 88.9% ## UBRE = 3.9225 Scale est. = 1 n = 59 40710 方差分析 方差分析(analysis of variation, 简写为 ANOVA)又称变异数分析或 F 检验, 用于两个及两个以上样本均值差别的显著性检验, 从函数的形式看, 方差分析和回归都是广义线性模型的特例,回归分析 lm() 也能作方差分析。 其目的是推断两组或多组数据的总体均值是否相同,检验两个或多个样本 均值的差异是否有统计学意义。方差分析的基本思路为:将试验数据的总 变异分解为来源于不同因素的相应变异,并作出数量估计,从而明确各个变 异因素在总变异中所占的重要程度;也就是将试验数据的总变异方差分解 成各变因方差,并以其中的误差方差作为和其他变因方差比较的标准,以推 断其它变因所引起的变异量是否真实的一种统计分析方法。把对试验结果 发生影响和起作用的自变量称为因素(factor),即我们所要检验的对象。如 果方差分析研究的是一个因素对于试验结果的影响和作用,就称为单因素 方差分析。因素的不同选择方案称之为因素的水平 (level of factor) 或处理 (treatment)。因素的水平实际上就是因素的取值或者是因素的分组。样本数 据之间差异如果是由于抽样的随机性造成的,称之为随机误差;如果是由于 因素水平本身不同引起的差异,称之为系统误差。 方差分析的基本前提各组的观察数据,要能够被看作是从服从正态分布 的总体中随机抽得的样本。各组的观察数据,是从具有相同方差的总体中抽 取得到的。观察值是相互独立的。方差分析的原假设:H0 θ1 = θ2 = ... = θk 即因素的不同水平对实验结果没有显著差异或影响。备择假设:不是所有 的 θi 都相等 (i = 1, 2, ..., k),即因素的不同水平对实验结果有显著差异或影 响。 aov() 函数的语法为 aov(formula,data=dataframe),formula 可使用的特 殊符号如下,其中 y 为因变量,A、B、C 为自变量。 符号 用法 ~ 分隔符,左边为因变量,右边为自变量。例 y ~ A+B+C + 分隔自变量 : 表示交互项,如 y ~ A+B+A:B 表示所有可能的交互项,如 y ~ A * B *C 等价于 y ~ A+B+C+A:B+A:C+B:C+A:B:C ˆ 表示交互项达到的某个次数,如 y ~ (A+B+C)ˆ2 等价于 y ~ A+B+C+A:B+A:C+B:C . 表示包含除因变量以外的所有变量。如 y ~. 408常用的方差设计表达式如下,其中小写字母表示定量变量,大写字母表 示组别因子,Subject 是被试着的标识变量。 设计 表达式 单因素 ANOVA Y~A 含但个协变量的单因素 ANCOVA Y~x+A 双因素 ANOVA Y~A*B 含两个协变量的双因素 ANCOVA Y~x1+x2+A*B 随机化区组 y~B+A(B 是区组因子) 单因素组内 ANOVA y~A+Error(Subject/A) 含单个组内因子 (w) 和单个组间因子 (b) 的重复测量 ANOVA Y~B*W+Error(Subject/W) 组别间观测数相等的设计均衡设计 (balanced design),观测数不等的设 计为非均衡设计 (unbalanced design)。如果因子不止一个,且别是非平衡设 计,或者存在协变量,表达式中的顺序会对结果造成影响。样本大小越不平 衡,效应项的顺序对结果影响越大。通常,越基础的效应需要风在表达式的 前面,如,先协变量,然后主效应,接着双因素的交互项,再接着是三因素 的交互项。标准的 anova() 默认类型为序贯型,car 包中的 Anova() 函数提 供使用分层型和边界型 (SAS 和 SPSS 默认类型) 的选项。 10.1 单因素方差分析(one-way ANOVA) 单因素方差分析是指对单因素试验结果进行分析,检验因素对试验结 果有无显著性影响的方法。单因素方差分析是用来检验多个平均数之间的 差异,从而确定因素对试验结果有无显著性影响的一种统计方法。对于完全 随机设计试验且处理数大于 2 时可以用单因素方差分析(等于 2 时用 t 检 验)。离差平方和的分解公式为:SST(总和)=SSR(组间)+SSE(组内),F 统 计量为 MSR/MSE,MSR=SSR/k-1,MSE=SSE/n-k。其中 SST 为总离差、 SSR 为组间平方和、SSE 为组内平方和或残差平方和、MSR 为组间均方差、 MSE 为组内均方差。 例某医院欲研究 A、B、C 三种降血脂药物对家兔血清肾素血管紧张素 转化酶(ACE)的影响,将家兔随机分为三组,均喂以高脂饮食,分别给 予不同的降血脂药物。一定时间后测定家兔血清 ACE 浓度(u/ml),A 组 (45 44 43 47 48 44 46 44 40 45 42 40 43 46 47 45 46 45 43 44),B 组(45 40948 47 43 46 47 48 46 43 49 46 43 47 46 47 46 45 46 44 45 46 44 43 42 45),c 组(47 48 45 46 46 44 45 48 49 50 49 48 47 44 45 46 45 43 44 45 46 43 42), 问三组家兔血清 ACE 浓度是否相同? a <- c(45, 44, 43, 47, 48, 44, 46, 44, 40, 45, 42, 40, 43, 46, 47, 45, 46, 45, 43, 44) b <- c(45, 48, 47, 43, 46, 47, 48, 46, 43, 49, 46, 43, 47, 46, 47, 46, 45, 46, 44, 45, 46, 44, 43, 42, 45) c <- c(47, 48, 45, 46, 46, 44, 45, 48, 49, 50, 49, 48, 47, 44, 45, 46, 45, 43, 44, 45, 46, 43, 42) dfCRp <- data.frame(length = c(a, b, c), site = factor(c(rep("1", 20), rep("2", 25), rep("3", 23)))) boxplot(length ~ site, data = dfCRp, xlab = "Sites", ylab = "Length") 1 2 3 40 42 44 46 48 50 Sites Length 图 38: 410plot.design(length ~ site, fun = mean, data = dfCRp, main = "Group means") 44.5 45.0 45.5 Group means Factors mean of length 1 2 3 site 箱形图中可观察到不同的因素对于因变量的影响。 10.1.1 假设检验 方差分析需要一定的假设,即数据集应该符合正态和各组的方差相等,可 以分别用 shapiro.test 和 bartlett.test 检验从 P 值观察到这两个假设是符合 的。对于不符合假设的情况,我们就要用到非参数方法,例如 Kruskal-Wallis 秩和检验 shapiro.test(dfCRp$length) ## ## Shapiro-Wilk normality test ## ## data: dfCRp$length ## W = 0.97, p-value = 0.2 411bartlett.test(length ~ site,data = dfCRp) ## ## Bartlett test of homogeneity of variances ## ## data: length by site ## Bartlett's K-squared = 0.76, df = 2, p-value = 0.7 #Fligner-Killeen(fligner.test() 函数) 和 #Brown-Forsythe 检验 (HH 包中的 hov() 函数) 也可以用来检验方差齐性 正态性检验和方差齐性检验 P 值均大于 0.05,可以认为数据满足正态 性和方差齐性的要求。 10.1.2 oneway.test() 和 aov() 函数进行方差分析 aovCRp =aov(length ~ site, data = dfCRp) summary(aovCRp) ## Df Sum Sq Mean Sq F value Pr(>F) ## site 2 26.3 13.15 3.24 0.045 * ## Residuals 65 263.4 4.05 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #oneway.test(length ~ site, data=dfCRp, var.equal=TRUE),与 aov() 结果基本相同。 plotmeans(length ~ site,data =dfCRp ) # 绘制有置信区间的组均值图 par(mfrow=c(2,2)) plot(aovCRp) 41243.5 44.5 45.5 46.5 site length 1 2 3 n=20 n=25 n=23 图 39: 44.5 45.0 45.5 −4 0 4 Fitted values Residuals Residuals vs Fitted 912 55 −2 −1 0 1 2 −2 0 2 Theoretical Quantiles Standardized residuals Normal Q−Q 9 12 55 44.5 45.0 45.5 0.0 1.0 Fitted values Standardized residuals Scale−Location 912 55 0.00 0.01 0.02 0.03 0.04 0.05 −2 0 2 Leverage Standardized residuals Cook's distance Residuals vs Leverage 9 12 55 图 40: 413par(mfrow=c(1,1)) 用 aov 函数建立单因子方差模型,从结果的 P 值可看到各组均值有显著 不同。Sum Sq = deviance (within groups, and residual),总方差和(分别有 groups 和 residual 的),Mean Sq = variance (within groups, and residual), 平均方差和(分别有 groups 和 residual 的)。单因子方差分析结果显示 F value = 3.24 ,Pr(>F) = 0.045,因此拒绝原假设,即认为三组组家兔血清 ACE 浓度在统计学上有显著差异。 10.1.3 模型比较 (anovaCRp <- anova(lm(length ~ site, data=dfCRp))) ## Analysis of Variance Table ## ## Response: length ## Df Sum Sq Mean Sq F value Pr(>F) ## site 2 26.3 13.15 3.24 0.045 * ## Residuals 65 263.4 4.05 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 anova(lm(length ~ 1, data=dfCRp), lm(length ~ site, data=dfCRp)) ## Analysis of Variance Table ## ## Model 1: length ~ 1 ## Model 2: length ~ site ## Res.Df RSS Df Sum of Sq F Pr(>F) ## 1 67 290 ## 2 65 263 2 26.3 3.24 0.045 * ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 414anovaCRp["Residuals","Sum Sq"] ## [1] 263.4 比较不含有自变量和含有一个自变量 site 模型,含有 site 变量的模型 结果较好 (残差的总方差和较小)。 10.1.4 效果大小 (Effect size) 效果大小是指某个特定总体中的某种特殊的非零的数值, 这个数值越大, 就表明由研究者所处理的研究现象所造成的效果越大。效果大小本身可以 被视为是一种参数: 当原假设为真时, 效果大小的值为零; 当原假设为假时, 效果大小为某种非零的值。因此, 可以把效果大小视为某种与原假设分离程 度的指标。方差分析效果大小的含义也基本上与 Z 检验或 t 检验的效果大 小的含义相同只不过它反映的是多组实验处理下不同组之间实验效果差异 大小的指标。常用的指标如下 η2 = SS SStotal ,f = √ η2 1−η2 ,ω2 = SS−DF ∗MSE SStotal+MSE。 dfSSb <- anovaCRp["site","Df"] SSb <- anovaCRp["site","Sum Sq"] MSb <- anovaCRp["site","Mean Sq"] SSw <- anovaCRp["Residuals","Sum Sq"] MSw <- anovaCRp["Residuals","Mean Sq"] # DescTools 包中 EtaSq(aovCRp, type=1) 函数可以计算 (etaSq <- SSb / (SSb + SSw)) ## [1] 0.09076 (omegaSq <- dfSSb * (MSb-MSw) / (SSb + SSw + MSw)) ## [1] 0.06192 (f <- sqrt(etaSq / (1-etaSq))) ## [1] 0.3159 η2, ω2, f 2 值如上,如 η2 实验处理之后各组间平方和在总体平方和中所 占的比重,η2 越大反映实验效果大。一般 η2 大于 0.14,就认为效果有大的 效果。 41510.1.5 多重比较 方差分析只告诉我们这三组之间是不同的,但没有告诉哪两组之间有明 显差别,此时需要使用 TukeyHSD 函数进行均值的多重比较分析,从结果 中观察到有一个两两比较是不显著的。 10.1.5.1 计划好的多重比较 (Planned comparisons - a-priori) 在收集数据之前就已确定。它与实验目的有关,反映了实验者的意图。 可以直接进行计划好的多重比较,不用考虑基本的 “均值相等的 F-test”。 cntrMat <- rbind("a-c" =c(1,0,-1), "1/3*(a+b)-c"=c(1/3,1/3,-1), "b-c" =c(0,1,-1)) summary(glht(aovCRp, linfct=mcp(site=cntrMat), alternative="less"), test=adjusted("none")) ## ## Simultaneous Tests for General Linear Hypotheses ## ## Multiple Comparisons of Means: User-defined Contrasts ## ## ## Fit: aov(formula = length ~ site, data = dfCRp) ## ## Linear Hypotheses: ## Estimate Std. Error t value Pr(= 0 -1.520 0.615 -2.47 0.0081 ** ## 1/3*(a+b)-c >= 0 -1.143 0.533 -2.14 0.0179 * ## b-c >= 0 -0.390 0.582 -0.67 0.2527 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## (Adjusted p values reported -- none method) 416#pairwise.t.test(dfCRp$length, dfCRp$site, p.adjust.method="bonferroni") # 结果与 glht() 函数类似。 依据事先实验的目的,进行多重比较,a 组和 c 组,a、b 组和 c 组的 差异有显著意义。 10.1.5.2 非计划的多重比较 (Planned comparisons - post-hoc) 在查看数据之后,并且 “均值相等的 F-test” 结果显著情况下才进行。 它用于探究研究者感兴趣但头脑中没有特定假设。 #ScheffeTest 检验 ScheffeTest(aovCRp, which="site", contrasts=t(cntrMat)) #DescTools 包 ## ## Posthoc multiple comparisons of means : Scheffe Test ## 95% family-wise confidence level ## ## $site ## diff lwr.ci upr.ci pval ## 1-3 -1.5196 -3.061 0.02234 0.0543 . ## 1,2-3 -15.9262 -17.092 -14.75999 <0.0000000000000002 *** ## 2-3 -0.3896 -1.847 1.06753 0.7997 ## ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #Tukey HSD 检验 (tHSD <- TukeyHSD(aovCRp)) ## Tukey multiple comparisons of means ## 95% family-wise confidence level ## ## Fit: aov(formula = length ~ site, data = dfCRp) 417## ## $site ## diff lwr upr p adj ## 2-1 1.1300 -0.31851 2.579 0.1553 ## 3-1 1.5196 0.04333 2.996 0.0422 ## 3-2 0.3896 -1.00547 1.785 0.7818 plot(tHSD) −1 0 1 2 3 3−2 3−1 2−1 95% family−wise confidence level Differences in mean levels of site 置信区间包含 0 说明差异不显著。 multcomp 包中 glht() 函数提供了多重均值更全面的方法,适用于线性 模型和广义线性模型。下面的代码重现 Tukey HSD 检验。 tukey <- glht(aovCRp, linfct=mcp(site="Tukey")) summary(tukey) ## ## Simultaneous Tests for General Linear Hypotheses ## 418## Multiple Comparisons of Means: Tukey Contrasts ## ## ## Fit: aov(formula = length ~ site, data = dfCRp) ## ## Linear Hypotheses: ## Estimate Std. Error t value Pr(>|t|) ## 2 - 1 == 0 1.130 0.604 1.87 0.155 ## 3 - 1 == 0 1.520 0.615 2.47 0.042 * ## 3 - 2 == 0 0.390 0.582 0.67 0.782 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## (Adjusted p values reported -- single-step method) #cld() 函数中 level 选项设置了使用显著水平 0.05,即 95% 的置信区间 plot(cld(tukey,level = .05),col="lightgrey") 1 2 3 40 42 44 46 48 50 site length a a b b 有相同字母的组(箱线图表示)说明均值差异不显著。 41910.1.6 离群点检测 outlierTest(aovCRp) ## ## No Studentized residuals with Bonferonni p < 0.05 ## Largest |rstudent|: ## rstudent unadjusted p-value Bonferonni p ## 9 -2.288 0.02544 NA 离群点检测结果显示,数据中没有离群点(当 p>1 时产生 NA)。 10.1.7 残差的相关检验 残差的正态性检验 Estud <- rstudent(aovCRp) shapiro.test(Estud) ## ## Shapiro-Wilk normality test ## ## data: Estud ## W = 0.99, p-value = 0.7 qqnorm(Estud, pch=20, cex=2) qqline(Estud, col="gray60", lwd=2) 420−2 −1 0 1 2 −2 −1 0 1 2 Normal Q−Q Plot Theoretical Quantiles Sample Quantiles 残差满足正态性的要求。 残差的方差齐性检验,levene 检验是对方差模型的残差进行组间齐性检 验的,bartlett.test 是对原始数据进行检验。 plot(Estud ~ dfCRp$site, main="Residuals per group") leveneTest(aovCRp) ## Levene's Test for Homogeneity of Variance (center = median) ## Df F value Pr(>F) ## group 2 0.39 0.68 ## 65 对模型的残差进行组间方差齐性检验,P 值大于 0.05 满足残差方差齐 性的要求。 10.2 单因素协方差分析 (Analysis of covariance ,ANCOVA) 单因素协方差分析在单因素方差分析的基础上包含一个或多个定量的 协变量。 4211 2 3 −2 −1 0 1 2 Residuals per group dfCRp$site Estud 图 41: 例 multcomp 包中 litter 数据集是怀孕小白鼠被分为四个小组,每个小 组接受不同剂量(0、5、50 和 500)的药物处理 dose 为自变量,产下幼崽 的体重 weigth 均值为因变量,怀孕时间 gesttime 为协变量。 data(litter,package = "multcomp") pander(head(litter)) dose weight gesttime number 0 28.05 22.5 15 0 33.33 22.5 14 0 36.37 22 14 0 35.52 22 13 0 36.77 21.5 15 0 29.6 23 5 ddply(.data = litter,.(dose),summarize,mean=mean(weight)) ## dose mean ## 1 0 32.31 ## 2 5 29.31 ## 3 50 29.87 ## 4 500 29.65 单因素协方差分析 shapiro.test(litter$weight) ## ## Shapiro-Wilk normality test ## ## data: litter$weight ## W = 0.97, p-value = 0.05 422bartlett.test(weight~dose,data = litter) ## ## Bartlett test of homogeneity of variances ## ## data: weight by dose ## Bartlett's K-squared = 9.6, df = 3, p-value = 0.02 ancova <- aov(weight~gesttime+dose,data = litter) summary(ancova) ## Df Sum Sq Mean Sq F value Pr(>F) ## gesttime 1 134 134.3 8.05 0.006 ** ## dose 3 137 45.7 2.74 0.050 * ## Residuals 69 1151 16.7 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 数据满足正态性的要求, 但不满足方差齐性的要求。ANCOVA 检验结 果表明怀孕时间 gesttime 与出生体重 weight 相关,在控制怀孕时间后,每 种药物剂量 dose 下出生体重 weight 均值不同。 10.2.1 调整的组均值 去除协变量效用的组均值,可以使用 effects 包中的 effect() 函数计算。 effect("dose",ancova) ## ## dose effect ## dose ## 0 5 50 500 ## 32.35 28.88 30.57 29.33 42310.2.2 多重比较 # 设定第一组和其他三组的均值进行比较 contrast <- rbind("no drug vs drug"=c(3,-1,-1,-1)) summary(glht(ancova,linfct=mcp(dose=contrast))) ## ## Simultaneous Tests for General Linear Hypotheses ## ## Multiple Comparisons of Means: User-defined Contrasts ## ## ## Fit: aov(formula = weight ~ gesttime + dose, data = litter) ## ## Linear Hypotheses: ## Estimate Std. Error t value Pr(>|t|) ## no drug vs drug == 0 8.28 3.21 2.58 0.012 * ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## (Adjusted p values reported -- single-step method) 在未用药和用药条件下,出生体重有显著的不同。 10.2.3 检验回归斜率的同质性 ANCOVA 模型假定回归斜率相同,如果 ANCOVA 模型包含交互项, 则需要对回归斜率的同质性进行检验。本例中假定四个处理组通过怀孕时 间来预测出生体重的回归斜率都相同。 summary(aov(weight~gesttime*dose,data = litter)) ## Df Sum Sq Mean Sq F value Pr(>F) ## gesttime 1 134 134.3 8.29 0.0054 ** ## dose 3 137 45.7 2.82 0.0456 * ## gesttime:dose 3 82 27.3 1.68 0.1789 424## Residuals 66 1069 16.2 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 交互效应不显著,支持斜率相等的假设。如果交互效应显著,则意味怀 孕时间和出生体重的关系依赖于药物剂量,需使用不需要假设回归斜率同质 性的非参数 ANCOVA 方法,如 sm 包中的 sm.ancova() 函数。 10.2.4 结果可视化 library(HH) ancova(weight~gesttime+dose,data = litter) ## Analysis of Variance Table ## ## Response: weight ## Df Sum Sq Mean Sq F value Pr(>F) ## gesttime 1 134 134.3 8.05 0.006 ** ## dose 3 137 45.7 2.74 0.050 * ## Residuals 69 1151 16.7 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 425weight ~ gesttime + dose gesttime weight 20 25 30 35 21.5 22.5 0 21.5 22.5 5 21.5 22.5 50 21.5 22.5 500 21.5 22.5 superpose dose 0 5 50 500 用怀孕时间预测出生体重的回归线相互平行,只是截距不同。随着怀孕时 间的增加,出生体重也会增加。若用 ancova(weight~gesttime*dose,data = litter) 生成的图形将允许斜率和截距依据组别发生变化,对违背回归斜率同 质性的实例比较有用。 10.2.5 I 类型的平方和 (Type I sum of squares) 单因素协方差分析 I 类型的平方和效应根据表达式中先出现的效应做调整。A 不做调整,B 根据 A 调整,A:B 交互项根据 A 和 B 调整。 fitFull <- lm(weight~gesttime+dose,data = litter) fitGrp <- lm(weight ~ dose, data=litter) fitRegr <- lm(weight ~ gesttime, data=litter) anova(fitFull) ## Analysis of Variance Table ## ## Response: weight ## Df Sum Sq Mean Sq F value Pr(>F) ## gesttime 1 134 134.3 8.05 0.006 ** 426## dose 3 137 45.7 2.74 0.050 * ## Residuals 69 1151 16.7 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 10.2.6 II/III 类型的平方和 (Type II/III sum of squares) 单因素协 方差分析 II 类型的平方和效应根据同水平或低水平的效应做调整。A 根据 B 调 整,B 依据 A 调整,A:B 交互项同时根据 A 和 B 调整。III 类型的平方和每 个效应根据模型其他各效应做相应调整。A 根据 B 和 A:B 做调整,A:B 交 互项根据 A 和 B 调整。 fitFiii <- lm(weight~gesttime+dose, contrasts=list(dose=contr.sum), data=litter) Anova(fitFiii, type="III") ## Anova Table (Type III tests) ## ## Response: weight ## Sum Sq Df F value Pr(>F) ## (Intercept) 60 1 3.60 0.0618 . ## gesttime 161 1 9.68 0.0027 ** ## dose 137 3 2.74 0.0499 * ## Residuals 1151 69 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 10.2.7 基于 II 类型的平方和的模型比较 anova(fitRegr, fitFull) ## Analysis of Variance Table ## ## Model 1: weight ~ gesttime 427## Model 2: weight ~ gesttime + dose ## Res.Df RSS Df Sum of Sq F Pr(>F) ## 1 72 1288 ## 2 69 1151 3 137 2.74 0.05 * ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 anova(fitGrp, fitFull) ## Analysis of Variance Table ## ## Model 1: weight ~ dose ## Model 2: weight ~ gesttime + dose ## Res.Df RSS Df Sum of Sq F Pr(>F) ## 1 70 1313 ## 2 69 1151 1 162 9.68 0.0027 ** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 RSS 值较小的模型较好,以怀孕时间 gesttime 为协变量的单因素模型 比仅含有药物剂量 dose 和怀孕时间 gesttime 的模型校好。 10.2.8 回归系数 (Test individual regression coefficients) (sumRes <- summary(fitFull)) ## ## Call: ## lm(formula = weight ~ gesttime + dose, data = litter) ## ## Residuals: ## Min 1Q Median 3Q Max ## -11.565 -2.007 0.148 3.076 7.302 ## 428## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) -45.37 24.98 -1.82 0.0737 . ## gesttime 3.52 1.13 3.11 0.0027 ** ## dose5 -3.48 1.32 -2.64 0.0103 * ## dose50 -1.79 1.34 -1.33 0.1878 ## dose500 -3.02 1.35 -2.23 0.0288 * ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 4.08 on 69 degrees of freedom ## Multiple R-squared: 0.191, Adjusted R-squared: 0.144 ## F-statistic: 4.07 on 4 and 69 DF, p-value: 0.00511 confint(fitFull) #95% 置信区间 ## 2.5 % 97.5 % ## (Intercept) -95.206 4.4752 ## gesttime 1.262 5.7749 ## dose5 -6.105 -0.8485 ## dose50 -4.468 0.8931 ## dose500 -5.717 -0.3212 10.2.9 效果大小 (Effect size) ω2 基于 II 类型的平方和 anRes <- anova(fitRegr, fitFull) dfGrp <- anRes[2,"Df"] dfE <- anRes[2,"Res.Df"] MSgrp <- anRes[2,"Sum of Sq"]/ dfGrp MSE <- anRes[2,"RSS"]/ dfE SST <- sum(anova(fitFull)[ , "Sum Sq"]) (omegaSqHat <- dfGrp*(MSgrp - MSE) / (SST + MSE)) 429## [1] 0.06049 效应 ω2 值如上。 10.2.10 调整的组均值 aovAncova <- aov(weight~gesttime+dose,data = litter) YMjAdj <- effect("dose", aovAncova) summary(YMjAdj) ## ## dose effect ## dose ## 0 5 50 500 ## 32.35 28.88 30.57 29.33 ## ## Lower 95 Percent Confidence Limits ## dose ## 0 5 50 500 ## 30.53 26.99 28.59 27.35 ## ## Upper 95 Percent Confidence Limits ## dose ## 0 5 50 500 ## 34.18 30.77 32.54 31.32 10.3 双因素方差分析(Two-way ANOVA) 研究两个因素的不同水平对试验结果的影响是否显著的问题就称作双 因素方差分析,分别对两个因素进行检验,考察各自的作用,同时分析两个 因素(因素 A 和因素 B)对试验结果的影响。如果因素 A 和因素 B 对试验 结果的影响是相互独立的,则可以分别考察各自的影响,这种双因素方差分 析称为无交互作用的双因素方差分析,也叫无重复双因素方差分析。无交互 作用的双因素方差分析,相当于对每个因素分别进行单因素方差分析。如果 因素 A 和因素 B 除了各自对试验结果的影响外,还产生额外的新影响,这 430种额外的影响称为交互作用,这时的双因素方差分析则称为有交互作用的双 因素方差分析,也叫有重复双因素方差分析。可用于随机区组实验设计,用 来分析两个因素的不同水平对结果是否有显著影响,以及两因素之间是否存 在交互效应。 例基础安装中的 ToothGrowth 数据集是随机分配 60 只豚鼠, 分别采用 两种喂食方法 supp(橙汁或维生素 C), 各喂食方法中抗坏血酸含量有三种水 平 dose(0.5mg、1mg 或 2mg), 每种处理方式组合都被分配 10 只豚鼠, 牙齿 长度 len 为因变量。 pander(head(ToothGrowth)) len supp dose 4.2 VC 0.5 11.5 VC 0.5 7.3 VC 0.5 5.8 VC 0.5 6.4 VC 0.5 10 VC 0.5 attach(ToothGrowth) table(supp,dose) ## dose ## supp 0.5 1 2 ## OJ 10 10 10 ## VC 10 10 10 ddply(.data = ToothGrowth,.(supp,dose),summarise,mean=mean(len)) ## supp dose mean ## 1 OJ 0.5 13.23 ## 2 OJ 1.0 22.70 ## 3 OJ 2.0 26.06 431## 4 VC 0.5 7.98 ## 5 VC 1.0 16.77 ## 6 VC 2.0 26.14 ddply(.data = ToothGrowth,.(supp,dose),summarise,sd=sd(len)) ## supp dose sd ## 1 OJ 0.5 4.460 ## 2 OJ 1.0 3.911 ## 3 OJ 2.0 2.655 ## 4 VC 0.5 2.747 ## 5 VC 1.0 2.515 ## 6 VC 2.0 4.798 table 语句的预处理表明该设计是均衡设计 (各设计单元中样本大小都 相同),ddply 语句处理可获得各单元的均值和标准差。 10.3.1 I 型双因素方差分析 (SS type I) aovCRFpq <- aov(len~ supp*dose, data=ToothGrowth) summary(aovCRFpq) ## Df Sum Sq Mean Sq F value Pr(>F) ## supp 1 205 205 12.32 0.00089 *** ## dose 1 2224 2224 133.42 < 0.0000000000000002 *** ## supp:dose 1 89 89 5.33 0.02463 * ## Residuals 56 934 17 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 par(mfrow=c(2,2)) plot(aovCRFpq) 43210 15 20 25 −10 0 Fitted values Residuals Residuals vs Fitted 22 5015 −2 −1 0 1 2 −2 0 2 Theoretical Quantiles Standardized residuals Normal Q−Q 22 5015 10 15 20 25 0.0 1.0 Fitted values S t a n d a r d i z e d r e s i d u a l s Scale−Location 225015 0.00 0.02 0.04 0.06 0.08 −2 0 2 Leverage Standardized residuals Cook's distance Residuals vs Leverage 22 23 37 图 42: par(mfrow=c(1,1)) 得到方差分析表, 可以看到主效应 (supp 和 dose) 和交互效应都非常显 著。 10.3.2 II/III 型双因素方差分析 (SS type II or III) # 转为因子 ToothGrowth$supp <- as.factor(ToothGrowth$supp) ToothGrowth$dose <- as.factor(ToothGrowth$dose) fitIII <- lm(len ~ supp + dose + supp:dose, data=ToothGrowth, contrasts=list(supp=contr.sum, dose=contr.sum)) Anova(fitIII, type="III") ## Anova Table (Type III tests) ## 433## Response: len ## Sum Sq Df F value Pr(>F) ## (Intercept) 21236 1 1610.39 < 0.0000000000000002 *** ## supp 205 1 15.57 0.00023 *** ## dose 2426 2 92.00 < 0.0000000000000002 *** ## supp:dose 108 2 4.11 0.02186 * ## Residuals 712 54 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 得到方差分析表, 可以看到主效应 (supp 和 dose) 和交互效应都非常显 著。 10.3.3 绘制边际均数及格均数图 plot.design(len ~ supp*dose, data=ToothGrowth, main="Marginal means") 10 15 20 25 Marginal means Factors mean of len OJ VC 0.5 1 2 supp dose 图 43: 434interaction.plot(ToothGrowth$dose, ToothGrowth$supp, ToothGrowth$len,main="Cell means", col=c("red","blue","green"), lwd=2) 10 15 20 25 Cell means ToothGrowth$dose mean of ToothGrowth$len 0.5 1 2 ToothGrowth$supp VC OJ 图 44: #interaction.plot(f1, f2, y) 展示双因素方差分析的交互效应, # 如果 f1 和 f2 是因子, 作 y 的均值图, 以 f1 的不同值作为 x 轴, # 而 f2 的不同值对应不同曲线; # 可以用选项 fun 指定 y 的其他的统计量 (缺省计算均值,fun=mean) gplots 包中的 plotmeans() 函数来展示交互效应,HH 包中 interac- tion2wt() 函数来展示交互效应 plotmeans(len ~ interaction(supp, dose, sep = ""), connect = list(c(1, 3, 5), c(2, 4, 6)), col = c("red","darkgreen"), main = "Interaction Plot with 95% CIs", xlab = "Treatment and Dose Combination") 43510 15 20 25 30 Interaction Plot with 95% CIs Treatment and Dose Combination len OJ 0.5 VC 0.5 OJ 1 VC 1 OJ 2 VC 2 n=10 n=10 n=10 n=10 n=10 n=10 图 45: #interaction2wt() 函数 , 因为它能展示任意 # 复杂度设计 ( 双因素方差分析、三因素方差分析等 ) # 的主效应 ( 箱线图 ) 和交互效应 interaction2wt (len ~ supp * dose) 10.3.4 效果大小 (Effect size estimate) EtaSq (aovCRFpq, type= 1 ) ## eta.sq eta.sq.part ## supp 0.05948 0.18029 ## dose 0.64431 0.70435 ## supp:dose 0.02576 0.08696 η 2 p 值如上。 43610.3.5 简单效应 (Simple effects) 简单效应指一个因素的不同水平在另一个因素的某个水平上的变异。 phia 包中 testInteractions() 可计算简单效应。 testInteractions(aovCRFpq, fixed="dose", across="supp", adjustment="none") ## Warning in testInteractions(aovCRFpq, fixed = "dose", across = "supp", ## adjustment = "none"): Some factors with specified contrasts are not in the ## model and will be ignored. ## F Test: ## P-value adjustment method: none ## Value Df Sum of Sq F Pr(>F) ## Mean 3.7 1 205 12.3 0.00089 *** ## Residuals 56 934 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #testInteractions(aovCRFpq, fixed="supp", across="dose", adjustment="none") 喂食方法 supp 在剂量 dose 的 0.5mg 和 1mg 水平上的变异显著。同样 的交换 dose 变量和 supp 变量后,剂量 dose 在喂食方法 OJ 和 VC 的水平 上变异显著。 10.3.6 多重比较 10.3.6.1 计划好的主效应 (Main effects) 多重比较, 计划比较 (0.5mg、 1mg) 和 2mg 剂量,0.5mg 和 2mg 剂量之间是否有差别 cMat <- rbind("c1"=c(1/2, 1/2,-1),"c2"=c(-1,0,1)) aovCRFpq <- aov(len~ supp*dose, data=ToothGrowth) summary(glht(aovCRFpq), linfct=mcp(dose=cMat), alternative="two.sided", test=adjusted("bonferroni")) 437## ## Simultaneous Tests for General Linear Hypotheses ## ## Fit: aov(formula = len ~ supp * dose, data = ToothGrowth) ## ## Linear Hypotheses: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) == 0 13.23 1.15 11.52 0.0000000000000027 *** ## suppVC == 0 -5.25 1.62 -3.23 0.013 * ## dose1 == 0 9.47 1.62 5.83 0.0000019053843276 *** ## dose2 == 0 12.83 1.62 7.90 0.0000000008578271 *** ## suppVC:dose1 == 0 -0.68 2.30 -0.30 1.000 ## suppVC:dose2 == 0 5.33 2.30 2.32 0.145 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## (Adjusted p values reported -- bonferroni method) 结果显示 0.5mg、1mg 和 2mg 剂量,0.5mg 和 2mg 剂量之间的差异显 著。 10.3.6.2 非计划的多重比较 非计划好的主效应多重比较,dose 变量的两两比较。 aovCRF <- aov(len~ supp*dose, data=ToothGrowth) TukeyHSD(aovCRF, which="dose") ## Tukey multiple comparisons of means ## 95% family-wise confidence level ## ## Fit: aov(formula = len ~ supp * dose, data = ToothGrowth) ## ## $dose ## diff lwr upr p adj ## 1-0.5 9.130 6.362 11.898 0 ## 2-0.5 15.495 12.727 18.263 0 438## 2-1 6.365 3.597 9.133 0 multcomp 包中的 glht() 函数 tukey <- glht(aovCRF, linfct=mcp(dose="Tukey")) ## Warning in mcp2matrix(model, linfct = linfct): covariate interactions found ## -- default contrast might be inappropriate summary(tukey) ## ## Simultaneous Tests for General Linear Hypotheses ## ## Multiple Comparisons of Means: Tukey Contrasts ## ## ## Fit: aov(formula = len ~ supp * dose, data = ToothGrowth) ## ## Linear Hypotheses: ## Estimate Std. Error t value Pr(>|t|) ## 1 - 0.5 == 0 9.47 1.62 5.83 <0.001 *** ## 2 - 0.5 == 0 12.83 1.62 7.90 <0.001 *** ## 2 - 1 == 0 3.36 1.62 2.07 0.11 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## (Adjusted p values reported -- single-step method) confint(tukey) #95% 置信区间 ## ## Simultaneous Confidence Intervals ## ## Multiple Comparisons of Means: Tukey Contrasts ## 439## ## Fit: aov(formula = len ~ supp * dose, data = ToothGrowth) ## ## Quantile = 2.41 ## 95% family-wise confidence level ## ## ## Linear Hypotheses: ## Estimate lwr upr ## 1 - 0.5 == 0 9.470 5.556 13.384 ## 2 - 0.5 == 0 12.830 8.916 16.744 ## 2 - 1 == 0 3.360 -0.554 7.274 结果显示 0.5mg 和 1mg 剂量,0.5mg 和 2mg 剂量之间的差异显著。 10.3.7 单元多重比较 (Cell comparisons using the associated one- way ANOVA) ToothGrowth$comb <- interaction(ToothGrowth$dose, ToothGrowth$supp) aovCRFpqA <- aov(len ~ comb, data=ToothGrowth) cntrMat <- rbind("c1"=c(-1/2, 1/4,-1/2, 1/4, 1/4, 1/4), "c2"=c( 0, 0,-1, 0, 1, 0), "c3"=c(-1/2,-1/2, 1/4, 1/4, 1/4, 1/4)) summary(glht(aovCRFpqA, linfct=mcp(comb=cntrMat), alternative="greater"), test=adjusted("none")) ## ## Simultaneous Tests for General Linear Hypotheses ## ## Multiple Comparisons of Means: User-defined Contrasts ## ## ## Fit: aov(formula = len ~ comb, data = ToothGrowth) ## 440## Linear Hypotheses: ## Estimate Std. Error t value Pr(>t) ## c1 <= 0 -1.248 0.995 -1.25 0.89 ## c2 <= 0 -9.290 1.624 -5.72 1.00 ## c3 <= 0 1.272 0.995 1.28 0.10 ## (Adjusted p values reported -- none method) 计划的单元的多重比较中,未发现显著的差异。 10.3.8 非计划 Scheffe 检验 ScheffeTest(aovCRFpqA, which="comb", contrasts=t(cntrMat)) ## ## Posthoc multiple comparisons of means : Scheffe Test ## 95% family-wise confidence level ## ## $comb ## diff lwr.ci upr.ci pval ## 1.OJ,0.5.VC,1.VC,2.VC-0.5.OJ,2.OJ -1.247 -4.683 2.188 0.9020 ## 1.VC-2.OJ -9.290 -14.899 -3.681 0.00008 *** ## 2.OJ,0.5.VC,1.VC,2.VC-0.5.OJ,1.OJ 1.272 -2.163 4.708 0.8943 ## ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #Post-hoc Scheffe tests using the associated one-way ANOVA ScheffeTest(aovCRFpq, which="dose", contrasts=c(-1, 1/2, 1/2)) ## ## Posthoc multiple comparisons of means : Scheffe Test ## 95% family-wise confidence level ## ## $dose 441## diff lwr.ci upr.ci pval ## 1,2-0.5 12.31 8.877 15.75 0.000000000000012 *** ## ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #Post-hoc Scheffe tests for marginal means 10.3.9 残差的相关检验 10.3.10 正态性检验 Estud <- rstudent(aovCRFpq) qqnorm(Estud, pch=20, cex=2) qqline(Estud, col="gray60", lwd=2) −2 −1 0 1 2 −2 −1 0 1 2 Normal Q−Q Plot Theoretical Quantiles Sample Quantiles 图 46: 442shapiro.test(Estud) ## ## Shapiro-Wilk normality test ## ## data: Estud ## W = 0.98, p-value = 0.6 P 值大于 0.05,可以认为残差满足正态性。 plot(Estud ~ ToothGrowth$comb, main="Residuals per group") 0.5.OJ 1.OJ 2.OJ 0.5.VC 1.VC 2.VC −2 −1 0 1 2 Residuals per group ToothGrowth$comb Estud 图 47: leveneTest(aovCRFpq) ## Levene's Test for Homogeneity of Variance (center = median) ## Df F value Pr(>F) ## group 5 1.71 0.15 ## 54 443P 值大于 0.05,可以认为残差满足方差齐性。 10.4 重复测量方差分析 重复测量数据的方差分析是对同一因变量进行重复测量的一种试验设 计技术。在给予一种或多种处理后,分别在不同的时间点上通过重复测量同 一个受试对象获得的指标的观察值,或者是通过重复测量同一个个体的不 同部位(或组织)获得的指标的观察值。重复测量数据在科学研究中十分 常见,常用来分析该观察指标在不同时间点上的变化特点。分析前要对重复 测量数据之间是否存在相关性进行球形检验。如果该检验结果为 P � 0.05, 则说明重复测量数据之间不存在相关性,测量数据符合 Huynh-Feldt 条件, 可以用单因素方差分析的方法来处理;如果检验结果 P � 0.05,则说明重 复测量数据之间是存在相关性的,所以不能用单因素方差分析的方法处理 数据。球形条件不满足时常有两种方法可供选择:(1)采用 MANOVA(多 变量方差分析方法);(2)对重复测量 ANOVA 检验结果中与时间有关的 F 值的自由度进行调整。 在重复测量的方差分析中,实验对象被测量多次,所以会存在组内因子, 组内因子要以下面的形式特别标明出来,其中 B 是组间因子,W 是组内因 子,subject 是实验对象的 ID,model=aov(Y ~ B * W + Error(Subject/W)) 上述方法的前提是对应组内因子不同水平的数据是等方差的,当传统方法的 假设得不到满足时,则应用 lme4 包中 lmer 函数,利用混合效应模型来解 决问题。 10.4.1 单因素重复测量方差分析 (One-way repeated measures ANOVA) 单因素重复测量方差分析通常只有组内因素,没有组间因素。例将 42 名 诊断为胎粪吸入综合症的新生儿患儿随机分为肺表面活性物质治疗组(PS 组)和常规治疗组(对照组),每组各 21 例。PS 组和对照组两组所有患 儿均给予除用药外的其他相应的对症治疗。PS 组患儿给予牛肺表面活性剂 70mg/kg 治疗。采集 PS 组及对照组患儿 0 小时,治疗后 24 小时和 72 小 时静脉血 2ml,离心并提取上清液后保存备用并记录血清中 VEGF 的含量 变化情况。在治疗组,不同时间的记录的 VEGF 是否有差异? 444MAS <- read.csv("MAS.csv",header = T) pander(head(MAS)) id time treatment value 1 time0 contrast 1.03 2 time0 contrast 1.772 3 time0 contrast 0.094 4 time0 contrast 0.596 5 time0 contrast 1.314 6 time0 contrast 1.516 10.4.1.1 传统的重复测量方差分析 (Traditional univariate approach) aov() 函数在处理重复测量设计时, 需要有长格式 (long format) 数据才 能拟合模型,在长格式中, 因变量的每次测量都要放到它独有的行中。reshape 包可方便地将数据转换为相应的格式 dfRBpL <- subset(MAS,treatment=="ps") dfRBpL$id <- as.factor(dfRBpL$id) #id 和 time 需为因子 aovRBp <- aov(value ~ time + Error(id/time), data=dfRBpL) summary(aovRBp) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## Residuals 20 0.653 0.0326 ## ## Error: id:time ## Df Sum Sq Mean Sq F value Pr(>F) ## time 2 0.826 0.413 17.6 0.0000033 *** ## Residuals 40 0.940 0.023 ## --- 445## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 在治疗组,不同时间记录的 VEGF 差异显著。 10.4.1.2 效果大小 (Effect size estimate) EtaSq(aovRBp, type=1) ## eta.sq eta.sq.part eta.sq.gen ## time 0.3416 0.4679 0.3416 η2 g 值如上。 10.4.1.3 重复测量的宽格式数据 (Using Anova() from package car with data in wide format) car 包中 Anova() 通常处理的数据集是宽格式 (wide format), 即列是变 量, 行是观测值, 而且一行一个受试对象。 dfRBpW <- reshape(dfRBpL, v.names="value", timevar="time", idvar="id", direction="wide") fitRBp <- lm(cbind(value.time0, value.time24, value.time72) ~ 1, data=dfRBpW) inRBp <- data.frame(time=gl(length(levels(dfRBpL$time)), 1)) AnovaRBp <- Anova(fitRBp, idata=inRBp, idesign=~time) ## Note: model has only an intercept; equivalent type-III tests substituted. summary(AnovaRBp, multivariate=FALSE, univariate=TRUE) ## ## Univariate Type III Repeated-Measures ANOVA Assuming Sphericity ## ## SS num Df Error SS den Df F Pr(>F) ## (Intercept) 80.6 1 0.653 20 2471.1 < 0.0000000000000002 *** ## time 0.8 2 0.940 40 17.6 0.0000033 *** ## --- 446## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## ## Mauchly Tests for Sphericity ## ## Test statistic p-value ## time 0.851 0.216 ## ## ## Greenhouse-Geisser and Huynh-Feldt Corrections ## for Departure from Sphericity ## ## GG eps Pr(>F[GG]) ## time 0.87 0.000012 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## HF eps Pr(>F[HF]) ## time 0.9462 0.000005595 在治疗组,不同时间记录的 VEGF 差异显著。 10.4.1.4 球形检验和校正 (Using anova.mlm() and mauchly.test() with data in wide format) 传统的重复测量方差分析假设任意组内因子的协方差矩阵为球形, 并且 任意组内因子两水平间的方差之差都相等. mauchly.test(fitRBp, M=~time, X=~1, idata=inRBp) #Mauchly 球形检验 ## ## Mauchly's test of sphericity ## Contrasts orthogonal to ## ~1 ## ## Contrasts spanned by 447## ~time ## ## ## data: SSD matrix from lm(formula = cbind(value.time0, value.time24, value.time72) ~ SSD matrix from 1, data = dfRBpW) ## W = 0.85, p-value = 0.2 # 如果不满足球形假设,可用 Greenhouse-Geisser 和 #Huynh-Feldt 校正或者用多变量方差分析 anova(fitRBp, M=~time, X=~1, idata=inRBp, test="Spherical") ## Analysis of Variance Table ## ## ## Contrasts orthogonal to ## ~1 ## ## ## Contrasts spanned by ## ~time ## ## Greenhouse-Geisser epsilon: 0.8703 ## Huynh-Feldt epsilon: 0.9462 ## ## Df F num Df den Df Pr(>F) G-G Pr H-F Pr ## (Intercept) 1 17.6 2 40 0.00000331 0.0000117 0.0000056 ## Residuals 20 P 大于 0.05,符合球形假设。 10.4.1.5 重复测量的多变量方差分析 (Multivariate approach) Hotelling′sT 2 检验是单变量检验的推广,常用于两组均向量的比较。 DVw<- data.matrix(subset(dfRBpW,select=c("value.time0", "value.time24","value.time72"))) diffMat <- combn(1:length(levels(dfRBpL$time)), 2, 448function(x) {DVw[ , x[1]] - DVw[ , x[2]]}) DVdiff<- diffMat[ , 1:(length(levels(dfRBpL$time))-1), drop=FALSE] muH0 <- rep(0, ncol(DVdiff)) HotellingsT2Test(DVdiff, mu=muH0) ## ## Hotelling's one sample T2-test ## ## data: DVdiff ## T.2 = 15, df1 = 2, df2 = 19, p-value = 0.0001 ## alternative hypothesis: true location is not equal to c(0,0) P 值小于 0.05,可以认为不同时间记录的 VEGF 差异显著。 10.4.1.6 car 包 Anova() 函数进行多变量方差分析 多元方差分析 (multivariate analysis of variance, MANOVA) 是单变量 方差分析和 Hotelling′sT 2 检验的推广,用于多组均向量间的比较。 summary(AnovaRBp, multivariate=TRUE, univariate=FALSE) ## ## Type III Repeated Measures MANOVA Tests: ## ## ------------------------------------------ ## ## Term: (Intercept) ## ## Response transformation matrix: ## (Intercept) ## value.time0 1 ## value.time24 1 ## value.time72 1 ## ## Sum of squares and products for the hypothesis: 449## (Intercept) ## (Intercept) 241.9 ## ## Sum of squares and products for error: ## (Intercept) ## (Intercept) 1.958 ## ## Multivariate Tests: (Intercept) ## Df test stat approx F num Df den Df Pr(>F) ## Pillai 1 0.99 2471 1 20 <0.0000000000000002 ## Wilks 1 0.01 2471 1 20 <0.0000000000000002 ## Hotelling-Lawley 1 123.55 2471 1 20 <0.0000000000000002 ## Roy 1 123.55 2471 1 20 <0.0000000000000002 ## ## Pillai *** ## Wilks *** ## Hotelling-Lawley *** ## Roy *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## ------------------------------------------ ## ## Term: time ## ## Response transformation matrix: ## time1 time2 ## value.time0 1 0 ## value.time24 0 1 ## value.time72 -1 -1 ## ## Sum of squares and products for the hypothesis: ## time1 time2 450## time1 1.6047 0.5625 ## time2 0.5625 0.1972 ## ## Sum of squares and products for error: ## time1 time2 ## time1 1.057 0.2310 ## time2 0.231 0.5838 ## ## Multivariate Tests: time ## Df test stat approx F num Df den Df Pr(>F) ## Pillai 1 0.6111 14.93 2 19 0.000127 *** ## Wilks 1 0.3889 14.93 2 19 0.000127 *** ## Hotelling-Lawley 1 1.5711 14.93 2 19 0.000127 *** ## Roy 1 1.5711 14.93 2 19 0.000127 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 P 值小于 0.05,可以认为不同时间记录 (time) 的 VEGF 差异显著,截 距 (Intercept) 差异显著,但无实际意义。 10.4.2 双因素重复测量方差分析 (Two-way repeated-measures ANOVA) 双因素重复测定资料中的因素是指一个组间因素(处理因素)和一个 组内因素(时间因素)。组间因素是指分组或分类变量,它把所有受试对象 按分类变量的水平分为几个组。组内因素是指重复测定的时间变量。 例将 42 名诊断为胎粪吸入综合症的新生儿患儿随机分为肺表面活性物 质治疗组(PS 组)和常规治疗组(对照组),每组各 21 例。PS 组和对照 组两组所有患儿均给予除用药外的其他相应的对症治疗。PS 组患儿给予牛 肺表面活性剂 70mg/kg 治疗。采集 PS 组及对照组患儿 0 小时,治疗后 24 小时和 72 小时静脉血 2ml,离心并提取上清液后保存备用并记录血清中 VEGF 的含量变化情况。不同组间不同时间的记录的 VEGF 是否有差异? 10.4.2.1 传统的重复测量方差分析 (Traditional univariate approach) 451aov() 同样需要长格式数据。 dfRBFpqL <- read.csv("MAS.csv",header = T) #dfRBFpqL$id <- as.factor(dfRBFpqL$id) # 这种法方法每组因子水平不是 21,而是 42 id <- factor(rep(1:21, times=2*3)) dfRBFpqL$id <- id aovRBFpq <- aov(value ~ treatment*time + Error(id/(treatment*time)), data=dfRBFpqL) summary(aovRBFpq) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## Residuals 20 1.24 0.0622 ## ## Error: id:treatment ## Df Sum Sq Mean Sq F value Pr(>F) ## treatment 1 0.196 0.1957 2.49 0.13 ## Residuals 20 1.574 0.0787 ## ## Error: id:time ## Df Sum Sq Mean Sq F value Pr(>F) ## time 2 3.15 1.577 43.1 0.0000000001 *** ## Residuals 40 1.46 0.037 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Error: id:treatment:time ## Df Sum Sq Mean Sq F value Pr(>F) ## treatment:time 2 0.249 0.124 3.27 0.048 * ## Residuals 40 1.522 0.038 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 452with(dfRBFpqL,interaction.plot(time,treatment, value, type = "b", col = c("red","blue"), pch = c(16, 18), main = "Interaction Plot for treatment and time")) 1.0 1.1 1.2 1.3 1.4 Interaction Plot for treatment and time time mean of value time0 time24 time72 treatment contrast ps 图 48: boxplot(value ~ treatment*time, data = dfRBFpqL, col = (c("gold", "green")), main = "treatment and time", ylab = "value") 453contrast.time0 contrast.time24 contrast.time72 0.5 1.0 1.5 treatment and time value 方差分析表明主效应 time 和交互效应 treatment:time 有显著性差异,主效 应 treatment 无显著性差异。 10.4.3 宽格式数据 dfTemp <- reshape(dfRBFpqL, v.names="value", timevar="treatment", idvar=c("id","time"), direction="wide") dfRBFpqW <- reshape(dfTemp, v.names=c("value.contrast","value.ps"), timevar="time", idvar="id", direction="wide") fitRBFpq <- lm(cbind(value.contrast.time0,value.ps.time0, value.contrast.time24,value.ps.time24, value.contrast.time72,value.ps.time72) ~ 1, data=dfRBFpqW) inRBFpq <- expand.grid(treatment=gl(2, 1), time=gl(3, 1)) AnovaRBFpq <- Anova(fitRBFpq, idata=inRBFpq, idesign=~treatment*time) ## Note: model has only an intercept; equivalent type-III tests substituted. summary(AnovaRBFpq, multivariate=FALSE, univariate=TRUE) ## 454## Univariate Type III Repeated-Measures ANOVA Assuming Sphericity ## ## SS num Df Error SS den Df F Pr(>F) ## (Intercept) 172.7 1 1.24 20 2777.61 < 0.0000000000000002 ## treatment 0.2 1 1.57 20 2.49 0.131 ## time 3.2 2 1.46 40 43.15 0.0000000001 ## treatment:time 0.2 2 1.52 40 3.27 0.048 ## ## (Intercept) *** ## treatment ## time *** ## treatment:time * ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## ## Mauchly Tests for Sphericity ## ## Test statistic p-value ## time 0.518 0.0019 ## treatment:time 0.704 0.0357 ## ## ## Greenhouse-Geisser and Huynh-Feldt Corrections ## for Departure from Sphericity ## ## GG eps Pr(>F[GG]) ## time 0.675 0.000000065 *** ## treatment:time 0.772 0.063 . ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## HF eps Pr(>F[HF]) 455## time 0.7060 0.00000003485 ## treatment:time 0.8239 0.05930374987 宽格式数据方差分析结果与长格式数据结果类似,但提供了 mauchly.test 检验,球形假设的条件不满足,同时给出了 Greenhouse- Geisser 和 Huynh-Feldt 校正结果。 10.4.4 anova.mlm() 和 mauchly.test() anova(fitRBFpq, M=~treatment, X=~1, idata=inRBFpq, test="Spherical") ## Analysis of Variance Table ## ## ## Contrasts orthogonal to ## ~1 ## ## ## Contrasts spanned by ## ~treatment ## ## Greenhouse-Geisser epsilon: 1 ## Huynh-Feldt epsilon: 1 ## ## Df F num Df den Df Pr(>F) G-G Pr H-F Pr ## (Intercept) 1 2.49 1 20 0.131 0.131 0.131 ## Residuals 20 anova(fitRBFpq, M=~treatment + time, X=~treatment, idata=inRBFpq, test="Spherical") ## Analysis of Variance Table ## ## 456## Contrasts orthogonal to ## ~treatment ## ## ## Contrasts spanned by ## ~treatment + time ## ## Greenhouse-Geisser epsilon: 0.6747 ## Huynh-Feldt epsilon: 0.7060 ## ## Df F num Df den Df Pr(>F) G-G Pr H-F Pr ## (Intercept) 1 43.1 2 40 0.000000000103 0.000000065 0.0000000349 ## Residuals 20 anova(fitRBFpq, M=~treatment + time + treatment:time, X=~treatment + time,idata=inRBFpq, test="Spherical") ## Analysis of Variance Table ## ## ## Contrasts orthogonal to ## ~treatment + time ## ## ## Contrasts spanned by ## ~treatment + time + treatment:time ## ## Greenhouse-Geisser epsilon: 0.7717 ## Huynh-Feldt epsilon: 0.8239 ## ## Df F num Df den Df Pr(>F) G-G Pr H-F Pr ## (Intercept) 1 3.27 2 40 0.0484 0.063 0.0593 ## Residuals 20 457mauchly.test(fitRBFpq, M=~treatment, X=~1, idata=inRBFpq) ## ## Mauchly's test of sphericity ## Contrasts orthogonal to ## ~1 ## ## Contrasts spanned by ## ~treatment ## ## ## data: SSD matrix from lm(formula = cbind(value.contrast.time0, value.ps.time0, value.contrast.time24, SSD matrix from value.ps.time24, value.contrast.time72, value.ps.time72) ~ SSD matrix from 1, data = dfRBFpqW) ## W = 1, p-value = 1 mauchly.test(fitRBFpq, M=~treatment + time, X=~treatment, idata=inRBFpq) ## ## Mauchly's test of sphericity ## Contrasts orthogonal to ## ~treatment ## ## Contrasts spanned by ## ~treatment + time ## ## ## data: SSD matrix from lm(formula = cbind(value.contrast.time0, value.ps.time0, value.contrast.time24, SSD matrix from value.ps.time24, value.contrast.time72, value.ps.time72) ~ SSD matrix from 1, data = dfRBFpqW) ## W = 0.52, p-value = 0.002 mauchly.test(fitRBFpq, M=~treatment + time + treatment:time, X=~treatment + time, idata=inRBFpq) ## ## Mauchly's test of sphericity 458## Contrasts orthogonal to ## ~treatment + time ## ## Contrasts spanned by ## ~treatment + time + treatment:time ## ## ## data: SSD matrix from lm(formula = cbind(value.contrast.time0, value.ps.time0, value.contrast.time24, SSD matrix from value.ps.time24, value.contrast.time72, value.ps.time72) ~ SSD matrix from 1, data = dfRBFpqW) ## W = 0.7, p-value = 0.04 10.4.5 效果大小 (Effect size estimates) EtaSq(aovRBFpq, type=1) ## eta.sq eta.sq.part eta.sq.gen ## treatment 0.02082 0.1106 0.03264 ## time 0.33556 0.6833 0.35222 ## treatment:time 0.02647 0.1405 0.04113 10.4.6 简单效应 (Simple effects) summary(aov(value ~ treatment + Error(id/treatment), data=dfRBFpqL, subset=(time=="time0"))) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## Residuals 20 1.84 0.0919 ## ## Error: id:treatment ## Df Sum Sq Mean Sq F value Pr(>F) ## treatment 1 0.022 0.0219 0.19 0.66 ## Residuals 20 2.265 0.1132 459summary(aov(value ~ treatment + Error(id/treatment), data=dfRBFpqL, subset=(time=="time24"))) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## Residuals 20 0.556 0.0278 ## ## Error: id:treatment ## Df Sum Sq Mean Sq F value Pr(>F) ## treatment 1 0.167 0.1670 8.76 0.0077 ** ## Residuals 20 0.381 0.0191 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 summary(aov(value ~ treatment + Error(id/treatment), data=dfRBFpqL, subset=(time=="time72"))) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## Residuals 20 0.312 0.0156 ## ## Error: id:treatment ## Df Sum Sq Mean Sq F value Pr(>F) ## treatment 1 0.256 0.2557 11.4 0.003 ** ## Residuals 20 0.450 0.0225 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 10.4.7 多元方法 (Multivariate approach) 460summary(AnovaRBFpq, multivariate=TRUE, univariate=FALSE) ## ## Type III Repeated Measures MANOVA Tests: ## ## ------------------------------------------ ## ## Term: (Intercept) ## ## Response transformation matrix: ## (Intercept) ## value.contrast.time0 1 ## value.ps.time0 1 ## value.contrast.time24 1 ## value.ps.time24 1 ## value.contrast.time72 1 ## value.ps.time72 1 ## ## Sum of squares and products for the hypothesis: ## (Intercept) ## (Intercept) 1036 ## ## Sum of squares and products for error: ## (Intercept) ## (Intercept) 7.46 ## ## Multivariate Tests: (Intercept) ## Df test stat approx F num Df den Df Pr(>F) ## Pillai 1 0.99 2778 1 20 <0.0000000000000002 ## Wilks 1 0.01 2778 1 20 <0.0000000000000002 ## Hotelling-Lawley 1 138.88 2778 1 20 <0.0000000000000002 ## Roy 1 138.88 2778 1 20 <0.0000000000000002 ## 461## Pillai *** ## Wilks *** ## Hotelling-Lawley *** ## Roy *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## ------------------------------------------ ## ## Term: treatment ## ## Response transformation matrix: ## treatment1 ## value.contrast.time0 1 ## value.ps.time0 -1 ## value.contrast.time24 1 ## value.ps.time24 -1 ## value.contrast.time72 1 ## value.ps.time72 -1 ## ## Sum of squares and products for the hypothesis: ## treatment1 ## treatment1 1.174 ## ## Sum of squares and products for error: ## treatment1 ## treatment1 9.446 ## ## Multivariate Tests: treatment ## Df test stat approx F num Df den Df Pr(>F) ## Pillai 1 0.1106 2.486 1 20 0.131 ## Wilks 1 0.8894 2.486 1 20 0.131 ## Hotelling-Lawley 1 0.1243 2.486 1 20 0.131 462## Roy 1 0.1243 2.486 1 20 0.131 ## ## ------------------------------------------ ## ## Term: time ## ## Response transformation matrix: ## time1 time2 ## value.contrast.time0 1 0 ## value.ps.time0 1 0 ## value.contrast.time24 0 1 ## value.ps.time24 0 1 ## value.contrast.time72 -1 -1 ## value.ps.time72 -1 -1 ## ## Sum of squares and products for the hypothesis: ## time1 time2 ## time1 11.957 3.546 ## time2 3.546 1.051 ## ## Sum of squares and products for error: ## time1 time2 ## time1 3.1267 -0.1862 ## time2 -0.1862 1.0729 ## ## Multivariate Tests: time ## Df test stat approx F num Df den Df Pr(>F) ## Pillai 1 0.840 49.89 2 19 0.0000000274 *** ## Wilks 1 0.160 49.89 2 19 0.0000000274 *** ## Hotelling-Lawley 1 5.252 49.89 2 19 0.0000000274 *** ## Roy 1 5.252 49.89 2 19 0.0000000274 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 463## ## ------------------------------------------ ## ## Term: treatment:time ## ## Response transformation matrix: ## treatment1:time1 treatment1:time2 ## value.contrast.time0 1 0 ## value.ps.time0 -1 0 ## value.contrast.time24 0 1 ## value.ps.time24 0 -1 ## value.contrast.time72 -1 -1 ## value.ps.time72 1 1 ## ## Sum of squares and products for the hypothesis: ## treatment1:time1 treatment1:time2 ## treatment1:time1 0.8545 0.12688 ## treatment1:time2 0.1269 0.01884 ## ## Sum of squares and products for error: ## treatment1:time1 treatment1:time2 ## treatment1:time1 4.210 1.088 ## treatment1:time2 1.088 1.443 ## ## Multivariate Tests: treatment:time ## Df test stat approx F num Df den Df Pr(>F) ## Pillai 1 0.1748 2.013 2 19 0.161 ## Wilks 1 0.8252 2.013 2 19 0.161 ## Hotelling-Lawley 1 0.2119 2.013 2 19 0.161 ## Roy 1 0.2119 2.013 2 19 0.161 多元方法分析结果类似,主效应 time 具有显著性,交互效应交互效应 treatment:time 和 treatment 主效应无显著性。可以认为不同时间的记录的 VEGF 有差异,不同组见记录的 VEGF 无差异。 46410.5 两级裂区设计(Two-way split-plot ANOVA) 在一个区组上,先按第一个因素(主因素或主处理)的水平数划分主因 素的试验小区,主因素的小区称为主区或整区,用于安排主因素;在主区内 再按第二个因素(副因素或副处理)的水平数划分小区,安排副因素,主区 内的小区称副区或裂区。从整个试验所有处理组合来说,主区仅是一个不完 全的区组,对第二个因素来讲,主区就是一个区组,这种设计将主区分裂成 副区,称为裂区设计。 例试验一种全身注射抗毒素对皮肤损伤的保护作用,将 10 只家兔随机 等分两组,一组注射抗毒素,一组注射生理盐水作对照。之后,每只家兔取 甲、乙两部位,随机分配分别注射低浓度毒素和高浓度毒素,观察指标为皮 肤受损直径。结果如下: 家兔编号 注射药物(A) 毒素低浓度(B1) 毒素高浓度(B2) 1 抗毒素 A1 15.75 19.00 2 15.50 20.75 3 15.50 18.50 4 17.00 20.50 5 16.50 20.00 6 生理盐水 A2 18.25 22.25 7 18.50 21.50 8 19.75 23.50 9 21.25 24.75 10 20.75 23.75 diameter<- c(15.75,15.50,15.50,17.00,16.50,19.00,20.75,18.50, 20.50,20.00,18.25,18.50,19.75,21.25,20.75,22.25 ,21.50,23.50,24.75,23.75) dfSPFpqL <- data.frame(id=factor(rep(1:5, times=4)), B=factor(rep(1:2,each=5,times=2)), A=factor(rep(1:2,each=10)), Diameter=diameter) 465aovSPFpq <- aov(Diameter ~ A*B + Error(id/B), data=dfSPFpqL) summary(aovSPFpq) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## Residuals 4 12.1 3.02 ## ## Error: id:B ## Df Sum Sq Mean Sq F value Pr(>F) ## B 1 63.9 63.9 560 0.000019 *** ## Residuals 4 0.5 0.1 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Error: Within ## Df Sum Sq Mean Sq F value Pr(>F) ## A 1 62.1 62.1 74.88 0.000025 *** ## A:B 1 0.1 0.1 0.09 0.77 ## Residuals 8 6.6 0.8 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 主因素和副因素均有统计学意义。 10.5.1 宽数据格式 dfSPFpqW <- reshape(dfSPFpqL, v.names="Diameter", timevar="B", idvar=c("id","A"), direction="wide") fitSPFpq <- lm(cbind(Diameter.1, Diameter.2) ~ A, data=dfSPFpqW) inSPFpq <- data.frame(B=gl(2, 1)) AnovaSPFpq <- Anova(fitSPFpq, idata=inSPFpq, idesign=~B) summary(AnovaSPFpq, multivariate=FALSE, univariate=TRUE) 466## ## Univariate Type II Repeated-Measures ANOVA Assuming Sphericity ## ## SS num Df Error SS den Df F Pr(>F) ## (Intercept) 7732 1 17.19 8 3599.02 0.0000000000066 *** ## A 62 1 17.19 8 28.92 0.00066 *** ## B 64 1 1.99 8 257.22 0.0000002291398 *** ## A:B 0 1 1.99 8 0.31 0.59031 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 与长数据格式结果基本一致。 10.5.2 宽数据格式 anova.mlm() 和 mauchly.test() anova(fitSPFpq, M=~1, X=~0, idata=inSPFpq, test="Spherical") ## Analysis of Variance Table ## ## ## Contrasts orthogonal to ## ~0 ## ## ## Contrasts spanned by ## ~1 ## ## Greenhouse-Geisser epsilon: 1 ## Huynh-Feldt epsilon: 1 ## ## Df F num Df den Df Pr(>F) G-G Pr H-F Pr ## (Intercept) 1 3599.0 1 8 0.000000 0.000000 0.000000 ## A 1 28.9 1 8 0.000664 0.000664 0.000664 ## Residuals 8 467anova(fitSPFpq, M=~B, X=~1, idata=inSPFpq, test="Spherical") ## Analysis of Variance Table ## ## ## Contrasts orthogonal to ## ~1 ## ## ## Contrasts spanned by ## ~B ## ## Greenhouse-Geisser epsilon: 1 ## Huynh-Feldt epsilon: 1 ## ## Df F num Df den Df Pr(>F) G-G Pr H-F Pr ## (Intercept) 1 257.22 1 8 0.00 0.00 0.00 ## A 1 0.31 1 8 0.59 0.59 0.59 ## Residuals 8 mauchly.test(fitSPFpq, M=~B, X=~1, idata=inSPFpq) ## ## Mauchly's test of sphericity ## Contrasts orthogonal to ## ~1 ## ## Contrasts spanned by ## ~B ## ## ## data: SSD matrix from lm(formula = cbind(Diameter.1, Diameter.2) ~ A, data = dfSPFpqW) ## W = 1, p-value = 1 46810.5.3 效果大小 (Effect size estimates) EtaSq(aovSPFpq, type=1) ## eta.sq eta.sq.part eta.sq.gen ## B 0.4398486 0.99291 0.769193 ## A 0.4276312 0.90348 0.764154 ## A:B 0.0005377 0.01163 0.004058 10.5.4 简单效应 #Between-subjects effect at a fixed level of the within-subjects factor summary(aov(Diameter ~ A, data=dfSPFpqL, subset=(B==1))) ## Df Sum Sq Mean Sq F value Pr(>F) ## A 1 33.3 33.3 30.1 0.00058 *** ## Residuals 8 8.8 1.1 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 summary(aov(Diameter ~ A, data=dfSPFpqL, subset=(B==2))) ## Df Sum Sq Mean Sq F value Pr(>F) ## A 1 28.9 28.90 22.4 0.0015 ** ## Residuals 8 10.3 1.29 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #Within-subjects effect at a fixed level of the between-subjects factor summary(aov(Diameter ~ B + Error(id/B), data=dfSPFpqL,subset=(A==1))) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## Residuals 4 3.96 0.991 469## ## Error: id:B ## Df Sum Sq Mean Sq F value Pr(>F) ## B 1 34.2 34.2 86.2 0.00075 *** ## Residuals 4 1.6 0.4 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 summary(aov(Diameter ~ B + Error(id/B), data=dfSPFpqL,subset=(A==2))) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## Residuals 4 13.2 3.31 ## ## Error: id:B ## Df Sum Sq Mean Sq F value Pr(>F) ## B 1 29.8 29.8 298 0.000066 *** ## Residuals 4 0.4 0.1 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 10.5.5 计划的多重比较(Planned comparisons for the between- subjects factor) mDf <- aggregate(Diameter ~ id + A, data=dfSPFpqL, FUN=mean) aovRes <- aov(Diameter ~ A, data=mDf) cMat <- rbind("1-2"=c(-1, 1)) summary(glht(aovRes, linfct=mcp(A=cMat), alternative="greater"), test=adjusted("none")) ## ## Simultaneous Tests for General Linear Hypotheses ## 470## Multiple Comparisons of Means: User-defined Contrasts ## ## ## Fit: aov(formula = Diameter ~ A, data = mDf) ## ## Linear Hypotheses: ## Estimate Std. Error t value Pr(>t) ## 1-2 <= 0 3.525 0.656 5.38 0.00033 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## (Adjusted p values reported -- none method) 主因素之间如果有多个分区的情况,其差异是否具有统计学意义可采取 上述方法。 10.6 再裂区设计(Three-way split-plot ANOVA) 在裂区设计中,若需再引进第三个因素时,可在副区内再分裂出第二副 区,称为再裂区,然后将第三个因素的各个处理(称为副副处理),随机排 列于再裂区内,这种设计称为再裂区设计(split-split plot design )。3 个以 上的多因素试验采用裂区设计,试验起来很复杂,统计分析也麻烦,特别是 因素之间有交互作用比较难以解释。 例观察 18 例不同分化程度的贲门癌患者的癌组织、癌旁组织、远离组 织中碱性磷酸酶(ALP)的变化,一级单位处理为分化度(低分化、中分化 和高分化,记为 A1、A2 和 A3),二级单位处理是组织部位(癌组织、癌旁 组织、远癌组织,记为 B1、B2 和 B3),三级单位处理是活性剂(加与不加, 记为 C1 和 C2),数据如下: ALP <- read.csv("ALP.csv",header = T) pander(ALP) 471A id B1C1 B1C2 B2C1 B2C2 B3C1 B3C2 A1 1 72.5 87.5 3.2 3.6 0.74 1.3 A1 2 61.7 66.2 2.1 3.7 1.1 1.7 A1 3 76.1 89.4 4.3 5 1.8 2.2 A1 4 93 98 5.1 5.5 1 1.9 A1 5 82.9 85.1 3.6 4.9 0.8 1.1 A1 6 75.6 90.2 2.2 3.3 1 1.8 A2 7 61.1 65.3 3.2 4 0.9 1.3 A2 8 53.2 58.2 3.1 4.1 1 1.5 A2 9 63.2 63.8 1.9 1.9 1.3 2 A2 10 55.1 55.7 1.7 2.3 2.1 1.8 A2 11 53.2 61.9 1.6 2.8 1.8 0.9 A2 12 49.9 63.2 2.2 3.1 1.3 1.9 A3 13 43.1 45.6 1.9 2.3 1.7 1.4 A3 14 39.2 43.1 1.7 3.9 1.4 1.9 A3 15 41.9 47.2 2 2.2 1.9 2.1 472A id B1C1 B1C2 B2C1 B2C2 B3C1 B3C2 A3 16 28.5 35.9 3.9 4.1 1.8 2.5 A3 17 36.3 41.2 1.3 2 1 0.8 A3 18 34.9 40 3.9 3.9 2.2 1.5 10.6.1 SPF-pq￿r dfSPFpq.rL <-read.csv("ALP2.csv",header = T) dfSPFpq.rL$id <- as.factor(dfSPFpq.rL$id) dfSPFpq.rL$B <- as.factor(dfSPFpq.rL$B) dfSPFpq.rL$C <- as.factor(dfSPFpq.rL$C) dfSPFpq.rL$A <- as.factor(dfSPFpq.rL$A) aovSPFpq.r <- aov(DV ~ C*B*A + Error(id/C), data=dfSPFpq.rL) summary(aovSPFpq.r) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## A 2 3645 1822 54.8 0.00000013 *** ## Residuals 15 499 33 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Error: id:C ## Df Sum Sq Mean Sq F value Pr(>F) ## C 1 167.7 167.7 48.49 0.0000046 *** ## C:A 2 15.1 7.5 2.18 0.15 ## Residuals 15 51.9 3.5 473## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Error: Within ## Df Sum Sq Mean Sq F value Pr(>F) ## B 2 79851 39925 2338.30 <0.0000000000000002 *** ## C:B 2 213 106 6.23 0.0035 ** ## B:A 4 6869 1717 100.57 <0.0000000000000002 *** ## C:B:A 4 18 4 0.26 0.9035 ## Residuals 60 1024 17 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 C、B 级处理、C 和 B 交互、A 和 B 的交互均有统计学意义。 10.6.1.1 效果大小 (Effect size estimates) EtaSq(aovSPFpq.r, type=1) ## eta.sq eta.sq.part eta.sq.gen ## A 0.0394681 0.87954 0.698204 ## C 0.0018153 0.76373 0.096175 ## C:A 0.0001632 0.22515 0.009475 ## B 0.8646246 0.98733 0.980651 ## C:B 0.0023022 0.17187 0.118902 ## B:A 0.0743756 0.87021 0.813421 ## C:B:A 0.0001909 0.01692 0.011068 10.6.1.2 宽格式数据 dfSPFpq.rW <- reshape(dfSPFpq.rL, v.names="DV", timevar="C", idvar=c("id","B","A"), direction="wide") fitSPFpq.r <- lm(cbind(DV.1, DV.2) ~ A*B, data=dfSPFpq.rW) inSPFpq.r <- data.frame(C=gl(2, 1)) 474AnovaSPFpq.r <- Anova(fitSPFpq.r, idata=inSPFpq.r, idesign=~C) summary(AnovaSPFpq.r, multivariate=FALSE, univariate=TRUE) ## ## Univariate Type II Repeated-Measures ANOVA Assuming Sphericity ## ## SS num Df Error SS den Df F Pr(>F) ## (Intercept) 50045 1 1420 45 1586.18 < 0.0000000000000002 *** ## A 3645 2 1420 45 57.76 0.00000000000037 *** ## B 79851 2 1420 45 1265.43 < 0.0000000000000002 *** ## A:B 6869 4 1420 45 54.43 < 0.0000000000000002 *** ## C 168 1 156 45 48.44 0.00000001168729 *** ## A:C 15 2 156 45 2.18 0.13 ## B:C 213 2 156 45 30.72 0.00000000387531 *** ## A:B:C 18 4 156 45 1.27 0.29 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 A、C、B 级处理、C 和 B 交互、A 和 B 的的交互均有统计学意义。 10.6.1.3 宽数据格式 anova.mlm() 和 mauchly.test() anova(fitSPFpq.r, M=~1, X=~0, idata=inSPFpq.r, test="Spherical") ## Analysis of Variance Table ## ## ## Contrasts orthogonal to ## ~0 ## ## ## Contrasts spanned by ## ~1 ## 475## Greenhouse-Geisser epsilon: 1 ## Huynh-Feldt epsilon: 1 ## ## Df F num Df den Df Pr(>F) G-G Pr ## (Intercept) 1 1586.2 1 45 0.000000000000000 0.000000000000000 ## A 2 57.8 2 45 0.000000000000374 0.000000000000374 ## B 2 1265.4 2 45 0.000000000000000 0.000000000000000 ## A:B 4 54.4 4 45 0.000000000000000 0.000000000000000 ## Residuals 45 ## H-F Pr ## (Intercept) 0.000000000000000 ## A 0.000000000000374 ## B 0.000000000000000 ## A:B 0.000000000000000 ## Residuals anova(fitSPFpq.r, M=~C, X=~1, idata=inSPFpq.r, test="Spherical") ## Analysis of Variance Table ## ## ## Contrasts orthogonal to ## ~1 ## ## ## Contrasts spanned by ## ~C ## ## Greenhouse-Geisser epsilon: 1 ## Huynh-Feldt epsilon: 1 ## ## Df F num Df den Df Pr(>F) G-G Pr H-F Pr ## (Intercept) 1 48.44 1 45 0.000 0.000 0.000 ## A 2 2.18 2 45 0.125 0.125 0.125 476## B 2 30.72 2 45 0.000 0.000 0.000 ## A:B 4 1.27 4 45 0.294 0.294 0.294 ## Residuals 45 mauchly.test(fitSPFpq.r, M=~C, X=~1, idata=inSPFpq.r) ## ## Mauchly's test of sphericity ## Contrasts orthogonal to ## ~1 ## ## Contrasts spanned by ## ~C ## ## ## data: SSD matrix from lm(formula = cbind(DV.1, DV.2) ~ A * B, data = dfSPFpq.rW) ## W = 1, p-value = 1 10.6.2 SPF-p￿qr aovSPFp.qr <- aov(DV ~ C*B*A + Error(id/(A*B)), data=dfSPFpq.rL) ## Warning in aov(DV ~ C * B * A + Error(id/(A * B)), data = dfSPFpq.rL): ## Error() model is singular summary(aovSPFp.qr) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## A 2 3645 1822 54.8 0.00000013 *** ## Residuals 15 499 33 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 477## ## Error: id:B ## Df Sum Sq Mean Sq F value Pr(>F) ## B 2 79851 39925 1301 < 0.0000000000000002 *** ## B:A 4 6869 1717 56 0.00000000000017 *** ## Residuals 30 921 31 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Error: Within ## Df Sum Sq Mean Sq F value Pr(>F) ## C 1 167.7 167.7 48.44 0.0000000117 *** ## C:B 2 212.6 106.3 30.72 0.0000000039 *** ## C:A 2 15.1 7.5 2.18 0.13 ## C:B:A 4 17.6 4.4 1.27 0.29 ## Residuals 45 155.7 3.5 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 C、C 和 B 交互均有统计学意义。 10.6.2.1 效果大小 (Effect size estimates) EtaSq(aovSPFp.qr, type=1) ## eta.sq eta.sq.part eta.sq.gen ## A 0.0394681 0.87954 0.698204 ## B 0.8646246 0.98860 0.980651 ## B:A 0.0743756 0.88182 0.813421 ## C 0.0018153 0.51841 0.096175 ## C:B 0.0023022 0.57719 0.118902 ## C:A 0.0001632 0.08823 0.009475 ## C:B:A 0.0001909 0.10170 0.011068 10.6.2.2 宽格式数据 478dfW1 <- reshape(dfSPFpq.rL, v.names="DV", timevar="C", idvar=c("id","B","A"), direction="wide") dfSPFp.qrW <- reshape(dfW1, v.names=c("DV.1","DV.2"), timevar="B", idvar=c("id","A"), direction="wide") fitSPFp.qr <- lm(cbind(DV.1.1, DV.2.1, DV.1.2, DV.2.2, DV.1.3, DV.2.3) ~ A, data=dfSPFp.qrW) inSPFp.qr <- expand.grid(B=gl(3, 1), C=gl(2, 1)) AnovaSPFp.qr <- Anova(fitSPFp.qr, idata=inSPFp.qr, idesign=~B*C) summary(AnovaSPFp.qr, multivariate=FALSE, univariate=TRUE) ## ## Univariate Type II Repeated-Measures ANOVA Assuming Sphericity ## ## SS num Df Error SS den Df F Pr(>F) ## (Intercept) 50045 1 499 15 1503.8 < 0.0000000000000002 *** ## A 3645 2 499 15 54.8 0.00000012772390782 *** ## B 20295 2 300 30 1015.6 < 0.0000000000000002 *** ## A:B 1704 4 300 30 42.6 0.00000000000578848 *** ## C 40475 1 481 15 1261.6 0.00000000000000068 *** ## A:C 3528 2 481 15 55.0 0.00000012448290748 *** ## B:C 19461 2 295 30 988.4 < 0.0000000000000002 *** ## A:B:C 1670 4 295 30 42.4 0.00000000000618473 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## ## Mauchly Tests for Sphericity ## ## Test statistic p-value ## B 0.776 0.169 ## A:B 0.776 0.169 ## B:C 0.766 0.154 479## A:B:C 0.766 0.154 ## ## ## Greenhouse-Geisser and Huynh-Feldt Corrections ## for Departure from Sphericity ## ## GG eps Pr(>F[GG]) ## B 0.817 < 0.0000000000000002 *** ## A:B 0.817 0.0000000004 *** ## B:C 0.810 < 0.0000000000000002 *** ## A:B:C 0.810 0.0000000005 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## HF eps Pr(>F[HF]) ## B 0.9031 0.00000000000000000000000009448 ## A:B 0.9031 0.00000000005438710946396368375 ## B:C 0.8940 0.00000000000000000000000023491 ## A:B:C 0.8940 0.00000000007133228024530542408 10.6.2.3 宽数据格式 anova.mlm() 和 mauchly.test() anova(fitSPFp.qr, M=~1, X=~0,idata=inSPFp.qr, test="Spherical") ## Analysis of Variance Table ## ## ## Contrasts orthogonal to ## ~0 ## ## ## Contrasts spanned by ## ~1 ## 480## Greenhouse-Geisser epsilon: 1 ## Huynh-Feldt epsilon: 1 ## ## Df F num Df den Df Pr(>F) G-G Pr H-F Pr ## (Intercept) 1 1503.8 1 15 0.000000000 0.000000000 0.000000000 ## A 2 54.8 2 15 0.000000128 0.000000128 0.000000128 ## Residuals 15 anova(fitSPFp.qr, M=~B, X=~1,idata=inSPFp.qr, test="Spherical") ## Analysis of Variance Table ## ## ## Contrasts orthogonal to ## ~1 ## ## ## Contrasts spanned by ## ~B ## ## Greenhouse-Geisser epsilon: 0.8170 ## Huynh-Feldt epsilon: 0.9031 ## ## Df F num Df den Df Pr(>F) G-G Pr ## (Intercept) 1 1015.6 2 30 0.00000000000000 0.000000000000 ## A 2 42.6 4 30 0.00000000000579 0.000000000401 ## Residuals 15 ## H-F Pr ## (Intercept) 0.0000000000000 ## A 0.0000000000544 ## Residuals 481anova(fitSPFp.qr, M=~B + C, X=~B,idata=inSPFp.qr, test="Spherical") ## Analysis of Variance Table ## ## ## Contrasts orthogonal to ## ~B ## ## ## Contrasts spanned by ## ~B + C ## ## Greenhouse-Geisser epsilon: 1 ## Huynh-Feldt epsilon: 1 ## ## Df F num Df den Df Pr(>F) G-G Pr H-F Pr ## (Intercept) 1 1262 1 15 0.000000000 0.000000000 0.000000000 ## A 2 55 2 15 0.000000125 0.000000125 0.000000125 ## Residuals 15 anova(fitSPFp.qr, M=~B + C + B:C, X=~B + C, idata=inSPFp.qr, test="Spherical") ## Analysis of Variance Table ## ## ## Contrasts orthogonal to ## ~B + C ## ## ## Contrasts spanned by ## ~B + C + B:C ## ## Greenhouse-Geisser epsilon: 0.8101 482## Huynh-Feldt epsilon: 0.8940 ## ## Df F num Df den Df Pr(>F) G-G Pr ## (Intercept) 1 988.4 2 30 0.00000000000000 0.000000000000 ## A 2 42.4 4 30 0.00000000000618 0.000000000496 ## Residuals 15 ## H-F Pr ## (Intercept) 0.0000000000000 ## A 0.0000000000713 ## Residuals mauchly.test(fitSPFp.qr, M=~B, X=~1,idata=inSPFp.qr) ## ## Mauchly's test of sphericity ## Contrasts orthogonal to ## ~1 ## ## Contrasts spanned by ## ~B ## ## ## data: SSD matrix from lm(formula = cbind(DV.1.1, DV.2.1, DV.1.2, DV.2.2, DV.1.3, DV.2.3) ~ SSD matrix from A, data = dfSPFp.qrW) ## W = 0.78, p-value = 0.2 mauchly.test(fitSPFp.qr, M=~B + C, X=~B, idata=inSPFp.qr) ## ## Mauchly's test of sphericity ## Contrasts orthogonal to ## ~B ## ## Contrasts spanned by 483## ~B + C ## ## ## data: SSD matrix from lm(formula = cbind(DV.1.1, DV.2.1, DV.1.2, DV.2.2, DV.1.3, DV.2.3) ~ SSD matrix from A, data = dfSPFp.qrW) ## W = 1, p-value = 1 mauchly.test(fitSPFp.qr, M=~B + C + B:C, X=~B + C, idata=inSPFp.qr) ## ## Mauchly's test of sphericity ## Contrasts orthogonal to ## ~B + C ## ## Contrasts spanned by ## ~B + C + B:C ## ## ## data: SSD matrix from lm(formula = cbind(DV.1.1, DV.2.1, DV.1.2, DV.2.2, DV.1.3, DV.2.3) ~ SSD matrix from A, data = dfSPFp.qrW) ## W = 0.77, p-value = 0.2 10.7 混合模型重复测量方差分析(Mixed-effects models for repeated-measures ANOVA) 在分析数据时,考虑一个因素和它的不同水平对结果变量的影响,称之 为这个因素不同水平对因变量的效应。这种效应不是固定效应就是随机效 应,当参数能被认为是固定的常数时,这种因素所产生的效应为固定效应, 当参数有随机变量的特征时,称之为随机效应。当模型中有多个因素,一部 分产生固定效应,一部分产生随机效应,这样的模型就称为混合效应模型。 重复测量中的单次测量为低水平,个体为高水平,建立的模型如下: Y = Xβ + Zγ + ϵ ,X 为已知设计矩阵,β 为固定效应参数构成的未知向量,ϵ 为未知的随机误 差向量,其元素不必为独立同分布。Y 和 γ 均为正态随机变量。 484例 d1 为长格式的重复观测数据,因变量为 Y,自变量为 Xw1、Xb1 和 Xb2,w 表示组内因子,b 表示组间因子,id 为标示变量。d2 为长格式的重 复观测数据,因变量为 Y,自变量为 Xw1、Xw2、Xb1 和 Xb2,w 表示组 内因子,b 表示组间因子,id 为标示变量。 d1 <- read.csv("d1.csv",header = T) d2 <- read.csv("d2.csv",header = T) 10.7.1 单因素重复测量方差分析 (One-way repeated measures ANOVA, RB-p design) 10.7.1.1 常规分析 (Conventional analysis using aov()) summary(aov(Y ~ Xw1 + Error(id/Xw1), data=d1)) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## Residuals 79 75040 950 ## ## Error: id:Xw1 ## Df Sum Sq Mean Sq F value Pr(>F) ## Xw1 2 5756 2878 3.36 0.037 * ## Residuals 158 135211 856 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 结果显示自变量 Xw1 有统计学意义。 10.7.1.2 混合效应分析 (Mixed-effects analysis) 对重复测量的数据有个假设就是重复测量的数据间的关系是相同的,这 就是我们所说的 compound symmetry。但在实际中,往往会违背这个假设, 特别是当临床试验的时间特别长或各个测量的时间点的间隔不相同时,这是 因为间隔时间长的两个点的测量值之间的关系往往不如间隔时间短的两个 点的测量值之间的关系紧密。 485# 没有明确是否符合 compound symmetry 假设 anova(lme(Y ~ Xw1, random=~1 | id, method="ML", data=d1)) ## numDF denDF F-value p-value ## (Intercept) 1 158 2554.8 <.0001 ## Xw1 2 158 3.4 0.0371 # 符合 compound symmetry 假设 lmeFit <- lme(Y ~ Xw1, random=~1 | id, correlation=corCompSymm(form=~1|id), method="ML", data=d1) anova(lmeFit) ## numDF denDF F-value p-value ## (Intercept) 1 158 2554.8 <.0001 ## Xw1 2 158 3.4 0.0371 anova(lme(Y ~ Xw1, random=list(id=pdCompSymm(~Xw1-1)), method="REML", data=d1)) ## numDF denDF F-value p-value ## (Intercept) 1 158 2554.8 <.0001 ## Xw1 2 158 3.4 0.0371 结果显示自变量 Xw1 有统计学意义。 10.7.1.2.1 lme4 包 lmer() 方法 fitF <- lmer(Y ~ Xw1 + (1|id), data=d1) anova(fitF) ## Analysis of Variance Table ## Df Sum Sq Mean Sq F value ## Xw1 2 5756 2878 3.36 486fitR <- lmer(Y ~ 1 + (1|id), data=d1) library(pbkrtest) KRmodcomp(fitF, fitR) ## F-test with Kenward-Roger approximation; computing time: 0.44 sec. ## large : Y ~ Xw1 + (1 | id) ## small : Y ~ 1 + (1 | id) ## stat ndf ddf F.scaling p.value ## Ftest 3.36 2.00 158.00 1 0.037 * ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 结果显示自变量 Xw1 有统计学意义。 10.7.1.2.2 AIC 值比较 library(AICcmodavg) AICc(fitF) ## [1] 2304 aictab(cand.set=list(fitR, fitF), modnames=c("restricted","full"), sort=FALSE, second.ord=FALSE) ## Warning in aictab.AIClmerMod(cand.set = list(fitR, fitF), modnames = c("restricted", : ## Model selection for fixed effects is only appropriate with ML estimation: ## REML (default) should only be used to select random effects for a constant set of fixed effects ## ## Model selection based on AIC : ## ## K AIC Delta_AIC AICWt Res.LL ## restricted 3 2316 12.17 0 -1155 ## full 5 2304 0.00 1 -1147 48710.7.1.3 多重比较 (基于 multcomp 包的 glht() 方法) contr <- glht(lmeFit, linfct=mcp(Xw1="Tukey")) summary(contr) ## ## Simultaneous Tests for General Linear Hypotheses ## ## Multiple Comparisons of Means: Tukey Contrasts ## ## ## Fit: lme.formula(fixed = Y ~ Xw1, data = d1, random = ~1 | id, correlation = corCompSymm(form = ~1 | ## id), method = "ML") ## ## Linear Hypotheses: ## Estimate Std. Error z value Pr(>|z|) ## B - A == 0 10.3637 4.5964 2.25 0.062 . ## C - A == 0 10.4142 4.5964 2.27 0.061 . ## C - B == 0 0.0504 4.5964 0.01 1.000 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## (Adjusted p values reported -- single-step method) confint(contr) # 置信区间 ## ## Simultaneous Confidence Intervals ## ## Multiple Comparisons of Means: Tukey Contrasts ## ## ## Fit: lme.formula(fixed = Y ~ Xw1, data = d1, random = ~1 | id, correlation = corCompSymm(form = ~1 | ## id), method = "ML") ## 488## Quantile = 2.343 ## 95% family-wise confidence level ## ## ## Linear Hypotheses: ## Estimate lwr upr ## B - A == 0 10.3637 -0.4073 21.1348 ## C - A == 0 10.4142 -0.3569 21.1852 ## C - B == 0 0.0504 -10.7206 10.8215 Xw1 变量 B-A 和 C-A 比较有差异。 10.7.2 双因素重复测量方差分析 (Two-way repeated measures ANOVA ,RBF-pq design) 10.7.2.1 常规分析(Conventional analysis using aov()) summary(aov(Y ~ Xw1*Xw2 + Error(id/(Xw1*Xw2)), data=d2)) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## Residuals 79 225120 2850 ## ## Error: id:Xw1 ## Df Sum Sq Mean Sq F value Pr(>F) ## Xw1 2 17269 8635 3.36 0.037 * ## Residuals 158 405633 2567 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Error: id:Xw2 ## Df Sum Sq Mean Sq F value Pr(>F) ## Xw2 2 9859 4929 1.62 0.2 ## Residuals 158 481938 3050 489## ## Error: id:Xw1:Xw2 ## Df Sum Sq Mean Sq F value Pr(>F) ## Xw1:Xw2 4 6118 1529 0.6 0.66 ## Residuals 316 802069 2538 结果显示自变量 Xw1 有统计学意义。 10.7.2.2 Mixed-effects analysis 10.7.2.2.1 nlme 包 lme 方法(Using lme() from package nlme) anova(lme(Y ~ Xw1*Xw2, random=list(id=pdBlocked(list(~1, pdIdent(~Xw1-1), pdIdent(~Xw2-1)))), method="ML", data=d2)) ## numDF denDF F-value p-value ## (Intercept) 1 632 2440.2 <.0001 ## Xw1 2 632 3.4 0.0344 ## Xw2 2 632 1.7 0.1924 ## Xw1:Xw2 4 632 0.6 0.6626 # 符合 compound symmetry 假设 anova(lme(Y ~ Xw1*Xw2, random=list(id=pdBlocked(list(~1, pdCompSymm(~Xw1-1), pdCompSymm(~Xw2-1)))), method="ML", data=d2)) ## numDF denDF F-value p-value ## (Intercept) 1 632 2554.8 <.0001 ## Xw1 2 632 3.4 0.0352 ## Xw2 2 632 1.6 0.1995 ## Xw1:Xw2 4 632 0.6 0.6609 结果显示自变量 Xw1 有统计学意义。 49010.7.2.2.2 lme4 包 lmer() 方法 (Using lmer() from package lme4) anova(lmer(Y ~ Xw1*Xw2 + (1|id) + (1|Xw1:id) + (1|Xw2:id), data=d2)) ## Analysis of Variance Table ## Df Sum Sq Mean Sq F value ## Xw1 2 17269 8635 3.39 ## Xw2 2 8419 4210 1.65 ## Xw1:Xw2 4 6118 1529 0.60 根据 F 值判断自变量 Xw1 有统计学意义。 10.7.3 两级裂区设计的方差分析 (Two-way split-plot-factorial ANOVA ,SPF-p￿q design) 10.7.3.1 常规分析 (Conventional analysis using aov()) summary(aov(Y ~ Xb1*Xw1 + Error(id/Xw1), data=d1)) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## Xb1 1 5335 5335 5.97 0.017 * ## Residuals 78 69705 894 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Error: id:Xw1 ## Df Sum Sq Mean Sq F value Pr(>F) ## Xw1 2 5756 2878 3.54 0.0313 * ## Xb1:Xw1 2 8414 4207 5.18 0.0067 ** ## Residuals 156 126797 813 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 49110.7.3.2 混合效应分析 (Mixed-effects) 10.7.3.2.1 nlme 包 lme 方法 (Using lme() from package nlme) # 没有明确是否符合 compound symmetry 假设 anova(lme(Y ~ Xb1*Xw1, random=~1 | id, method="ML", data=d1)) ## numDF denDF F-value p-value ## (Intercept) 1 156 2715.5 <.0001 ## Xb1 1 78 6.0 0.0168 ## Xw1 2 156 3.5 0.0313 ## Xb1:Xw1 2 156 5.2 0.0067 # 符合 compound symmetry 假设 anova(lme(Y ~ Xb1*Xw1, random=~1 | id, correlation=corCompSymm(form=~1|id), method="ML", data=d1)) ## numDF denDF F-value p-value ## (Intercept) 1 156 2715.5 <.0001 ## Xb1 1 78 6.0 0.0168 ## Xw1 2 156 3.5 0.0313 ## Xb1:Xw1 2 156 5.2 0.0067 anova(lme(Y ~ Xb1*Xw1, random=list(id=pdCompSymm(~Xw1-1)), method="REML", data=d1)) ## numDF denDF F-value p-value ## (Intercept) 1 156 2715.5 <.0001 ## Xb1 1 78 6.0 0.0168 ## Xw1 2 156 3.5 0.0313 ## Xb1:Xw1 2 156 5.2 0.0067 自变量 Xb1、Xw1 和其交互效应均有统计学意义。 49210.7.3.2.2 lme4 包 lmer() 方法(Using lmer() from package lme4) anova(lmer(Y ~ Xb1*Xw1 + (1|id), data=d1)) ## Analysis of Variance Table ## Df Sum Sq Mean Sq F value ## Xb1 1 4852 4852 5.97 ## Xw1 2 5756 2878 3.54 ## Xb1:Xw1 2 8414 4207 5.18 10.7.4 三级裂区设计的方差分析 (Three-way split-plot-factorial ANOVA ,SPF-pq￿r design) 10.7.4.1 常规分析 (Conventional analysis using aov()) summary(aov(Y ~ Xb1*Xb2*Xw1 + Error(id/Xw1), data=d1)) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## Xb1 1 5335 5335 7.47 0.0078 ** ## Xb2 1 7246 7246 10.14 0.0021 ** ## Xb1:Xb2 1 8169 8169 11.44 0.0011 ** ## Residuals 76 54290 714 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Error: id:Xw1 ## Df Sum Sq Mean Sq F value Pr(>F) ## Xw1 2 5756 2878 4.12 0.01817 * ## Xb1:Xw1 2 8414 4207 6.02 0.00306 ** ## Xb2:Xw1 2 11336 5668 8.11 0.00045 *** ## Xb1:Xb2:Xw1 2 9167 4583 6.55 0.00186 ** ## Residuals 152 106294 699 493## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 自变量 Xb1、Xb2、Xw1 和其交互效应均有统计学意义。 10.7.4.2 混合效应模型 (Mixed-effects analysis) 10.7.4.2.1 nlme 包 lme 方法 (Using lme() from package nlme) # 没有明确是否符合 compound symmetry 假设 anova(lme(Y ~ Xb1*Xb2*Xw1, random=~1 | id, method="ML", data=d1)) ## numDF denDF F-value p-value ## (Intercept) 1 152 3397 <.0001 ## Xb1 1 76 7 0.0078 ## Xb2 1 76 10 0.0021 ## Xw1 2 152 4 0.0182 ## Xb1:Xb2 1 76 11 0.0011 ## Xb1:Xw1 2 152 6 0.0031 ## Xb2:Xw1 2 152 8 0.0005 ## Xb1:Xb2:Xw1 2 152 7 0.0019 # 符合 compound symmetry 假设 anova(lme(Y ~ Xb1*Xb2*Xw1, random=~1 | id, correlation=corCompSymm(form=~1 | id), method="ML", data=d1)) ## numDF denDF F-value p-value ## (Intercept) 1 152 3397 <.0001 ## Xb1 1 76 7 0.0078 ## Xb2 1 76 10 0.0021 ## Xw1 2 152 4 0.0182 ## Xb1:Xb2 1 76 11 0.0011 ## Xb1:Xw1 2 152 6 0.0031 ## Xb2:Xw1 2 152 8 0.0005 ## Xb1:Xb2:Xw1 2 152 7 0.0019 494anova(lme(Y ~ Xb1*Xb2*Xw1, random=list(id=pdBlocked(list(~1, pdCompSymm(~Xw1-1)))), method="ML", data=d1)) ## Warning in lme.formula(Y ~ Xb1 * Xb2 * Xw1, random = list(id = ## pdBlocked(list(~1, : fewer observations than random effects in all level 1 ## groups ## numDF denDF F-value p-value ## (Intercept) 1 152 3397 <.0001 ## Xb1 1 76 7 0.0078 ## Xb2 1 76 10 0.0021 ## Xw1 2 152 4 0.0182 ## Xb1:Xb2 1 76 11 0.0011 ## Xb1:Xw1 2 152 6 0.0031 ## Xb2:Xw1 2 152 8 0.0005 ## Xb1:Xb2:Xw1 2 152 7 0.0019 自变量 Xb1、Xb2、Xw1 和其交互效应均有统计学意义。 10.7.4.2.2 lme4 包 lmer() 方法(Using lmer() from package lme4) anova(lmer(Y ~ Xb1*Xb2*Xw1 + (1|id), data=d1)) ## Analysis of Variance Table ## Df Sum Sq Mean Sq F value ## Xb1 1 5223 5223 7.47 ## Xb2 1 7093 7093 10.14 ## Xw1 2 5756 2878 4.12 ## Xb1:Xb2 1 7997 7997 11.44 ## Xb1:Xw1 2 8414 4207 6.02 ## Xb2:Xw1 2 11336 5668 8.11 ## Xb1:Xb2:Xw1 2 9167 4583 6.55 根据 F 值判断自变量 Xb1、Xb2、Xw1 和其交互效应均有统计学意义。 49510.7.5 三级裂区设计的方差分析 Three-way split-plot-factorial ANOVA (SPF-p￿qr design) 10.7.5.1 常规分析 (Conventional analysis using aov()) summary(aov(Y ~ Xb1*Xw1*Xw2 + Error(id/(Xw1*Xw2)), data=d2)) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## Xb1 1 16005 16005 5.97 0.017 * ## Residuals 78 209116 2681 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Error: id:Xw1 ## Df Sum Sq Mean Sq F value Pr(>F) ## Xw1 2 17269 8635 3.54 0.0313 * ## Xb1:Xw1 2 25243 12622 5.18 0.0067 ** ## Residuals 156 380390 2438 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Error: id:Xw2 ## Df Sum Sq Mean Sq F value Pr(>F) ## Xw2 2 9859 4929 1.6 0.20 ## Xb1:Xw2 2 2462 1231 0.4 0.67 ## Residuals 156 479476 3074 ## ## Error: id:Xw1:Xw2 ## Df Sum Sq Mean Sq F value Pr(>F) ## Xw1:Xw2 4 6118 1529 0.60 0.66 ## Xb1:Xw1:Xw2 4 7609 1902 0.75 0.56 ## Residuals 312 794460 2546 496Xb1、Xw1 和 Xw2 无统计学意义。 10.7.5.2 混合效应模型 (Mixed-effects analysis) 10.7.5.2.1 nlme 包 lme 方法 (Using lme() from package nlme) # 没有明确是否符合 compound symmetry 假设 anova(lme(Y ~ Xb1*Xw1*Xw2, random=list(id=pdBlocked(list(~1, pdIdent(~Xw1-1), pdIdent(~Xw2-1)))), method="ML", data=d2)) ## numDF denDF F-value p-value ## (Intercept) 1 624 2474.0 <.0001 ## Xb1 1 78 5.4 0.0223 ## Xw1 2 624 3.4 0.0327 ## Xw2 2 624 1.7 0.1881 ## Xb1:Xw1 2 624 5.0 0.0068 ## Xb1:Xw2 2 624 0.4 0.6584 ## Xw1:Xw2 4 624 0.6 0.6561 ## Xb1:Xw1:Xw2 4 624 0.8 0.5531 # 符合 compound symmetry 假设 anova(lme(Y ~ Xb1*Xw1*Xw2, random=list(id=pdBlocked(list(~1, pdCompSymm(~Xw1-1), pdCompSymm(~Xw2-1)))), method="ML", data=d2)) ## numDF denDF F-value p-value ## (Intercept) 1 624 2715.4 <.0001 ## Xb1 1 78 6.0 0.0168 ## Xw1 2 624 3.4 0.0327 ## Xw2 2 624 1.6 0.2020 ## Xb1:Xw1 2 624 5.0 0.0068 497## Xb1:Xw2 2 624 0.4 0.6702 ## Xw1:Xw2 4 624 0.6 0.6561 ## Xb1:Xw1:Xw2 4 624 0.8 0.5531 Xb1、Xw1 和其交互作用有统计学意义。 10.7.5.2.2 lme4 包 lmer() 方法(Using lmer() from package lme4) anova(lmer(Y ~ Xb1*Xw1*Xw2 + (1|id) + (1|Xw1:id) + (1|Xw2:id), data=d2)) ## Analysis of Variance Table ## Df Sum Sq Mean Sq F value ## Xb1 1 13653 13653 5.44 ## Xw1 2 17269 8635 3.44 ## Xw2 2 8410 4205 1.68 ## Xb1:Xw1 2 25243 12622 5.03 ## Xb1:Xw2 2 2100 1050 0.42 ## Xw1:Xw2 4 6118 1529 0.61 ## Xb1:Xw1:Xw2 4 7609 1902 0.76 10.7.6 四级裂区设计的方差分析 (Four-way split-plot-factorial ANOVA ,SPF-pq￿rs design) 10.7.6.1 常规分析 (Conventional analysis using aov()) summary(aov(Y ~ Xb1*Xb2*Xw1*Xw2 + Error(id/(Xw1*Xw2)), data=d2)) ## ## Error: id ## Df Sum Sq Mean Sq F value Pr(>F) ## Xb1 1 16005 16005 7.47 0.0078 ** ## Xb2 1 21738 21738 10.14 0.0021 ** ## Xb1:Xb2 1 24507 24507 11.44 0.0011 ** ## Residuals 76 162871 2143 ## --- 498## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Error: id:Xw1 ## Df Sum Sq Mean Sq F value Pr(>F) ## Xw1 2 17269 8635 4.12 0.01817 * ## Xb1:Xw1 2 25243 12622 6.02 0.00306 ** ## Xb2:Xw1 2 34008 17004 8.11 0.00045 *** ## Xb1:Xb2:Xw1 2 27500 13750 6.55 0.00186 ** ## Residuals 152 318882 2098 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Error: id:Xw2 ## Df Sum Sq Mean Sq F value Pr(>F) ## Xw2 2 9859 4929 1.73 0.1811 ## Xb1:Xw2 2 2462 1231 0.43 0.6503 ## Xb2:Xw2 2 11822 5911 2.07 0.1294 ## Xb1:Xb2:Xw2 2 34080 17040 5.97 0.0032 ** ## Residuals 152 433574 2852 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Error: id:Xw1:Xw2 ## Df Sum Sq Mean Sq F value Pr(>F) ## Xw1:Xw2 4 6118 1529 0.61 0.656 ## Xb1:Xw1:Xw2 4 7609 1902 0.76 0.553 ## Xb2:Xw1:Xw2 4 24545 6136 2.45 0.046 * ## Xb1:Xb2:Xw1:Xw2 4 7595 1899 0.76 0.554 ## Residuals 304 762320 2508 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Xb1、Xb2、Xb1:Xb2、Xw1、Xb1:Xw1、Xb2:Xw1 和 Xb1:Xb2:Xw1 均 有统计学意义。 49910.7.6.2 混合效应模型 (Mixed-effects analysis) 10.7.6.2.1 nlme 包 lme 方法 (Using lme() from package nlme) # 没有明确是否符合 compound symmetry 假设 anova(lme(Y ~ Xb1*Xb2*Xw1*Xw2, random=list(id=pdBlocked(list(~1, pdIdent(~Xw1-1), pdIdent(~Xw2-1)))), method="ML", data=d2)) ## numDF denDF F-value p-value ## (Intercept) 1 608 2782.9 <.0001 ## Xb1 1 76 6.1 0.0156 ## Xb2 1 76 8.3 0.0051 ## Xw1 2 608 3.6 0.0268 ## Xw2 2 608 1.9 0.1528 ## Xb1:Xb2 1 76 9.4 0.0031 ## Xb1:Xw1 2 608 5.3 0.0051 ## Xb2:Xw1 2 608 7.2 0.0008 ## Xb1:Xw2 2 608 0.5 0.6249 ## Xb2:Xw2 2 608 2.3 0.1053 ## Xw1:Xw2 4 608 0.6 0.6305 ## Xb1:Xb2:Xw1 2 608 5.8 0.0032 ## Xb1:Xb2:Xw2 2 608 6.5 0.0016 ## Xb1:Xw1:Xw2 4 608 0.8 0.5240 ## Xb2:Xw1:Xw2 4 608 2.6 0.0359 ## Xb1:Xb2:Xw1:Xw2 4 608 0.8 0.5249 # 符合 compound symmetry 假设 anova(lme(Y ~ Xb1*Xb2*Xw1*Xw2, random=list(id=pdBlocked(list(~1, pdCompSymm(~Xw1-1), pdCompSymm(~Xw2-1)))), method="ML", data=d2)) 500## numDF denDF F-value p-value ## (Intercept) 1 608 3113.2 <.0001 ## Xb1 1 76 6.8 0.0107 ## Xb2 1 76 9.3 0.0032 ## Xw1 2 608 3.7 0.0255 ## Xw2 2 608 1.7 0.1785 ## Xb1:Xb2 1 76 10.5 0.0018 ## Xb1:Xw1 2 608 5.4 0.0047 ## Xb2:Xw1 2 608 7.3 0.0008 ## Xb1:Xw2 2 608 0.4 0.6497 ## Xb2:Xw2 2 608 2.1 0.1268 ## Xw1:Xw2 4 608 0.7 0.6242 ## Xb1:Xb2:Xw1 2 608 5.9 0.0030 ## Xb1:Xb2:Xw2 2 608 6.0 0.0027 ## Xb1:Xw1:Xw2 4 608 0.8 0.5168 ## Xb2:Xw1:Xw2 4 608 2.6 0.0339 ## Xb1:Xb2:Xw1:Xw2 4 608 0.8 0.5178 Xb1、Xb2、Xb1:Xb2、Xw1、Xb1:Xw1、Xb2:Xw1 和 Xb1:Xb2:Xw1 均 有统计学意义。 10.7.6.2.2 lme4 包 lmer() 方法(Using lmer() from package lme4) anova(lmer(Y ~ Xb1*Xb2*Xw1*Xw2 + (1|id) + (1|Xw1:id) + (1|Xw2:id), data=d2)) ## Analysis of Variance Table ## Df Sum Sq Mean Sq F value ## Xb1 1 14506 14506 6.12 ## Xb2 1 19703 19703 8.31 ## Xw1 2 17269 8635 3.64 ## Xw2 2 8935 4468 1.88 ## Xb1:Xb2 1 22212 22212 9.37 ## Xb1:Xw1 2 25243 12622 5.32 501## Xb2:Xw1 2 34008 17004 7.17 ## Xb1:Xw2 2 2231 1116 0.47 ## Xb2:Xw2 2 10715 5357 2.26 ## Xw1:Xw2 4 6118 1529 0.65 ## Xb1:Xb2:Xw1 2 27500 13750 5.80 ## Xb1:Xb2:Xw2 2 30889 15444 6.51 ## Xb1:Xw1:Xw2 4 7609 1902 0.80 ## Xb2:Xw1:Xw2 4 24545 6136 2.59 ## Xb1:Xb2:Xw1:Xw2 4 7595 1899 0.80 根据 F 值判断 Xb1、Xb2、Xb1:Xb2、Xw1、Xb1:Xw1、Xb2:Xw1 和 Xb1:Xb2:Xw1 均有统计学意义。 50211 生存分析 生存分析 (Survival analysis) 是指根据试验或调查得到的数据对生物或 人的生存时间进行分析和推断,研究生存时间和结局与众多影响因素间关系 及其程度大小的方法,也称生存率分析或存活率分析。生存分析适合于处理 时间-事件数据, 生存时间 (survival time) 是指从某起点事件开始到被观测 对象出现终点事件所经历的时间,如从疾病的 “确诊” 到 “死亡”。生存时间 有两种类型:完全数据 (complete data) 指被观测对象从观察起点到出现终 点事件所经历的时间; 截尾数据 (consored data) 或删失数据,指在出现终 点事件前,被观测对象的观测过程终止了。由于被观测对象所提供的信息是 不完全的,只知道他们的生存事件超过了截尾时间。截尾主要由于失访、退 出和终止产生。生存分析方法大体上可分为三类:非参数法、半参数方法和 参数法,用 Kaplan-Meier 曲线 (也称乘积极限法 Product limit method) 和 寿命表法 (Life table method) 估计生存率和中位生存时间等是非参数的方 法,半参数方法指 Cox 比例风险模型,参数方法指指数模型、Weibull 模型、 Gompertz 模型等分析方法。 死亡概率 (mortality probability) 指某段时间开始时生存的个体在该段 时间内死亡的可能性大小,若无删失数据,死亡概率 = 某人群某段时间总死 亡例数/该人群同时间段期初观察例数。生存概率 (survival probability) 指 某段时间开始时存活的个体至该时间结束时仍然存活的可能性大小,生存概 率 =1-死亡概率 = 某人群活过某段时间例数/该人群同时间段期初观察例 数。由于生存分析中常存在删失数据,假定删失事件在观察时间内各个时间 点等机会发生,分母改用校正观察例数。校正观察例数 = 期初观察例数-删 失例数/2。生存率 (Survival rate),用 S(tk) 表示,指经历 tk 个单位时间后 仍存活的概率,若无删失数据,则为活过了 tk 时刻仍然存活的例数/观察开 始的总例数。如果有删失数据,分母则需要按时段进行校正,此时生存率的 计算公式为 S(tk) = P(T > tk) = p1 · p2 ··· pk , 其中 p1 · p2 ··· pk 表示不同时间段的生存概率。生存率为多个时间段生存 概率的累积,故又称累积生存概率,其标准误计算公式为 SE(S(tk)) = S(tk) vuut k∑ i=1 qi pini ,qi 为死亡概率,pi 为生存概率。 503例 addicts 是 238 名病例随访信息,status 变量表示病例的生存状况 (0 为删失,1 为终点事件),Days.survival 变量表示生存的天数。 addicts <- read.table('ADDICTS.txt',T) addicts$Clinic <- as.factor(addicts$Clinic) addicts$Prison <- as.factor(addicts$Prison) 11.1 非参数法 11.1.1 寿命表(Life Table) 寿命表时描述一段时间内生存状况、终点事件和生存概率的表格,需 计算累积生存概率即每一步生存概率的乘积,可完成对病例随访资料在任 意指定时点的生存状况评价。survival 包中包括了所有生存分析所必须的 函数,生存分析主要是把数据放入 Surv object,通过 Surv() 函数做进一 步分析。Surv object 是将时间和生存状况的信息合并在一个简单的对象内, Surv(time, time2, event,type=c(‘right’, ‘left’, ‘interval’, ‘counting’, ‘inter- val2’, ‘mstate’),origin=0),time 为生存时间,time2 为区间删失的结束时间, event 为生存状况,生存状况变量必须是数值或者逻辑型的。如果时数值型, 则有两个选项,0 表示删失,1 表示终点事件,或者 1 表示删失,2 表示终 点事件。如果时逻辑型的,则 FALSE 表示删失,True 表示终点事件。type 为删失的类型有右删失、左删失、区间删失、第一类区间删失、第二类区间 删失。 addicts$surv <- Surv(addicts$Days.survival,addicts$Status) summary(survfit(addicts$surv~1),censor=T) ## Call: survfit(formula = addicts$surv ~ 1) ## ## time n.risk n.event survival std.err lower 95% CI upper 95% CI ## 2 238 0 1.000 0.00000 1.0000 1.000 ## 7 236 1 0.996 0.00423 0.9875 1.000 ## 13 235 1 0.992 0.00597 0.9799 1.000 ## 17 234 1 0.987 0.00729 0.9731 1.000 ## 19 233 1 0.983 0.00840 0.9667 1.000 504## 26 232 1 0.979 0.00937 0.9606 0.997 ## 28 231 0 0.979 0.00937 0.9606 0.997 ## 29 229 1 0.975 0.01026 0.9546 0.995 ## 30 228 1 0.970 0.01107 0.9488 0.992 ## 33 227 1 0.966 0.01182 0.9431 0.989 ## 35 226 2 0.957 0.01317 0.9320 0.984 ## 37 224 1 0.953 0.01379 0.9265 0.981 ## 41 223 2 0.945 0.01493 0.9158 0.974 ## 47 221 1 0.940 0.01546 0.9105 0.971 ## 49 220 1 0.936 0.01597 0.9053 0.968 ## 50 219 1 0.932 0.01646 0.9001 0.965 ## 53 218 0 0.932 0.01646 0.9001 0.965 ## 59 216 1 0.927 0.01694 0.8949 0.961 ## 62 215 1 0.923 0.01740 0.8897 0.958 ## 67 213 1 0.919 0.01785 0.8845 0.954 ## 72 212 0 0.919 0.01785 0.8845 0.954 ## 75 211 1 0.914 0.01829 0.8793 0.951 ## 79 210 1 0.910 0.01871 0.8742 0.948 ## 84 209 1 0.906 0.01913 0.8691 0.944 ## 86 208 0 0.906 0.01913 0.8691 0.944 ## 90 207 1 0.901 0.01953 0.8639 0.940 ## 95 206 1 0.897 0.01992 0.8588 0.937 ## 96 205 1 0.893 0.02029 0.8537 0.933 ## 98 204 0 0.893 0.02029 0.8537 0.933 ## 103 203 0 0.893 0.02029 0.8537 0.933 ## 109 202 1 0.888 0.02067 0.8486 0.930 ## 111 201 0 0.888 0.02067 0.8486 0.930 ## 117 200 1 0.884 0.02104 0.8435 0.926 ## 122 199 1 0.879 0.02140 0.8384 0.922 ## 126 198 1 0.875 0.02174 0.8333 0.919 ## 127 197 1 0.870 0.02208 0.8282 0.915 ## 129 196 1 0.866 0.02241 0.8232 0.911 ## 136 194 1 0.862 0.02274 0.8181 0.907 505## 143 193 1 0.857 0.02305 0.8131 0.903 ## 145 192 1 0.853 0.02336 0.8080 0.900 ## 146 191 0 0.853 0.02336 0.8080 0.900 ## 147 190 1 0.848 0.02366 0.8030 0.896 ## 148 189 0 0.848 0.02366 0.8030 0.896 ## 149 188 1 0.844 0.02396 0.7979 0.892 ## 150 187 1 0.839 0.02426 0.7929 0.888 ## 157 185 1 0.835 0.02455 0.7878 0.884 ## 160 184 1 0.830 0.02483 0.7828 0.880 ## 161 183 1 0.826 0.02510 0.7777 0.876 ## 167 181 1 0.821 0.02538 0.7727 0.872 ## 168 180 1 0.816 0.02564 0.7676 0.868 ## 170 179 1 0.812 0.02590 0.7626 0.864 ## 175 178 1 0.807 0.02615 0.7576 0.860 ## 176 176 1 0.803 0.02640 0.7526 0.856 ## 180 175 2 0.794 0.02689 0.7425 0.848 ## 181 173 1 0.789 0.02712 0.7375 0.844 ## 183 172 1 0.784 0.02735 0.7325 0.840 ## 190 171 1 0.780 0.02757 0.7275 0.836 ## 192 170 1 0.775 0.02779 0.7226 0.832 ## 193 169 1 0.771 0.02800 0.7176 0.827 ## 204 168 1 0.766 0.02821 0.7127 0.823 ## 205 166 1 0.761 0.02841 0.7077 0.819 ## 207 165 1 0.757 0.02861 0.7027 0.815 ## 209 164 1 0.752 0.02881 0.6978 0.811 ## 210 163 0 0.752 0.02881 0.6978 0.811 ## 212 162 2 0.743 0.02919 0.6878 0.802 ## 216 160 2 0.734 0.02955 0.6779 0.794 ## 222 158 0 0.734 0.02955 0.6779 0.794 ## 223 157 1 0.729 0.02973 0.6729 0.790 ## 231 156 1 0.724 0.02991 0.6679 0.785 ## 232 155 1 0.720 0.03008 0.6630 0.781 ## 237 154 1 0.715 0.03024 0.6580 0.777 506## 244 153 1 0.710 0.03040 0.6531 0.772 ## 247 152 1 0.706 0.03056 0.6481 0.768 ## 257 151 1 0.701 0.03071 0.6432 0.764 ## 258 150 1 0.696 0.03086 0.6383 0.759 ## 259 149 1 0.692 0.03101 0.6333 0.755 ## 262 148 2 0.682 0.03128 0.6235 0.746 ## 268 146 2 0.673 0.03154 0.6138 0.738 ## 275 144 1 0.668 0.03167 0.6089 0.733 ## 280 143 1 0.663 0.03179 0.6040 0.729 ## 283 142 0 0.663 0.03179 0.6040 0.729 ## 286 141 1 0.659 0.03191 0.5991 0.724 ## 293 140 1 0.654 0.03203 0.5942 0.720 ## 294 139 1 0.649 0.03214 0.5893 0.716 ## 299 138 1 0.645 0.03225 0.5844 0.711 ## 302 137 1 0.640 0.03236 0.5796 0.707 ## 314 136 1 0.635 0.03246 0.5747 0.702 ## 317 135 0 0.635 0.03246 0.5747 0.702 ## 322 134 1 0.631 0.03256 0.5698 0.698 ## 325 133 0 0.631 0.03256 0.5698 0.698 ## 326 132 0 0.631 0.03256 0.5698 0.698 ## 337 131 1 0.626 0.03267 0.5648 0.693 ## 341 129 1 0.621 0.03277 0.5598 0.689 ## 342 128 0 0.621 0.03277 0.5598 0.689 ## 346 127 0 0.621 0.03277 0.5598 0.689 ## 348 126 1 0.616 0.03288 0.5547 0.684 ## 350 125 1 0.611 0.03298 0.5496 0.679 ## 358 124 1 0.606 0.03308 0.5446 0.675 ## 366 122 1 0.601 0.03318 0.5395 0.670 ## 367 121 1 0.596 0.03328 0.5343 0.665 ## 368 119 1 0.591 0.03338 0.5292 0.660 ## 376 118 1 0.586 0.03347 0.5241 0.656 ## 386 117 1 0.581 0.03355 0.5189 0.651 ## 389 116 1 0.576 0.03364 0.5138 0.646 507## 393 115 1 0.571 0.03371 0.5087 0.641 ## 394 114 1 0.566 0.03379 0.5036 0.636 ## 399 112 1 0.561 0.03386 0.4984 0.631 ## 405 111 0 0.561 0.03386 0.4984 0.631 ## 408 110 0 0.561 0.03386 0.4984 0.631 ## 428 109 1 0.556 0.03394 0.4932 0.627 ## 434 108 1 0.551 0.03401 0.4879 0.622 ## 438 107 1 0.546 0.03408 0.4827 0.617 ## 439 106 0 0.546 0.03408 0.4827 0.617 ## 450 105 1 0.540 0.03415 0.4774 0.612 ## 452 104 1 0.535 0.03422 0.4722 0.607 ## 456 103 0 0.535 0.03422 0.4722 0.607 ## 457 102 1 0.530 0.03428 0.4668 0.602 ## 460 101 1 0.525 0.03434 0.4615 0.597 ## 461 100 0 0.525 0.03434 0.4615 0.597 ## 465 99 1 0.519 0.03440 0.4562 0.591 ## 475 98 0 0.519 0.03440 0.4562 0.591 ## 480 97 0 0.519 0.03440 0.4562 0.591 ## 482 96 1 0.514 0.03447 0.4507 0.586 ## 489 95 1 0.509 0.03453 0.4452 0.581 ## 496 94 1 0.503 0.03458 0.4398 0.576 ## 504 92 1 0.498 0.03463 0.4342 0.570 ## 512 91 1 0.492 0.03468 0.4287 0.565 ## 514 90 1 0.487 0.03473 0.4232 0.560 ## 517 89 1 0.481 0.03476 0.4178 0.554 ## 518 87 1 0.476 0.03480 0.4122 0.549 ## 522 86 1 0.470 0.03483 0.4067 0.544 ## 523 85 2 0.459 0.03488 0.3956 0.533 ## 531 83 0 0.459 0.03488 0.3956 0.533 ## 532 80 1 0.453 0.03491 0.3899 0.527 ## 533 78 1 0.448 0.03495 0.3841 0.522 ## 540 77 1 0.442 0.03497 0.3783 0.516 ## 541 76 0 0.442 0.03497 0.3783 0.516 508## 543 75 0 0.442 0.03497 0.3783 0.516 ## 546 74 1 0.436 0.03501 0.3723 0.510 ## 550 73 1 0.430 0.03503 0.3664 0.504 ## 551 72 0 0.430 0.03503 0.3664 0.504 ## 555 71 0 0.430 0.03503 0.3664 0.504 ## 560 70 1 0.424 0.03507 0.3603 0.498 ## 563 69 1 0.418 0.03509 0.3542 0.492 ## 564 66 0 0.418 0.03509 0.3542 0.492 ## 566 64 0 0.418 0.03509 0.3542 0.492 ## 575 63 0 0.418 0.03509 0.3542 0.492 ## 581 62 1 0.411 0.03517 0.3474 0.486 ## 587 60 0 0.411 0.03517 0.3474 0.486 ## 591 59 1 0.404 0.03525 0.3404 0.479 ## 602 57 0 0.404 0.03525 0.3404 0.479 ## 609 56 0 0.404 0.03525 0.3404 0.479 ## 611 55 0 0.404 0.03525 0.3404 0.479 ## 612 54 2 0.389 0.03550 0.3252 0.465 ## 613 52 0 0.389 0.03550 0.3252 0.465 ## 624 51 1 0.381 0.03561 0.3175 0.458 ## 633 50 0 0.381 0.03561 0.3175 0.458 ## 641 49 0 0.381 0.03561 0.3175 0.458 ## 646 48 1 0.373 0.03574 0.3095 0.450 ## 652 47 1 0.365 0.03586 0.3015 0.443 ## 661 46 1 0.357 0.03595 0.2935 0.435 ## 667 45 1 0.350 0.03601 0.2856 0.428 ## 679 44 1 0.342 0.03606 0.2777 0.420 ## 683 43 1 0.334 0.03609 0.2699 0.412 ## 684 41 0 0.334 0.03609 0.2699 0.412 ## 708 39 1 0.325 0.03616 0.2614 0.404 ## 713 38 0 0.325 0.03616 0.2614 0.404 ## 714 37 1 0.316 0.03623 0.2527 0.396 ## 730 36 0 0.316 0.03623 0.2527 0.396 ## 739 35 1 0.307 0.03631 0.2437 0.387 509## 749 34 1 0.298 0.03635 0.2348 0.379 ## 755 33 1 0.289 0.03635 0.2260 0.370 ## 760 32 1 0.280 0.03632 0.2173 0.361 ## 769 31 0 0.280 0.03632 0.2173 0.361 ## 771 28 1 0.270 0.03638 0.2075 0.352 ## 774 27 1 0.260 0.03638 0.1978 0.342 ## 785 26 1 0.250 0.03633 0.1882 0.332 ## 787 25 0 0.250 0.03633 0.1882 0.332 ## 788 24 0 0.250 0.03633 0.1882 0.332 ## 790 23 0 0.250 0.03633 0.1882 0.332 ## 796 22 0 0.250 0.03633 0.1882 0.332 ## 808 21 0 0.250 0.03633 0.1882 0.332 ## 821 20 2 0.225 0.03675 0.1635 0.310 ## 826 18 0 0.225 0.03675 0.1635 0.310 ## 836 17 1 0.212 0.03690 0.1506 0.298 ## 837 16 1 0.199 0.03689 0.1380 0.286 ## 840 15 0 0.199 0.03689 0.1380 0.286 ## 857 14 1 0.184 0.03688 0.1246 0.273 ## 878 13 1 0.170 0.03667 0.1116 0.260 ## 881 12 0 0.170 0.03667 0.1116 0.260 ## 884 11 0 0.170 0.03667 0.1116 0.260 ## 892 10 1 0.153 0.03675 0.0958 0.245 ## 899 9 1 0.136 0.03639 0.0807 0.230 ## 905 8 0 0.136 0.03639 0.0807 0.230 ## 932 7 0 0.136 0.03639 0.0807 0.230 ## 944 5 0 0.136 0.03639 0.0807 0.230 ## 969 4 0 0.136 0.03639 0.0807 0.230 ## 1021 3 0 0.136 0.03639 0.0807 0.230 ## 1052 2 0 0.136 0.03639 0.0807 0.230 ## 1076 1 0 0.136 0.03639 0.0807 0.230 上表的第一行表示,在第 2 天,有 238 个调查对象,没有发生终点事件 (n.event),生存概率为 (238-0)/238=1, 其中有 2 个删失对象没有显示出来。 第二行表示在第 7 天,有 236 个对象,其中 1 个发生了终点事件,生存概 510率为 (236-1)/235*1=0.996。寿命表中其他数据行的意思类似。 11.1.2 Kaplan-Meier 曲线 Kaplan-Meier 曲线也称生存曲线,纵轴表示生存概率,横轴表示生存 事件,它是一条下降的曲线, 下降的坡度越陡, 表示生存率越低或生存时间 越短, 其斜率表示死亡速率。如果在概率 50% 处画一条水平线,它将中位生 存事件点和生存曲线相交。 KM0 <- survfit(surv ~ 1, type="kaplan-meier",data=addicts) kml <- summary(KM0,censor=T) attributes(kml) ## $names ## [1] "n" "time" "n.risk" "n.event" "n.censor" ## [6] "surv" "type" "std.err" "upper" "lower" ## [11] "conf.type" "conf.int" "call" "table" ## ## $class ## [1] "summary.survfit" plot(kml$time,kml$surv,type="s") plot(survfit(addicts$surv~1)) # 绘制一条曲线时,图形中 a 包含 95% 的置信区间和删失标记, # 不需要可设置为 False plot(survfit(addicts$surv~1),conf.int = F,mark.time = F) abline(h=0.5,lty=2,col="red") # 中位生存期 survfit(addicts$surv~1) 5110 200 400 600 800 1000 0.2 0.4 0.6 0.8 1.0 kml$time kml$surv 图 49: 0 200 400 600 800 1000 0.0 0.2 0.4 0.6 0.8 1.0 图 50: 5120 200 400 600 800 1000 0.0 0.2 0.4 0.6 0.8 1.0 图 51: ## Call: survfit(formula = addicts$surv ~ 1) ## ## n events median 0.95LCL 0.95UCL ## 238 150 504 399 560 #25%,50% 和 75% 生存期 quantile(KM0, probs=c(0.25, 0.5, 0.75), conf.int=FALSE) ## 25 50 75 ## 212 504 821 #50 天和 100 天生存状况 summary(KM0, times=c(50, 100)) ## Call: survfit(formula = surv ~ 1, data = addicts, type = "kaplan-meier") ## ## time n.risk n.event survival std.err lower 95% CI upper 95% CI ## 50 219 16 0.932 0.0165 0.900 0.965 ## 100 203 9 0.893 0.0203 0.854 0.933 513在 survfit 函数中改变公式右边的参数,可获得不同因子水平的生存曲 线。 plot(survfit(addicts$surv~addicts$Clinic),col=c("red","blue"),conf.int = F) legend(10,.4,legend=c("1","2"),col = c("red","blue"),lty=c(1,1)) 0 200 400 600 800 1000 0.0 0.2 0.4 0.6 0.8 1.0 1 2 图 52: 不同生存曲线间是否有差异,可通过 survdiff 进行比较,该函数最后 一个参数时 rho,用于指定检验的类型。让 rho=0(默认时),进行对数秩 (log-rank) 检验或 Mantel − Haenszelχ2 检验,比较各组期望频数和实际观 察数。如果两组间的差异水平太大,χ2 会较大而 P 值较小,表示生存曲线 有统计学差异。当 rho=1 时,进行 Gehan-Wilcoxon 的 Peto 校正检验,该 检验赋予早期终点事件较大的权重。 survdiff(addicts$surv~addicts$Clinic) ## Call: ## survdiff(formula = addicts$surv ~ addicts$Clinic) ## ## N Observed Expected (O-E)^2/E (O-E)^2/V ## addicts$Clinic=1 163 122 90.9 10.6 27.9 514## addicts$Clinic=2 75 28 59.1 16.4 27.9 ## ## Chisq= 27.9 on 1 degrees of freedom, p= 0.000000128 11.1.3 分层比较 在 Clinic 变量有可能和其他变量之间存在相关性,应调整其影响后,研 究生存区间之间的差异。 cc(addicts$Clinic,addicts$Prison) 0.3 0.36 0.43 0.5 0.6 0.71 OR = 1.08 95% CI = 0.6 , 1.94 Exposure category0 1 Odds ratio from prospective/X−sectional study Exposure = $, outcome = $ Exposure = addicts, outcome = addicts Odds of being 2 图 53: ## ## addicts$Prison ## addicts$Clinic 0 1 Total ## 1 88 75 163 ## 2 39 36 75 ## Total 127 111 238 515## ## OR = 1.08 ## Exact 95% CI = 0.6, 1.94 ## Chi-squared = 0.08, 1 d.f., P value = 0.775 ## Fisher's exact test (2-sided) P value = 0.782 survdiff(addicts$surv~addicts$Clinic+strata(addicts$Prison)) ## Call: ## survdiff(formula = addicts$surv ~ addicts$Clinic + strata(addicts$Prison)) ## ## N Observed Expected (O-E)^2/E (O-E)^2/V ## addicts$Clinic=1 163 122 91.7 10.0 26.9 ## addicts$Clinic=2 75 28 58.3 15.8 26.9 ## ## Chisq= 26.9 on 1 degrees of freedom, p= 0.00000021 在调整 addicts$Prison 的影响之后,与原始情况没有太大差异,说明 Prison 对 surv 的影响不是独立的。 11.1.4 累积风险率 风险率指每个单位时间的时小比例,这个随时间变化。用图形可绘制累 积风险率,其斜率可相对容易的观察。 plot(survfit(addicts$surv~1),conf.int = F,fun="cumhaz") 5160 200 400 600 800 1000 0.0 0.5 1.0 1.5 2.0 上图显示,在后 800 多天的时,由于没有终点事件的发生,斜率时水平的。 在 survfit 函数中改变公式右边的参数,可获得不同因子水平的累积风 险概率。 plot(survfit(addicts$surv~addicts$Clinic),col=c("red","blue"),conf.int = F,fun="cumhaz") legend(5,4,legend=c("1","2"),col = c("red","blue"),lty=c(1,1)) 0 200 400 600 800 1000 0 1 2 3 4 1 2 图 54: 517model <-coxph(surv~Clinic,data=addicts) 包含通过寿命表(Life Table)分析法,;Kaplan-Meier 方法,对病例 随访资料进行生存分析,在对应于每一实际观察事件时点上,作生存率的评 价和建立 Cox 回归模型(亦称比例风险模型)。 11.2 参数法 (Parametric proportional hazards models) 参数方法要求观察的生存事件服从某一特定的分布,采用估计分布中 参数的方法获得生存率的估计值。生存事件的分布可能为指数分布、weibull 分布、对数正态分布等,这些分布曲线都有相应的生存率函数形式,只需求 的相应参数的估计值,即可获得生存率的估计值和生存曲线。 11.2.1 假定生存时间符合 weibull 分布 fitWeib <- survreg(surv~Clinic+Prison+Dose, dist="weibull", data=addicts) summary(fitWeib) ## ## Call: ## survreg(formula = surv ~ Clinic + Prison + Dose, data = addicts, ## dist = "weibull") ## Value Std. Error z ## (Intercept) 4.8139 0.27499 17.51 ## Clinic2 0.7090 0.15722 4.51 ## Prison1 -0.2295 0.12079 -1.90 ## Dose 0.0244 0.00459 5.32 ## Log(scale) -0.3150 0.06756 -4.66 ## p ## (Intercept) 0.0000000000000000000000000000000000000000000000000000000000000000000129 ## Clinic2 0.0000064908854776428113127792300651730528215921367518603801727294921875 ## Prison1 0.0574678078855941285030262122290878323838114738464355468750000000000000 ## Dose 0.0000001028482716093322610233701036239195580890282144537195563316345215 ## Log(scale) 0.0000031324499457871863443197881643476065960385312791913747787475585938 518## ## Scale= 0.73 ## ## Weibull distribution ## Loglik(model)= -1084 Loglik(intercept only)= -1115 ## Chisq= 60.89 on 3 degrees of freedom, p= 0.00000000000038 ## Number of Newton-Raphson Iterations: 7 ## n= 238 11.2.2 AFT 参数转换为 Cox 模型的 β (betaHat <- -coef(fitWeib) / fitWeib$scale) ## (Intercept) Clinic2 Prison1 Dose ## -6.59596 -0.97152 0.31441 -0.03347 11.2.3 模型比较 fitExp <- survreg(surv~Clinic+Prison+Dose,dist="exponential", data=addicts) anova(fitExp, fitWeib) ## Terms Resid. Df -2*LL Test Df Deviance Pr(>Chi) ## 1 Clinic + Prison + Dose 234 2188 NA NA NA ## 2 Clinic + Prison + Dose 233 2169 = 1 18.99 0.00001315 11.2.3.1 提出因子变量后,模型的比较 fitR <- survreg(surv~Dose, dist="weibull", data=addicts) anova(fitR, fitWeib) ## Terms Resid. Df -2*LL Test Df Deviance Pr(>Chi) ## 1 Dose 235 2195 NA NA NA ## 2 Clinic + Prison + Dose 233 2169 = 2 26.41 0.000001845 51911.2.4 生存曲线估计 dfNew <- data.frame(Clinic=factor(c("1","2"), levels=levels(addicts$Clinic)), Dose=c(50, 60),Prison=factor(c("0","1"), levels=levels(addicts$Prison))) percs <- (1:99)/100 FWeib <- predict(fitWeib, newdata=dfNew, type="quantile", p=percs, se=TRUE) matplot(cbind(FWeib$fit[1, ], FWeib$fit[1,]- 2*FWeib$se.fit[1, ], FWeib$fit[1, ] + 2*FWeib$se.fit[1, ]), 1-percs, type="l", main=expression(paste("Weibull-Fit ", hat(S)(t), " mit SE")), xlab="t", ylab="Survival", lty=c(1, 2, 2), lwd=2, col="blue") matlines(cbind(FWeib$fit[2, ], FWeib$fit[2,]- 2*FWeib$se.fit[2, ], FWeib$fit[2, ] + 2*FWeib$se.fit[2, ]), 1-percs, col="red", lwd=2) legend(x="topright", lwd=2, lty=c(1, 2, 1, 2), col=c("blue","blue","red","red"), legend=c("Clinic=1, Dose=50, Prison=0", "+- 2*SE","Clinic=2, Dose=60, Prison=1","+- 2*SE")) 11.3 半参数法 (COX 回归) 多数生存时间的分布并不符合指数分布、weibull 分布等,不宜采用参 数法进行分析。COX 回归用于研究各种因素(称为协变量)对于生存期长 短的关系,Cox 回归是一种半参数模型,只规定了影响因素和生存时间的关 系,但是没有对生存时间的分布情况加以限定,与参数模型相比,该模型不 能给出各时点的风险率,,但可估计出各研究因素对风险率的影响,进行多 5200 500 1000 1500 0.0 0.2 0.4 0.6 0.8 1.0 Weibull−Fit S^(t) mit SE t Survival Clinic=1, Dose=50, Prison=0 +− 2*SE Clinic=2, Dose=60, Prison=1 +− 2*SE 图 55: 因素分析。风险函数 (Hazard Function), 用 h(t) 表示, 其定义为: h(t) = lim ∆t→0 [ S(t) − S(t + ∆t) ∆t ] /S(t) , 表示时刻 t 上一个事件瞬时发生的概率,即一个到 t 时刻存活的个体,在 t 时刻事件的瞬时发生率。Cox 模型为 ln h(t) = ln h0(t) + β1X1 + ··· + βpXp 其中 X1 + ··· + Xp 是协变量,β1 + ··· + βp 是回归系数,由样本估计而得。 βi > 0 表示该协变量是危险因素,越大使生存时间越短,βi < 0 表示该协变 量是保护因素,越大使生存时间越长。h0(t) 为基础风险函数,它是全部协 变量都为 0 或标准状态下的风险函数,一般是未知的。h(t) 表示当各协变 量值 X 固定时的风险函数,它和 h0(t) 成比例,所以该模型又称为比例风险 模型(proportional hazard model),COX 回归模型不用于估计生存率,主要 用于因素分析。 521model <- coxph(surv~Clinic+Prison,data=addicts) summary(model) ## Call: ## coxph(formula = surv ~ Clinic + Prison, data = addicts) ## ## n= 238, number of events= 150 ## ## coef exp(coef) se(coef) z Pr(>|z|) ## Clinic2 -1.109 0.330 0.214 -5.17 0.00000023 *** ## Prison1 0.278 1.320 0.166 1.68 0.093 . ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## exp(coef) exp(-coef) lower .95 upper .95 ## Clinic2 0.33 3.031 0.217 0.502 ## Prison1 1.32 0.757 0.954 1.826 ## ## Concordance= 0.599 (se = 0.025 ) ## Rsquare= 0.132 (max possible= 0.997 ) ## Likelihood ratio test= 33.8 on 2 df, p=0.0000000463 ## Wald test = 28.2 on 2 df, p=0.000000764 ## Score (logrank) test = 30.5 on 2 df, p=0.000000237 Clinic2 系数为负值,且有统计学意义。Clinic2exp(coef) 是 0.3412,提 示 Clinic2 与 Clinic1 相比风险率降低了 65.88%(1-0.3412)。Prison1 无统计 学意义。 11.3.1 模型拟合 AIC 值 extractAIC(model) ## [1] 2 1381 522McFadden, Cox & Snell and Nagelkerke pseudo R2 LLf <- model$loglik[2] LL0 <- model$loglik[1] McFadden pseudo-R2 as.vector(1 -(LLf / LL0)) ## [1] 0.02394 Cox & Snell as.vector(1 - exp((2/nrow(addicts)) * (LL0 - LLf))) ## [1] 0.1323 Nagelkerke as.vector((1 - exp((2/nrow(addicts)) * (LL0 - LLf))) / (1 - exp(LL0)^(2/nrow(addicts)))) ## [1] 0.1327 11.3.1.1 模型比较 model1 <- coxph(surv~Clinic,data=addicts) anova(model1, model) ## Analysis of Deviance Table ## Cox model: response is surv ## Model 1: ~ Clinic ## Model 2: ~ Clinic + Prison ## loglik Chisq Df P(>|Chi|) ## 1 -690 ## 2 -689 2.79 1 0.095 . ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 52311.3.1.2 生存函数 (Survival function) (CPH <- survfit(model)) ## Call: survfit(formula = model) ## ## n events median 0.95LCL 0.95UCL ## 238 150 518 450 591 quantile(CPH, probs=c(0.25, 0.5, 0.75), conf.int=FALSE) ## 25 50 75 ## 231 518 821 11.3.1.3 估计生存函数 (Estimated survival function for new spe- cific data) dfNew <- data.frame(Clinic=factor(c("2","2"), levels=levels(addicts$Clinic)),X=c(-2,-2), Prison=factor(c("0","1"), levels=levels(addicts$Prison))) CPHnew <- survfit(model, newdata=dfNew) par(mar=c(5, 4.5, 4, 2)+0.1, cex.lab=1.4, cex.main=1.4) plot(CPH, main=expression(paste("Cox PH-estimate ", hat(S)(t), " with CI")), xlab="t", ylab="Survival", lwd=2) lines(CPHnew$time, CPHnew$surv[ , 1], lwd=2, col="blue") lines(CPHnew$time, CPHnew$surv[ , 2], lwd=2, col="red") legend(x="topright", lwd=2, col=c("black","blue","red"), legend=c("pseudo-observation","Clinic=2, X=-2, Prison=0", "Clinic=2, X=-2, Prison=1")) 11.3.1.4 累积基础风险函数 (Cumulative baseline hazard) 5240 200 400 600 800 1000 0.0 0.2 0.4 0.6 0.8 1.0 Cox PH−estimate S^(t) with CI t Survival pseudo−observation Clinic=2, X=−2, Prison=0 Clinic=2, X=−2, Prison=1 图 56: expCoef <- exp(coef(model)) Lambda0A <- basehaz(model, centered=FALSE) Lambda0B <- expCoef[2]*Lambda0A$hazard Lambda0C <- expCoef[3]*Lambda0A$hazard plot(hazard ~ time, main=expression(paste("Cox PH-estimate ", hat(Lambda)[g](t), " per group")), type="s", ylim=c(0, 5), xlab="t", ylab="cumulative hazard", lwd=2, data=Lambda0A) lines(Lambda0A$time, Lambda0B, lwd=2, col="red") lines(Lambda0A$time, Lambda0C, lwd=2, col="green") legend(x="bottomright", lwd=2, col=1:3, legend=LETTERS[1:3]) 11.3.2 模型诊断 (Model diagnostics) 11.3.2.1 比例风险假定 (Proportional hazards assumption) 将纵轴取对数后,绘制时间的对数值图形,可以比较 Clinic 变量两种取 5250 200 400 600 800 1000 0 1 2 3 4 5 Cox PH−estimate Λ^ g(t) per group t cumulative hazard A B C 图 57: 值的生存曲线。如果两条曲线平行,则不太可能违反比例风险假定。 plot(survfit(surv~Clinic,data=addicts),fun="cloglog", conf.int = F,col = c("red","blue")) 2 5 10 20 50 100 200 500 1000 −5 −4 −3 −2 −1 0 1 两条曲线相交不止一次,从图形很难判断是否违反比例风险假定。可采取 526如下检验 czph <- cox.zph(coxph(surv~Clinic+Prison,data=addicts)) czph ## rho chisq p ## Clinic2 -0.2698 12.179 0.000483 ## Prison1 -0.0292 0.128 0.720595 ## GLOBAL NA 12.663 0.001779 par(mfrow=c(2, 2)) plot(czph) Time Beta(t) for Clinic2 45 220 470 740 −4 0 4 Time Beta(t) for Prison1 45 220 470 740 −2 0 2 结果显示,违反比例风险假定的证据非常强。图形展现的是随时间变化的 β 图形。 11.3.2.2 影响分析 (Influential observations) dfbetas <- residuals(coxph(surv~Clinic+Prison,data=addicts), type="dfbetas") par(mfrow=c(1, 2)) plot(dfbetas[ , 1], type="h", main="DfBETAS for Clinic", ylab="DfBETAS", lwd=2) plot(dfbetas[ , 2], type="h", main="DfBETAS for Prison", ylab="DfBETAS", lwd=2) 11.3.2.3 对数线性假设 (Linearity of log hazard) 对自变量是连续性变量,需检测其线性的假设 5270 50 100 200 −0.15 −0.05 0.05 0.15 DfBETAS for Clinic Index DfBETAS 0 50 100 200 −0.2 −0.1 0.0 0.1 DfBETAS for Prison Index DfBETAS 图 58: resMart <- residuals(coxph(surv~Clinic+Dose,data=addicts), type="martingale") par(mfrow=c(1, 1)) plot(addicts$Dose, resMart, main="Martingale-residuals for Dose", xlab="Dose", ylab="Residuen", pch=20) lines(loess.smooth(addicts$Dose, resMart), lwd=2, col="blue") legend(x="bottomleft", col="blue", lwd=2, legend="LOESS fit") 11.3.3 预测风险 (Predicted hazard ratios) 根据建立的模型对每个个体的风险率进行预测,连续性变量假定其等于 样本均值,因子变量假定其等于亚变量。#### 风险率预测 predRes <- predict(coxph(surv~Clinic+Prison,data=addicts), type="risk") head(predRes, n=10)# 显示前 10 个 ## [1] 1.246 1.645 1.246 1.246 1.645 1.246 1.645 1.645 1.246 1.645 52820 40 60 80 100 −3 −2 −1 0 1 Martingale−residuals for Dose Dose Residuen LOESS fit 图 59: 11.3.3.1 生存期预测 Shat1 <- survexp(~ 1, ratetable=model, data=addicts) with(Shat1, head(data.frame(time, surv), n=4)) ## time surv ## 1 7 0.9958 ## 2 13 0.9915 ## 3 17 0.9873 ## 4 19 0.9831 分因子变量生存期预测 Shat2 <- survexp(~ Clinic, ratetable=model, data=addicts) with(Shat2, head(data.frame(time, surv), n=4)) ## time Clinic.1 Clinic.2 ## 1 7 0.9946 0.9982 ## 2 13 0.9893 0.9964 529## 3 17 0.9840 0.9946 ## 4 19 0.9786 0.9929 11.3.3.2 分层回归 phFit <- coxph(surv~Clinic+Prison+Dose,data=addicts) summary(phFit) ## Call: ## coxph(formula = surv ~ Clinic + Prison + Dose, data = addicts) ## ## n= 238, number of events= 150 ## ## coef exp(coef) se(coef) z Pr(>|z|) ## Clinic2 -1.00990 0.36426 0.21489 -4.70 0.000002607 *** ## Prison1 0.32655 1.38618 0.16722 1.95 0.051 . ## Dose -0.03537 0.96525 0.00638 -5.54 0.000000029 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## exp(coef) exp(-coef) lower .95 upper .95 ## Clinic2 0.364 2.745 0.239 0.555 ## Prison1 1.386 0.721 0.999 1.924 ## Dose 0.965 1.036 0.953 0.977 ## ## Concordance= 0.665 (se = 0.026 ) ## Rsquare= 0.238 (max possible= 0.997 ) ## Likelihood ratio test= 64.6 on 3 df, p=0.0000000000000623 ## Wald test = 54.1 on 3 df, p=0.0000000000106 ## Score (logrank) test = 56.3 on 3 df, p=0.0000000000036 step(phFit) ## Start: AIC=1353 530## surv ~ Clinic + Prison + Dose ## ## Df AIC ## 1353 ## - Prison 1 1354 ## - Clinic 1 1377 ## - Dose 1 1381 ## Call: ## coxph(formula = surv ~ Clinic + Prison + Dose, data = addicts) ## ## ## coef exp(coef) se(coef) z p ## Clinic2 -1.00990 0.36426 0.21489 -4.70 0.000002607 ## Prison1 0.32655 1.38618 0.16722 1.95 0.051 ## Dose -0.03537 0.96525 0.00638 -5.54 0.000000029 ## ## Likelihood ratio test=64.6 on 3 df, p=0.0000000000000623 ## n= 238, number of events= 150 没有变量剔除时,AIC 水平是最低的,所有变量均应保留。 cox.zph(phFit) ## rho chisq p ## Clinic2 -0.2578 11.19 0.000824 ## Prison1 -0.0382 0.22 0.639369 ## Dose 0.0724 0.70 0.402749 ## GLOBAL NA 12.62 0.005546 全局检验的 P 值,有统计学意义,表面违反了比例风险的假定。一种 可能方法是对因子变量 Clinic 进行分层分析。 strataphFit <- coxph(surv~strata(Clinic)+Prison+Dose,data=addicts) cox.zph(strataphFit) 531## rho chisq p ## Prison1 -0.0205 0.0628 0.802 ## Dose 0.0860 0.9953 0.318 ## GLOBAL NA 1.0186 0.601 summary(strataphFit) ## Call: ## coxph(formula = surv ~ strata(Clinic) + Prison + Dose, data = addicts) ## ## n= 238, number of events= 150 ## ## coef exp(coef) se(coef) z Pr(>|z|) ## Prison1 0.38960 1.47640 0.16893 2.31 0.021 * ## Dose -0.03511 0.96549 0.00646 -5.43 0.000000056 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## exp(coef) exp(-coef) lower .95 upper .95 ## Prison1 1.476 0.677 1.060 2.056 ## Dose 0.965 1.036 0.953 0.978 ## ## Concordance= 0.651 (se = 0.034 ) ## Rsquare= 0.133 (max possible= 0.994 ) ## Likelihood ratio test= 33.9 on 2 df, p=0.0000000432 ## Wald test = 32.7 on 2 df, p=0.0000000808 ## Score (logrank) test = 33.3 on 2 df, p=0.0000000577 用 Clinic 进行分层降低了 χ2 值,全局检验的 P 值,没有统计学意义, 没有违反比列风险的假定。strataphFit 模型与 phFit 模型比较,Clinic 分 层因素的系统被忽略。 53212 非参数检验 非参数检验不考虑总体分布是否已知,也不针对总体参数,而是针对总 体的某些一般性假设(如总体分布的位置是否相同,总体分布是否正态)进 行检验。非参数检验方法简便,不依赖于总体分布的具体形式因而适用性强, 但灵敏度和精确度不如参数检验。一般而言,非参数检验适用于以下三种情 况:顺序类型的数据资料,这这类数据的分布形态一般是未知的;总体分布 形态未知或者非正态的连续型数据,这类数据和卡方检验一样,称自由分布 检验;总体分布虽正态,数据也是连续类型,但样本容量极小,如 10 以下 (虽然T检验被称为小样本统计方法,但样本容量太小时,代表性毕竟很差, 最好不要用要求较严格的参数检验法) 12.1 单样本 (One-sample) 12.1.1 符号检验 (Sign-test) 符号检验法是通过对两个相关样本的每对数据之差的符号(正号或负 号)进行检验,以比较这两个样本所代表的总体的差异显著性,对应于参数 检验中两相关样本差异显著性的T检验。其基本思想是:若两总体差异不 显著,则两样本差值的正号与负号应大致各占一半,即中位数为 0,可见符 号检验是以中数作为统计量进行假设检验的。例某药厂生产的胶囊平均长 度为 13mm,现随机在生产线上抽取 10 个,测得长度如下:15 13 13 15 13 13 12 12 10 9,生产过程中对长度的控制是否需要调整? leng <- c(15,13,13,15,13,13,12,12,10,9) SignTest(leng,mu = 13) ## ## One-sample Sign-Test ## ## data: leng ## S = 2, number of differences = 6, p-value = 0.7 ## alternative hypothesis: true median is not equal to 13 ## 97.9 percent confidence interval: ## 10 15 533## sample estimates: ## median of the differences ## 13 P 值大于 0.05,可以认为长度不需要调整。 例乙型脑炎病例在 25 个不同三甲医院的治疗费用(元)如下:15165 4257 25844 36779 4730 14687 2901 13964 16226 25004 37086 2193 31139 4057 34443 37572 6260 2754 18377 39357 29184 17398 9948 13938 32874 试 用符号检验分析,某三甲医院治疗费 (10000 元) 用是在中位数之上还是之 下。 样本的中位数 (M) 作为治疗费用的中间值,H0:M>10000,H1:M<10000。 x <- c(15165,4257,25844,36779,4730,14687,2901,13964, 16226,25004,37086,2193,31139,4057,34443,37572,6260,2754, 18377,39357,29184,17398,9948,13938,32874) binom.test(sum(x>10000),n = length(x),alternative = "l") ## ## Exact binomial test ## ## data: sum(x > 10000) and length(x) ## number of successes = 17, number of trials = 25, p-value = 1 ## alternative hypothesis: true probability of success is less than 0.5 ## 95 percent confidence interval: ## 0.0000 0.8297 ## sample estimates: ## probability of success ## 0.68 P 值大于 0.05,可以认为样本的中位数大于 10000 元,也就是说某三 甲医院治疗费用(10000 元)在中位数之下。 例为豚鼠注入肾上腺素前后的每分钟灌流滴数,给药前:30 38 48 48 60 46 26 58 46 48 44 46,给药后:46 50 52 52 58 64 56 54 54 58 36 54,试 比较给药前后灌流滴数有无显著差别? 534x <- c(30,38,48,48,60,46,26,58,46,48,44,46) y <- c(46,50,52,52,58,64,56,54,54,58,36,54) binom.test(sum(x2.15,H1:M<2.15。 x <- c(2.15,2.10,2.20,2.12,2.42,2.52,2.62,2.72,2.99,3.19,3.37,4.57) wilcox.test(x,alternative = "l",mu = 2,15) ## ## Wilcoxon rank sum test ## ## data: x and 15 ## W = 0, p-value = 0.08 ## alternative hypothesis: true location shift is less than 2 P 值大于 0.05,接受原假设,认为该工厂的尿氟含量高于当地正常人。 12.2.2.1 配对样本比较的 Wilcoxon 配对设计计量资料两处理效应的比较,一般采用配对 t 检验,如果差数 严重偏离正态分布,可采用 Wilcoxon 秩检验,亦称符号秩和检验(signed rank test)。一般认为,在数据满足配对 t 检验要求时,Wilcoxon 秩检验的 功效是检验效能的 95% 左右。目的是推断配对样本差值的总体中位数是否 和 0 有差别,即推断配对的两个相关样本所来自的两个总体中位数是否有 差别。 例某研究者欲研究保健食品对小鼠抗疲劳作用,将同种属的小鼠按性别 和年龄相同、体重相近配成对子,共 10 对,并将每对中的两只小鼠随机分 到保健食品两个不同的剂量组,过一定时期将小鼠杀死,测得 10 对小鼠肝 糖原含量(mg/100g)中剂量组 620.16 866.50 641.22 812.91 738.96 899.38 760.78 694.95 749.92 793.94 高剂量组 958.47 838.42 788.90 815.20 783.17 910.92 758.49 870.80 862.26 805.48,问不同剂量组的小鼠肝糖原含量有无 差别? 538x <- c(620.16,866.50,641.22,812.91,738.96,899.38, 760.78,694.95,749.92,793.94) y <- c(958.47,838.42,788.90,815.20,783.17,910.92, 758.49,870.80,862.26,805.48) wilcox.test(x,y,paired = T) ## Warning in wilcox.test.default(x, y, paired = T): cannot compute exact p- ## value with ties ## ## Wilcoxon signed rank test with continuity correction ## ## data: x and y ## V = 6, p-value = 0.03 ## alternative hypothesis: true location shift is not equal to 0 P 值小于 0.05,可以认为该保健食品的不同剂量对小鼠肝糖原含量的 作用不同。 例在某项研究中,经随机抽样获得甲乙两组病人的血尿素氮 (BUN)mmol/L,甲组:4.98 3.90 4.02 0.68 4.98 5.04 1.20 2.64 6.23 3.00, 乙 组:4.17 4.95 3.96 3.59 4.89 3.03 3.71 5.91 5.55 6.29 4.82 3.90 6.11,试比 较甲乙组病人血尿素氮 (BUN) 的含量有无差别? x <- c(4.98,3.90,4.02,0.68,4.98,5.04,1.20,2.64,6.23,3.00) y <- c(4.17,4.95,3.96,3.59,4.89,3.03,3.71,5.91,5.55, 6.29,4.82,3.90,6.11) wilcox.test(x,y,exact = FALSE,correct =F) ## ## Wilcoxon rank sum test ## ## data: x and y ## W = 48, p-value = 0.3 ## alternative hypothesis: true location shift is not equal to 0 539wilcox.test(x,y,exact = FALSE) ## ## Wilcoxon rank sum test with continuity correction ## ## data: x and y ## W = 48, p-value = 0.3 ## alternative hypothesis: true location shift is not equal to 0 无论是否采用连续校正,P 值均大于 0.05,不能拒绝原假设,可以两组 病人血尿素氮无差异。 例某研究者欲评价新药按摩乐口服液治疗高甘油三脂血症的疗效,将高 甘油三脂血症患者 189 例随机分为两组,分别用按摩乐口服液和山楂精降 脂片治疗,数据见下表,问两种药物治疗高甘油三脂血症的疗效有无不同? 疗效 按摩乐口服液 山楂精降脂片 无效 17 70 有效 25 13 显效 37 37 a <- rep(1:3,c(17,25,27)) b <- rep(1:3,c(70,13,37)) wilcox.test(a, b, exact=FALSE) ## ## Wilcoxon rank sum test with continuity correction ## ## data: a and b ## W = 5200, p-value = 0.0009 ## alternative hypothesis: true location shift is not equal to 0 P 值小于 0.05,可以认为,两种药物对高甘油三脂血症的疗效分布不 同。 54012.3 多组样本 (more than two samples) 非参数多组比较法其主要用于等级型数据或不满足参数检验条件的场 合,故亦称等级方差分析(ANOVA by ranks)。和方差分析一样,按照实验 设计不同,非参数多组比较法也包括适用于完全随机化设计的单向秩次方差 分析或称 Kruskal-Wallis 检验和适用于随机化区组设计的双向秩次方差分 析 (Friedman 检验)。 12.3.1 无序独立样本 (Independent samples - unordered groups) Kruskal-Wallis 检验用来检验多个独立样本的位置是否一样。 例四组病例测试的智力 IQ 分别打分如下:A:99, 131, 118, 112, 128, 136, 120, 107, 134, 122,B:134, 103, 127, 121, 139, 114, 121, 132 C:110, 123, 100, 131, 108, 114, 101, 128, 110,D:117, 125, 140, 109, 128, 137, 110, 138, 127, 141, 119, 148 问不同组之间的 IQ 是否有差异? A <- c(99, 131, 118, 112, 128, 136, 120, 107, 134, 122) B <- c(134, 103, 127, 121, 139, 114, 121, 132) C <- c(110, 123, 100, 131, 108, 114, 101, 128, 110) D <- c(117, 125, 140, 109, 128, 137, 110, 138, 127, 141, 119, 148) Nj <- c(length(A), length(B), length(C), length(D)) KWdf <- data.frame(DV=c(A,B,C,D), IV=factor(rep(1:4, Nj), labels=c("A","B","C","D"))) #stats 包 kruskal.test(DV ~ IV, data=KWdf) ## ## Kruskal-Wallis rank sum test ## ## data: DV by IV ## Kruskal-Wallis chi-squared = 6.1, df = 3, p-value = 0.1 #coin 包 kruskal_test(DV ~ IV, distribution=approximate(B=9999), data=KWdf) ## 541## Approximative Kruskal-Wallis Test ## ## data: DV by IV (A, B, C, D) ## chi-squared = 6.1, p-value = 0.1 # 两两比较 pairwise.wilcox.test(KWdf$DV, KWdf$IV, p.adjust.method="holm") ## Warning in wilcox.test.default(xi, xj, paired = paired, ...): cannot ## compute exact p-value with ties ## Warning in wilcox.test.default(xi, xj, paired = paired, ...): cannot ## compute exact p-value with ties ## Warning in wilcox.test.default(xi, xj, paired = paired, ...): cannot ## compute exact p-value with ties ## Warning in wilcox.test.default(xi, xj, paired = paired, ...): cannot ## compute exact p-value with ties ## Warning in wilcox.test.default(xi, xj, paired = paired, ...): cannot ## compute exact p-value with ties ## Warning in wilcox.test.default(xi, xj, paired = paired, ...): cannot ## compute exact p-value with ties ## ## Pairwise comparisons using Wilcoxon rank sum test ## ## data: KWdf$DV and KWdf$IV ## ## A B C ## B 1.0 - - ## C 0.8 0.5 - ## D 0.8 1.0 0.2 ## ## P value adjustment method: holm 542P 值均大于 0.05,不能拒绝原假设,可以认为四组的智力没有差异。两 两比较结果,没有智力差异。permutation 检验即置换检验,在当样本量不 够大,样本分布未知的情况下,用置换检验模拟出样本均值分布,然后再进 行比较。 oneway_test(DV ~ IV, distribution=approximate(B=9999), data=KWdf) ## ## Approximative K-Sample Fisher-Pitman Permutation Test ## ## data: DV by IV (A, B, C, D) ## chi-squared = 6.8, p-value = 0.07 P 值均大于 0.05,不能拒绝原假设,可以认为四组的智力没有差异。 例三名评分员对 10 名测试的分别打分如下:A:1 2 5 3 2 1 1 3 2 1, B:4 3 6 5 2 6 1 6 5 4,C:9,6,7,7,5,1,8,9,6,5,问不同的评分员之间是否有 差异? Value <- c(1,2,5,3,2,1,1,3,2,1,4,3,6,5,2,6,1,6,5,4,9,6, 7,7,5,1,8,9,6,5) Group <- factor(c(rep(1,10),rep(2,10),rep(3,10))) data <- data.frame(Group, Value) kruskal.test(Value ~ Group, data=data) ## ## Kruskal-Wallis rank sum test ## ## data: Value by Group ## Kruskal-Wallis chi-squared = 14, df = 2, p-value = 0.001 P 值小于 0.05,可以认为,三位评员的评分分布不同。 例下面的数据是游泳、打篮球、骑自行车等三种不同的运动在 30 分钟 内消耗的热量 (单位: 卡路里). 这些数据是否说明这三种运动消耗的热量全 相等? 游泳: 306, 385, 300, 319, 320; 打篮球: 311, 364, 315, 338, 398; 骑自 行车: 289, 198, 201, 302, 289. 543x<-list(swim=c(306, 385, 300, 319, 320), basketball=c(311, 364, 315, 338, 398), bicycle=c(289, 198, 201, 302, 289)) kruskal.test(x) ## ## Kruskal-Wallis rank sum test ## ## data: x ## Kruskal-Wallis chi-squared = 9.2, df = 2, p-value = 0.01 12.3.2 有序独立样本 (Independent samples - ordered groups) Jonckheere Terpstra trend 检验适用于多个总体有相似的连续分布 (除 了位置可能不同外),所有的观察值在样本内和样本间独立。不同于 Kruskal- Wallis 检验,Jonckheere Terpstra trend 检验可以判断是否出现单调的趋 势。 例在一项健康试验中,有 3 种生活方式,他们一个月后减少的种类如 下:A 3.7 3.7 3.0 3.9 2.7 B:7.3 5.2 5.3 5.7 6.5 C:9.0 4.9 7.1 8.7,能否得 三种生活方式减肥效果相同? A <- c(3.7,3.7,3.0,3.9,2.7) B <- c(7.3,5.2,5.3,5.7,6.5) C <- c(9.0,4.9,7.1,8.7) Nj <- c(length(A), length(B), length(C)) JTdf <- data.frame(IV=ordered(rep(LETTERS[1:3], Nj)), DV=c(A,B,C)) kruskal_test(DV ~ IV, distribution=approximate(B=9999), data=JTdf) ## ## Approximative Linear-by-Linear Association Test ## ## data: DV by IV (A < B < C) ## Z = 2.9, p-value = 0.001 544## alternative hypothesis: two.sided JonckheereTerpstraTest(DV ~ IV, data=JTdf) ## Warning in JonckheereTerpstraTest.default(c(3.7, 3.7, 3, 3.9, 2.7, 7.3, : Sample size > 100 or data with ties ## p-value based on normal approximation. Specify nperm for permutation p-value ## ## Jonckheere-Terpstra test ## ## data: DV by IV ## JT = 59, p-value = 0.002 ## alternative hypothesis: two.sided p 值小于 0.05,可以认为三个总体的位置有上升趋势。 12.3.3 无序非独立样本 (Dependent samples - unordered groups) Friedman 检验即双向等级方差分析对应于参数检验中随机区组设计的 方差分析例现有 6 条狗服用阿司匹林不同时间(时间)血中的药物浓度数 据(r/ml)如下表,问服药后不同时间血中的药物浓度有无差别? 编号 0.5h 1h 6h 8h 24h 48h 1 51.6 135.2 169.8 137.2 31.9 0.4 2 49.6 101.6 158.4 133.0 18.7 0.0 3 40.6 88.4 142.8 126.6 18.1 2.0 4 11.2 37.2 131.8 130.3 17.5 0.2 5 17.8 48.2 118.0 124.5 18.7 1.8 6 14.4 41.6 120.8 123.5 24.8 3.0 x<-matrix(c(51.6,49.6,40.6,11.2,17.8,14.4, 135.2,101.6,88.4,37.2,48.2,41.6, 169.8,158.4,142.8,131.8,118,120.8, 137.2,133,126.6,130.3,124.5,123.5, 54531.9,18.7,18.1,17.5,18.7,24.8, 0.4,0,2,0.2,1.8,3 ), nrow = 6, byrow = TRUE, dimnames = list(1 : 6,c("h1","h2","h3","h4","h5","h6"))) friedman.test(x) ## ## Friedman rank sum test ## ## data: x ## Friedman chi-squared = 13, df = 5, p-value = 0.03 P 值小于 0.05,拒绝原假设,可以认为服药后不同时间血中的药物浓度 有差异。 例四种测试的方式,分别测试得到如下:A:14 13 12 11 10 ,B:11 12 13 14 15,C:16 15 14 13 12,D:13 12 11 10 9,问不同的测试方式之间是 否有差异? N <- 5 P <- 4 DV1 <- c(14, 13, 12, 11, 10) DV2 <- c(11, 12, 13, 14, 15) DV3 <- c(16, 15, 14, 13, 12) DV4 <- c(13, 12, 11, 10,9) Fdf <- data.frame(id=factor(rep(1:N, times=P)), DV=c(DV1, DV2, DV3, DV4), IV=factor(rep(1:P, each=N), labels=LETTERS[1:P])) friedman.test(DV ~ IV | id, data=Fdf) ## ## Friedman rank sum test 546## ## data: DV and IV and id ## Friedman chi-squared = 8.3, df = 3, p-value = 0.04 P 值小于 0.05,拒绝原假设,可以认为四种不同的测试方式之间有差 异。 由于本例中样本量较小,置换检验如下 oneway_test(DV ~ IV | id, distribution=approximate(B=9999), data=Fdf) ## ## Approximative K-Sample Fisher-Pitman Permutation Test ## ## data: DV by IV (A, B, C, D) ## stratified by id ## chi-squared = 6.8, p-value = 0.06 置换检验结果表明四种不同的测试方式之间没有差异。 例现有 6 条狗服用阿司匹林不同时间(时间)血中的药物浓度数据 (r/ml)如下表,问服药后不同时间血中的药物浓度有无差别? 编号 0.5h 1h 6h 8h 24h 48h 1 51.6 135.2 169.8 137.2 31.9 0.4 2 49.6 101.6 158.4 133.0 18.7 0.0 3 40.6 88.4 142.8 126.6 18.1 2.0 4 11.2 37.2 131.8 130.3 17.5 0.2 5 17.8 48.2 118.0 124.5 18.7 1.8 6 14.4 41.6 120.8 123.5 24.8 3.0 x<-matrix(c(51.6,49.6,40.6,11.2,17.8,14.4, 135.2,101.6,88.4,37.2,48.2,41.6, 169.8,158.4,142.8,131.8,118,120.8, 137.2,133,126.6,130.3,124.5,123.5, 31.9,18.7,18.1,17.5,18.7,24.8, 5470.4,0,2,0.2,1.8,3 ), nrow = 6, byrow = TRUE, dimnames = list(1 : 6,c("h1","h2","h3","h4","h5","h6"))) friedman.test(x) ## ## Friedman rank sum test ## ## data: x ## Friedman chi-squared = 13, df = 5, p-value = 0.03 P 值小于 0.05,拒绝原假设,可以认为服药后不同时间血中的药物浓度 有差异 例 A、B 两种药物治疗后,测得体重相近的三组患儿的血肌酐含量如 下,每组 2 名,问 A、B 两种药物对患儿的血肌酐含量的影响是否有差异? 药物 区组 血浆蛋白 A L 44.55 B L 28.22 A M 24.00 B M 28.77 A H 24.55 B H 18.77 w <- as.factor(c("A","B","A","B","A","B")) t <- as.factor(c("L","L","M","M","H","H")) x <- c(44.55,28.22,24.00,28.77,24.55,18.77) wb <- as.data.frame(cbind(x,w,t)) friedman.test(x ~ w | t, data = wb) ## 548## Friedman rank sum test ## ## data: x and w and t ## Friedman chi-squared = 0.33, df = 1, p-value = 0.6 P 值大于 0.05,不能拒绝原假设,可以认为 A、B 两种药物对患儿的血 肌酐含量影响无差异。 12.3.4 有序非独立样本 (Dependent samples - ordered groups) Page trend 检验对应于参数检验中 Spearman’s rank 相关检验,适用于 有序的多组之间的的非参数的趋势检验。例四种测试的方式,分别测试得到 如下:A:1.79 -3.05 2.44 1.53 -0.43 0.96 0.17 1.55 0.19 -1.21,B:2.43 -3.20 0.73 -3.60 -4.05 -1.91 -5.44 1.97 -3.78 -3.25,C:3.33 -3.50 -0.49 0.87 2.28 -1.25 6.70 2.79 3.53 4.73,D:-3.23 2.00 4.43 3.95 2.54 3.45 0.66 0.91 0.06 -1.47,问不同的测试方式之间是否有差异? A <- c(1.79,-3.05,2.44,1.53,-0.43,0.96,0.17,1.55,0.19,-1.21) B <- c(2.43,-3.20,0.73,-3.60,-4.05,-1.91,-5.44,1.97,-3.78,-3.25) C <- c(3.33,-3.50,-0.49,0.87,2.28,-1.25,6.70,2.79,3.53,4.73) D <- c(-3.23,2.00,4.43,3.95,2.54,3.45,0.66,0.91,0.06,-1.47) Pdf <- data.frame(id=factor(rep(1:10, times=4)), DV=c(A,B,C,D), IV=ordered(rep(LETTERS[1:4], each=10))) #DescTools 包 PageTest(DV ~ IV | id, data=Pdf) ## ## Page test for ordered alternatives ## ## data: DV and IV and id ## L = 260, p-value = 0.1 549#coin 包 friedman_test(DV ~ IV | id, distribution=approximate(B=9999), data=Pdf) ## ## Approximative Page Test ## ## data: DV by ## IV (A < B < C < D) ## stratified by id ## Z = 1.2, p-value = 0.2 ## alternative hypothesis: two.sided p 值大于 0.05,可以认为四种不同的测试方式之间没有差异。 12.4 二项分布检验 (Binomial test) 二项分布检验是对二分类变量的拟合优度检验,它考察每个类别中观察 值的频数与特定二项分布下的预期频数间是否存在统计学差异。在二项分 布检验中,实际上采用的和 K-S 检验的原理相同,只是这里主要使用的是 二分变量,是一个离散分布的检验情况。 12.4.1 单侧 (One-sided) 例某研究检测 7 份血清标本,乙肝 HBsAg 的抗体结果如下:“+”, “+”, “-”, “+”, “-”, “+”, “+”,问研究的血清标本阳性率是否小于等于 0.25? DV <- factor(c("+","+","-","+","-","+","+"), levels=c("+","-")) N <- length(DV) (tab <- table(DV)) ## DV ## + - ## 5 2 550pH0 <- 0.25 binom.test(tab, p=pH0, alternative="greater", conf.level=0.95) ## ## Exact binomial test ## ## data: tab ## number of successes = 5, number of trials = 7, p-value = 0.01 ## alternative hypothesis: true probability of success is greater than 0.25 ## 95 percent confidence interval: ## 0.3413 1.0000 ## sample estimates: ## probability of success ## 0.7143 P 值大于 0.05,可以认为研究的血清标本阳性率时候小于等于 0.25。 12.4.2 双侧 (Two-sided) 例某研究检测 20 份血清标本,乙肝 HBsAg 的抗体有 10 份是阳性,问 研究的血清标本阳性率是否等于 0.25? N <- 20 hits <- 10 binom.test(hits, N, p=pH0, alternative="two.sided") ## ## Exact binomial test ## ## data: hits and N ## number of successes = 10, number of trials = 20, p-value = 0.02 ## alternative hypothesis: true probability of success is not equal to 0.25 ## 95 percent confidence interval: ## 0.272 0.728 ## sample estimates: 551## probability of success ## 0.5 P 值小于 0.05,可以认为研究的血清标本阳性率时候不等于 0.25。 12.4.3 置信区间 (Confidence intervals) 例某研究检测 7 份血清标本,乙肝 HBsAg 的抗体结果如下:“+”, “+”, “-”, “+”, “-”, “+”, “+”,问研究的血清标本阳性率和其置信区间? DV <- factor(c("+","+","-","+","-","+","+"), levels=c("+","-")) N <- length(DV) tab <- table(DV) BinomCI(tab[1], sum(tab), method="wilson") ## est lwr.ci upr.ci ## [1,] 0.7143 0.3589 0.9178 该血清阳性率为 71.42%,95% 置信区间为 35.89%~91.77%. 12.5 Pearson 拟合优度 χ2 检验 假定某随机变量 X 应当有分布,对 X 进行 n 次观察,可以得到 Pear- sonχ2 统计量 K = ∑m i=1 (ni−npi)2 npi , 当 n → ∞ 时,K 分布收敛于自由度为 m − 1 的 χ2 分布。m 为区间个数,ni 为随机变量落在区间内的个数,pi 为 区间的理论概率。 例 20 位病人的某项临床检验值如下 9.66 35.42 39.24 32.00 6.63 27.96 20.79 17.81 19.97 13.03 35.93 13.30 32.39 23.21 31.35 16.98 20.56 16.94 35.21 23.33,请用 Pearson χ2 检验判断是否服从正态分布? x <- c(9.66,35.42,39.24,32.00,6.63,27.96,20.79, 17.81,19.97,13.03,35.93,13.30,32.39,23.21, 31.35,16.98,20.56,16.94,35.21,23.33) g <- table(cut(x,breaks = c(5,10,15,20,25,30,35))) p <- pnorm(c(10,15,20,25,30,35),mean(x),sd(x)) 552p <- c(p[1],p[2]-p[1],p[3]-p[2],p[4]-p[3],p[5]-p[4],1-p[5]) chisq.test(g,p = p) ## Warning in chisq.test(g, p = p): Chi-squared approximation may be incorrect ## ## Chi-squared test for given probabilities ## ## data: g ## X-squared = 2.9, df = 5, p-value = 0.7 P 值大于 0.05,可以认为服从正态分布 12.6 Kolmogorov-Smirnov 检验 Kolmogorov-Smirnov 是比较一个频率分布 f(x) 与理论分布 g(x) 或者 两个观测值分布的检验方法。其原假设 H0: 两个数据分布一致或者数据符合 理论分布。D = max|f(x)−g(x)|, 当实际观测值 D > D(n, α) 则拒绝 H0,否 则则接受 H0 假设。检验统计量为 Z = √ n maxi(|Fn(xi−1 −F(xi)|, |Fn(xi − F(xi)|)。 12.6.1 单样本检验 例 20 位病人的某项临床检验值如下 9.66 35.42 39.24 32.00 6.63 27.96 20.79 17.81 19.97 13.03 35.93 13.30 32.39 23.21 31.35 16.98 20.56 16.94 35.21 23.33,请用 Kolmogorov-Smirnov 检验判断是否服从正态分布? x <- c(9.66,35.42,39.24,32.00,6.63,27.96,20.79,17.81, 19.97,13.03,35.93,13.30,32.39,23.21,31.35,16.98, 20.56,16.94,35.21,23.33) ks.test(x,mean(x),sd(x)) ## ## Two-sample Kolmogorov-Smirnov test ## ## data: x and mean(x) 553## D = 0.6, p-value = 0.9 ## alternative hypothesis: two-sided P 值大于 0.05,可以认为服从正态分布 例对一台设备进行寿命检验,记录十次无故障操作时间,并按从小到大 的次序排列如下 420 500 920 1380 1510 1650 1760 2100 2300 2350 检验此 设备无故障工作时间是否符合 rambda=1/1500 的指数分布? X<-c(420, 500, 920, 1380, 1510, 1650, 1760, 2100, 2300, 2350) ks.test(X, "pexp", 1/1500) ## ## One-sample Kolmogorov-Smirnov test ## ## data: X ## D = 0.3, p-value = 0.3 ## alternative hypothesis: two-sided 12.6.2 两样本检验 例测定两组病人尿液中的尿胆原(URO),A 组 2.13 13.91 15.65 12.34 0.74 10.49 7.22 5.86 6.84 3.67 B 组 4.62 6.16 0.52 4.79 0.21 3.69 3.46 3.42 5.67 2.83,请检验 A 组和 B 组是否相同? a <- c(2.13,13.91,15.65,12.34,0.74,10.49,7.22,5.86,6.84,3.67) b <- c(4.62,6.16,0.52,4.79,0.21,3.69,3.46,3.42,5.67,2.83) ks.test(a,b) ## ## Two-sample Kolmogorov-Smirnov test ## ## data: a and b ## D = 0.6, p-value = 0.05 ## alternative hypothesis: two-sided P 值大于 0.05,可以认为 A、B 两组的分布相同。 55412.7 列联表的独立性检验 在研究问题时有时候会遇到要求判断两个分类变量之间是否存在联系 的问题,通常使用 χ2 检验判断两组或多组资料是否相互关联。如果不相互 关联,就称为独立,这类问题处理称为独立性检验(Test of Independence)。 12.7.0.1 pearsonχ2 检验 在 i 为行,j 为列的列联表中,统计量为 K = ∑I i=1 ∑J j=1 [n·nij −ni·nj ]2 n·ni·nj 。 例 vcd 包中 Arthritis 数据集是一项风湿性关节炎新疗法的双盲临床实 验的结果,请分析治疗措施是否与风湿性关节炎改善情况有关? panderOptions('table.split.table', Inf) pander(head(Arthritis)) ID Treatment Sex Age Improved 57 Treated Male 27 Some 46 Treated Male 29 None 77 Treated Male 30 None 17 Treated Male 32 Marked 36 Treated Male 46 Marked 23 Treated Male 58 Marked mytable <- xtabs(~Treatment+Improved,data=Arthritis) chisq.test(mytable) ## ## Pearson's Chi-squared test 555## ## data: mytable ## X-squared = 13, df = 2, p-value = 0.001 P 值小于 0.05,可以认为治疗情况与改善状况有关。 例某杂志刊登了一篇研究吸烟是否与患肺癌有关文章,对 63 位肺癌患 者及 43 名非肺癌患者调查了其中的吸烟人数,得到 2*2 列联表,如下表所 示,认为吸烟与肺癌有关,请予以验证! 患肺癌 未患肺癌 吸烟 60 32 不吸烟 3 11 x<-c(60, 3, 32, 11) dim(x)<-c(2,2) chisq.test(x,correct = FALSE) ## ## Pearson's Chi-squared test ## ## data: x ## X-squared = 9.7, df = 1, p-value = 0.002 P 值小于 0.05,可以认为吸烟与肺癌有关。 12.8 卡方检验 (χ2 检验) 卡方检验用于两个率或两个构成比之间的比较。例三组大白鼠分别为 35 16 94 只,在不同致癌剂作用下的发病数分别为 15 6 39,问不同组只见 发病数是否有差别? total <- c(35, 16, 94) hits <- c(15,6,39) prop.test(hits, total) 556## ## 3-sample test for equality of proportions without continuity ## correction ## ## data: hits out of total ## X-squared = 0.13, df = 2, p-value = 0.9 ## alternative hypothesis: two.sided ## sample estimates: ## prop 1 prop 2 prop 3 ## 0.4286 0.3750 0.4149 P 值大于 0.05,不能拒绝零假设,不能认为三组之间的发病数有差异。 12.9 游程检验 (Runs-test) 游程检验即单样本变量值的随机性检验,其一个或多个的代表相同属 性或类型的接连出现区段称为游程。游程检验主要是用来检验数据是否为 随机性取得。例某村发生一种地方病,其住户沿一条河排列,调查时对发病 的住户标记为 “t”,对非发病的住户标记为 “f”,共 8 户,其取值如下表所 示:“f”, “t”, “t”, “f”, “t”, “f”, “f”, “f”, 问该地方的发病是否随机? queue <- factor(c("f","t","t","f","t","f","f","f")) RunsTest(queue, alternative="greater") ## ## Runs Test for Randomness ## ## data: queue ## runs = 5, m = 5, n = 3, p-value = 0.6 ## alternative hypothesis: true number of runs is greater than expected P 值大于 0.05,可以认为地方病的发病是随机的。 12.9.1 置换检验 (Manual permutation test) 样本数较少,实现置换检验 557Nj <- table(queue) (runs <- rle(levels(queue)[as.numeric(queue)])) ## Run Length Encoding ## lengths: int [1:5] 1 2 1 1 3 ## values : chr [1:5] "f" "t" "f" "t" "f" (rr <- length(runs$lengths)) ## [1] 5 (rr1 <- table(runs$values)[1]) ## f ## 3 (rr2 <- table(runs$values)[2]) ## t ## 2 getP <- function(r1, r2, n1, n2) { # iterations of a symbol <= total number of this symbol? stopifnot(r1 <= n1, r2 <= n2) # probability in case r1+r2 is uneven p <- (choose(n1-1, r1-1)* choose(n2-1, r2-1)) / choose(n1+n2, n1) # probability in case r1+r2 is even: twice the uneven case ifelse(((r1+r2) %% 2) == 0, 2*p, p) } n1 <- Nj[1] n2 <- Nj[2] 558N <- sum(Nj) rMin <- 2 (rMax <- ifelse(n1 == n2, N, 2*min(n1, n2) + 1)) ## f ## 7 p3.2 <- getP(3, 2, n1, n2) p2.3 <- getP(2, 3, n1, n2) p3.3 <- getP(3, 3, n1, n2) p4.3 <- getP(4, 3, n1, n2) (pGrEq <- p3.2 + p2.3 + p3.3 + p4.3) ## [1] 0.5714 p2.2 <- getP(2, 2, n1, n2) p1.2 <- getP(1, 2, n1, n2) p2.1 <- getP(2, 1, n1, n2) p1.1 <- getP(1, 1, n1, n2) (pLess <- p2.2 + p1.2 + p2.1 + p1.1) ## [1] 0.4286 pGrEq + pLess ## [1] 1 对上述游程进行检验可用正态近似法 muR <- 1 + ((2*n1*n2) / N) varR <- (2*n1*n2*(2*n1*n2 - N)) / (N^2 *(N-1)) rZ <- (rr-muR) / sqrt(varR) (pVal <- 1-pnorm(rZ)) ## f ## 0.4184 55912.10 无序分类联合检验 (Association tests and measures for unordered categorical variables) 12.10.1 (2×2) 列联表 Fishe 精确检验是检验两个二分类变量是否是独立的一种检验。在样本 较小时(单元的期望频数小于 5),需要用 Fisher 精确检验来做独立性检验。 Fisher 精确检验的原假设是:边界固定的列联表中行和列是相互独立的, 其 调用格式为 fisher.test(mytable),其中的 mytable 是一个二维列联表, 这里 的 fisher.test() 函数可以在任意行列数大于等于 2 的二维列联表上使用,但 不能用于 2×2 的列联表。 例 vcd 包中 Arthritis 数据集是一项风湿性关节炎新疗法的双盲临床实 验的结果,请用 Fisher 精确独立检验分析治疗措施是否与风湿性关节炎改 善情况。 mytable <- xtabs(~Treatment+Improved,data=Arthritis) fisher.test(mytable) #fish.test() 函数不可用于 2*2 列联表 ## ## Fisher's Exact Test for Count Data ## ## data: mytable ## p-value = 0.001 ## alternative hypothesis: two.sided P 值小于 0.05,可以认为治疗情况与改善状况有关。 例某疾病的影像学诊断和疾病的确诊结果如下,问影像学诊断和确诊结 果是否有差别? 疾病 isHealthy isIll no 8 2 yes 1 4 560disease <- factor(rep(c("no","yes"), c(10, 5))) diagN <- rep(c("isHealthy","isIll"), c( 8, 2)) diagY <- rep(c("isHealthy","isIll"), c( 1, 4)) diagT <- factor(c(diagN, diagY)) contT1 <- table(disease, diagT) addmargins(contT1) ## diagT ## disease isHealthy isIll Sum ## no 8 2 10 ## yes 1 4 5 ## Sum 9 6 15 fisher.test(contT1) ## ## Fisher's Exact Test for Count Data ## ## data: contT1 ## p-value = 0.09 ## alternative hypothesis: true odds ratio is not equal to 1 ## 95 percent confidence interval: ## 0.747 875.880 ## sample estimates: ## odds ratio ## 12.5 P 值大于 0.05,可以认为影像学诊断和确诊结果没有差别。 12.10.2 灵敏度、特异度等 (Prevalence, sensitivity, specificity, CCR, F-score) 561## true negative 真阴性 TN <- c11 <- contT1[1, 1] ## true positive / hit 真阳性 TP <- c22 <- contT1[2, 2] ## false positive 假阳性 FP <- c12 <- contT1[1, 2] ## false negative / miss 假阴性 FN <- c21 <- contT1[2, 1] # 盛行率 (prevalence <- sum(contT1[2, ]) / sum(contT1)) ## [1] 0.3333 # 灵敏度 (sensitivity <- recall <- TP / (TP+FN)) ## [1] 0.8 # 特异度 (specificity <- TN / (TN+FP)) ## [1] 0.8 # 阳性预测值 (relevance <- precision <- TP / (TP+FP)) ## [1] 0.6667 # 正确分类率 accuracy = (TP + TN)/(TP + FP + FN + TN) (CCR <- sum(diag(contT1)) / sum(contT1)) ## [1] 0.8 562#F 得分 = 2*TP /(2*TP + FP + FN) % (Fval <- 1 / mean(1 / c(precision, recall))) ## [1] 0.7273 12.10.3 OR 值、相对危险度等 (Odds ratio, Yule’s Q and risk ratio) # OR 值 (OR <- OddsRatio(contT1, conf.level=0.95)) ## odds ratio lwr.ci upr.ci ## 16.000 1.093 234.248 ## Goodman-Kruskal ￿ 值,属于 2×2 四格表的列联比例函数 YuleQ(contT1) ## [1] 0.8824 # 相对危险度 RelRisk(contT1) ## [1] 4 (risk <- prop.table(contT1, margin=1)) ## diagT ## disease isHealthy isIll ## no 0.8 0.2 ## yes 0.2 0.8 # 相对危险度 (relRisk <- risk[1, 1]/ risk[2, 1]) ## [1] 4 56312.10.4 (r×c) 列联表 例某研究得出吸烟和冠心病疾病的严重程度人数分布如下表,问吸烟和 冠心病疾病的严重程度是否有关? smokes 轻 中 重 no 5 21 6 yes 4 13 1 table2flat <- function(mytable){ df <- as.data.frame(mytable) rows <- dim(df)[1] cols <- dim(df)[2] x <- NULL for(i in 1:rows){ for(j in 1:as.integer(as.character(df$Freq[i]))){ row <- df[i,c(1:(cols-1))] x <- rbind(x,row) } } row.names(x) <- c(1:dim(x)[1]) return(x) } smokes <- rep(c("no","yes"),times=1) siblings <- rep(c("1","2","3"),each=2) Freq <- c(5,4,21,13,6,1) mytable <- as.data.frame(cbind(smokes,siblings,Freq)) mydata <- table2flat(mytable) cTab <- table(mydata) cTab ## siblings ## smokes 1 2 3 564## no 5 21 6 ## yes 4 13 1 addmargins(cTab) ## siblings ## smokes 1 2 3 Sum ## no 5 21 6 32 ## yes 4 13 1 18 ## Sum 9 34 7 50 chisq.test(cTab) ## Warning in chisq.test(cTab): Chi-squared approximation may be incorrect ## ## Pearson's Chi-squared test ## ## data: cTab ## X-squared = 1.8, df = 2, p-value = 0.4 p 值大于 0.05,可以认为吸烟和冠心病疾病的严重程度无关。 12.10.4.1 ϕ, Cramer’s V, contingency coefficient 等值 Assocs(cTab) ## estimate lwr.ci upr.ci ## Phi Coeff. 0.1889 -- ## Contingency Coeff. 0.1857 -- ## Cramer V 0.1889 0.0000 0.4302 ## Goodman Kruskal Gamma -0.3430 -0.8497 0.1638 ## Kendall Tau-b -0.1607 -0.4096 0.0883 ## Stuart Tau-c -0.1520 -0.3905 0.0865 ## Somers D C|R -0.1649 -0.4224 0.0925 ## Somers D R|C -0.1565 -0.4360 0.1229 565## Pearson Correlation -0.1684 -0.4267 0.1154 ## Spearman Correlation -0.1667 -0.4253 0.1171 ## Lambda C|R 0.0000 0.0000 0.0000 ## Lambda R|C 0.0000 0.0000 0.0000 ## Lambda sym 0.0000 0.0000 0.0000 ## Uncertainty Coeff. C|R 0.0236 -0.0361 0.0834 ## Uncertainty Coeff. R|C 0.0306 -0.0473 0.1086 ## Uncertainty Coeff. sym 0.0267 -0.0409 0.0942 ## Mutual Information 0.0289 -- 12.10.4.2 Cochran-Mantel-Haenszel 检验 MHC 检验在存在第三个类别变量的情况下有条件地检验两个二分类变 量的关联度。 例检验在 A、B 两组组别因素存在的情况下,性别和工作而分类变量的 关联度 set.seed(123) myDf <- data.frame(work =factor(sample(c("home","office"), 10, replace=TRUE)), sex=factor(sample(c("f","m"),10, replace=TRUE)), group=factor(sample(c("A","B"), 10, replace=TRUE))) tab3 <- xtabs(~ work + sex + group, data=myDf) tab3 ## , , group = A ## ## sex ## work f m ## home 0 1 ## office 1 0 ## ## , , group = B ## ## sex 566## work f m ## home 0 3 ## office 4 1 cmh_test(tab3, distribution=approximate(B=9999)) ## ## Approximative Generalized Cochran-Mantel-Haenszel Test ## ## data: sex by ## work (home, office) ## stratified by group ## chi-squared = 5.1, p-value = 0.07 P 值大于 0.05,可以认为性别和工作无关联。 在存在第三个分类变量的情况下,有条件的检验两个分类变量的关联 度,需要用 Cochran-Mantel-Haenszel 检验。其原假设是两个分类变量在第 三个变量的每一层中都是条件独立的。 例 Arthritis 数据集检验治疗情况和改善情况在性别的每一水平下是否 独立,假设不存在三阶交互作用(治疗情况 × 改善情况 × 性别)。 mytable <- xtabs(~Treatment+Improved+Sex,data=Arthritis) mantelhaen.test(mytable) ## ## Cochran-Mantel-Haenszel test ## ## data: mytable ## Cochran-Mantel-Haenszel M^2 = 15, df = 2, p-value = 0.0007 P 值较小,表明接受治疗与得到改善在性别的每一水平下并不独立即, 分性别来看,用药治疗的患者叫接受安慰剂的患者有了更多的改善。 56712.11 有序分类联合检验 (Association tests and measures for ordered categorical variables) 12.11.1 线性间的联合检验 (Linear-by-linear association test) 线性间的联合检验检验两有序变量之间升高或降低的变化趋势。 例下表表示不同年龄组血液病患者真菌感染发生的严重分级情况,是否 年龄组越高,感染越重?年龄 I II III IV — — — — — <=29 1 5 6 9 30~59 5 7 6 7 >=60 8 9 13 10 age <- rep(c("Q","Z","L"),times=4) severity <- rep(c("I","II","III","IV"),each=3) Freq <- c(1,5,8,5,7,9,6,6,13,9,7,10) mytable <- as.data.frame(cbind(age,severity,Freq)) dfOrd <- table2flat(mytable) cTab <- xtabs(~ age + severity, data=dfOrd) addmargins(cTab) ## severity ## age I II III IV Sum ## L 8 9 13 10 40 ## Q 1 5 6 9 21 ## Z 5 7 6 7 25 ## Sum 14 21 25 26 86 lbl_test(cTab, distribution=approximate(B=9999)) ## ## Approximative Linear-by-Linear Association Test ## ## data: severity (ordered) by age (L < Q < Z) ## Z = 0.12, p-value = 1 ## alternative hypothesis: two.sided P 值大于 0.05,不能认为年龄越高真菌感染的严重程度越重。 56812.11.2 多序列相关 (Polychoric and polyserial correlation) Polychoric 相关是估计从两个从有序分类变量所获得的两个近似连续 正态分布的潜变量(latent variables)之间的相关。 polychor(dfOrd$age, dfOrd$severity, ML=TRUE) ## [1] 0.03117 #polychor(cTab, ML=TRUE) polyserial 相关是估计一个连续性变量和一个有序分类的变量之间的相 关。 x <- rnorm(86,mean = 23,sd=10) polyserial(x, dfOrd$severity) # 两步骤估计 ## [1] 0.04069 polyserial(x, dfOrd$severity,ML=TRUE, std.err=TRUE)#ML 估计 ## ## Polyserial Correlation, ML est. = 0.0428 (0.116) ## Test of bivariate normality: Chisquare = 25.2, df = 11, p = 0.00865 ## ## 1 2 3 ## Threshold -0.983 -0.235 0.518 ## Std.Err. 0.162 0.136 0.142 12.11.3 异构相关矩阵 (Heterogeneous correlation matrices) N <- 100 Sigma <- matrix(c(4,2,-3, 2,16,-1,-3,-1,9), byrow=TRUE, ncol=3) mu<- c(-3, 2, 4) Xdf <- data.frame(rmvnorm(n=N, mean=mu, sigma=Sigma)) 569lOrd <- lapply(Xdf, function(x) { cut(x, breaks=quantile(x), include.lowest=TRUE, ordered=TRUE, labels=LETTERS[1:4]) }) dfOrd <- data.frame(lOrd) Xdf2<- rmvnorm(n=N, mean=mu, sigma=Sigma) # 产生随机多元正态分布 dfBoth <- cbind(Xdf2, dfOrd) hetcor(dfBoth, ML=TRUE) ## ## Maximum-Likelihood Estimates ## ## Correlations/Type of Correlation: ## 1 2 3 X1 X2 X3 ## 1 1 Pearson Pearson Polyserial Polyserial Polyserial ## 2 0.198 1 Pearson Polyserial Polyserial Polyserial ## 3 -0.389 -0.0869 1 Polyserial Polyserial Polyserial ## X1 0.0219 -0.00254 -0.0465 1 Polychoric Polychoric ## X2 0.0448 -0.0148 -0.0441 0.12 1 Polychoric ## X3 0.0549 0.0669 -0.0385 -0.442 -0.0862 1 ## ## Standard Errors: ## 1 2 3 X1 X2 ## 1 ## 2 0.0964 ## 3 0.0853 0.0995 ## X1 0.107 0.109 0.107 ## X2 0.108 0.11 0.108 0.116 ## X3 0.108 0.108 0.108 0.0979 0.115 ## ## n = 100 ## ## P-values for Tests of Bivariate Normality: ## 1 2 3 X1 X2 570## 1 ## 2 0.98 ## 3 0.837 0.865 ## X1 0.771 0.707 0.714 ## X2 0.947 0.609 0.427 0.398 ## X3 0.819 0.196 0.506 0.581 0.582 12.11.4 有序变量和连续性变量 (Association measures involving categorical and continuous variables) 对有序分类变量和连续性变量的相关测量,可以使用 rms 包中建立 Logistic 模型的 lmr 函数,AUC 等指标可从模型的 stats 中获得。 set.seed(123) N <- 100 x <- rnorm(N) y <- x + rnorm(N, 0, 2) yDi <- ifelse(y <= median(y), 0, 1) lrm(yDi ~ x)$stats ## Obs Max Deriv Model L.R. d.f. ## 100.00000000000 0.00000000177 15.78679530262 1.00000000000 ## PC Dxy Gamma ## 0.00007089558 0.72400000000 0.44800000000 0.44871794872 ## Tau-a R2 Brier g ## 0.22626262626 0.19471661641 0.21235347641 1.01886507025 ## gr gp ## 2.77004916808 0.22251063462 # 绘制 ROC 曲线 (rocRes <- roc(yDi ~ x, plot=TRUE, ci=TRUE, main="ROC-curve", xlab="specificity (TN / (TN+FP))", ylab="sensitivity (TP / (TP+FN))")) 571## ## Call: ## roc.formula(formula = yDi ~ x, plot = TRUE, ci = TRUE, main = "ROC-curve", xlab = "specificity (TN / (TN+FP))", ylab = "sensitivity (TP / (TP+FN))") ## ## Data: x in 50 controls (yDi 0) < 50 cases (yDi 1). ## Area under the curve: 0.724 ## 95% CI: 0.624-0.825 (DeLong) rocCI <- ci.se(rocRes) plot(rocCI, type="shape") ## Warning in plot.ci.se(rocCI, type = "shape"): Low definition shape. ROC−curve specificity (TN / (TN+FP)) sensitivity (TP / (TP+FN)) 0.0 0.2 0.4 0.6 0.8 1.0 1.0 0.8 0.6 0.4 0.2 0.0 图 60: 12.12 Cochran Q 检验 (Cochran-Q-test) Cochran-Q 检验是对多个变量的二分数据具有同一分布的检验。检验 的数据是二分类数据,且数据是 0 或 1 两种编码。 572例某研究调查了 20 名患者,对四个医院的满意情况,满意用 1 表示, 不满意用 0 表示。 data_wide <- read.csv("Cochran.csv",header = T) data_wide ## A. B. C. D. ## 1 0 1 0 0 ## 2 1 1 1 0 ## 3 1 0 1 0 ## 4 0 0 1 0 ## 5 0 0 1 1 ## 6 1 1 0 1 ## 7 1 1 0 0 ## 8 1 1 0 0 ## 9 1 1 0 1 ## 10 1 1 1 0 ## 11 1 0 0 0 ## 12 1 1 0 0 ## 13 1 1 0 0 ## 14 1 0 1 1 ## 15 1 1 1 0 ## 16 1 1 0 1 ## 17 0 0 1 1 ## 18 1 0 0 0 ## 19 1 0 1 0 ## 20 1 0 0 0 data_long <- melt(data_wide, id.vars = NULL)# 转为长格式 id=factor(rep(1:20,times=4)) cdf <- data.frame(id,data_long) cdf$value <- as.numeric(cdf$value) # 转为数字 symmetry_test(value~variable | id, teststat="quad", data=cdf) ## 573## Asymptotic General Symmetry Test ## ## data: value by ## variable (A., B., C., D.) ## stratified by id ## chi-squared = 9.4, df = 3, p-value = 0.02 P 值小于 0.05,可以认为对四个医院的满意情况有差异。 12.13 McNemar 检验 (McNemar test) McNemar 检验用于配对计数资料的分析,主要分析配对资料中对照组 和处理组的频数或比率是否有差异。常用于同一批观察对象用药前后或试 验前后的结果是否有差异。McNemar 检验用于配对计数资料的分析,主要 分析配对资料中对照组和处理组的频数或比率是否有差异,也可以分析统 一批观察对象用药前后或试验前后的结果是否有差异,并不是独立性检验。 Kappa 统计量用于测量两次调查的可重复性,k = p0−pe 1−pe ,p0 两次调查中一致 的概率,pe 两次调查的期望一致概率,pe = ∑c i=1 aibi,aibi 为 c∗c 列联表中 两个调查第 i 个类型的边际概率,k>0.75 表示极好的重复性,0.4<=k<=0.75 好的重复性,0<=k<0.4 边界 (勉强够格) 的重复性。 例同一批病例治疗前后症状研究结果如下,试分析治疗前后是否有差 异? 后有 后无 前有 3 5 前无 6 6 pre <- rep(c("yes","no"),times=2) post <- rep(c("yes","no"),each=2) Freq <- c(3,6,5,6) mytable <- as.data.frame(cbind(pre,post,Freq)) mydata <- table2flat(mytable) cTab <- table(mydata$pre, mydata$post) addmargins(cTab) 574## ## no yes Sum ## no 6 6 12 ## yes 5 3 8 ## Sum 11 9 20 mcnemar.test(cTab, correct=FALSE) ## ## McNemar's Chi-squared test ## ## data: cTab ## McNemar's chi-squared = 0.091, df = 1, p-value = 0.8 #coin 包 symmetry_test(cTab, teststat="quad", distribution=approximate(B=9999)) ## ## Approximative General Symmetry Test ## ## data: response by ## conditions (Var1, Var2) ## stratified by block ## chi-squared = 0.091, p-value = 1 P 值大于 0.05,不但能认为治疗前后的症状有差异。例研究人员将患 霍奇金淋巴瘤的病人和非病人按同性别及年龄在 5 岁以内的条件进行配对, 共配对 85 对病人。两组人群中扁桃体切除情况如下,试问配对的两组人群 扁桃体切除率是否有差别? 对照是 对照否 病人是 26 15 病人否 7 37 575x <- c(26,7,15,37) dim(x) <- c(2,2) mcnemar.test(x,correct=F) ## ## McNemar's Chi-squared test ## ## data: x ## McNemar's chi-squared = 2.9, df = 1, p-value = 0.09 P 值大于 0.05,不能认为两组人群扁桃体切除率有差异。 例同时使用甲乙两种方法测定 265 份标本中的金黄色葡萄球菌,结果 如下,问甲乙两种方法可重复性 (kappa) 是多少? 甲 + 甲- 乙 + 107 35 乙- 24 99 kappa.test <- function(x) { N=sum(x) # 观察到的一致数 Po=sum(diag(x)/N) # 行边际 mr=apply(x,1,sum) mr=mr/N # 列边际 mc=apply(x,2,sum) mc=mc/N # 期望一致数 Pe=sum(mc * mr) #kappa 统计量 k=(Po-Pe)/(1-Pe) 576# kappa 统计量的标准误 se_k = sqrt((Pe+Pe^2-sum(mr*mc*(mr+mc)))/(N*(1-Pe)^2)) # 检验统计量 z=k/se_k # p 值 p.value=1-pnorm(z) res=list(kappa=k,se_k=se_k,p.value=p.value,z=z) } X<-c(107, 24, 35, 99) dim(X)<-c(2,2) k <- kappa.test(X) k ## $kappa ## [1] 0.5551 ## ## $se_k ## [1] 0.06122 ## ## $p.value ## [1] 0 ## ## $z ## [1] 9.067 12.14 Bowker 检验 (Bowker test) 对于配对设计的二分类资料,通常使用 McNemar 检验,而对于配对设 计多分类资料,使用 Bowker 检验,是 McNemar 检验的一般化。 例两名放射科医生对 203 名棉屑沉着病可疑患者的诊断结果见下表。试 分析两名医生诊断的结果是否相同。 577IIIIII I 78 5 2 II 6 56 12 III 2 10 32 A <- rep(c("I","II","III"),times=3) B <- rep(c("I","II","III"),each=3) Freq <- c(78,6,2,5,56,10,2,12,32) mytable <- as.data.frame(cbind(A,B,Freq)) mydata <- table2flat(mytable) cTab <- table(mydata$A, mydata$B) addmargins(cTab) ## ## I II III Sum ## I 78 5 2 85 ## II 6 56 12 74 ## III 2 10 32 44 ## Sum 86 71 46 203 # 对于大于 2*2 的列联表 mcnemar.test 自动采用 Bowke 检验 mcnemar.test(cTab) ## ## McNemar's Chi-squared test ## ## data: cTab ## McNemar's chi-squared = 0.27, df = 3, p-value = 1 #coin 包 symmetry_test(cTab, teststat="quad", distribution=approximate(B=9999)) ## 578## Approximative General Symmetry Test ## ## data: response by ## conditions (Var1, Var2) ## stratified by block ## chi-squared = 0.27, p-value = 0.9 P 值大于 0.05,不能认为两医生的诊断有差异。 12.15 Stuart Maxwell 检 验 (Stuart-Maxwell-test for marginal homogeneity) Stuart Maxwell 检验与 Bowker 检验类似,适用于有序多分类的资料。 例如上题。 mh_test(cTab, distribution=approximate(B=9999)) ## ## Approximative Marginal Homogeneity Test ## ## data: response by ## conditions (Var1, Var2) ## stratified by block ## chi-squared = 0.27, p-value = 0.9 结果与上题类似,P 值大于 0.05,不能认为两医生的诊断有差异。 12.16 基于尺度参数的检验 Kruskal-Wallis 和 Wilcoxon 检验均为基于位置参数的检验,常用基于 尺度参数的检验有 Ansari-Bradley 检验和 Fligner-Killeen 检验。 12.16.1 尺度参数的 Ansari-Bradley 检验 例两台机器加工的片剂直径 (各 10 个) 为 (单位:mm): 机器 A: 18.0, 17.1, 16.4, 16.9, 16.9, 16.7, 16.7, 17.2, 17.5, 16.9; 机器 B: 17.0, 16.9, 17.0, 57916.9, 17.2, 17.1, 16.8, 17.1, 17.1, 17.2. 这个结果能否说明两台机器的水平 (加工精度) 一致? worker.a<-c(18.0,17.1,16.4,16.9,16.9,16.7,16.7,17.2,17.5,16.9) worker.b<-c(17.0,16.9,17.0,16.9,17.2,17.1,16.8,17.1,17.1,17.2) ansari.test(worker.a,worker.b) ## Warning in ansari.test.default(worker.a, worker.b): cannot compute exact p- ## value with ties ## ## Ansari-Bradley test ## ## data: worker.a and worker.b ## AB = 42, p-value = 0.04 ## alternative hypothesis: true ratio of scales is not equal to 1 P 值小于 0.05,拒绝原假设,可以认为两台机器的加工精度不同。 12.16.2 尺度参数的 Fligner-Killeen 检验 例三名不同的病人 A、B、C 同时在同一条件下进行某项智力测验, 各 进行 10 次, 他们评分如下: A: 8, 7, 9, 10, 9, 6, 5, 8, 10, 5; B: 8, 7, 9, 6, 8, 9, 10, 7, 8, 9; C: 10, 10, 9, 6, 8, 3, 5, 6, 7, 4. 问这三名病例的智力测验稳定 性是否一样? x<-list(A=c(8,7,9,10,9,6,5,8,10,5), B=c(8,7,9,6,8,9,10,7,8,9), C=c(10,10,9,6,8,3,5,6,7,4)) fligner.test(x) ## ## Fligner-Killeen test of homogeneity of variances ## ## data: x ## Fligner-Killeen:med chi-squared = 5.2, df = 2, p-value = 0.07 P 值大于 0.05,接受原假设,认为三名病例的智力测验稳定性一样。 58012.17 重抽样(Resampling) 当数据抽样于非正态分布时,如未知或混合分布、样本量过小、存在离 群点、基于理论分布设计合适的统计检验过于复杂且数学上难以处理等情 况,这时可以使用基于随机化和重抽样的统计方法。 12.17.1 置换检验(Permutation tests) 以原假设为起点,假定二组没有差别,由此将二组样本合并,从中以无放 回方式进行抽样,分别归入两个组再计算统计量,反复进行由此得到置换分 布,在此基础上进行推断。相对于传统检验,coin 包提供了进行置换检验的 一般性框架,函数形式:function(formula,data,distribution=),formula 描 述的是要检验变量间的关系,如下表所示,data 是一个数据框,distribution 指定经验分布在零假设条件下的形式,若 distribution =“exact”,那么表示 在零假设条件下,分布的计算是精确的(即依据所有可能的排列组合),仅 可用于两样本问题;若 distribution = “asymptotic” 表示根据它的渐进分 布进行计算;若 distribution =“approxiamate(B = #)” 表示根据蒙特卡洛 重抽样来做近似计算,其中 # 指所需重复的次数。 检验 coin 函数 两样本和 K 样本置换检验 oneway_test(y ~ A) 含一个分层(区组)因子的两样本和 K 样本置换检验 oneway_test(y ~ A | C) Wilcoxon-Mann-Whitney 秩和检验 wilcox_test(y ~ A) Kruskal-Wallis 检验 kruskal_test(y ~ A) Person 卡方检验 chisq_test(A ~ B) Cochran-Mantel-Haenszel 检验 cmh_test(A ~ B | C) 线性关联检验 lbl_test(D ~ E) Spearman 检验 spearman_test(y ~ x) Friedman 检验 friedman_test(y ~ A | C) Wilcoxon 符号秩检验 wilcoxsign_test(y1 ~ y2) coin 函数中,y 和 x 是数值变量,A 和 B 是分类因子,C 是类别型区 组变量,D 和 E 是有序因子,y1 和 y2 是相匹配的数值变量。类别变量和 有序变量均应转化为因子和有序因子。 58112.17.1.1 独立两样本和 K 样本检验(Two-sample t-test / one-way ANOVA for independent groups) 例某医院欲研究 A、B 两种降血脂药物对家兔血清肾素血管紧张素转 化酶(ACE)的影响,将家兔随机分为三组,均喂以高脂饮食,分别给予不 同的降血脂药物。一定时间后测定家兔血清 ACE 浓度(u/ml),A 组(45 44 43 47 48 44 46 44 40 45 42 40 43 46 47 45 46 45 43 44),B 组(45 48 47 43 46 47 48 46 43 49 46 43 47 46 47 46 45 46 44 45 46 44 43 42 45),问两 组家兔血清 ACE 浓度是否相同? a <- c(45, 44, 43, 47, 48, 44, 46, 44, 40, 45, 42, 40, 43, 46, 47, 45, 46, 45, 43, 44) b <- c(45, 48, 47, 43, 46, 47, 48, 46, 43, 49, 46, 43, 47, 46, 47, 46, 45, 46, 44, 45, 46, 44, 43, 42, 45) dfCRp <- data.frame(length = c(a, b), site = factor(c(rep("1", 20), rep("2", 25)))) set.seed(123) ot <- oneway_test(length ~ site, data = dfCRp, distribution=approximate(B=9999)) ot ## ## Approximative Two-Sample Fisher-Pitman Permutation Test ## ## data: length by site (1, 2) ## Z = -1.9, p-value = 0.06 ## alternative hypothesis: true mu is not equal to 0 置换密度图 supp <- support(ot) dens <- sapply(supp, dperm, object=ot) plot(supp, dens, xlab="Support", ylab=NA, pch=20, main="Density permutation distribution") 582−3 −2 −1 0 1 2 3 0.00 0.02 0.04 0.06 Density permutation distribution Support 图 61: QQ 图 qEmp <- sapply(ppoints(supp), qperm, object=ot) qqnorm(qEmp, xlab="Normal quantiles", ylab="Permutation quantiles", pch=20, main="Permutation quantiles vs. normal quantiles") abline(a=0, b=1, lwd=2, col="blue") 累积分布图 plot(qEmp, ecdf(qEmp)(qEmp), col="gray60", pch=16, xlab="Difference in means", ylab="Cumulative relative frequency", main="Cumulative relative frequency and normal CDF") 12.17.1.2 非独立两样本和 K 样本检验(Two-sample t-test / one- way ANOVA for dependent groups) 例 10 各高血压病人在治疗前后的血压值分别为 86 120 82 137 96 104 583−2 −1 0 1 2 −2 −1 0 1 2 Permutation quantiles vs. normal quantiles Normal quantiles Permutation quantiles 图 62: −2 −1 0 1 2 0.0 0.2 0.4 0.6 0.8 1.0 Cumulative relative frequency and normal CDF Difference in means Cumulative relative frequency 图 63: 584142 86 77 82 和 75 107 88 111 111 132 67 115 103 136,问治疗前后的血压 值是否有不同? N <- 10 pre <- c(86,120,82,137,96,104,142,86,77,82) post <- c(75,107,88,111,111,132,67,115,103,136) tDepDf <- data.frame(DV=c(pre, post), IV=factor(rep(0:1, each=N), labels=c("pre","post"))) id <- factor(rep(1:N, times=2)) set.seed(123) oneway_test(DV ~ IV | id, alternative="less", distribution=approximate(B=9999), data=tDepDf) ## ## Approximative Two-Sample Fisher-Pitman Permutation Test ## ## data: DV by IV (pre, post) ## stratified by id ## Z = -0.3, p-value = 0.4 ## alternative hypothesis: true mu is less than 0 P 值大于 0.05,治疗前后的血压值没有不同。 12.17.1.3 独立性检验 例 vcd 包中 Arthritis 数据集包含了关节炎的治疗情况(Treatment) 和改善情况(Improved),问治疗情况和改善情况是否独立? Arthritisc <- transform(Arthritis,Improved=as.factor(as.numeric(Improved))) set.seed(123) chisq_test(Treatment~Improved,distribution=approximate(B=9999),data=Arthritisc) ## ## Approximative Pearson Chi-Squared Test ## ## data: Treatment by Improved (1, 2, 3) ## chi-squared = 13, p-value = 0.001 585p 值较小,可以认为治疗情况和改善情况不独立。 12.17.1.3.1 Cochran-Mantel-Haenszel 检验 CMH 检验可以对一些分层变量进行调整,从而获得反应率的总体比较。 最为最为常见的应用是在多中心试验中对研究中心进行调整而进行两组率 的比较。 例 vcd 包中 Arthritis 数据集包含了关节炎的治疗情况(Treatment)、 性别(Sex)和改善情况(Improved),在性别分层的情况下治疗情况和改 善情况是否独立? set.seed(123) cmh_test(Treatment~Improved|Sex, distribution=approximate(B=9999),data=Arthritis) ## ## Approximative Linear-by-Linear Association Test ## ## data: Treatment by ## Improved (None < Some < Marked) ## stratified by Sex ## Z = -3.8, p-value = 0.0003 ## alternative hypothesis: two.sided P 值较小,分性别来看,治疗情况和改善情况并不独立。 12.17.1.3.2 趋势检验 例 vcd 包中 Arthritis 数据集包含了关节炎的治疗情况(Treatment) 和改善情况(Improved),问治疗情况和改善情况是否存在线性趋势? set.seed(123) lbl_test(Treatment~Improved, distribution=approximate(B=9999),data=Arthritis) ## ## Approximative Linear-by-Linear Association Test 586## ## data: Treatment by Improved (None < Some < Marked) ## Z = -3.6, p-value = 0.0003 ## alternative hypothesis: two.sided P 值较小,治疗情况和改善情况存在线性趋势。 12.17.1.3.3 数值变量的独立性 某医生分别采用盐析法和结合法测定正常皮肤中胶原蛋白的含量,检测 结果如下,分析两数值变量之间的独立性。 编号 盐析法 结合法 1 6.8 546 2 7.8 553 3 8.7 562 4 8.7 563 5 8.9 570 6 9.5 575 7 10.1 581 8 10.2 605 9 10.3 607 10 10.4 621 11 11.1 624 12 12.4 626 13 13.3 632 14 13.1 640 15 13.2 656 y <- c(546,553,562,563,570,575,581,605,607,621,624,626,632,640,656) x <- c(6.8,7.8,8.7,8.7,8.9,9.5,10.1,10.2,10.3,10.4,11.1,12.4,13.3,13.1,13.2) df <- as.data.frame(cbind(x,y)) set.seed(123) 587spearman_test(x~y,data=df,distribution=approximate(B=9999)) ## ## Approximative Spearman Correlation Test ## ## data: x by y ## Z = 3.7, p-value <0.0000000000000002 ## alternative hypothesis: true rho is not equal to 0 基于 9999 次重复的近似置换检验,盐析法和结合法并不独立。 12.17.1.4 相关性 12.17.1.4.1 Wilcoxon 符号秩检验 Wilcoxon 符号秩检验适用于成对观测的数据,主要用于成对比较,比传 统的单独用正负号的检验更加有效。例某医生为了探讨缺碘地区母婴 TSH 水平的关系,应用免疫放射分析测定了 160 名孕妇(15-17 周)及分娩时脐 带血 TSH 水平(mU/L),现随机抽取 10 对数据,母血 TSH1.21 1.30 1.39 1.42 1.47 1.56 1.68 1.72 1.98 2.1, 脐血 TSH3.90 4.5 4.20 4.83 4.16 4.93 4.32 4.99 4.7 5.2,试对母血 TSH 水平与新生儿脐带血 TSH 水平进行相关分析。 x <- c(1.21,3.90,1.30,4.50,1.39,4.20,1.42 ,4.83,1.47,4.16) y <- c(1.56,4.93,1.68,4.32,1.72,4.99,1.98 ,4.70,2.10,5.20) df <- as.data.frame(cbind(x,y)) set.seed(123) wilcoxsign_test(x~y,data=df,distribution="exact") ## ## Exact Wilcoxon-Pratt Signed-Rank Test ## ## data: y by x (pos, neg) 588## stratified by block ## Z = -2.5, p-value = 0.01 ## alternative hypothesis: true mu is not equal to 0 P 值较小,可以认为母血 TSH 水平与新生儿脐带血 TSH 水平相关。 12.17.1.4.2 Mann-Whitney-Wilcoxon 检验 Mann-Whitney-Wilcoxon 检验是比较没有配对的两个独立样本的非 参数检验。例在某项研究中,经随机抽样获得甲乙两组病人的血尿素氮 (BUN)mmol/L,甲组:4.98 3.90 4.02 0.68 4.98 5.04 1.20 2.64 6.23 3.00, 乙 组:4.17 4.95 3.96 3.59 4.89 3.03 3.71 5.91 5.55 6.29 4.82 3.90 6.11,试比较 甲组病人血尿素氮 (BUN) 的含量是否大于乙组? #wilcox.test(x,y,exact = FALSE,correct =F) # 差异性比较 #wilcox.test(x,y,exact = FALSE) wilcox_test(DV ~ IV, alternative="less", conf.int=TRUE, distribution="exact", data=wIndDf) ## ## Exact Wilcoxon-Mann-Whitney Test ## ## data: DV by IV (A, B) ## Z = -1.1, p-value = 0.1 ## alternative hypothesis: true mu is less than 0 ## 95 percent confidence interval: ## -Inf 0.15 ## sample estimates: ## difference in location ## -0.93 P 值均大于 0.05,不能拒绝原假设,可以认为甲组病人血尿素氮 (BUN) 的含量不大于乙组。 12.17.1.4.3 Spearman 秩相关检验 589例两位评分员对新出生的 5 名新生儿进行 Apgar 评分,甲:6 7 8 9 10, 乙:5 6 7 8 10。试用 Spearman 秩相关检验方法检验两个评分员对等级评 定有无相关关系。 x <- c(6,7,8,9,10) y <- c(5,6,7,8,10) set.seed(123)####Spearman 秩相关检验 spearman_test(y~x) ## ## Asymptotic Spearman Correlation Test ## ## data: y by x ## Z = 2, p-value = 0.05 ## alternative hypothesis: true rho is not equal to 0 P 值小于 0.05,可以认为两位评分员结论有关。 12.17.1.4.4 Friedman 检验 例四种测试的方式,分别测试得到如下:A:14 13 12 11 10 ,B:11 12 13 14 15,C:16 15 14 13 12,D:13 12 11 10 9,问不同的测试方式之间是 否有差异? N <- 5 P <- 4 DV1 <- c(14, 13, 12, 11, 10) DV2 <- c(11, 12, 13, 14, 15) DV3 <- c(16, 15, 14, 13, 12) DV4 <- c(13, 12, 11, 10,9) Fdf <- data.frame(id=factor(rep(1:N, times=P)), DV=c(DV1, DV2, DV3, DV4), IV=factor(rep(1:P, each=N), labels=LETTERS[1:P])) set.seed(123) 590friedman_test(DV ~ IV | id, distribution=approximate(B=9999), data=Fdf) ## ## Approximative Friedman Test ## ## data: DV by IV (A, B, C, D) ## stratified by id ## chi-squared = 8.3, p-value = 0.03 P 值小于 0.05,拒绝原假设,可以认为四种不同的测试方式之间有差 异。 12.17.1.5 回归分析 例 某项 “冠状动脉缓慢血流现象” 的影响因素的研究,以前降支、回 旋支、右冠状动脉三支血管的平均 TIMI 帧基数 (MTFC) 表示,调查的影 响因素有年龄 (AGE, 岁)、收缩压 (SBP,mmHg)、舒张压 (DBP,mmHg)、白 细胞 (WBC,102/L), 寻找影响 MTFC 变化的因素。 age sbp dbp wbc mtfc 43 110 50 6.19 33.67 63 105 60 6.03 26.67 59 100 60 5.28 23 78 100 60 6.52 26 67 100 60 7.31 28 65 119 61 5.67 30.33 66 120 64 5.11 27 73 130 88 6.40 47 53 113 68 4.41 27.67 76 120 70 4.20 37.33 76 136 70 5.38 35.67 76 130 70 4.94 31.33 68 126 70 4.56 32.33 61 136 70 5.42 30.67 591age sbp dbp wbc mtfc 78 124 70 5.75 37.67 80 110 70 4.68 36 74 140 70 8.67 41 75 130 70 6.62 41.67 66 130 70 6.86 22 55 114 70 7.52 23.33 71 120 70 4.94 25.67 62 130 70 4.59 25 69 130 70 4.26 27 45 110 70 10.21 29 79 120 70 6.46 30.33 58 110 70 4.70 27 65 100 70 6.06 28 44 119 70 5.55 22.33 53 110 70 14.0 29.33 62 130 72 7.29 43 62 118 72 3.97 27.33 53 122 74 3.97 18.33 71 130 75 3.78 31 54 116 75 4.35 22.33 64 120 76 6.59 30 71 140 78 5.70 35.67 50 121 78 5.27 40.33 51 138 80 5.65 34.67 73 130 80 7.45 35.33 64 138 80 6.58 33.67 40 130 80 7.51 35.33 72 120 80 4.42 34 51 100 80 7.85 21 49 120 89 5.14 20.67 63 150 90 8.18 42.67 56 130 90 5.23 30.67 592age sbp dbp wbc mtfc 69 160 90 7.10 39 78 130 90 6.03 29 78 120 90 4.52 30.67 61 150 92 7.52 40 76 142 92 4.66 38 51 140 100 5.70 28.33 51 140 100 6.71 42.67 57 160 100 6.14 41 63 190 100 5.25 46 69 150 80 6.33 22.67 records <- read.table("example1") ex <- rename(records, c("V1"="age","V2"="sbp", "V3"="dbp","V4"="wbc","V5"="mtfc")) set.seed(123) fit <- lmp(mtfc~age+sbp+log10(wbc),data=ex,perm = "Prob") ## [1] "Settings: unique SS : numeric variables centered" summary(fit) ## ## Call: ## lmp(formula = mtfc ~ age + sbp + log10(wbc), data = ex, perm = "Prob") ## ## Residuals: ## Min 1Q Median 3Q Max ## -15.7634 -3.0155 0.0769 2.4431 12.6482 ## ## Coefficients: ## Estimate Iter Pr(Prob) ## age 0.157 3026 0.032 * 593## sbp 0.225 5000 <0.0000000000000002 *** ## log10(wbc) 15.655 2972 0.033 * ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 5.5 on 52 degrees of freedom ## Multiple R-Squared: 0.417, Adjusted R-squared: 0.384 ## F-statistic: 12.4 on 3 and 52 DF, p-value: 0.00000307 结果显示三个因素均有统计学意义。perm 有 Exact、Prob 和 SPR 三 个选项,Exact 适用于 10 个观测数以下的精确间检验,Prob 从可能的排 列中不断抽样,直至估计的标准差在 0.1 之下,SPR 适用序贯概率比检验 来判断何时停止抽样。pgirmess 包中 PermTest 函数也可以对 lm、lme 和 glm(binomial and Poisson) 进行置换检验。 fit <- lm(mtfc~age+sbp+log10(wbc),data=ex) PermTest(fit,B=1000) ## ## Monte-Carlo test ## ## Call: ## PermTest.lm(obj = fit, B = 1000) ## ## Based on 1000 replicates ## Simulated p-value: ## p.value ## age 0.022 ## sbp 0.000 ## log10(wbc) 0.029 回归系数的置信区间 594getRegr <- function(dat, idx) { bsFit <- lm(mtfc~age+sbp+log10(wbc), subset=idx, data=dat) coef(bsFit) } (bsRegr <- boot(ex, statistic=getRegr, R=999)) ## ## ORDINARY NONPARAMETRIC BOOTSTRAP ## ## ## Call: ## boot(data = ex, statistic = getRegr, R = 999) ## ## ## Bootstrap Statistics : ## original bias std. error ## t1* -18.6720 0.170057 9.56748 ## t2* 0.1574 0.001221 0.07671 ## t3* 0.2247 -0.004773 0.03942 ## t4* 15.6553 0.468670 6.20925 # 需要指定索引参数 boot.ci(bsRegr, conf=0.95, type="bca", index=1)$bca ## conf ## [1,] 0.95 37.79 984.5 -34.53 1.681 12.17.1.6 方差分析 12.17.1.6.1 单因素方差分析 例某医院欲研究 A、B、C 三种降血脂药物对家兔血清肾素血管紧张素 转化酶(ACE)的影响,将家兔随机分为三组,均喂以高脂饮食,分别给 予不同的降血脂药物。一定时间后测定家兔血清 ACE 浓度(u/ml),A 组 595(45 44 43 47 48 44 46 44 40 45 42 40 43 46 47 45 46 45 43 44),B 组(45 48 47 43 46 47 48 46 43 49 46 43 47 46 47 46 45 46 44 45 46 44 43 42 45),c 组(47 48 45 46 46 44 45 48 49 50 49 48 47 44 45 46 45 43 44 45 46 43 42), 问三组家兔血清 ACE 浓度是否相同? a <- c(45, 44, 43, 47, 48, 44, 46, 44, 40, 45, 42, 40, 43, 46, 47, 45, 46, 45, 43, 44) b <- c(45, 48, 47, 43, 46, 47, 48, 46, 43, 49, 46, 43, 47, 46, 47, 46, 45, 46, 44, 45, 46, 44, 43, 42, 45) c <- c(47, 48, 45, 46, 46, 44, 45, 48, 49, 50, 49, 48, 47, 44, 45, 46, 45, 43, 44, 45, 46, 43, 42) dfCRp <- data.frame(length = c(a, b, c), site = factor(c(rep("1", 20), rep("2", 25), rep("3", 23)))) set.seed(123) ot <- aovp(length ~ site, data = dfCRp,perm="Prob") ## [1] "Settings: unique SS " summary(ot) ## Component 1 : ## Df R Sum Sq R Mean Sq Iter Pr(Prob) ## site 2 26.3 13.15 4491 0.051 . ## Residuals 65 263.4 4.05 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 P 值为 0.05,可以认为三组的家兔血清 ACE 浓度不同。 自主法求 F 值及其置信区间 anBase <- anova(lm(length ~ site, data=dfCRp)) Fbase <- anBase["site","F value"] (pBase <- anBase["length","Pr(>F)"]) ## [1] NA 596fit0 <- lm(length ~ 1, data=dfCRp) ## fit 0-model E <- residuals(fit0) ## residuals Er <- E/ sqrt(1-hatvalues(fit0)) ## rescaled residuals Yhat <- fitted(fit0) getAnova <- function(dat, idx) { Ystar <- Yhat + Er[idx] anBS <- anova(lm(Ystar ~ site, data=dat)) anBS["site","F value"] } (bsAnova <- boot(dfCRp, statistic=getAnova, R=999)) ## ## ORDINARY NONPARAMETRIC BOOTSTRAP ## ## ## Call: ## boot(data = dfCRp, statistic = getAnova, R = 999) ## ## ## Bootstrap Statistics : ## original bias std. error ## t1* 3.244 -2.263 1.035 boot.ci(bsAnova,conf=0.95, type=c("basic","bca")) ## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS ## Based on 999 bootstrap replicates ## ## CALL : ## boot.ci(boot.out = bsAnova, conf = 0.95, type = c("basic", "bca")) ## ## Intervals : 597## Level Basic BCa ## 95% ( 2.603, 6.468 ) ( 2.686, 7.750 ) ## Calculations and Intervals on Original Scale ## Warning : BCa Intervals used Extreme Quantiles ## Some BCa intervals may be unstable Fstar <- bsAnova$t # don't use >= because of floating point arithmetic problems tol <- .Machine$double.eps^0.5 FsIsGEQ <- (Fstar > Fbase) | (abs(Fstar-Fbase) < tol) (pValBS <- (sum(FsIsGEQ) + 1)/(length(Fstar) + 1)) ## [1] 0.046 plot(Fstar, ecdf(Fstar)(Fstar), col="gray60", pch=1, xlab="f* bzw. f", ylab="P(F <= f)", main="F*: cumulative rel. freqs and F CDF") curve(pf(x, P-1, sum(Nj) - P), lwd=2, add=TRUE) legend(x="topleft", lty=c(NA, 1), pch=c(1, NA), lwd=c(2, 2), col=c("gray60","black"), legend=c("F*","F")) 0 2 4 6 8 0.0 0.2 0.4 0.6 0.8 1.0 F*: cumulative rel. freqs and F CDF f* bzw. f P(F <= f) F* F Wild boostrap 598getAnovaWild <- function(dat, idx) { n <- length(idx) ## size of replication ## 1st choice for random variate U: Rademacher-variables Ur <- sample(c(-1, 1), size=n, replace=TRUE, prob=c(0.5, 0.5)) ## 2nd option for choosing random variate U Uf <- sample(c(-(sqrt(5)- 1)/2,(sqrt(5) + 1)/2), size=n, replace=TRUE, prob=c((sqrt(5) + 1)/(2*sqrt(5)), (sqrt(5)- 1)/(2*sqrt(5)))) ## for E* with Rademacher-variables Ystar <- Yhat + (Er*Ur)[idx] # Ystar <- Yhat + (Er*Uf)[idx] ## for E* with 2nd option anBS <- anova(lm(Ystar ~ site, data=dat)) anBS["site","F value"] } bsAnovaW <- boot(dfCRp, statistic=getAnovaWild, R=999) boot.ci(bsAnovaW,conf=0.95, type=c("basic","bca")) ## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS ## Based on 999 bootstrap replicates ## ## CALL : ## boot.ci(boot.out = bsAnovaW, conf = 0.95, type = c("basic", "bca")) ## ## Intervals : ## Level Basic BCa ## 95% (-4.0163, 0.0822 ) ( 0.0005, 0.0933 ) ## Calculations and Intervals on Original Scale ## Warning : BCa Intervals used Extreme Quantiles ## Some BCa intervals may be unstable 599FstarW <- bsAnovaW$t # don't use >= because of floating point arithmetic problems tol <- .Machine$double.eps^0.5 FsIsGEQ <- (FstarW > Fbase) | (abs(FstarW-Fbase) < tol) (pValBSw <- (sum(FsIsGEQ) + 1)/(length(FstarW) + 1)) ## [1] 0.056 12.17.1.6.2 单因素协方差分析 例 multcomp 包中 litter 数据集是怀孕小白鼠被分为四个小组,每个小 组接受不同剂量(0、5、50 和 500)的药物处理 dose 为自变量,产下幼崽 的体重 weigth 均值为因变量,怀孕时间 gesttime 为协变量。 data(litter,package = "multcomp") ddply(.data = litter,.(dose),summarize,mean=mean(weight)) ## dose mean ## 1 0 32.31 ## 2 5 29.31 ## 3 50 29.87 ## 4 500 29.65 shapiro.test(litter$weight) ## ## Shapiro-Wilk normality test ## ## data: litter$weight ## W = 0.97, p-value = 0.05 bartlett.test(weight~dose,data = litter) ## 600## Bartlett test of homogeneity of variances ## ## data: weight by dose ## Bartlett's K-squared = 9.6, df = 3, p-value = 0.02 set.seed(123) ancova <- aovp(weight~gesttime+dose,data = litter,perm = "Prob") ## [1] "Settings: unique SS : numeric variables centered" summary(ancova) ## Component 1 : ## Df R Sum Sq R Mean Sq Iter Pr(Prob) ## gesttime 1 161 161.5 5000 0.0026 ** ## dose 3 137 45.7 4457 0.0339 * ## Residuals 69 1151 16.7 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 par(mfrow=c(2,2)) plot(ancova) par(mfrow=c(1,1)) 数据满足正态性的要求, 但不满足方差齐性的要求。检验结果表明怀孕 时间 gesttime 与出生体重 weight 相关,在控制怀孕时间后,每种药物剂量 dose 下出生体重 weight 均值不同。 12.17.1.6.3 双因素方差分析 例基础安装中的 ToothGrowth 数据集是随机分配 60 只豚鼠, 分别采用 两种喂食方法 supp(橙汁或维生素 C), 各喂食方法中抗坏血酸含量有三种水 平 dose(0.5mg、1mg 或 2mg), 每种处理方式组合都被分配 10 只豚鼠, 牙齿 长度 len 为因变量。 60128 30 32 34 −10 0 Fitted values Residuals Residuals vs Fitted 6366 41 −2 −1 0 1 2 −3 0 2 Theoretical Quantiles Standardized residuals Normal Q−Q 63 66 41 28 30 32 34 0.0 1.0 Fitted values S t a n d a r d i z e d r e s i d u a l s Scale−Location 636641 0.00 0.04 0.08 0.12 −3 0 2 Leverage Standardized residuals Cook's distance Residuals vs Leverage 6366 71 图 64: attach(ToothGrowth) ## The following object is masked _by_ .GlobalEnv: ## ## supp ## ## The following object is masked from data (pos = 3): ## ## dose ## ## The following objects are masked from ToothGrowth (pos = 26): ## ## dose, len, supp #table(supp,dose) ddply(.data = ToothGrowth,.(supp,dose),summarise,mean=mean(len)) ## supp dose mean 602## 1 OJ 0.5 13.23 ## 2 OJ 1 22.70 ## 3 OJ 2 26.06 ## 4 VC 0.5 7.98 ## 5 VC 1 16.77 ## 6 VC 2 26.14 ddply(.data = ToothGrowth,.(supp,dose),summarise,sd=sd(len)) ## supp dose sd ## 1 OJ 0.5 4.460 ## 2 OJ 1 3.911 ## 3 OJ 2 2.655 ## 4 VC 0.5 2.747 ## 5 VC 1 2.515 ## 6 VC 2 4.798 table 语句的预处理表明该设计是均衡设计 (各设计单元中样本大小都 相同),ddply 语句处理可获得各单元的均值和标准差。 set.seed(123) aovCRFpq <- aovp(len~ supp*dose, data=ToothGrowth,perm = "Prob") ## [1] "Settings: unique SS " summary(aovCRFpq) ## Component 1 : ## Df R Sum Sq R Mean Sq Iter Pr(Prob) ## supp 1 205 205 5000 <0.0000000000000002 *** ## dose 2 2426 1213 5000 <0.0000000000000002 *** ## supp:dose 2 108 54 3100 0.031 * ## Residuals 54 712 13 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 603par(mfrow=c(2,2)) plot(aovCRFpq) 10 15 20 25 −10 0 10 Fitted values Residuals Residuals vs Fitted 32 49 23 −2 −1 0 1 2 −2 0 2 Theoretical Quantiles Standardized residuals Normal Q−Q 32 49 23 10 15 20 25 0.0 1.0 Fitted values S t a n d a r d i z e d r e s i d u a l s Scale−Location 32 49 23 −2 0 2 Factor Level Combinations Standardized residuals OJ VC supp : Constant Leverage: Residuals vs Factor Levels 32 49 23 图 65: par(mfrow=c(1,1)) 得到方差分析表, 可以看到主效应 (supp 和 dose) 和交互效应都非常显 著。 12.17.1.7 Logistic 回归 例 AER 包中包含一个 Affairs 数据,记录了一组婚外情数据,其中包 括参与者性别、年龄、婚龄、是否有小孩、宗教信仰程度(5 分制,1 表示 反对,5 表示非常信仰)、学历、职业和婚姻的自我评分(5 分制,1 表示非 常不幸福,5 表示非常幸福),问婚外情的影响因素。 data(Affairs,package="AER") Affairs$ynaffair[Affairs$affairs > 0] <- 1 Affairs$ynaffair[Affairs$affairs==0] <- 0 604Affairs$ynaffair <- factor(Affairs$ynaffair, levels=c(0,1),labels=c("No","Yes")) fit<- glm(Affairs$ynaffair~gender+age+yearsmarried+ children+religiousness+education+occupation+rating, data=Affairs,family=binomial()) summary(fit) ## ## Call: ## glm(formula = Affairs$ynaffair ~ gender + age + yearsmarried + ## children + religiousness + education + occupation + rating, ## family = binomial(), data = Affairs) ## ## Deviance Residuals: ## Min 1Q Median 3Q Max ## -1.571 -0.750 -0.569 -0.254 2.519 ## ## Coefficients: ## Estimate Std. Error z value Pr(>|z|) ## (Intercept) 1.3773 0.8878 1.55 0.1208 ## gendermale 0.2803 0.2391 1.17 0.2411 ## age -0.0443 0.0182 -2.43 0.0153 * ## yearsmarried 0.0948 0.0322 2.94 0.0033 ** ## childrenyes 0.3977 0.2915 1.36 0.1725 ## religiousness -0.3247 0.0898 -3.62 0.0003 *** ## education 0.0211 0.0505 0.42 0.6769 ## occupation 0.0309 0.0718 0.43 0.6666 ## rating -0.4685 0.0909 -5.15 0.00000026 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## (Dispersion parameter for binomial family taken to be 1) ## 605## Null deviance: 675.38 on 600 degrees of freedom ## Residual deviance: 609.51 on 592 degrees of freedom ## AIC: 627.5 ## ## Number of Fisher Scoring iterations: 4 set.seed(123) PermTest(fit,B=250) ## ## Monte-Carlo test ## ## Call: ## PermTest.glm(obj = fit, B = 250) ## ## Based on 250 replicates ## Simulated p-value: ## p.value ## gender 0.236 ## age 0.232 ## yearsmarried 0.000 ## children 0.108 ## religiousness 0.000 ## education 0.876 ## occupation 0.508 ## rating 0.000 yearsmarried、religiousness 和 rating 三个变量的 P 值较小,可能是婚 外情的影响因素。 12.17.1.8 广义线性模型 例 robust 包中 Breslow 癫痫数据记录了治疗初期八周内,抗癫痫药物 对癫痫发病数的影响,因变量 sumY 为随机后 8 周内癫痫发病数,自变量 治疗 Trt,年龄 Age 和治疗前 8 周的癫痫发病数 Base。 606data(breslow.dat,package="robust") fitm <- glm(breslow.dat$sumY~Base+Age+Trt, data=breslow.dat,family = poisson()) summary(fitm) ## ## Call: ## glm(formula = breslow.dat$sumY ~ Base + Age + Trt, family = poisson(), ## data = breslow.dat) ## ## Deviance Residuals: ## Min 1Q Median 3Q Max ## -6.057 -2.043 -0.940 0.793 11.006 ## ## Coefficients: ## Estimate Std. Error z value Pr(>|z|) ## (Intercept) 1.948826 0.135619 14.37 < 0.0000000000000002 *** ## Base 0.022652 0.000509 44.48 < 0.0000000000000002 *** ## Age 0.022740 0.004024 5.65 0.000000016 *** ## Trtprogabide -0.152701 0.047805 -3.19 0.0014 ** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## (Dispersion parameter for poisson family taken to be 1) ## ## Null deviance: 2122.73 on 58 degrees of freedom ## Residual deviance: 559.44 on 55 degrees of freedom ## AIC: 850.7 ## ## Number of Fisher Scoring iterations: 5 set.seed(123) PermTest(fitm,B=250) 607## ## Monte-Carlo test ## ## Call: ## PermTest.glm(obj = fitm, B = 250) ## ## Based on 250 replicates ## Simulated p-value: ## p.value ## Base 0.000 ## Age 0.432 ## Trt 0.736 Base 变量的 P 值较小,可能对癫痫的发病数有影响。 12.18 自主法 (Bootstrapping) 自主法是在原样本中有放回的抽样,随机抽取形成一个新的样本,重复 这样的操作,形成一系列的新样本,通过这些样本就可以计算出样本的一个 分布。该法无需特定的理论分布,便可计算统计量的置信区间,并能检验统 计假设。 12.18.1 单个统计量 例计算 robust 包中 breslow.dat 数据集年龄 Age 的中位数及其置信区 间 mymedian <- function(data,indices){ d <- data[indices,] rs <- median(d$Age) return (rs) } set.seed(123) result <- boot(data=breslow.dat,statistic = mymedian,R=1000) print(result) 608## ## ORDINARY NONPARAMETRIC BOOTSTRAP ## ## ## Call: ## boot(data = breslow.dat, statistic = mymedian, R = 1000) ## ## ## Bootstrap Statistics : ## original bias std. error ## t1* 28 -0.095 1.54 plot(result) Histogram of t t* Density 24 26 28 30 32 0.0 0.2 0.4 0.6 0.8 1.0 1.2 −3 −1 0 1 2 3 24 26 28 30 32 Quantiles of Standard Normal t* 图 66: 609boot.ci(result,type = c("perc","bca")) ## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS ## Based on 1000 bootstrap replicates ## ## CALL : ## boot.ci(boot.out = result, type = c("perc", "bca")) ## ## Intervals : ## Level Percentile BCa ## 95% (25, 31 ) (25, 30 ) ## Calculations and Intervals on Original Scale ## Some BCa intervals may be unstable 12.18.2 多个统计量 例计算 Affairs 数据中 logistic 回归系统的置信区间 bs <- function(formula,data,indices){ d <- data[indices,] fit <- glm(formula,data=d,family=binomial()) return (coef(fit)) } result <- boot(data = Affairs,statistic = bs,R=1000, formula=ynaffair~gender+age+yearsmarried+ children+religiousness+education+occupation+rating) print(result) ## ## ORDINARY NONPARAMETRIC BOOTSTRAP ## ## ## Call: ## boot(data = Affairs, statistic = bs, R = 1000, formula = ynaffair ~ 610## gender + age + yearsmarried + children + religiousness + ## education + occupation + rating) ## ## ## Bootstrap Statistics : ## original bias std. error ## t1* 1.37726 0.0432808 0.96143 ## t2* 0.28029 -0.0014780 0.25592 ## t3* -0.04426 -0.0019614 0.01922 ## t4* 0.09477 0.0021235 0.03311 ## t5* 0.39767 0.0289371 0.30131 ## t6* -0.32472 -0.0062587 0.09369 ## t7* 0.02105 0.0008435 0.05141 ## t8* 0.03092 0.0013996 0.07642 ## t9* -0.46845 -0.0112432 0.09467 # 多个统计量,添加索引 #print(result,index = 8) plot(result,index = 8) boot.ci(result,type = "perc",index = 8) ## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS ## Based on 1000 bootstrap replicates ## ## CALL : ## boot.ci(boot.out = result, type = "perc", index = 8) ## ## Intervals : ## Level Percentile ## 95% (-0.1209, 0.1699 ) ## Calculations and Intervals on Original Scale type 参数有 norm(normal approximation 方法)、basic(basic bootstrap 611Histogram of t t* Density −0.2 0.0 0.2 0 1 2 3 4 5 −3 −1 0 1 2 3 −0.2 −0.1 0.0 0.1 0.2 Quantiles of Standard Normal t* 图 67: 方法)、stud(studentized bootstrap 方法)、perc(bootstrap percentile 方法)、 bca(adjusted bootstrap percentile) 和 all(全部)。 12.19 分层自主法 (Stratified bootstrapping) 例制药厂试制某种安定神经的新药,两台仪器制造药品服从正态分布, 从各自加工药品中,分别取若干个测量其直径,两组直径如下 A 组 20.5 19.8 19.7 20.4 20.1 20.0 19.0 19.9 B 组 20.7 19.8 19.5 20.8 20.4 19.6 20.2,问两 组均数之差的置信区间?两组分层抽样非参数法 DVm<-c(20.5, 19.8, 19.7, 20.4, 20.1, 20.0, 19.0, 19.9) DVf<-c(20.7, 19.8, 19.5, 20.8, 20.4, 19.6, 20.2) tDf <- data.frame(DV=c(DVm, DVf), IV=factor(rep(c("m","f"), c(length(DVm), length(DVf))))) getDM <- function(dat, idx) { Mfm <- aggregate(DV ~ IV, data=dat, subset=idx, FUN=mean) -diff(Mfm$DV) 612} bsTind <- boot(tDf, statistic=getDM, strata=tDf$IV, R=999) boot.ci(bsTind, conf=0.95, type=c("basic","bca")) ## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS ## Based on 999 bootstrap replicates ## ## CALL : ## boot.ci(boot.out = bsTind, conf = 0.95, type = c("basic", "bca")) ## ## Intervals : ## Level Basic BCa ## 95% (-0.2446, 0.6625 ) (-0.1881, 0.7330 ) ## Calculations and Intervals on Original Scale 参数法 tt <- t.test(DV ~ IV, alternative="two.sided", var.equal=TRUE, data=tDf) tt$conf.int ## [1] -0.3327 0.7684 ## attr(,"conf.level") ## [1] 0.95 613 13 地图展示 流行病学的数据讲究 “三间分布”, 即人群分布、 时间分布和空间 分布。其中的 “空间分布” 最好是在地图上展示,才比较清楚。R 语言 中 ggplot2 包无疑是最佳选择。 地图数据基本可以分为点、 线、 面三 种数据,在 maptools 包内分别有对应的函数来读取(readShapePoints、 readShapeLines 和 readShapePoly 函数) # 读取地理信息数据 city = readShapePoly("/home/xuefliang/RInMedicine/city/city_region.shp") # 将数据转为数据框 gpclibPermit() #install.packages('gpclib', type = 'source') ## Warning in gpclibPermit(): support for gpclib will be withdrawn from ## maptools at the next major release ## [1] TRUE ## Joining by: "id" 地图数据查看及加工 names(city) ## [1] "CNTY_CODE" "NAME" "PYNAME" "AREA" "CNTY_CODE8" ## [6] "USE_CODE8" tract <- fortify(city, region = "CNTY_CODE") # 发病数据 data <- read.csv("/home/xuefliang/RInMedicine/city/data.csv", stringsAsFactors = FALSE) data$id <- as.character(data$id) plotData <- left_join(tract, data) 614 615 ## ## 临夏回族自治州 兰州市 嘉峪关市 天水市 定西市 ## 1 1 1 1 1 ## 平凉市 庆阳市 张掖市 武威市 甘南藏族自治州 ## 1 1 1 1 1 ## 白银市 酒泉市 金昌市 陇南市 ## 1 1 1 1 图 1: #Linux 环境是 UTF-8,需要 iconv 函数转化 table(iconv(city$NAME, from = "GBK")) # 选择兰州的地图 lanzhou = city[city$CNTY_CODE8 == 62010000,] # 默认把经度和纬度作为普通数据,均匀平等对待,绘制在笛卡尔坐标系上 plot(lanzhou) # 地球的球面图形映射到平面图上,在地理学上是有不同的专业算法, #ggplot2 包提供了专门的 coord_map() 函数 616 13.1 Choropleth map 13.1.1 geom_polygon() 绘制地图 p <- ggplot() + geom_polygon(data = plotData, aes(x = long, y = lat, group = group, fill = rand), color = "black", size = 0.25) + coord_map() + theme_set(theme_bw()) + theme(legend.position = "right", axis.line = element_blank(), axis.text.x = element_blank(), axis.text.y = element_blank(), axis.ticks = element_blank(), axis.title.x = element_blank(), axis.title.y = element_blank(), panel.border = element_blank(), panel.grid.major = element_line(colour = NA)) + xlab("") + ylab("") + labs(title = " 甘肃省") + scale_fill_gradient2(low = "darkgreen", high = "red", mid = "yellow") + guides(fill = guide_legend(keywidth = 1, keyheight = 1)) ggsave(p, file = "map2.png", width = 5, height = 4.5, type = "cairo-png") print(p) 13.1.2 geom_map() 绘制地图 ggplot(data, aes(map_id = id)) + geom_map(aes(fill = rand), map = tract) + expand_limits(x = tract$long, y = tract$lat) + coord_map() + theme(legend.position = "right", axis.line = element_blank(), axis.text.x = element_blank(), axis.text.y = element_blank(), axis.ticks = element_blank(), axis.title.x = element_blank(), axis.title.y = element_blank(), panel.border = element_blank(), panel.grid.major = element_line(colour = NA)) + xlab("") + ylab("") + labs(title = " 甘肃省") + scale_fill_gradientn(" 发病率", breaks = c(0, 617 rand 0.25 0.50 0.75 图 2: 618 ......... 0.8 0.4 图 3: 13.2 点密度地图 (Dot Density Maps) 13.2.1 spsample() 绘制地图 tract$group <- tract$id tract <- rbind(filter(tract,id=="62290000"),filter(tract,id=="62300000")) 0.4, 0.8, 1), colours = c("green", "yellow", "red"), space = "Lab") # scale_fill_gradient2(' 发病率',low = 'darkgreen', # high = 'red', mid = 'yellow', midpoint = # 0.5,space = 'Lab',guide = ) 619 ## Joining by: "id" pointCollector <- list() perNCapita <- 1 for(ss in tract$id){ #print(ss) stateShapeFrame <- tract[tract$id == ss, ] if(nrow(stateShapeFrame) < 1){next()} statePoly <- Polygons(lapply(split(stateShapeFrame[, c("long", "lat")], stateShapeFrame$group), Polygon), ID = "b") nA <- ceiling(data[data$id == ss, "A"]/perNCapita) nB <- ceiling(data[data$id == ss, "B"]/perNCapita) pA <- data.frame(spsample(statePoly, nA, type = "random")@coords, Vote = "A") # 空间数据抽样,样本数 nDems, # 抽样方法 random,regular,stratified,nonaliged,hexagonal,clustered,Fibonacci pB <- data.frame(spsample(statePoly, nB, type = "random")@coords, Vote = "B") allPoints <- data.frame(State = ss, rbind(pA, pB)) pointCollector[[ss]] <- allPoints } pointFrame <- do.call(rbind, pointCollector) pointFrame <- pointFrame[sample(1:nrow(pointFrame), nrow(pointFrame)), ] # 发病数据 data$id <- as.character(data$id) data$A <- round(data$rand*1000) data$B <- round(data$rand*100*4) plotData <- left_join(tract, data) 620 #head(pointFrame) new_theme_empty <- theme_bw() # 创建自己的主题 new_theme_empty$line <- element_blank() new_theme_empty$rect <- element_blank() new_theme_empty$strip.text <- element_blank() new_theme_empty$axis.text <- element_blank() #new_theme_empty$axis.title <- element_blank() new_theme_empty$plot.margin <- structure(c(0, 0, -1, -1), unit = "lines", valid.unit = 3L, class = "unit") ggplot(tract)+ geom_point(data = pointFrame,aes(x = x, y = y, colour = Vote),size=1)+ geom_polygon(aes(x = long, y = lat, group = group), colour = "BLACK", fill = "transparent")+ coord_map(project="conic", lat0 = 30)+ new_theme_empty+ scale_colour_manual(values = c("blue", "red"))+ ggtitle("Type by State")+ ylab("")+ xlab(paste("Each dot represents ",perNCapita, " Vote", sep = ""))+ guides(colour = guide_legend(override.aes =list(shape = 19, alpha = 1))) 13.2.2 dotsInPolys() 绘制地图 在循环中使用 spsample() 方法获取点的速度较慢,可以 dotsInPolys() 方法提高作图的速度。 city = readShapePoly("/home/xuefliang/RInMedicine/city/city_region.shp") gpclibPermit() #install.packages('gpclib', type = 'source') ## Warning in gpclibPermit(): support for gpclib will be withdrawn from ## maptools at the next major release ## [1] TRUE 621 Type by State 图 4: Vote A B 622 ## Joining by: "CNTY_CODE" dots.A <- dotsInPolys(city, as.integer(plotDdata$A)) dots.A$Vote <- "A" dots.B <- dotsInPolys(city, as.integer(plotDdata$B)) dots.B$Vote <- "B" dots.all <- spRbind(dots.A, dots.B) dots <- data.frame(coordinates(dots.all)[, 1:2], Vote = dots.all$Vote) ggplot(tract, aes(x = long, y = lat)) + geom_polygon(aes(group = group), size = 0.2, fill = "white") + coord_equal() + geom_point(data = dots, aes(x = x, y = y, colour = factor(Vote)), size = 0.8) + scale_colour_manual(values = c("blue", "orange")) 13.3 ggmap 包使用 ggmap 包中 get_map() 函数用于获取基于位置名称和经纬度的地图 (非矢 量图片),get_map() 函数最重要的参数是 location(默认取值为德克 萨斯州的 休斯敦市),用来指定地图中心的经纬度,它伴随有参数 zoom。 zoom 取值为 3 到 20,用来指定地图中心所在区域扩展的大小,其中 3 是 大陆级别,20 是建 筑级别,一般城市级别是 12。getcode() 函数获取地点的 经纬度,主要基于 Google Maps;ggmap 主要用于画图,与 ggplot 函数用 tract <- fortify(city, region = "CNTY_CODE") data <- read.csv("/home/xuefliang/RInMedicine/city/data.csv", stringsAsFactors = FALSE) data$id <- as.character(data$id) data$CNTY_CODE <- as.integer(data$id) data$A <- round(data$rand * 1000) data$B <- round(data$rand * 100 * 4) plotDdata <- left_join(city@data, data) 623 42.5 40.0 37.5 35.0 factor(Vote) A B 32.5 95 100 105 long 图 5: 途一致。qmap() 快速画图,整合了 get_map() 和 ggmap();qmplot() 对上 述函数 的整合,可以直接画图。 Center:get_googlemap 的函数。可以放经纬度,如 c(25.09026,121.52111), 也 可 以 直 接 放 地 名, 如’taipei city’。 地 图 类 型, 有’terrain’(地 形 图)、 ‘satellite’(卫星图)、‘roadmap’(街道地图)、‘hybrid’(混合式);extent: ggmap 的函数,有’normal’、’panel’ 和’device’ 三种可以选择。 # 由于 goole 的 API 被封,国内需要使用代理服务器完成访问 BeijinMap <-get_map(location = 'beijin', zoom = 12,maptype='roadmap') ggmap(BeijinMap,extent='device') lat 624 # 获得定中心的经纬度坐标 geocode("Peking University") # 绘制北京大学地图 baylor <- "Peking university" qmap(baylor, zoom = 14) 625 # 绘制基于 OpenStreetMaps 数据的北京大学地图 626 qmap(baylor, zoom = 14,source = "osm") 例 data.csv 数据用经纬度记录了某时刻甘肃省的流感疾病的发病地点, 请用地图展现流感波及的范围和流行过程。 city = readShapePoly("/home/xuefliang/RInMedicine/city/city_region.shp") gpclibPermit() #install.packages('gpclib', type = 'source') tract <- fortify(city, region = "CNTY_CODE") data <- read.csv("data.csv", header = T, stringsAsFactors = F) data$lan <- as.numeric(data$lan) data$lon <- as.numeric(data$lon) data$date <- as.Date(data$date, " Y- m- d") ggmap(get_googlemap(center = "gansu", zoom = 5, maptype = "roadmap"),627 extent = "device") + geom_polygon(data = tract, aes(x = long, y = lat, group = group), colour = "black", fill = "grey", alpha = 0.2) + geom_point(data = data, aes(x = lon, y = lan), colour = "red", alpha = 0.7) + stat_density2d(aes(x = lon, y = lan, fill = ..level.., alpha = ..level..), size = 2, bins = 4, data = data, geom = "polygon") + theme_nothing(legend = TRUE) + coord_cartesian(xlim = c(90, 110), ylim = c(32, 43)) # 为了生成动画,先准备好一个绘图函数 plotfunc <- function(x) { df <- subset(data, date <= x) df$lan <- as.numeric(df$lan) df$lon <- as.numeric(df$lon) p <- ggmap(get_googlemap(center = "gansu", zoom = 8, maptype = "roadmap"), , extent = "device") + geom_point(data = df, aes(x = lon, y = lan), colour = "red", alpha = 0.7) 628 13.4 添加标记和路径 dat <- read.table(text = " location lat long A 33.29 104.6 B 40.01 97.95 C 36.83 103.65 D 35.32 106.53 E 36.06 103.49 F 39.2 97.81 ", header = TRUE) } # 获取日期 time <- sort(unique(data$date)) # 生成并保存动画 saveHTML(for (i in time) print(plotfunc(i))) # 用 getwd() 查看目录,此目录下有生成 html 文件 629 map <- get_map(location = "gansu", zoom = 6, maptype = "watercolor") p <- ggmap(map) p <- p + geom_point(data = dat, aes(x = long, y = lat, shape = location, colour = location, size = 7)) p <- p + geom_text(data = dat, aes(x = long, y = lat, label = location), hjust = -0.2) p <- p + theme(legend.position = "none", panel.grid.major = element_blank(), panel.grid.minor = element_blank(), axis.text = element_blank(), axis.title = element_blank(), axis.ticks = element_blank()) p <- p + labs(title print(p) 添加路径 = "Gansu locations") 630 dat.pts <- data.frame(x = dat$long, y = dat$lat) map <- get_googlemap("gansu", zoom = 6, maptype = "satellite", markers = dat.pts, path = dat.pts, scale = 2) p <- ggmap(map, extent = "device" # 除去白色边框 , darken = 0.1 # 图层淡化,凸显标记点 ) p <- p + geom_text(data = dat, aes(x = long, y = lat, label = location), hjust = -0.2, colour = "white", size = 6) p <- p + theme(legend.position = c(0.05, 0.05) # put the legend inside the plot are , legend.justification = c(0, 0), legend.background = element_rect(colour = F, fill = "white"), legend.key = element_rect(fill = F, colour = F), panel.grid.major = element_blank(), panel.grid.minor = element_blank(), axis.text = element_blank(), axis.title = element_blank(), axis.ticks = element_blank()) p <- p + labs(title = "Around Gansu") print(p) 631 13.5 交互式地图 交互式地图提供比传统地图更好的展示效果,通过生成的 html 进行缩 放查看。交互式地图的绘制主要依靠 leaflet 包完成, 交互式地图查看应以 html 方式,此处由于要印刷而添加了 eval=F。 13.5.1 添加标记点 Icon <- makeIcon( iconAnchorX = 22, iconAnchorY = 32 ) m <- leaflet() > 632 setView(103.87,36.05,zoom=13) > addTiles() > # 默认 OpenStreetMap 地图 addMarkers(lng=103.87, lat=36.05, popup=" 我的工作地",icon = Icon) m # Print the map 13.5.2 添加多边形连线 city = readShapePoly("/home/xuefliang/RInMedicine/city/city_region.shp") longnan = city[city$CNTY_CODE8 == 62120000,] longnan <- fortify(longnan,region="CNTY_CODE") leaflet() > addTiles() > addPolylines(lng=longnan$long,lat=longnan$lat) 633 13.5.3 以人口多少绘制圆形 cities <- read.csv(textConnection(" City,Long,Lat,Pop 兰 州,103.8343,36.06109,3616163 陇南,104.9218,33.40069,2567718 甘南,102.911,34.983399,689132 临 夏,103.2105,35.60118,1946677 天 水,105.7249,34.58086,3262548 庆 阳,107.6436,35.70908,2211191 平 凉,106.6651,35.54306,2068033 ")) leaflet(cities) > addTiles() > addCircles(lng = ~Long, lat = ~Lat, weight = 1, radius = ~sqrt(Pop) * 30, popup = ~City ) 634 13.5.4 绘制多边形区域 states <- readOGR("/home/xuefliang/RInMedicine/cb_2013_us_state_20m", layer = "cb_2013_us_state_20m", verbose = FALSE) neStates <- subset(states, states$STUSPS in c( "CT","ME","MA","NH","RI","VT","NY","NJ"," PA" )) leaflet(neStates) > addPolygons( stroke = FALSE, fillOpacity = 0.5, smoothFactor = 0.5, color = ~colorQuantile("YlOrRd", states$AWATER)(AWATER) ) 635 13.5.5 添加包含超级连接的标记点 content <- paste(sep = "
", " 甘肃省疾控中心", " 东岗西路 230 号", " 甘肃省, 兰州市" ) leaflet() > addTiles() > addPopups(103.87,36.05, content, options = popupOptions(closeButton = FALSE) ) 636 13.5.6 添加多个 html 标记点 leaflet(cities) > addTiles() > addMarkers(~Long, ~Lat, popup = ~htmlEscape(City)) 637 13.5.7 连续性变量 countries <- readOGR("/home/xuefliang/RInMedicine/countries.geojson", "OGRGeoJSON") map <- leaflet(countries) qpal <- colorQuantile("Blues", countries$gdp_md_est, n = 7) # 将 GDP 这个连续性变量分为 7 段 map > addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1, color = ~qpal(gdp_md_est) ) 638 13.5.8 分类变量 countries$category <- factor(sample.int(5L, nrow(countries), TRUE) factpal <- colorFactor(topo.colors(5), countries$category) leaflet(countries) > addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity ) = 1, color = ~factpal(category) # 分类变量 639 13.5.9 添加图例 1, map <- leaflet(countries) > addTiles() pal <- colorNumeric( pal ette = "YlGnBu", domain = countries$gdp_md_est ) map > addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = color = ~pal(gdp_md_est) 640 13.5.10 比例图例 1, ) > addLegend("bottomright", pal = pal, values = ~gdp_md_est, #addLegend()函数添加图例 title = "Est. GDP (2010)", labFormat = labelFormat(prefix = "$"), opacity = 1 ) qpal <- colorQuantile("RdYlBu", countries$gdp_md_est, n = 5) # 用不同颜色表示所占比例 map > addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = color = ~qpal(gdp_md_est) ) > addLegend(pal = qpal, values = ~gdp_md_est, opacity = 1) 641 13.5.11 波及范围交互地图 data <- read.csv("data.csv",header = T,stringsAsFactors = F) data$lan <- as.numeric(data$lan) data$lon <- as.numeric(data$lon) outline <- data[chull(data$lon, data$lan),] map <- leaflet(data) > # Base groups addTiles(group = "OSM (default)") > addProviderTiles("Stamen.Toner", group = "Toner") > addProviderTiles("Stamen.TonerLite", group = "Toner Lite") > # Overlay groups addCircles(~lon, ~lan, ~10^X/5,stroke = F, group = "occur") > addPolygons(data = outline, lng = ~lon, lat = ~lan, 642 > 13.6 等高线 fill = F, weight = 2, color = "#FFFFCC", group = "Outline") # Layers control addLayersControl( baseGroups = c("OSM (default)", "Toner", "Toner Lite"), overlayGroups = c("Quakes", "Outline"), options = layersControlOptions(collapsed = FALSE) ) map 643 volcano3d <- melt(volcano) #reshape2 包 names(volcano3d) <- c("x", "y", "z") # 等高线 v <- ggplot(volcano3d, aes(x, y, z = z)) v + stat_contour(binwidth = 5,aes(colour = ..level..),size = 1) # 面积 v + stat_contour(geom="polygon", aes(fill=..level..))+geom_tile(aes(fill = z)) v + geom_tile(aes(fill = z)) + stat_contour() 644 645 13.6.1 制作三维图 z <- 2*volcano x <- 10*(1:nrow(z)) y <- 10*(1:ncol(z)) zlim <- range(z) zlen <- zlim[2]-zlim[1]+1 colorlut <- terrain.colors(zlen)col <- colorlut[z-zlim[1]+1] rgl.open() rgl.surface(x,y,z,color=col,back="lines") 参考文献 1.Chow SC, Shao J, Wang H. Sample Size Calculation in Clinical Re- search[M]. New York: Marcel Dekker, 2003 2. 汤银才.R 语言与统计分析 [M]. 北京. 高等教育出版社, 2008. 3. 薛毅, 陈立萍. 统计建模与 R 软件 [M] 清华大学出版社,2006. 4. 徐俊晓. 统计学与 R 读书笔记 (第六版)[EB/OL].PhD diss. 5.Kabacoff, Robert. R in Action[M]. Manning Publications Co., 2011. 6. 李明.R 语言与网站分析 [M]. 机械工业出版社,2014 646 View publication statsView publication stats

还剩645页未读

继续阅读

下载pdf到电脑,查找使用更方便

pdf的实际排版效果,会与网站的显示效果略有不同!!

需要 10 金币 [ 分享pdf获得金币 ] 15 人已下载

下载pdf

pdf贡献者

qianshu

贡献于2017-03-13

下载需要 10 金币 [金币充值 ]
亲,您也可以通过 分享原创pdf 来获得金币奖励!
下载pdf