├── .Rinstignore ├── DESCRIPTION ├── MD5 ├── NAMESPACE ├── R ├── Surv.R ├── Surv2.R ├── aareg.R ├── aareg.taper.R ├── aeqSurv.R ├── agexact.fit.R ├── aggregate.survfit.R ├── agreg.fit.R ├── agsurv.R ├── anova.coxph.R ├── anova.coxph.penal.R ├── anova.coxphlist.R ├── anova.coxphms.R ├── anova.survreg.R ├── anova.survreglist.R ├── attrassign.R ├── basehaz.R ├── blogit.R ├── brier.R ├── cch.R ├── cipoisson.R ├── clogit.R ├── cluster.R ├── concordance.R ├── cox.zph.R ├── coxexact.fit.R ├── coxpenal.df.R ├── coxpenal.fit.R ├── coxph.R ├── coxph.control.R ├── coxph.detail.R ├── coxph.fit.R ├── coxph.getdata.R ├── coxph.wtest.R ├── coxsurvfit.R ├── drop.special.R ├── dsurvreg.R ├── finegray.R ├── firstlib.R ├── frailty.R ├── frailty.brent.R ├── frailty.controlaic.R ├── frailty.controldf.R ├── frailty.controlgam.R ├── frailty.controlgauss.R ├── frailty.gamma.R ├── frailty.gammacon.R ├── frailty.gaussian.R ├── frailty.t.R ├── is.na.coxph.penalty.R ├── is.ratetable.R ├── labels.survreg.R ├── lines.aareg.R ├── lines.survexp.R ├── lines.survfit.coxph.R ├── logLik.coxph.R ├── match.ratetable.R ├── methods.R ├── model.frame.survfit.R ├── model.frame.survreg.R ├── model.matrix.coxph.R ├── neardate.R ├── normalizetime.R ├── nsk.R ├── pade.R ├── parsecovar.R ├── plot.aareg.R ├── plot.cox.zph.R ├── plot.survfit.R ├── predict.coxph.R ├── predict.coxph.penal.R ├── predict.coxphms.R ├── predict.survreg.R ├── predict.survreg.penal.R ├── print.aareg.R ├── print.coxph.R ├── print.coxph.null.R ├── print.coxph.penal.R ├── print.pyears.R ├── print.ratetable.R ├── print.summary.coxph.R ├── print.summary.coxph.penal.R ├── print.summary.survexp.R ├── print.summary.survfit.R ├── print.summary.survfitms.R ├── print.summary.survreg.R ├── print.survcheck.R ├── print.survdiff.R ├── print.survexp.R ├── print.survfit.R ├── print.survreg.R ├── print.survreg.penal.R ├── pseudo.R ├── pspline.R ├── pyears.R ├── quantile.survfit.R ├── ratetable.R ├── ratetableDate.R ├── ratetableold.R ├── residuals.coxph.R ├── residuals.coxph.null.R ├── residuals.coxph.penal.R ├── residuals.survfit.R ├── residuals.survreg.R ├── residuals.survreg.penal.R ├── ridge.R ├── royston.R ├── rsurvpart2.R ├── rttright.R ├── stacker.R ├── statefig.R ├── strata.R ├── summary.aareg.R ├── summary.coxph.R ├── summary.coxph.penal.R ├── summary.ratetable.R ├── summary.survexp.R ├── summary.survfit.R ├── summary.survfitms.R ├── summary.survreg.R ├── surv2data.R ├── survConcordance.R ├── survConcordance.fit.R ├── survSplit.R ├── survcallback.R ├── survcheck.R ├── survcondense.R ├── survdiff.R ├── survdiff.fit.R ├── survexp.R ├── survexp.cfit.R ├── survexp.fit.R ├── survexpm.R ├── survfit.R ├── survfit.coxph.R ├── survfit.coxphms.R ├── survfit.matrix.R ├── survfit0.R ├── survfitAJ.R ├── survfitKM.R ├── survfitTurnbull.R ├── survfitcoxph.fit.R ├── survfitms.R ├── survobrien.R ├── survpenal.fit.R ├── survreg.R ├── survreg.control.R ├── survreg.distributions.R ├── survreg.fit.R ├── survregDtest.R ├── tcut.R ├── timeline.R ├── tmerge.R ├── untangle.specials.R ├── xtras.R └── yates.R ├── build └── vignette.rds ├── data ├── cancer.rda ├── cgd.rda ├── diabetic.rda ├── flchain.rda ├── heart.rda ├── logan.rda ├── nafld.rda ├── nwtco.rda ├── pbc.rda ├── reliability.rda ├── retinopathy.rda ├── rhDNase.rda ├── solder.rda ├── survexp.rda ├── tobin.rda ├── transplant.rda └── udca.rda ├── inst ├── CITATION ├── COPYRIGHTS ├── NEWS.Rd └── doc │ ├── adjcurve.R │ ├── adjcurve.Rnw │ ├── adjcurve.pdf │ ├── approximate.R │ ├── approximate.Rnw │ ├── approximate.pdf │ ├── compete.R │ ├── compete.Rnw │ ├── compete.pdf │ ├── concordance.R │ ├── concordance.Rnw │ ├── concordance.pdf │ ├── matrix.R │ ├── matrix.Rnw │ ├── matrix.pdf │ ├── methods.R │ ├── methods.Rnw │ ├── methods.pdf │ ├── multi.Rnw │ ├── multi.pdf │ ├── other.Rnw │ ├── other.pdf │ ├── population.R │ ├── population.Rnw │ ├── population.pdf │ ├── redistribute.R │ ├── redistribute.Rnw │ ├── redistribute.pdf │ ├── splines.R │ ├── splines.Rnw │ ├── splines.pdf │ ├── survival.R │ ├── survival.Rnw │ ├── survival.pdf │ ├── tiedtimes.R │ ├── tiedtimes.Rnw │ ├── tiedtimes.pdf │ ├── timedep.R │ ├── timedep.Rnw │ ├── timedep.pdf │ ├── validate.R │ ├── validate.Rnw │ └── validate.pdf ├── man ├── Surv.Rd ├── Surv2.Rd ├── Surv2data.Rd ├── Survmethods.Rd ├── aareg.Rd ├── aeqSurv.Rd ├── aggregate.survfit.Rd ├── agreg.fit.Rd ├── aml.Rd ├── anova.coxph.Rd ├── attrassign.Rd ├── basehaz.Rd ├── bladder.Rd ├── blogit.Rd ├── brier.Rd ├── cch.Rd ├── cgd.Rd ├── cgd0.Rd ├── cipoisson.Rd ├── clogit.Rd ├── cluster.Rd ├── colon.Rd ├── concordance.Rd ├── concordancefit.Rd ├── cox.zph.Rd ├── coxph.Rd ├── coxph.control.Rd ├── coxph.detail.Rd ├── coxph.object.Rd ├── coxph.wtest.Rd ├── coxphms.object.Rd ├── coxsurv.fit.Rd ├── diabetic.Rd ├── dsurvreg.Rd ├── figures │ └── logo.png ├── finegray.Rd ├── flchain.Rd ├── frailty.Rd ├── gbsg.Rd ├── heart.Rd ├── hoel.Rd ├── is.ratetable.Rd ├── kidney.Rd ├── levels.Surv.Rd ├── lines.survfit.Rd ├── logLik.coxph.Rd ├── logan.Rd ├── lung.Rd ├── mgus.Rd ├── mgus2.Rd ├── model.frame.coxph.Rd ├── model.matrix.coxph.Rd ├── myeloid.Rd ├── myeloma.Rd ├── nafld.Rd ├── neardate.Rd ├── nsk.Rd ├── nwtco.Rd ├── ovarian.Rd ├── pbc.Rd ├── pbcseq.Rd ├── plot.aareg.Rd ├── plot.cox.zph.Rd ├── plot.survfit.Rd ├── predict.coxph.Rd ├── predict.survreg.Rd ├── print.aareg.Rd ├── print.summary.coxph.Rd ├── print.summary.survexp.Rd ├── print.summary.survfit.Rd ├── print.survfit.Rd ├── pseudo.Rd ├── pspline.Rd ├── pyears.Rd ├── quantile.survfit.Rd ├── ratetable.Rd ├── ratetableDate.Rd ├── rats.Rd ├── rats2.Rd ├── reliability.Rd ├── residuals.coxph.Rd ├── residuals.survfit.Rd ├── residuals.survreg.Rd ├── retinopathy.Rd ├── rhDNase.Rd ├── ridge.Rd ├── rotterdam.Rd ├── royston.Rd ├── rttright.Rd ├── solder.Rd ├── stanford2.Rd ├── statefig.Rd ├── strata.Rd ├── summary.aareg.Rd ├── summary.coxph.Rd ├── summary.pyears.Rd ├── summary.survexp.Rd ├── summary.survfit.Rd ├── survSplit.Rd ├── survcheck.Rd ├── survcondense.Rd ├── survdiff.Rd ├── survexp.Rd ├── survexp.fit.Rd ├── survexp.object.Rd ├── survexp.us.Rd ├── survfit.Rd ├── survfit.coxph.Rd ├── survfit.formula.Rd ├── survfit.matrix.Rd ├── survfit.object.Rd ├── survfit0.Rd ├── survfitcoxph.fit.Rd ├── survival-deprecated.Rd ├── survival-internal.Rd ├── survobrien.Rd ├── survreg.Rd ├── survreg.control.Rd ├── survreg.distributions.Rd ├── survreg.object.Rd ├── survregDtest.Rd ├── tcut.Rd ├── timeline.Rd ├── tmerge.Rd ├── tobin.Rd ├── transplant.Rd ├── udca.Rd ├── untangle.specials.Rd ├── uspop2.Rd ├── vcov.coxph.Rd ├── veteran.Rd ├── xtfrm.Surv.Rd ├── yates.Rd └── yates_setup.Rd ├── noweb ├── Makefile ├── Readme ├── agreg.Rnw ├── casecohort.Rnw ├── code.nw ├── concordance.Rnw ├── coxph.Rnw ├── coxsurv.Rnw ├── coxsurv2.Rnw ├── coxsurv3.Rnw ├── exact.nw ├── finegray.Rnw ├── main.Rnw ├── maximacode ├── msurv.nw ├── noweb.sty ├── parse.Rnw ├── plot.Rnw ├── predict.coxph.Rnw ├── pyears.Rnw ├── pyears2.Rnw ├── rates │ ├── minn2000.dat │ ├── minn2004.dat │ ├── minndecennial.dat │ ├── us1996.dat │ ├── us1997.dat │ ├── us1998.dat │ ├── us1999.dat │ ├── us2000.dat │ ├── us2001.dat │ ├── us2002.dat │ ├── us2003.dat │ ├── us2004.dat │ ├── us2005.dat │ ├── us2006.dat │ ├── usdecennial.dat │ └── usinfant.dat ├── ratetable.Rnw ├── refer.bib ├── residuals.survfit.Rnw ├── residuals.survfit2.Rnw ├── residuals.survreg.Rnw ├── statefig.Rnw ├── survConcordance.Rnw ├── survexp.Rnw ├── survfit.Rnw ├── survfitms.Rnw ├── tail ├── tmerge.Rnw ├── yates.Rnw ├── yates2.Rnw └── zph.Rnw ├── src ├── agexact.c ├── agfit4.c ├── agfit5.c ├── agmart.c ├── agmart3.c ├── agscore2.c ├── agscore3.c ├── agsurv4.c ├── agsurv5.c ├── cdecomp.c ├── chinv2.c ├── chinv3.c ├── cholesky2.c ├── cholesky3.c ├── cholesky5.c ├── chsolve2.c ├── chsolve3.c ├── chsolve5.c ├── collapse.c ├── concordance1.c ├── concordance3.c ├── concordance5.c ├── cox_Rcallback.c ├── coxcount1.c ├── coxdetail.c ├── coxexact.c ├── coxfit5.c ├── coxfit6.c ├── coxmart.c ├── coxmart2.c ├── coxph_wtest.c ├── coxsafe.c ├── coxscho.c ├── coxscore2.c ├── coxsurv1.c ├── coxsurv2.c ├── coxsurv3.c ├── coxsurv4.c ├── dmatrix.c ├── doloop.c ├── fastkm.c ├── finegray.c ├── gchol.c ├── init.c ├── multicheck.c ├── norisk.c ├── pyears1.c ├── pyears2.c ├── pyears3b.c ├── pystep.c ├── residcsum.c ├── survConcordance.c ├── survS.h ├── survdiff2.c ├── survfit4.c ├── survfitaj.c ├── survfitkm.c ├── survfitresid.c ├── survpenal.c ├── survproto.h ├── survreg6.c ├── survreg7.c ├── survregc1.c ├── survregc2.c ├── survsplit.c ├── tmerge.c ├── twoclust.c ├── zph1.c └── zph2.c ├── tests ├── Examples │ └── survival-Ex.Rout.save ├── aareg.R ├── aareg.Rout.save ├── anova.R ├── anova.Rout.save ├── bladder.R ├── bladder.Rout.save ├── book1.R ├── book1.Rout.save ├── book2.R ├── book2.Rout.save ├── book3.R ├── book3.Rout.save ├── book4.R ├── book4.Rout.save ├── book5.R ├── book5.Rout.save ├── book6.R ├── book6.Rout.save ├── book7.R ├── book7.Rout.save ├── brier.R ├── brier.Rout.save ├── cancer.R ├── cancer.Rout.save ├── checkSurv2.R ├── checkSurv2.Rout.save ├── clogit.R ├── clogit.Rout.save ├── concordance.R ├── concordance.Rout.save ├── concordance2.R ├── concordance2.Rout.save ├── concordance3.R ├── concordance3.Rout.save ├── counting.R ├── counting.Rout.save ├── coxsurv.R ├── coxsurv.Rout.save ├── coxsurv2.R ├── coxsurv2.Rout.save ├── coxsurv3.R ├── coxsurv3.Rout.save ├── coxsurv4.R ├── coxsurv4.Rout.save ├── coxsurv5.R ├── coxsurv5.Rout.save ├── coxsurv6.R ├── coxsurv6.Rout.save ├── data.interval ├── data.smoke ├── data.turbine ├── detail.R ├── detail.Rout.save ├── difftest.R ├── difftest.Rout.save ├── doaml.R ├── doaml.Rout.save ├── doublecolon.R ├── doublecolon.Rout.save ├── doweight.R ├── doweight.Rout.save ├── dropspecial.R ├── dropspecial.Rout.save ├── ekm.R ├── ekm.Rout.save ├── expected.R ├── expected.Rout.save ├── expected2.R ├── expected2.Rout.save ├── factor.R ├── factor.Rout.save ├── factor2.R ├── factor2.Rout.save ├── finegray.R ├── finegray.Rout.save ├── fr_cancer.R ├── fr_cancer.Rout.save ├── fr_kidney.R ├── fr_kidney.Rout.save ├── fr_lung.R ├── fr_lung.Rout.save ├── fr_ovarian.R ├── fr_ovarian.Rout.save ├── fr_rat1.R ├── fr_rat1.Rout.save ├── fr_resid.R ├── fr_resid.Rout.save ├── fr_simple.R ├── fr_simple.Rout.save ├── frailty.R ├── frailty.Rout.save ├── frank.R ├── frank.Rout.save ├── gray1.rda ├── infcox.R ├── infcox.Rout.save ├── jasa.R ├── jasa.Rout.save ├── model.matrix.R ├── model.matrix.Rout.save ├── mstate.R ├── mstate.Rout.save ├── mstate2.R ├── mstate2.Rout.save ├── mstrata.R ├── mstrata.Rout.save ├── multi2.R ├── multi2.Rout.save ├── multi3.R ├── multi3.Rout.save ├── multistate.R ├── multistate.Rout.save ├── neardate.R ├── neardate.Rout.save ├── nested.R ├── nested.Rout.save ├── nsk.R ├── nsk.Rout.save ├── ovarian.R ├── ovarian.Rout.save ├── overlap.R ├── overlap.Rout.save ├── prednew.R ├── prednew.Rout.save ├── predsurv.R ├── predsurv.Rout.save ├── pseudo.R ├── pseudo.Rout.save ├── pspline.R ├── pspline.Rout.save ├── pyear.R ├── pyear.Rout.save ├── quantile.R ├── quantile.Rout.save ├── r_lung.R ├── r_lung.Rout.save ├── r_resid.R ├── r_resid.Rout.save ├── r_sas.R ├── r_sas.Rout.save ├── r_scale.R ├── r_scale.Rout.save ├── r_stanford.R ├── r_stanford.Rout.save ├── r_strata.R ├── r_strata.Rout.save ├── r_tdist.R ├── r_tdist.Rout.save ├── r_user.R ├── r_user.Rout.save ├── ratetable.R ├── ratetable.Rout.save ├── residsf.R ├── residsf.Rout.save ├── residsfx.Rtemp ├── royston.R ├── royston.Rout.save ├── rttright.R ├── rttright.Rout.save ├── sexpm.save ├── singtest.R ├── singtest.Rout.save ├── strata2.R ├── strata2.Rout.save ├── stratatest.R ├── stratatest.Rout.save ├── summary_survfit.R ├── summary_survfit.Rout.save ├── surv.R ├── surv.Rout.save ├── survSplit.R ├── survSplit.Rout.save ├── survcheck.R ├── survcheck.Rout.save ├── survexpm.R.later ├── survexpm.R.notyet ├── survfit1.R ├── survfit1.Rout.save ├── survfit2.R ├── survfit2.Rout.save ├── survreg1.R ├── survreg1.Rout.save ├── survreg2.R ├── survreg2.Rout.save ├── survtest.R ├── survtest.Rout.save ├── testci.R ├── testci.Rout.save ├── testci2.R ├── testci2.Rout.save ├── testnull.R ├── testnull.Rout.save ├── testreg.R ├── testreg.Rout.save ├── tiedtime.R ├── tiedtime.Rout.save ├── ties.rda ├── tmerge.R ├── tmerge.Rout.save ├── tmerge2.R ├── tmerge2.Rout.save ├── tmerge3.R ├── tmerge3.Rout.save ├── tt.R ├── tt.Rout.save ├── tt2.R ├── tt2.Rout.save ├── turnbull.R ├── turnbull.Rout.save ├── update.R ├── update.Rout.save ├── yates0.R ├── yates0.Rout.save ├── yates1.R ├── yates1.Rout.save ├── yates2.R ├── zph.R └── zph.Rout.save └── vignettes ├── adjcurve.Rnw ├── approximate.Rnw ├── compete.Rnw ├── concordance.Rnw ├── matrix.Rnw ├── methods.Rnw ├── multi.Rnw ├── other.Rnw ├── population.Rnw ├── redistribute.Rnw ├── refer.bib ├── splines.Rnw ├── survival.Rnw ├── tiedtimes.Rnw ├── timedep.Rnw └── validate.Rnw /.Rinstignore: -------------------------------------------------------------------------------- 1 | inst/doc/validate.tex 2 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Title: Survival Analysis 2 | Priority: recommended 3 | Package: survival 4 | Version: 3.8-3 5 | Date: 2024-12-17 6 | Depends: R (>= 3.5.0) 7 | Imports: graphics, Matrix, methods, splines, stats, utils 8 | LazyData: Yes 9 | LazyDataCompression: xz 10 | ByteCompile: Yes 11 | Authors@R: c(person(c("Terry", "M"), "Therneau", 12 | email="therneau.terry@mayo.edu", 13 | role=c("aut", "cre")), 14 | person("Thomas", "Lumley", role=c("ctb", "trl"), 15 | comment="original S->R port and R maintainer until 2009"), 16 | person("Atkinson", "Elizabeth", role="ctb"), 17 | person("Crowson", "Cynthia", role="ctb")) 18 | Description: Contains the core survival analysis routines, including 19 | definition of Surv objects, 20 | Kaplan-Meier and Aalen-Johansen (multi-state) curves, Cox models, 21 | and parametric accelerated failure time models. 22 | License: LGPL (>= 2) 23 | URL: https://github.com/therneau/survival 24 | NeedsCompilation: yes 25 | Packaged: 2024-12-17 16:37:18 UTC; therneau 26 | Author: Terry M Therneau [aut, cre], 27 | Thomas Lumley [ctb, trl] (original S->R port and R maintainer until 28 | 2009), 29 | Atkinson Elizabeth [ctb], 30 | Crowson Cynthia [ctb] 31 | Maintainer: Terry M Therneau 32 | Repository: CRAN 33 | Date/Publication: 2024-12-17 20:20:02 UTC 34 | -------------------------------------------------------------------------------- /R/aareg.taper.R: -------------------------------------------------------------------------------- 1 | # 2 | # Do running averages of an information matrix 3 | # 4 | aareg.taper <- function(taper, imat, nevent) { 5 | dd <- dim(imat) 6 | if (length(taper)==0 || !is.numeric(taper) || any(taper <=0)) 7 | stop("Invalid taper vector") 8 | 9 | ntaper <- length(taper) 10 | ntime <- dd[3] 11 | if (ntaper > ntime) { 12 | taper <- taper[1:ntime] 13 | ntaper <- ntime 14 | } 15 | 16 | # 17 | # Turn imat into an array: 1 row per coef, one col per time 18 | # and then scale it by the number of events to get a variance 19 | # (coxph.detail returns imat = var(X) * nevents) 20 | # 21 | imat <- matrix(as.vector(imat), ncol=dd[3]) 22 | imat <- imat / rep(nevent, rep(dd[1]*dd[2], dd[3])) 23 | 24 | if (ntaper >1) { 25 | smoother <- matrix(0., ntime, ntime) 26 | tsum <- cumsum(rev(taper)) 27 | for (i in 1:ntaper) 28 | smoother[1:i, i] <- taper[seq(to=ntaper, length=i)]/tsum[i] 29 | if (ntaper < ntime) { 30 | for (i in (ntaper+1):ntime) 31 | smoother[seq(to=i, length=ntaper),i] <- taper/tsum[ntaper] 32 | } 33 | imat <- imat %*% smoother 34 | } 35 | array(imat, dim=dd) 36 | } 37 | 38 | 39 | -------------------------------------------------------------------------------- /R/aeqSurv.R: -------------------------------------------------------------------------------- 1 | # 2 | # Create time values such that tiny differences are treated as a tie 3 | # The decision and tolerance are the same as all.equal 4 | # 5 | # see methods document: tied times 6 | aeqSurv <- function(x, tolerance = sqrt(.Machine$double.eps)) { 7 | if (!missing(tolerance)) { 8 | if (!is.numeric(tolerance) || length(tolerance)!=1 || 9 | !is.finite(tolerance)) 10 | stop("invalid value for tolerance") 11 | if (tolerance <=0) return(x) # do nothing 12 | } 13 | 14 | if (!is.Surv(x)) stop("argument is not a Surv object") 15 | y <- sort(unique(c(x[, -ncol(x)]))) 16 | y <- y[is.finite(y)] #someone may hand us an INF 17 | 18 | dy <- diff(y) 19 | tied <- ((dy <=tolerance) |( (dy/ mean(abs(y)) <=tolerance))) 20 | if (!any(tied)) return(x) # all values are unique 21 | 22 | # There were ties. Bin the data by the unique values that were found 23 | cuts <- y[c(TRUE, !tied)] # set of unique values 24 | if (ncol(x) ==2) { # simple survival 25 | z <- findInterval(x[,1], cuts) # map each time point to an interval 26 | z <- cbind(cuts[z], as.integer(x[,2])) 27 | } 28 | else { 29 | z <- matrix(findInterval(x[,1:2], cuts), ncol=2) 30 | # We may have created zero length intervals 31 | zeros <- which(z[,1] == z[,2]) 32 | if (length(zeros)>0 && any(x[zeros,1] != x[zeros,2])) 33 | stop("aeqSurv exception, an interval has effective length 0") 34 | z <- cbind(matrix(cuts[z], ncol=2), as.integer(x[,3])) 35 | } 36 | 37 | attributes(z) <- attributes(x) 38 | z 39 | } 40 | -------------------------------------------------------------------------------- /R/attrassign.R: -------------------------------------------------------------------------------- 1 | # $Id$ 2 | # When X is a model matrix, Splus and R have a different format 3 | # for the "assign" attribute 4 | # For instance 5 | # survreg(Surv(time, status) ~ age + sex + factor(ph.ecog), lung) 6 | # R gives the compact form, a vector (0, 1, 2, 3, 3, 3); which can be 7 | # read as "the first column of the X matrix (intercept) goes with none of 8 | # the terms', 'the second column goes with term 1', etc. 9 | # Splus gives a list 10 | # $(Intercept) 1 11 | # $age 2 12 | # $sex 3 13 | # $factor(ph.ecog) 4 5 6 14 | # 15 | # This function creates the Splus style of output from the R style. Several 16 | # of the routines in the package use this, as it is somewhat easier (more 17 | # transparent) to work with. 18 | # 19 | 20 | attrassign<-function (object, ...) UseMethod("attrassign") 21 | 22 | attrassign.lm<-function(object, ...){ 23 | attrassign(model.matrix(object), terms(object))} 24 | 25 | attrassign.default<-function(object, tt, ...){ 26 | if (!inherits(tt,"terms")) 27 | stop("need terms object") 28 | aa<-attr(object,"assign") 29 | if (is.null(aa)) 30 | stop("argument is not really a model matrix") 31 | ll<-attr(tt,"term.labels") 32 | temp <- c("(Intercept)", ll)[aa+1] #vector of term names 33 | # Don't put them in alphabetical order, retain the order we inherited 34 | split(seq(along.with=temp), factor(temp, levels=unique(temp))) 35 | } 36 | 37 | -------------------------------------------------------------------------------- /R/basehaz.R: -------------------------------------------------------------------------------- 1 | # 2 | # This function is simply an alias for "survfit". In the Cox model 3 | # case users often look for the words "baseline hazard" 4 | # 5 | basehaz <- function (fit, newdata, centered = TRUE) 6 | { 7 | if (inherits(fit, "coxphms")) 8 | stop("the basehaz function is not implemented for multi-state models") 9 | if (!inherits(fit, "coxph")) 10 | stop("must be a coxph object") 11 | if (!missing(newdata)) { 12 | sfit <- survfit(fit, newdata=newdata, se.fit=FALSE) 13 | chaz <- sfit$cumhaz 14 | } 15 | else { 16 | sfit <- survfit(fit, se.fit=FALSE) 17 | if (!centered) { 18 | # The right thing to do here is to call survfit with a vector of 19 | # all zeros for the "subject to predict". But if there is a factor 20 | # in the model, there may be no subject at all who will give all 21 | # zeros, so we post process instead 22 | zcoef <- ifelse(is.na(coef(fit)), 0, coef(fit)) 23 | offset <- sum(fit$means * zcoef) 24 | chaz <- sfit$cumhaz * exp(-offset) 25 | } 26 | else chaz <- sfit$cumhaz 27 | } 28 | new <- data.frame(hazard=chaz, time=sfit$time) 29 | 30 | strata <- sfit$strata 31 | if (!is.null(strata)) 32 | new$strata <- factor(rep(names(strata), strata), levels = names(strata)) 33 | new 34 | } 35 | -------------------------------------------------------------------------------- /R/blogit.R: -------------------------------------------------------------------------------- 1 | # bounded links for pseudovalues 2 | 3 | blogit <- function(edge=.05) { 4 | new <- make.link("logit") 5 | new$linkfun <- function(mu) { 6 | x <- (pmax(edge, pmin(mu, 1-edge))) 7 | log(x/(1-x)) 8 | } 9 | new$name <- "blogit" 10 | new 11 | } 12 | 13 | bcloglog <- function(edge=.05) { 14 | new <- make.link("cloglog") 15 | new$linkfun <- function(mu) { 16 | x <- (pmax(edge, pmin(mu, 1-edge))) 17 | log(-log(1-x)) 18 | } 19 | new$name <- "bcloglog" 20 | new 21 | } 22 | 23 | bprobit <- function(edge=.05) { 24 | new <- make.link("probit") 25 | new$linkfun <- function(mu) { 26 | x <- (pmax(edge, pmin(mu, 1-edge))) 27 | qnorm(x) 28 | } 29 | new$name <- "probit" 30 | new 31 | } 32 | 33 | blog <- function(edge= .05) { 34 | new <- make.link("log") 35 | new$linkfun <- function(mu) { 36 | x <- pmax(edge, mu) 37 | log(x) 38 | } 39 | new$name <- "blog" 40 | new 41 | } 42 | 43 | -------------------------------------------------------------------------------- /R/cipoisson.R: -------------------------------------------------------------------------------- 1 | cipoisson <- function(k, time=1, p=0.95, method=c('exact', 'anscombe')) 2 | { 3 | nn <- max(length(k), length(time), length(p)) 4 | if (nn>1) { 5 | k <- rep(k, length=nn) 6 | time <- rep(time, length=nn) 7 | p <- rep(p, length=nn) 8 | } 9 | p <- (1-p)/2 10 | method <- match.arg(method) 11 | 12 | if (method=='exact') { 13 | dummy1 <- ifelse(k==0, 1, k) #avoid an error message of qgamma 14 | lower <- ifelse(k==0, 0, qgamma(p, dummy1)) 15 | upper <- qgamma(1-p, k+1) 16 | } else if (method=='anscombe'){ # anscombe's method 17 | upper <- (sqrt(k + 7/8) - qnorm(p)/2)^2 18 | lower <- (sqrt(k - 1/8) + qnorm(p)/2)^2 19 | } 20 | else stop("Invalid method") 21 | 22 | # The summary.pyears routine sometimes calls this with time=0 23 | if (any(time<=0)) { 24 | lower <- ifelse(time<=0, NA, lower) 25 | upper <- ifelse(time<=0, NA, upper) 26 | } 27 | 28 | if (nn==1) c(lower=lower, upper=upper)/time 29 | else { 30 | temp <- cbind(lower=lower, upper=upper)/time 31 | if (is.array(k)) { 32 | if (is.null(dd <- dimnames(k))) 33 | array(temp, dim=c(dim(k), 2), 34 | dimnames=list(NULL, NULL, c("lower", "upper"))) 35 | else array(temp, dim=c(dim(k), 2), 36 | dimnames=list(dd, c("lower", "upper"))) 37 | } 38 | else temp 39 | } 40 | } 41 | -------------------------------------------------------------------------------- /R/cluster.R: -------------------------------------------------------------------------------- 1 | # $Id: cluster.S 11166 2008-11-24 22:10:34Z therneau $ 2 | cluster <- function(x) x 3 | -------------------------------------------------------------------------------- /R/coxph.control.R: -------------------------------------------------------------------------------- 1 | # 2 | # Gather all of the control parameters for coxph into one spot 3 | # 4 | coxph.control <- function(eps=1e-9, 5 | toler.chol = .Machine$double.eps ^ .75, 6 | iter.max=20, 7 | toler.inf= sqrt(eps), outer.max=10, 8 | timefix =TRUE) { 9 | if (!is.numeric(iter.max) ||iter.max <0) stop("Invalid value for iterations") 10 | if (!is.numeric(eps) || eps <=0) stop ("Invalid convergence criteria") 11 | if (!is.numeric(toler.chol) || toler.chol <=0) 12 | stop("invalid value for toler.chol") 13 | if (!is.numeric(eps) || eps <=0) stop("eps must be > 0") 14 | if (eps <= toler.chol) 15 | warning("For numerical accuracy, tolerance should be < eps") 16 | if (!is.numeric(toler.inf) || toler.inf <=0) 17 | stop ("The toler.inf setting must be >0") 18 | if (!is.logical(timefix)) stop("timefix must be TRUE or FALSE") 19 | if (!is.numeric(outer.max) || outer.max <=0) 20 | stop("invalid value for outer.max") 21 | list(eps=eps, toler.chol=toler.chol, iter.max=as.integer(iter.max), 22 | toler.inf=toler.inf, outer.max=as.integer(outer.max), 23 | timefix=timefix) 24 | } 25 | -------------------------------------------------------------------------------- /R/coxph.wtest.R: -------------------------------------------------------------------------------- 1 | # 2 | # A Wald test routine, used by the Cox model 3 | # Why not just do sum(b * solve(var, b))? -- because the solve 4 | # function chokes on singular matrices. 5 | # 6 | coxph.wtest <- function(var, b, toler.chol=1e-9) { 7 | if (any(is.na(b))) { 8 | # there is a redundant column in the X matrix, remove it 9 | toss <- which(is.na(b)) 10 | b <- b[!toss] 11 | var <- var[!toss, !toss] 12 | } 13 | 14 | if (is.matrix(b)) { 15 | nvar <- nrow(b) 16 | ntest<- ncol(b) 17 | } 18 | else { 19 | nvar <- length(b) 20 | ntest<- 1 21 | } 22 | 23 | if (length(var)==0) { #special case added by Tom Lumley 24 | if (nvar==0) return(list(test=numeric(0), df=0, solve=0)) 25 | else stop("Argument lengths do not match") 26 | } 27 | 28 | if (length(var)==1) { 29 | if (nvar ==1) return(list(test=b*b/var, df=1, solve=b/var)) 30 | else stop("Argument lengths do not match") 31 | } 32 | 33 | if (!is.matrix(var) || (nrow(var) != ncol(var))) 34 | stop("First argument must be a square matrix") 35 | if (nrow(var) != nvar) stop("Argument lengths do not match") 36 | 37 | if (any(!is.finite(b)) || any(!is.finite(var))) { 38 | stop("infinite argument in coxph.wtest") 39 | # this shouldn't happen 40 | } 41 | temp <- .C(Ccoxph_wtest, df=as.integer(nvar), 42 | as.integer(ntest), 43 | as.double(var), 44 | tests= as.double(b), 45 | solve= double(nvar*ntest), 46 | as.double(toler.chol)) 47 | if (ntest==1) list(test=temp$tests[1], df=temp$df, solve=temp$solve) 48 | else list(test=temp$tests[1:ntest], df=temp$df, 49 | solve=matrix(temp$solve, nvar, ntest)) 50 | } 51 | -------------------------------------------------------------------------------- /R/dsurvreg.R: -------------------------------------------------------------------------------- 1 | # The density, quantile, and CDF functions for those distributions 2 | # supported by survreg 3 | # 4 | dsurvreg <- function(x, mean, scale=1, distribution='weibull', parms) { 5 | dist <- survreg.distributions[[casefold(distribution)]] 6 | if (is.null(dist)) stop("Distribution not found") 7 | 8 | if (!is.null(dist$trans)) { 9 | dx <- dist$dtrans(x) 10 | x <- dist$trans(x) 11 | x <- (x-mean)/scale 12 | dist <- survreg.distributions[[dist$dist]] 13 | y <- dist$density(x, parms)[,3] 14 | y *dx / scale 15 | } 16 | else { 17 | x <- (x-mean)/scale 18 | y <- dist$density(x, parms)[,3] 19 | y/ scale 20 | } 21 | } 22 | 23 | psurvreg <- function(q, mean, scale=1, distribution='weibull', parms) { 24 | dist <- survreg.distributions[[casefold(distribution)]] 25 | if (is.null(dist)) stop("Distribution not found") 26 | 27 | if (!is.null(dist$trans)) { 28 | q <- dist$trans(q) 29 | q <- (q-mean)/scale 30 | dist <- survreg.distributions[[dist$dist]] 31 | dist$density(q, parms)[,1] 32 | } 33 | else { 34 | q <- (q-mean)/scale 35 | dist$density(q, parms)[,1] 36 | } 37 | } 38 | 39 | qsurvreg <- function(p, mean, scale=1, distribution='weibull', parms) { 40 | dist <- survreg.distributions[[casefold(distribution)]] 41 | if (is.null(dist)) stop("Distribution not found") 42 | 43 | if (!is.null(dist$trans)) { 44 | d2 <- survreg.distributions[[dist$dist]] 45 | x <- d2$quantile(p, parms) 46 | dist$itrans(x*scale + mean) 47 | } 48 | else { 49 | x <- dist$quantile(p, parms) 50 | x*scale + mean 51 | } 52 | } 53 | 54 | rsurvreg <- function(n, mean, scale=1, distribution='weibull', parms) { 55 | if (missing(parms)) 56 | qsurvreg(runif(n), mean, scale, distribution) 57 | else 58 | qsurvreg(runif(n), mean, scale, distribution, parms) 59 | } 60 | -------------------------------------------------------------------------------- /R/firstlib.R: -------------------------------------------------------------------------------- 1 | .onUnload <- function(libpath) 2 | library.dynam.unload("survival", libpath) 3 | 4 | -------------------------------------------------------------------------------- /R/frailty.R: -------------------------------------------------------------------------------- 1 | # $Id: frailty.S 11166 2008-11-24 22:10:34Z therneau $ 2 | # 3 | # Parent function for frailty, calls the actuall working functions 4 | # 5 | frailty <- function(x, distribution = 'gamma', ...) { 6 | dlist <- c("gamma", "gaussian", "t") 7 | i <- pmatch(distribution, dlist) 8 | if (!is.na(i)) distribution <- dlist[i] 9 | 10 | temp <- paste("frailty", distribution, sep='.') 11 | if (!exists(temp)) 12 | stop(paste("Function '", temp, "' not found", sep="")) 13 | (get(temp))(x, ...) 14 | } 15 | 16 | 17 | 18 | 19 | -------------------------------------------------------------------------------- /R/frailty.brent.R: -------------------------------------------------------------------------------- 1 | # $Id: frailty.brent.S 11166 2008-11-24 22:10:34Z therneau $ 2 | # 3 | # Brent's method for finding a maximum 4 | # If upper and/or lower is given, it transforms x to stay out of trouble 5 | # during the "bracketing" phase 6 | # 7 | frailty.brent <- function(x, y, lower, upper) { 8 | n <- length(x) 9 | if (length(y) != n) stop ("Length mismatch for x and y") 10 | 11 | if (n<3) return(mean(x)) 12 | 13 | # First, is the solution bracketed? 14 | # If not, take big steps until it is 15 | ord <- order(x) 16 | xx <- x[ord] 17 | yy <- y[ord] 18 | best <- (1:n)[yy==max(y)] 19 | if (length(best) >1) stop("Ties for max(y), I surrender") #fix this later 20 | if (best==1) { 21 | new <- xx[1] - 3*(xx[2] - xx[1]) 22 | if (!missing(lower) && !is.null(lower) && new < lower) 23 | new <- lower + (min(xx[xx>lower])-lower)/10 24 | return(new) 25 | } 26 | if (best==n) { 27 | new <- xx[n] + 3*(xx[n] - xx[n-1]) 28 | if (!missing(upper) && !is.null(upper) && new > upper) 29 | new <- upper + (max(xx[xx xx[3] || 44 | ( (n>4) && (new-x[n]) > .5*abs(x[n-1]-x[n-2]))) { 45 | if ((xx[2]-xx[1]) > (xx[3]-xx[2])) return(xx[2] - .38*(xx[2]-xx[1])) 46 | else return(xx[2] + .32*(xx[3]-xx[2])) 47 | } 48 | else return(new) 49 | } 50 | 51 | -------------------------------------------------------------------------------- /R/frailty.gammacon.R: -------------------------------------------------------------------------------- 1 | # $Id: frailty.gammacon.S 11166 2008-11-24 22:10:34Z therneau $ 2 | # Correct the loglik for a gamma frailty 3 | # Term2 is the hard one, discussed in section 3.5 of the report 4 | # The penalty function only adds \vu \sum(w_j) to the CoxPL, so this 5 | # does a bit more than equation 15. 6 | # 7 | frailty.gammacon <- function(d, nu) { 8 | maxd <- max(d) 9 | if (nu > 1e7*maxd) term1 <- sum(d*d)/nu #second order Taylor series 10 | else term1 <- sum(d + nu*log(nu/(nu+d))) #easy part 11 | 12 | tbl <- table(factor(d[d>0], levels=1:maxd)) 13 | ctbl<- rev(cumsum(rev(tbl))) 14 | dlev<- 1:maxd 15 | term2.numerator <- nu + rep(dlev-1, ctbl) 16 | term2.denom <- nu + rep(dlev, tbl*dlev) 17 | term2 <- sum(log(term2.numerator/term2.denom)) 18 | 19 | term1 + term2 20 | } 21 | 22 | -------------------------------------------------------------------------------- /R/is.na.coxph.penalty.R: -------------------------------------------------------------------------------- 1 | # $Id: is.na.coxph.penalty.S 11447 2010-11-12 15:10:18Z therneau $ 2 | # The subscript function for coxph.penalty objects 3 | # without it the "subset" arg of a model statement tosses 4 | # away all of the attributes 5 | # 6 | "[.coxph.penalty" <- function(x, ..., drop=FALSE) { 7 | attlist <- attributes(x) 8 | attributes(x) <- attlist[match(c('dim', 'dimnames', 'levels', 'class'), 9 | names(attlist), 0)] 10 | x <- NextMethod('[') #let the default method do actual subscripting 11 | 12 | # Tack back on all of the old attributes, except dim and dimnames 13 | # which will have been properly modified by the standard [ method, 14 | # "levels" which may have dropped some, and "class" which is special 15 | attributes(x) <- c(attributes(x), 16 | attlist[is.na(match(names(attlist), 17 | c("dim", "dimnames", "levels", "class")))]) 18 | # The class will have lost it's first level 19 | oldClass(x) <- attlist$class 20 | return(x) 21 | } 22 | 23 | 24 | is.na.coxph.penalty <- function(x) { 25 | if (is.matrix(x)) 26 | is.na(c(unclass(x) %*% rep(1,ncol(x)))) 27 | else 28 | is.na(unclass(x)) 29 | } 30 | -------------------------------------------------------------------------------- /R/labels.survreg.R: -------------------------------------------------------------------------------- 1 | # $Id: labels.survreg.S 11166 2008-11-24 22:10:34Z therneau $ 2 | labels.survreg <- function(object, ...) 3 | attr(object$terms, "term.labels") 4 | 5 | -------------------------------------------------------------------------------- /R/lines.survexp.R: -------------------------------------------------------------------------------- 1 | lines.survexp <- function(x, type="l", ...) { 2 | type <- type 3 | NextMethod("lines", type=type, ...) 4 | } 5 | 6 | -------------------------------------------------------------------------------- /R/lines.survfit.coxph.R: -------------------------------------------------------------------------------- 1 | # $Id: lines.survfit.coxph.S 11166 2008-11-24 22:10:34Z therneau $ 2 | lines.survfit.coxph <- function(x, mark.time=FALSE, ...) { 3 | if (is.logical(mark.time) & mark.time) 4 | stop("Invalid value for mark.time") 5 | invisible(NextMethod('lines', mark.time=mark.time)) 6 | } 7 | -------------------------------------------------------------------------------- /R/logLik.coxph.R: -------------------------------------------------------------------------------- 1 | # 2 | # The AIC function depends on a logLik method 3 | # 4 | logLik.coxph <- function(object, ...) { 5 | out <- object$loglik[2] 6 | if (!is.null(object$df)) attr(out, "df") <- sum(object$df) 7 | else attr(out, 'df') <- sum(!is.na(coefficients(object))) 8 | attr(out, "nobs") <- object$nevent 9 | class(out) <- 'logLik' 10 | out 11 | } 12 | 13 | # Cox models with no covariates 14 | logLik.coxph.null <- function(object, ...) { 15 | out <- object$loglik[1] 16 | attr(out, "df") <- 0 17 | attr(out, "nobs") <- object$nevent 18 | class(out) <- "logLik" 19 | out 20 | } 21 | 22 | logLik.survreg <- function(object, ...) { 23 | out <- object$loglik[2] 24 | dd <- diag(object$var) 25 | if (!is.null(object$df)) attr(out, "df") <- sum(object$df) 26 | else attr(out, 'df') <- sum(!is.na(dd) & dd > 0) 27 | # attr(out, "nobs") <- sum(object$df) + object$df.residual 28 | class(out) <- 'logLik' 29 | out 30 | } 31 | -------------------------------------------------------------------------------- /R/methods.R: -------------------------------------------------------------------------------- 1 | # 2 | # new generic methods sprout up regularly 3 | # This is a convenient place to add them 4 | # 5 | 6 | # The AER package has a deviance function for tobit models, but I don't think 7 | # that deviance is a useful quantity there. 8 | # 9 | fitted.survreg <- function(object, ...) 10 | predict(object, type = "response", se.fit = FALSE) 11 | 12 | fitted.coxph <- function(object, ...) object$linear.predictors 13 | 14 | # The nobs result is intended for computing BIC; for coxph we think that 15 | # this is the number of events. 16 | nobs.survreg <- function(object, ...) 17 | length(object$linear.predictors) 18 | nobs.coxph <- function(object, ...) object$nevent 19 | 20 | weights.survreg <- function(object, ...) 21 | model.weights(model.frame(object)) 22 | 23 | weights.coxph <- function(object, ...) { 24 | if (!is.null(object$weights)) object$weights 25 | else model.weights(model.frame(object)) 26 | } 27 | -------------------------------------------------------------------------------- /R/model.frame.survfit.R: -------------------------------------------------------------------------------- 1 | model.frame.survfit <- function(formula, ...) { 2 | dots <- list(...) 3 | nargs <- dots[match(c("data", "subset", "id", "cluster"), 4 | names(dots), 0)] 5 | # if this was called without updating the data, and the model was saved 6 | # then just return the model component 7 | if (length(nargs) ==0 && !is.null(formula$model)) formula$model 8 | else { 9 | fcall <- formula$call 10 | na.action <- getOption("na.action") 11 | if (is.character(na.action)) 12 | na.action <- get(na.action) # this is a temporary hack 13 | # create a copy of the call that has only the arguments we want, 14 | # and use it to call model.frame() 15 | indx <- match(c('formula', 'data', 'weights', 'subset','na.action', 16 | 'istate', 'id', 'cluster', "etype"), names(fcall), 17 | nomatch=0) 18 | # The next error message is usually due to a typo 19 | # eg survfit(wt=Surv(time, status) ~1) 20 | if (indx[1]==0) stop("a formula argument is required") 21 | temp <- fcall[c(1, indx)] 22 | temp$xlev <- formula$xlevels 23 | if (length(nargs) > 0) 24 | temp[names(nargs)] <- nargs 25 | 26 | temp[[1L]] <- quote(stats::model.frame) 27 | 28 | if (is.null(environment(formula$terms))) 29 | mf <- eval(temp, parent.frame()) 30 | else mf <- eval(temp, environment(formula$terms), parent.frame()) 31 | 32 | n <- nrow(mf) 33 | if (n==0) stop("data set has no non-missing observations") 34 | mf 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /R/normalizetime.R: -------------------------------------------------------------------------------- 1 | # 2 | # Create time values such that tiny differences are treated as a tie 3 | # The actions and tolerance are the same as all.equal 4 | # 5 | normalizetime <- function(x, replace=TRUE, 6 | tolerance = sqrt(.Machine$double.eps)) { 7 | if (is.Surv(x)) y <- sort(unique(c(x[, -ncol(x)]))) 8 | else y <- sort(unique(x)) 9 | y <- y[is.finite(y)] #someone may hand us an INF 10 | 11 | dy <- diff(y) 12 | tied <- ((dy <=tolerance) |( (dy/ mean(abs(y)) <=tolerance))) 13 | if (!any(tied)) return(x) # all values are unique 14 | 15 | cuts <- y[c(TRUE, !tied)] 16 | if (is.Surv(x)) { 17 | z <- findInterval(x[, -ncol(x)], cuts) 18 | if (replace) { 19 | z <- matrix(c(cuts[z], as.integer(x[,ncol(x)])), ncol=ncol(x)) 20 | attributes(z) <- attributes(x) 21 | } 22 | else { 23 | z <- matrix(c(z, as.integer(x[,ncol(x)])), ncol=ncol(x)) 24 | attributes(z) <- attributes(x) 25 | attr(z, 'utime') <- unname(cuts) 26 | } 27 | } else { 28 | z <- findInterval(x, cuts) 29 | if (replace) { 30 | z <- cuts[z] 31 | attributes(z) <- attributes(x) 32 | } 33 | else { 34 | attributes(z) <- attributes(x) 35 | attr(z, 'utime') <- unname(cuts) 36 | } 37 | } 38 | z 39 | } 40 | -------------------------------------------------------------------------------- /R/predict.survreg.penal.R: -------------------------------------------------------------------------------- 1 | # $Id: predict.survreg.penal.S 11166 2008-11-24 22:10:34Z therneau $ 2 | # 3 | # This routine just stops disastrous arithmetic for models with sparse 4 | # terms. A placeholder until the proper sparse terms actions are inserted. 5 | # 6 | predict.survreg.penal <- function(object, ...) { 7 | pterms <- object$pterms 8 | if (any(pterms==2)) 9 | stop("Predictions not available for sparse models") 10 | NextMethod('predict') 11 | } 12 | -------------------------------------------------------------------------------- /R/print.aareg.R: -------------------------------------------------------------------------------- 1 | print.aareg <- function(x, maxtime, test=c('aalen', 'nrisk'), scale=1, ...) { 2 | if (!inherits(x, 'aareg')) stop ("Must be an addreg object") 3 | if (!is.null(cl<- x$call)) { 4 | cat("Call:\n") 5 | dput(cl) 6 | cat("\n") 7 | } 8 | 9 | if (missing(test)) test <- x$test 10 | else test <- match.arg(test) 11 | 12 | if (missing(maxtime)) summ <- summary(x, test=test, scale=scale) 13 | else summ <- summary(x, maxtime=maxtime, test=test, 14 | scale=scale) 15 | 16 | omit <- x$na.action 17 | if (length(omit)) 18 | cat(" n=", x$n[1], " (", naprint(omit), ")\n", sep="") 19 | else cat(" n=", x$n[1], "\n") 20 | cat(" ", summ$n[2], "out of", x$n[3], "unique event times used\n\n") 21 | print(signif(summ$table,3)) 22 | chi <- summ$chisq 23 | df <- nrow(summ$table) -1 24 | pdig <- max(1, getOption("digits")-4) # default it too high IMO 25 | cat("\nChisq=", format(round(chi,2)), " on ", df, " df, p=", 26 | format.pval(pchisq(chi,df, lower.tail=FALSE), digits=pdig), 27 | "; test weights=", x$test, "\n", sep="") 28 | invisible(x) 29 | } 30 | 31 | -------------------------------------------------------------------------------- /R/print.coxph.null.R: -------------------------------------------------------------------------------- 1 | # $Id: print.coxph.null.S 11166 2008-11-24 22:10:34Z therneau $ 2 | print.coxph.null <- 3 | function(x, digits=max(options()$digits - 4, 3), ...) 4 | { 5 | if (!is.null(cl<- x$call)) { 6 | cat("Call: ") 7 | dput(cl) 8 | cat("\n") 9 | } 10 | 11 | cat("Null model\n log likelihood=", format(x$loglik), "\n") 12 | omit <- x$na.action 13 | if (length(omit)) 14 | cat(" n=", x$n, " (", naprint(omit), ")\n", 15 | sep="") 16 | else cat(" n=", x$n, "\n") 17 | } 18 | -------------------------------------------------------------------------------- /R/print.ratetable.R: -------------------------------------------------------------------------------- 1 | 2 | print.ratetable <- function(x, ...) { 3 | if (is.null(attr(x, 'dimid'))) 4 | cat ("Rate table with dimension(s):", names(dimnames(x)), "\n") 5 | else cat ("Rate table with dimension(s):", attr(x, 'dimid'), "\n") 6 | attributes(x) <- attributes(x)[c("dim", "dimnames")] 7 | NextMethod() 8 | } 9 | -------------------------------------------------------------------------------- /R/print.summary.survexp.R: -------------------------------------------------------------------------------- 1 | print.summary.survexp <- function(x, 2 | digits = max(options()$digits - 4, 3), ...) { 3 | savedig <- options(digits=digits) 4 | on.exit(options(savedig)) 5 | 6 | if (!is.null(cl<- x$call)) { 7 | cat("Call: ") 8 | dput(cl) 9 | cat("\n") 10 | } 11 | 12 | omit <- x$na.action 13 | if (length(omit)) 14 | cat(naprint(omit), "\n") 15 | 16 | mat <- cbind(x$time, x$n.risk, x$surv) 17 | if (is.matrix(x$n.risk)) 18 | cnames <- c("time", paste("nrisk", 1:ncol(x$n.risk), sep='')) 19 | else cnames <- c("time", "n.risk") 20 | 21 | if (is.matrix(x$surv)) ncurve <- ncol(x$surv) 22 | else ncurve <- 1 23 | if (ncurve==1) { #only 1 curve 24 | cnames <- c(cnames, "survival") 25 | # if (!is.null(x$std.err)) { 26 | # if (is.null(x$lower)) { 27 | # mat <- cbind(mat, x$std.err) 28 | # cnames <- c(cnames, "std.err") 29 | # } 30 | # else { 31 | # mat <- cbind(mat, x$std.err, x$lower, x$upper) 32 | # cnames <- c(cnames, 'std.err', 33 | # paste("lower ", x$conf.int*100, "% CI", sep=''), 34 | # paste("upper ", x$conf.int*100, "% CI", sep='')) 35 | # } 36 | # } 37 | } 38 | else cnames <- c(cnames, paste("survival", seq(ncurve), sep='')) 39 | 40 | if (!is.matrix(mat)) mat <- matrix(mat, nrow=1) 41 | if (!is.null(mat)) { 42 | dimnames(mat) <- list(rep("", nrow(mat)), cnames) 43 | if (is.null(x$strata)) print(mat) 44 | else { #print it out one strata at a time 45 | strata <- x$strata 46 | for (i in levels(strata)) { 47 | who <- (strata==i) 48 | cat(" ", i, "\n") 49 | print(mat[who,]) 50 | cat("\n") 51 | } 52 | } 53 | } 54 | else 55 | stop("There are no observations to print.") 56 | invisible(x) 57 | } 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | -------------------------------------------------------------------------------- /R/print.summary.survreg.R: -------------------------------------------------------------------------------- 1 | print.summary.survreg <- function(x, digits = max(options()$digits - 4, 3), 2 | signif.stars=FALSE, ...) { 3 | correl <- x$correlation 4 | 5 | if(is.null(digits)) 6 | digits <- options()$digits 7 | cat("\nCall:\n") 8 | dput(x$call) 9 | 10 | printCoefmat(x$table, digits = digits, signif.stars=signif.stars, 11 | P.values=TRUE, has.Pvalue=TRUE) 12 | if (nrow(x$var)==length(x$coefficients)) 13 | cat("\nScale fixed at",format(x$scale, digits=digits),"\n") 14 | else if (length(x$scale)==1) 15 | cat ("\nScale=", format(x$scale, digits=digits), "\n") 16 | else { 17 | cat("\nScale:\n") 18 | print(x$scale, digits=digits, ...) 19 | } 20 | 21 | cat("\n", x$parms, "\n", sep='') 22 | df <- sum(x$df) - x$idf # The sum is for penalized models 23 | cat("Loglik(model)=", format(round(x$loglik[2],1)), 24 | " Loglik(intercept only)=", format(round(x$loglik[1],1))) 25 | if (df > 0) 26 | cat("\n\tChisq=", format(round(x$chi,2)), "on", round(df,1), 27 | "degrees of freedom, p=", 28 | format(signif(pchisq(x$chi, df, lower.tail=FALSE),2)), "\n") 29 | else cat("\n") 30 | if (x$robust) cat("(Loglikelihood assumes independent observations)\n") 31 | cat("Number of Newton-Raphson Iterations:", format(trunc(x$iter)), 32 | "\n") 33 | omit <- x$na.action 34 | if (length(omit)) 35 | cat("n=", x$n, " (", naprint(omit), ")\n", sep="") 36 | else cat("n=", x$n, "\n") 37 | 38 | if(!is.null(correl)) { 39 | p <- dim(correl)[2] 40 | if(p > 1) { 41 | cat("\nCorrelation of Coefficients:\n") 42 | ll <- lower.tri(correl) 43 | correl[ll] <- format(round(correl[ll], digits=digits)) 44 | correl[!ll] <- "" 45 | print(correl[-1, - p, drop = FALSE], quote = FALSE) 46 | } 47 | } 48 | cat("\n") 49 | invisible(NULL) 50 | } 51 | -------------------------------------------------------------------------------- /R/print.survdiff.R: -------------------------------------------------------------------------------- 1 | # $Date: 2006-08-28 14:31:20 $ $Id: print.survdiff.S 11166 2008-11-24 22:10:34Z therneau $ 2 | print.survdiff <- function(x, digits = max(options()$digits - 4, 3), ...) { 3 | 4 | saveopt <-options(digits=digits) 5 | on.exit(options(saveopt)) 6 | 7 | if (!inherits(x, 'survdiff')) 8 | stop("Object is not the result of survdiff") 9 | if (!is.null(cl<- x$call)) { 10 | cat("Call:\n") 11 | dput(cl) 12 | cat("\n") 13 | } 14 | 15 | omit <- x$na.action 16 | if (length(omit)) cat("n=", sum(x$n), ", ", naprint(omit), 17 | ".\n\n", sep='') 18 | 19 | if (length(x$n)==1) { 20 | z <- sign(x$exp - x$obs) * sqrt(x$chisq) 21 | temp <- c(x$obs, x$exp, z, signif(pchisq(x$chisq, 1, lower.tail=FALSE), 22 | digits)) 23 | names(temp) <- c("Observed", "Expected", "Z", "p") 24 | print(temp) 25 | } 26 | else { 27 | if (is.matrix(x$obs)){ 28 | otmp <- apply(x$obs,1,sum) 29 | etmp <- apply(x$exp,1,sum) 30 | } 31 | else { 32 | otmp <- x$obs 33 | etmp <- x$exp 34 | } 35 | df <- (sum(1*(etmp>0))) -1 36 | temp <- cbind(x$n, otmp, etmp, ((otmp-etmp)^2)/ etmp, 37 | ((otmp-etmp)^2)/ diag(x$var)) 38 | dimnames(temp) <- list(names(x$n), c("N", "Observed", "Expected", 39 | "(O-E)^2/E", "(O-E)^2/V")) 40 | print(temp) 41 | cat("\n Chisq=", format(round(x$chisq,1)), 42 | " on", df, "degrees of freedom, p=", 43 | format.pval(pchisq(x$chisq, df, lower.tail=FALSE)), 44 | "\n") 45 | } 46 | invisible(x) 47 | } 48 | -------------------------------------------------------------------------------- /R/print.survreg.R: -------------------------------------------------------------------------------- 1 | print.survreg <- function(x, ...) 2 | { 3 | if(!is.null(cl <- x$call)) { 4 | cat("Call:\n") 5 | dput(cl) 6 | } 7 | if (!is.null(x$fail)) { 8 | cat(" Survreg failed.", x$fail, "\n") 9 | return(invisible(x)) 10 | } 11 | coef <- x$coef 12 | if(any(nas <- is.na(coef))) { 13 | if(is.null(names(coef))) names(coef) <- paste("b", 1:length(coef), sep = "") 14 | cat("\nCoefficients: (", sum(nas), 15 | " not defined because of singularities)\n", sep = "") 16 | } 17 | else cat("\nCoefficients:\n") 18 | print(coef, ...) 19 | 20 | if (nrow(x$var)==length(coef)) 21 | cat("\nScale fixed at",format(x$scale),"\n") 22 | else if (length(x$scale)==1) cat ("\nScale=", format(x$scale), "\n") 23 | else { 24 | cat("\nScale:\n") 25 | print(x$scale, ...) 26 | } 27 | 28 | pdig <- max(1, getOption("digits")-4) # default it too high IMO 29 | nobs <- length(x$linear) 30 | chi <- 2*diff(x$loglik) 31 | df <- sum(x$df) - x$idf # The sum is for penalized models 32 | cat("\nLoglik(model)=", format(round(x$loglik[2],1)), 33 | " Loglik(intercept only)=", format(round(x$loglik[1],1))) 34 | if (df > 0) 35 | cat("\n\tChisq=", format(round(chi,2)), "on", round(df,1), 36 | "degrees of freedom, p=", 37 | format.pval(pchisq(chi, df, lower.tail=FALSE), digits=pdig), 38 | "\n") 39 | else cat("\n") 40 | 41 | omit <- x$na.action 42 | if (length(omit)) 43 | cat("n=", nobs, " (", naprint(omit), ")\n", sep="") 44 | else cat("n=", nobs, "\n") 45 | invisible(x) 46 | } 47 | -------------------------------------------------------------------------------- /R/ratetableDate.R: -------------------------------------------------------------------------------- 1 | # 2 | # Support for older style ratetables: if the type attribute for the dimension 3 | # is 3 or 4 (a date) and the associated cutpoint is a vector of integers, 4 | # then the date has a baseline of 1/1/1960. (Ratetables predate the 5 | # Date class). 6 | # The newer and simpler form uses a Date vector for the cutpoints. 7 | # 8 | ratetableDate <- function(x) { 9 | UseMethod("ratetableDate", x) 10 | } 11 | 12 | # This function places a fake "rtabledate" class on the object, for recognition 13 | rtfun <- function(x) { 14 | y <- as.vector(x) # as.integer makes sense, but Dates are double 15 | class(y) <- "rtabledate" 16 | y 17 | } 18 | 19 | # Normally used in R 20 | ratetableDate.Date <- function(x) 21 | rtfun(x) 22 | 23 | # POSIXt includes both POSIXlt and POSIXct 24 | ratetableDate.POSIXt <- function(x) 25 | rtfun(as.Date(x)) 26 | 27 | # Normally Splus 28 | #ratetableDate.timeDate <- function(x) 29 | # rtfun(x - timeDate('1/1/1970')) 30 | 31 | # Therneau's old "date" class (should someday wither away) 32 | ratetableDate.date <- function(x) rtfun(x - 3653) 33 | 34 | # David James's old "chron" class (will someday wither away) 35 | # Support it without using the chron library, which may not be loaded. 36 | ratetableDate.chron <- function(x) { 37 | origin <- attr(x, "origin") 38 | x<- as.numeric(x) + as.Date(paste(origin["year"], origin["month"], 39 | origin["day"], sep='/')) 40 | rtfun(x) 41 | } 42 | ratetableDate.dates <- ratetableDate.chron 43 | 44 | # Old ratetables had an integer based on 1/1/1960 45 | ratetableDate.integer <- function(x) 46 | rtfun(x - 3653) # number of days from 1/1/1960 to 1/1/1970 47 | 48 | # leave other data types alone 49 | ratetableDate.default <- function(x) x 50 | -------------------------------------------------------------------------------- /R/ratetableold.R: -------------------------------------------------------------------------------- 1 | # These functions are depricated 2 | # Only relsurv uses them, and I'm working on that 3 | ratetable <- function(...) { 4 | datecheck <- function(x) 5 | inherits(x, c("Date", "POSIXt", "date", "chron")) 6 | 7 | args <- list(...) 8 | nargs <- length(args) 9 | ll <- sapply(args, length) 10 | n <- max(ll) # We assume this is the dimension of the user's data frame 11 | levlist <- vector("list", nargs) 12 | x <- matrix(0,n,nargs) 13 | dimnames(x) <- list(1:n, names(args)) 14 | isDate <- sapply(args, datecheck) 15 | 16 | for (i in 1:nargs) { 17 | if (ll[i] ==1) args[[i]] <- rep(args[[i]], n) 18 | else if (ll[i] != n) 19 | stop(paste("Aguments do not all have the same length (arg ", 20 | i, ")", sep='')) 21 | 22 | # In Splus cut and tcut produce class 'category' 23 | if (inherits(args[[i]], 'cateogory') || is.character(args[[i]])) 24 | args[[i]] <- as.factor(args[[i]]) 25 | if (is.factor(args[[i]])) { 26 | levlist[[i]] <- levels(args[[i]]) 27 | x[,i] <- as.numeric(args[[i]]) # the vector of levels 28 | } 29 | else x[,i] <- ratetableDate(args[[i]]) 30 | } 31 | attr(x, "isDate") <- isDate 32 | attr(x, "levlist") <- levlist 33 | class(x) <- 'ratetable2' 34 | x 35 | } 36 | 37 | # The two functions below should only be called internally, when missing 38 | # values cause model.frame to drop some rows 39 | is.na.ratetable2 <- function(x) { 40 | attributes(x) <- list(dim=dim(x)) 41 | as.vector((1 * is.na(x)) %*% rep(1, ncol(x)) >0) 42 | } 43 | "[.ratetable2" <- function(x, rows, cols, drop=FALSE) { 44 | if (!missing(cols)) { 45 | stop("This should never be called!") 46 | } 47 | aa <- attributes(x) 48 | attributes(x) <- aa[c("dim", "dimnames")] 49 | y <- x[rows,,drop=FALSE] 50 | attr(y,'isDate') <- aa$isDate 51 | attr(y,'levlist') <- aa$levlist 52 | class(y) <- 'ratetable2' 53 | y 54 | } 55 | -------------------------------------------------------------------------------- /R/residuals.coxph.null.R: -------------------------------------------------------------------------------- 1 | # $Id $ 2 | residuals.coxph.null <- 3 | function(object, type=c("martingale", "deviance", "score", "schoenfeld"), 4 | collapse=FALSE, weighted=FALSE, ...) 5 | { 6 | type <- match.arg(type) 7 | if (type=='martingale' || type=='deviance') NextMethod() 8 | else stop(paste("\'", type, "\' residuals are not defined for a null model", 9 | sep="")) 10 | } 11 | -------------------------------------------------------------------------------- /R/residuals.coxph.penal.R: -------------------------------------------------------------------------------- 1 | # $Id: residuals.coxph.penal.S 11516 2012-04-24 12:49:14Z therneau $ 2 | residuals.coxph.penal <- function(object, 3 | type=c("martingale", "deviance", "score", "schoenfeld", 4 | "dfbeta", "dfbetas", "scaledsch","partial"), 5 | collapse=FALSE, weighted=FALSE, ...) { 6 | 7 | type <- match.arg(type) 8 | # Are there any sparse terms, and if so do I need the X matrix? 9 | if (any(object$pterms==2) && !(type=='martingale' || type=='deviance')){ 10 | # treat the sparse term as an offset term 11 | # It gets picked up in the linear predictor, so all I need to 12 | # do is "X" it out of the model so that it doesn't get picked up 13 | # as a part of the X matrix and etc. 14 | # I know that the sparse term is a single column BTW 15 | # 16 | sparsename <- (names(object$pterms))[object$pterms==2] 17 | x <- object[['x']] #don't accidentally get object$xlevels 18 | if (is.null(x)) { 19 | temp <- coxph.getdata(object, y=TRUE, x=TRUE, stratax=TRUE) 20 | if (is.null(object$y)) object$y <- temp$y 21 | if (is.null(object$strata)) object$strata <- temp$strata 22 | x <- temp$x 23 | } 24 | object$x <- x[, -match(sparsename, dimnames(x)[[2]]), drop=FALSE] 25 | 26 | temp <- attr(object$terms, 'term.labels') 27 | object$terms <- object$terms[-match(sparsename, temp)] 28 | } 29 | NextMethod('residuals') 30 | } 31 | -------------------------------------------------------------------------------- /R/residuals.survreg.penal.R: -------------------------------------------------------------------------------- 1 | # This routine just stops disastrous arithmetic for models with sparse 2 | # terms. A placeholder until the proper sparse terms actions are inserted. 3 | residuals.survreg.penal <- function(object, ...) { 4 | pterms <- object$pterms 5 | if (any(pterms==2)) 6 | stop("Residualss not available for sparse models") 7 | NextMethod('residuals') 8 | } 9 | -------------------------------------------------------------------------------- /R/ridge.R: -------------------------------------------------------------------------------- 1 | # $Id: ridge.S 11166 2008-11-24 22:10:34Z therneau $ 2 | ridge <- function(..., theta, df=nvar/2, eps=.1, scale=TRUE) { 3 | x <- cbind(...) 4 | nvar <- ncol(x) 5 | xname <- as.character(parse(text=substitute(cbind(...))))[-1] 6 | vars <- apply(x, 2, function(z) var(z[!is.na(z)])) 7 | class(x) <- 'coxph.penalty' 8 | 9 | if (!missing(theta) && !missing(df)) 10 | stop("Only one of df or theta can be specified") 11 | 12 | if (scale) 13 | pfun <- function(coef,theta, ndead, scale) { 14 | list(penalty= sum(coef^2 *scale)*theta/2, 15 | first = theta*coef*scale, 16 | second = theta*scale, 17 | flag=FALSE) 18 | } 19 | else 20 | pfun <- function(coef,theta, ndead, scale) { 21 | list(penalty= sum(coef^2)*theta/2, 22 | first = theta*coef, 23 | second = theta, 24 | flag=FALSE) 25 | } 26 | 27 | 28 | if (!missing(theta)) { 29 | temp <- list(pfun=pfun, 30 | diag=TRUE, 31 | cfun=function(parms, iter, history) { 32 | list(theta=parms$theta, done=TRUE) }, 33 | cparm=list(theta= theta), 34 | pparm= vars, 35 | varname=paste('ridge(', xname, ')', sep='')) 36 | } 37 | else { 38 | temp <- list(pfun=pfun, 39 | diag=TRUE, 40 | cfun=frailty.controldf, 41 | cargs = 'df', 42 | cparm=list(df=df, eps=eps, thetas=0, dfs=nvar, 43 | guess=1), 44 | pparm= vars, 45 | varname=paste('ridge(', xname, ')', sep='')) 46 | } 47 | 48 | attributes(x) <- c(attributes(x), temp) 49 | x 50 | } 51 | -------------------------------------------------------------------------------- /R/survdiff.fit.R: -------------------------------------------------------------------------------- 1 | survdiff.fit <- function(y, x, strat, rho=0) { 2 | # 3 | # This routine is almost always called from survdiff 4 | # If called directly, remember that it does no error checking 5 | # 6 | n <- length(x) 7 | if (ncol(y) !=2) stop ("Invalid y matrix") 8 | if (nrow(y) !=n | length(x) !=n) stop("Data length mismatch") 9 | 10 | ngroup <- length(unique(x)) 11 | if (ngroup <2) stop ("There is only 1 group") 12 | if (inherits(x, "factor")) x <- as.numeric(x) 13 | else x <- match(x, unique(x)) 14 | 15 | if (missing(strat)) strat <- rep(1,n) 16 | else strat <- as.numeric(as.factor(strat)) 17 | nstrat <- length(unique(strat)) 18 | if (length(strat) !=n) stop("Data length mismatch") 19 | 20 | ord <- order(strat, y[,1], -y[,2]) 21 | strat2 <- c(1*(diff(strat[ord])!=0), 1) 22 | 23 | xx <- .C(Csurvdiff2, as.integer(n), 24 | as.integer(ngroup), 25 | as.integer(nstrat), 26 | as.double(rho), 27 | as.double(y[ord,1]), 28 | as.integer(y[ord,2]), 29 | as.integer(x[ord]), 30 | as.integer(strat2), 31 | observed = double(ngroup*nstrat), 32 | expected = double(ngroup*nstrat), 33 | var.e = double(ngroup * ngroup), 34 | double(ngroup), double(n)) 35 | 36 | if (nstrat==1) list(expected = xx$expected, 37 | observed = xx$observed, 38 | var = matrix(xx$var.e, ngroup, ngroup)) 39 | else list(expected = matrix(xx$expected, ngroup), 40 | observed = matrix(xx$observed, ngroup), 41 | var = matrix(xx$var.e, ngroup, ngroup)) 42 | } 43 | -------------------------------------------------------------------------------- /R/survfitcoxph.fit.R: -------------------------------------------------------------------------------- 1 | # The survfitcoxph.fit function was replaced by coxsurv.fit, which has a few 2 | # more arguments and a more logical naming (it fits in with other calls). 3 | # Enough people use rms, however, which calls survfitcoxph.fit, that we are 4 | # giving this as a temporary pass through. 5 | 6 | survfitcoxph.fit <- function(y, x, wt, x2, risk, newrisk, strata, se.fit, 7 | survtype, vartype, varmat, id, y2, strata2, 8 | unlist=TRUE) { 9 | # soon, but not at first issue 10 | # .Deprecated("coxsurv.fit", "survival") 11 | Call <- match.call() 12 | 13 | if (missing(survtype)) { 14 | stype <- 1 15 | ctype <- 1 16 | } else { 17 | stype <- c(1,2,2)[survtype] 18 | ctype <- c(1,1,2)[survtype] 19 | } 20 | 21 | indx <- match(c("y", "x", "wt", "x2", "y2", "risk", "strata", "strata2", 22 | "se.fit", "varmat"), names(Call), nomatch=0) 23 | temp <-Call[c(1, indx)] 24 | temp[[1]] <- quote(survival::coxsurv.fit) 25 | 26 | temp$ctype <- ctype 27 | temp$stype <- stype 28 | if (!missing(newrisk)) temp$risk2 <- newrisk 29 | if (!missing(id)) temp$id2 <- id 30 | temp$unlist <- unlist 31 | 32 | eval(temp, parent.frame()) 33 | } 34 | -------------------------------------------------------------------------------- /R/survreg.control.R: -------------------------------------------------------------------------------- 1 | # $Id: survreg.control.S 11236 2009-02-14 11:46:53Z therneau $ 2 | survreg.control <- function(maxiter=30, rel.tolerance=1e-9, 3 | toler.chol=1e-10, iter.max, debug=0, 4 | outer.max = 10) { 5 | 6 | if (missing(iter.max)) { 7 | iter.max <- maxiter 8 | } 9 | else maxiter <- iter.max 10 | list(iter.max = iter.max, rel.tolerance = rel.tolerance, 11 | toler.chol= toler.chol, debug=debug, 12 | maxiter=maxiter, outer.max=outer.max) 13 | } 14 | -------------------------------------------------------------------------------- /R/tcut.R: -------------------------------------------------------------------------------- 1 | tcut <- function (x, breaks, labels, scale=1){ 2 | # avoid some problems with dates 3 | x <- as.numeric(x) 4 | breaks <- as.numeric(breaks) 5 | 6 | if(length(breaks) == 1) { 7 | if(breaks < 1) 8 | stop("Must specify at least one interval") 9 | if(missing(labels)) 10 | labels <- paste("Range", seq(length = breaks)) 11 | else if(length(labels) != breaks) 12 | stop("Number of labels must equal number of intervals") 13 | r <- range(x[!is.na(x)]) 14 | r[is.na(r)] <- 1 15 | if((d <- diff(r)) == 0) { 16 | r[2] <- r[1] + 1 17 | d <- 1 18 | } 19 | breaks <- seq(r[1] - 0.01 * d, r[2] + 0.01 * d, length = breaks +1) 20 | } 21 | else { 22 | if(is.na(adb <- all(diff(breaks) >= 0)) || !adb) 23 | stop("breaks must be given in ascending order and contain no NA's") 24 | if(missing(labels)) 25 | labels <- paste(format(breaks[ - length(breaks)]), 26 | "+ thru ", format(breaks[-1]), sep = "") 27 | else if(length(labels) != length(breaks) - 1) 28 | stop("Number of labels must be 1 less than number of break points") 29 | } 30 | 31 | temp <- structure(x*scale, cutpoints=breaks*scale, labels=labels) 32 | class(temp) <- 'tcut' 33 | temp 34 | } 35 | 36 | "[.tcut" <- function(x, ..., drop=FALSE) { 37 | atts <- attributes(x) 38 | x <- unclass(x)[..1] 39 | attributes(x) <- atts 40 | class(x) <- 'tcut' 41 | x 42 | } 43 | 44 | levels.tcut <- function(x) attr(x, 'labels') 45 | -------------------------------------------------------------------------------- /R/untangle.specials.R: -------------------------------------------------------------------------------- 1 | # 2 | # This function takes a terms object, and extracts some aspects 3 | # of it into a "nice" list. It is simple an operation that 4 | # I do again and again in the modeling routines, so it was 5 | # made into a separate function 6 | # 7 | untangle.specials <- function(tt, special, order=1) { 8 | spc <- attr(tt, 'specials')[[special]] 9 | if (length(spc)==0) 10 | return(list(vars=character(0), terms=numeric(0))) 11 | 12 | facs <- attr(tt, 'factors') 13 | fname <- dimnames(facs) 14 | ff <- apply(facs[spc,,drop=FALSE], 2, sum) 15 | list(vars= (fname[[1]])[spc], tvar = spc - attr(tt, "response"), 16 | terms= seq(ff)[ff & match(attr(tt, 'order'), order, nomatch=0)]) 17 | } 18 | -------------------------------------------------------------------------------- /build/vignette.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/build/vignette.rds -------------------------------------------------------------------------------- /data/cancer.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/cancer.rda -------------------------------------------------------------------------------- /data/cgd.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/cgd.rda -------------------------------------------------------------------------------- /data/diabetic.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/diabetic.rda -------------------------------------------------------------------------------- /data/flchain.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/flchain.rda -------------------------------------------------------------------------------- /data/heart.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/heart.rda -------------------------------------------------------------------------------- /data/logan.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/logan.rda -------------------------------------------------------------------------------- /data/nafld.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/nafld.rda -------------------------------------------------------------------------------- /data/nwtco.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/nwtco.rda -------------------------------------------------------------------------------- /data/pbc.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/pbc.rda -------------------------------------------------------------------------------- /data/reliability.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/reliability.rda -------------------------------------------------------------------------------- /data/retinopathy.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/retinopathy.rda -------------------------------------------------------------------------------- /data/rhDNase.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/rhDNase.rda -------------------------------------------------------------------------------- /data/solder.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/solder.rda -------------------------------------------------------------------------------- /data/survexp.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/survexp.rda -------------------------------------------------------------------------------- /data/tobin.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/tobin.rda -------------------------------------------------------------------------------- /data/transplant.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/transplant.rda -------------------------------------------------------------------------------- /data/udca.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/data/udca.rda -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | year <- sub("-.*", "", meta$Date) 2 | note <- sprintf("R package version %s", meta$Version) 3 | 4 | bibentry(bibtype="Manual", 5 | title = "A Package for Survival Analysis in R", 6 | author= person(c("Terry M"), "Therneau"), 7 | year = year, 8 | note = note, 9 | url="https://CRAN.R-project.org/package=survival", 10 | key= "survival-package" 11 | ) 12 | bibentry(bibtype= "Book", 13 | title="Modeling Survival Data: Extending the {C}ox Model", 14 | author=c(person(c("Terry M.", "Therneau")), 15 | person(c("Patricia M.", "Grambsch"))), 16 | year = "2000", 17 | publisher= "Springer", 18 | address = "New York", 19 | isbn = "0-387-98784-3", 20 | key = "survival-book" 21 | ) 22 | -------------------------------------------------------------------------------- /inst/COPYRIGHTS: -------------------------------------------------------------------------------- 1 | Copyright 2000 Mayo Foundation for Medical Education and Research. This 2 | software is accepted by users "as is" and without warranties or guarantees 3 | of any kind. 4 | -------------------------------------------------------------------------------- /inst/doc/adjcurve.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/inst/doc/adjcurve.pdf -------------------------------------------------------------------------------- /inst/doc/approximate.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/inst/doc/approximate.pdf -------------------------------------------------------------------------------- /inst/doc/compete.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/inst/doc/compete.pdf -------------------------------------------------------------------------------- /inst/doc/concordance.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/inst/doc/concordance.pdf -------------------------------------------------------------------------------- /inst/doc/matrix.R: -------------------------------------------------------------------------------- 1 | ### R code from vignette source 'matrix.Rnw' 2 | 3 | ################################################### 4 | ### code chunk number 1: init 5 | ################################################### 6 | options(continue=" ", width=60) 7 | options(SweaveHooks=list(fig=function() par(mar=c(4.1, 4.1, .3, 1.1)))) 8 | pdf.options(pointsize=8) #text in graph about the same as regular text 9 | library(survival, quietly=TRUE) 10 | library(Matrix, quietly=TRUE) 11 | 12 | 13 | ################################################### 14 | ### code chunk number 2: matrix.Rnw:160-170 15 | ################################################### 16 | A = rbind(c(-.2, .1, .1), c(0, -1.1, 1.1), c(0, 0,0)) 17 | expm(A) 18 | B <- A + 1.1*diag(3) 19 | exp(-1.1) * expm(B) # verify the formula 20 | 21 | diag(3) + A # the bad estimate 22 | diag(3) + A + A^2/2 + A^3/6 23 | 24 | exp(-1.1) *(diag(3)+ B) 25 | exp(-1.1) *(diag(3)+ B + B^2/2 + B^3/6) 26 | 27 | 28 | -------------------------------------------------------------------------------- /inst/doc/matrix.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/inst/doc/matrix.pdf -------------------------------------------------------------------------------- /inst/doc/methods.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/inst/doc/methods.pdf -------------------------------------------------------------------------------- /inst/doc/multi.Rnw: -------------------------------------------------------------------------------- 1 | \documentclass{article} 2 | \usepackage{Sweave} 3 | \usepackage{amsmath} 4 | \title{Multi-state models as a data exploration tool} 5 | \author{Terry Therneau} 6 | %\VignetteIndexEntry{Multi-state survival curves} 7 | 8 | \begin{document} 9 | \maketitle 10 | 11 | This vignette has been absorbed into the overall `survival' vignette. 12 | \end{document} 13 | -------------------------------------------------------------------------------- /inst/doc/multi.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/inst/doc/multi.pdf -------------------------------------------------------------------------------- /inst/doc/other.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/inst/doc/other.pdf -------------------------------------------------------------------------------- /inst/doc/population.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/inst/doc/population.pdf -------------------------------------------------------------------------------- /inst/doc/redistribute.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/inst/doc/redistribute.pdf -------------------------------------------------------------------------------- /inst/doc/splines.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/inst/doc/splines.pdf -------------------------------------------------------------------------------- /inst/doc/survival.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/inst/doc/survival.pdf -------------------------------------------------------------------------------- /inst/doc/tiedtimes.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/inst/doc/tiedtimes.pdf -------------------------------------------------------------------------------- /inst/doc/timedep.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/inst/doc/timedep.pdf -------------------------------------------------------------------------------- /inst/doc/validate.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/inst/doc/validate.pdf -------------------------------------------------------------------------------- /man/Surv2.Rd: -------------------------------------------------------------------------------- 1 | \name{Surv2} 2 | \alias{Surv2} 3 | \title{Create a survival object} 4 | \description{ 5 | Create a survival object from a timeline style data set. This will 6 | almost always be the response variable in a formula. 7 | } 8 | \usage{ 9 | Surv2(time, event, repeated=FALSE) 10 | } 11 | \arguments{ 12 | \item{time}{a timeline variable, such as age, time from enrollment, 13 | date, etc.} 14 | \item{event}{the outcome at that time. This can be a 0/1 variable, 15 | TRUE/FALSE, or a factor. 16 | If the latter, the first level of the factor corresponds to 17 | `no event was observed at this time'.} 18 | \item{repeated}{if the same level of the outcome repeats, without an 19 | intervening event of another type, should this be treated as a new event?} 20 | } 21 | 22 | \value{ 23 | An object of class \code{Surv2}. There are methods for \code{print}, 24 | \code{is.na} and subscripting. 25 | } 26 | 27 | \details{ 28 | This function is still experimental. 29 | 30 | When used in a \code{coxph} or \code{survfit} model, 31 | Surv2 acts as a trigger to internally convert a timeline style data 32 | set into counting process style data, which is then acted on by the 33 | routine. 34 | 35 | The \code{repeated} argument controls how repeated instances of the same event 36 | code are treated. If TRUE, they are treated as new events, an example 37 | where this might be desired is repeated infections in a subject. 38 | If FALSE, then repeats are not a new 39 | event. An example would be a data set where we wanted to use 40 | diabetes, say, as an endpoint, but this is repeated at each medical 41 | visit. 42 | } 43 | \seealso{ 44 | \code{\link{Surv2data}}, \code{\link{coxph}}, 45 | \code{\link{survfit}} 46 | } 47 | \keyword{survival} 48 | -------------------------------------------------------------------------------- /man/Surv2data.Rd: -------------------------------------------------------------------------------- 1 | \name{Surv2data} 2 | \alias{Surv2data} 3 | \title{Convert data from timecourse to (time1,time2) style 4 | } 5 | \description{ 6 | The multi-state survival functions \code{coxph} and \code{survfit} 7 | allow for two forms of input data. This routine converts between them. 8 | The function is normally called behind the scenes when \code{Surv2} is 9 | as the response. 10 | } 11 | \usage{ 12 | Surv2data(formula, data, subset, id) 13 | } 14 | \arguments{ 15 | \item{formula}{a model formula} 16 | \item{data}{a data frame} 17 | \item{subset}{optional, selects rows of the data to be retained} 18 | \item{id}{a variable that identified multiple rows for the same 19 | subject, normally found in the referenced data set} 20 | } 21 | \value{ 22 | a list with elements 23 | \item{mf}{an updated model frame (fewer rows, unchanged columns)} 24 | \item{S2.y}{the constructed response variable} 25 | \item{S2.state}{the current state for each of the rows} 26 | } 27 | 28 | \details{ 29 | For timeline style data, each row is uniquely identified by an 30 | (identifier, time) pair. The time could be a date, time from entry to a 31 | study, age, etc, (there may often be more than one time variable). 32 | The identifier and time cannot be missing. 33 | The remaining covariates represent values that were observed at that 34 | time point. Often, a given covariate is observed at only a subset of 35 | times and is missing at others. At the time of death, in particular, 36 | often only the identifier, time, and status indicator are known. 37 | 38 | In the resulting data set missing covariates are replaced by their 39 | last known value, and the response y will be a Surv(time1, time2, 40 | endpoint) object. 41 | } 42 | \keyword{survival} 43 | -------------------------------------------------------------------------------- /man/aeqSurv.Rd: -------------------------------------------------------------------------------- 1 | \name{aeqSurv} 2 | \alias{aeqSurv} 3 | \title{Adjudicate near ties in a Surv object} 4 | \description{The check for tied survival times can fail due 5 | to floating point imprecision, which can make actual ties appear to 6 | be distinct values. 7 | Routines that depend on correct identification of ties pairs will then 8 | give incorrect results, e.g., a Cox model. 9 | This function rectifies these. 10 | } 11 | \usage{ 12 | aeqSurv(x, tolerance = sqrt(.Machine$double.eps)) 13 | } 14 | \arguments{ 15 | \item{x}{a Surv object} 16 | \item{tolerance}{the tolerance used to detect values that will 17 | be considered equal} 18 | } 19 | \details{ 20 | This routine is called by both \code{survfit} and \code{coxph} to 21 | deal with the issue of ties that get incorrectly broken due to 22 | floating point imprecision. See the short vignette on tied times 23 | for a simple example. Use the \code{timefix} argument of 24 | \code{survfit} or \code{coxph.control} to control the option 25 | if desired. 26 | 27 | The rule for `equality' is identical to that used by the 28 | \code{all.equal} routine. Pairs of values that are within round off 29 | error of each other are replaced by the smaller value. 30 | An error message is generated if this process causes a 0 length 31 | time interval to be created. 32 | } 33 | \value{a Surv object identical to the original, but with ties restored.} 34 | \author{Terry Therneau} 35 | \seealso{\code{\link{survfit}}, \code{\link{coxph.control}}} 36 | 37 | \keyword{ survival } 38 | 39 | -------------------------------------------------------------------------------- /man/aggregate.survfit.Rd: -------------------------------------------------------------------------------- 1 | \name{aggregate.survfit} 2 | \alias{aggregate.survfit} 3 | \title{Average survival curves} 4 | \description{ 5 | For a survfit object containing multiple curves, create average curves 6 | over a grouping. 7 | } 8 | \usage{ 9 | \method{aggregate}{survfit}(x, by = NULL, FUN = mean, ...) 10 | } 11 | \arguments{ 12 | \item{x}{a \code{survfit} object which has a data dimension.} 13 | \item{by}{an optional list or vector of grouping elements, each as 14 | long as \code{dim(x)['data']}. } 15 | \item{FUN}{a function to compute the summary statistic of interest. } 16 | \item{\dots}{optional further arguments to FUN.} 17 | } 18 | \details{ 19 | The primary use of this is to take an average over multiple survival 20 | curves that were created from a modeling function. That is, a 21 | marginal estimate of the survival. 22 | It is primarily used to average over multiple predicted curves from a 23 | Cox model. 24 | } 25 | \value{a \code{survfit} object of lower dimension.} 26 | \seealso{\code{\link{survfit}}} 27 | \examples{ 28 | cfit <- coxph(Surv(futime, death) ~ sex + age*hgb, data=mgus2) 29 | # marginal effect of sex, after adjusting for the others 30 | dummy <- rbind(mgus2, mgus2) 31 | dummy$sex <- rep(c("F", "M"), each=nrow(mgus2)) # population data set 32 | dummy <- na.omit(dummy) # don't count missing hgb in our "population 33 | csurv <- survfit(cfit, newdata=dummy) 34 | dim(csurv) # 2 * 1384 survival curves 35 | csurv2 <- aggregate(csurv, dummy$sex) 36 | } 37 | \keyword{ survival } 38 | -------------------------------------------------------------------------------- /man/aml.Rd: -------------------------------------------------------------------------------- 1 | \name{aml} 2 | \docType{data} 3 | \alias{aml} 4 | \alias{leukemia} 5 | \title{Acute Myelogenous Leukemia survival data} 6 | \description{Survival in patients with Acute Myelogenous Leukemia. 7 | The question at the time was whether the standard course of 8 | chemotherapy should be extended ('maintainance') for additional 9 | cycles.} 10 | \usage{ 11 | aml 12 | leukemia 13 | data(cancer, package="survival") 14 | } 15 | \format{ 16 | \tabular{ll}{ 17 | time:\tab survival or censoring time\cr 18 | status:\tab censoring status\cr 19 | x: \tab maintenance chemotherapy given? (factor)\cr 20 | } 21 | } 22 | \source{ 23 | Rupert G. Miller (1997), 24 | \emph{Survival Analysis}. 25 | John Wiley & Sons. 26 | ISBN: 0-471-25218-2. 27 | } 28 | \keyword{datasets} 29 | -------------------------------------------------------------------------------- /man/cgd.Rd: -------------------------------------------------------------------------------- 1 | \name{cgd} 2 | \docType{data} 3 | \alias{cgd} 4 | \alias{cgd.raw} 5 | \title{Chronic Granulotamous Disease data} 6 | 7 | \description{Data are from a placebo controlled trial of gamma 8 | interferon in chronic granulotomous disease (CGD). 9 | Contains the data on time to serious infections observed through 10 | end of study for each patient. 11 | } 12 | \usage{cgd 13 | data(cgd) 14 | } 15 | \format{ 16 | \describe{ 17 | \item{id}{subject identification number} 18 | \item{center}{enrolling center } 19 | \item{random}{date of randomization } 20 | \item{treatment}{placebo or gamma interferon } 21 | \item{sex}{sex} 22 | \item{age}{age in years, at study entry } 23 | \item{height}{height in cm at study entry} 24 | \item{weight}{weight in kg at study entry} 25 | \item{inherit}{pattern of inheritance } 26 | \item{steroids}{use of steroids at study entry,1=yes} 27 | \item{propylac}{use of prophylactic antibiotics at study entry} 28 | \item{hos.cat}{a categorization of the centers into 4 groups} 29 | \item{tstart, tstop}{start and end of each time interval } 30 | \item{status}{1=the interval ends with an infection } 31 | \item{enum}{observation number within subject} 32 | } 33 | } 34 | \details{ 35 | The \code{cgd0} data set is in the form found in the references, 36 | with one line per patient and no recoding of the variables. 37 | The \code{cgd} data set (this one) has been cast into (start, stop] 38 | format with one line per event, and covariates 39 | such as center recoded as factors 40 | to include meaningful labels. 41 | } 42 | \source{ 43 | Fleming and Harrington, Counting Processes and Survival Analysis, 44 | appendix D.2. 45 | } 46 | \seealso{\code{link{cgd0}}} 47 | \keyword{datasets} 48 | \keyword{survival} 49 | -------------------------------------------------------------------------------- /man/cgd0.Rd: -------------------------------------------------------------------------------- 1 | \name{cgd0} 2 | \docType{data} 3 | \alias{cgd0} 4 | \title{Chronic Granulotomous Disease data} 5 | 6 | 7 | \description{Data are from a placebo controlled trial of gamma 8 | interferon in chronic granulotomous disease (CGD). 9 | Contains the data on time to serious infections observed through 10 | end of study for each patient. 11 | } 12 | \usage{cgd0} 13 | \format{ 14 | \describe{ 15 | \item{id}{subject identification number} 16 | \item{center}{enrolling center } 17 | \item{random}{date of randomization } 18 | \item{treatment}{placebo or gamma interferon } 19 | \item{sex}{sex} 20 | \item{age}{age in years, at study entry } 21 | \item{height}{height in cm at study entry} 22 | \item{weight}{weight in kg at study entry} 23 | \item{inherit}{pattern of inheritance } 24 | \item{steroids}{use of steroids at study entry,1=yes} 25 | \item{propylac}{use of prophylactic antibiotics at study entry} 26 | \item{hos.cat}{a categorization of the centers into 4 groups} 27 | \item{futime}{days to last follow-up} 28 | \item{etime1-etime7}{up to 7 infection times for the subject} 29 | } 30 | } 31 | \details{ 32 | The \code{cgdraw} data set (this one) is in the form found in the references, 33 | with one line per patient and no recoding of the variables. 34 | 35 | The \code{cgd} data set has been further processed so as to have one 36 | line per event, with covariates such as center recoded as factors 37 | to include meaningful labels. } 38 | \source{ 39 | Fleming and Harrington, Counting Processes and Survival Analysis, 40 | appendix D.2. 41 | } 42 | \seealso{\code{\link{cgd}}} 43 | \keyword{datasets} 44 | \keyword{survival} 45 | -------------------------------------------------------------------------------- /man/cluster.Rd: -------------------------------------------------------------------------------- 1 | \name{cluster} 2 | \alias{cluster} 3 | \title{ 4 | Identify clusters. 5 | } 6 | \description{ 7 | This is a special function used in the context of survival models. It 8 | identifies correlated groups of observations, and is used on the right hand 9 | side of a formula. 10 | This style is now discouraged, use the \code{cluster} option instead. 11 | } 12 | \usage{ 13 | cluster(x) 14 | } 15 | \arguments{ 16 | \item{x}{ 17 | A character, factor, or numeric variable. 18 | } 19 | } 20 | \value{ 21 | \code{x} 22 | } 23 | \details{ 24 | The function's only action is semantic, to mark a variable as the 25 | cluster indicator. 26 | The resulting variance is what is known as the ``working independence'' 27 | variance in a GEE model. 28 | Note that one cannot use both a frailty term and a cluster term in the 29 | same model, the first is a mixed-effects approach to correlation and the 30 | second a GEE approach, and these don't mix. 31 | } 32 | \seealso{ 33 | \code{\link{coxph}}, \code{\link{survreg}} 34 | } 35 | \examples{ 36 | marginal.model <- coxph(Surv(time, status) ~ rx, data= rats, cluster=litter, 37 | subset=(sex=='f')) 38 | frailty.model <- coxph(Surv(time, status) ~ rx + frailty(litter), rats, 39 | subset=(sex=='f')) 40 | } 41 | \keyword{survival} 42 | 43 | 44 | -------------------------------------------------------------------------------- /man/coxph.wtest.Rd: -------------------------------------------------------------------------------- 1 | \name{coxph.wtest} 2 | \alias{coxph.wtest} 3 | \title{Compute a quadratic form} 4 | \description{ 5 | This function is used internally by several survival routines. It 6 | computes a simple quadratic form, while properly dealing with missings. 7 | } 8 | \usage{ 9 | coxph.wtest(var, b, toler.chol = 1e-09) 10 | } 11 | \arguments{ 12 | \item{var}{variance matrix} 13 | \item{b}{vector} 14 | \item{toler.chol}{tolerance for the internal cholesky decomposition} 15 | } 16 | \details{ 17 | Compute b' V-inverse b. Equivalent to sum(b * solve(V,b)), except for 18 | the case of redundant covariates in the original model, which lead to 19 | NA values in V and b. 20 | } 21 | \value{a real number} 22 | \author{Terry Therneau} 23 | \keyword{ survival } 24 | 25 | -------------------------------------------------------------------------------- /man/diabetic.Rd: -------------------------------------------------------------------------------- 1 | \name{diabetic} 2 | \alias{diabetic} 3 | \docType{data} 4 | \title{Ddiabetic retinopathy} 5 | \description{ 6 | Partial results from a trial of laser coagulation for the treatment 7 | of diabetic retinopathy. 8 | } 9 | \usage{diabetic 10 | data(diabetic, package="survival") 11 | } 12 | \format{ 13 | A data frame with 394 observations on the following 8 variables. 14 | \describe{ 15 | \item{\code{id}}{subject id} 16 | \item{\code{laser}}{laser type: \code{xenon} or \code{argon}} 17 | \item{\code{age}}{age at diagnosis} 18 | \item{\code{eye}}{a factor with levels of \code{left} \code{right}} 19 | \item{\code{trt}}{treatment: 0 = no treatment, 1= laser} 20 | \item{\code{risk}}{risk group of 6-12} 21 | \item{\code{time}}{time to event or last follow-up} 22 | \item{\code{status}}{status of 0= censored or 1 = visual loss} 23 | } 24 | } 25 | \details{ 26 | The 197 patients in this dataset were a 50\% random sample of the 27 | patients with "high-risk" diabetic retinopathy as defined by the 28 | Diabetic Retinopathy Study (DRS). Each patient had one eye randomized 29 | to laser treatment and the other eye received no treatment. For each 30 | eye, the event of interest was the time from initiation of treatment 31 | to the time when visual acuity dropped below 5/200 two visits in a row. 32 | Thus there is a built-in lag time of 33 | approximately 6 months (visits were every 3 months). Survival times 34 | in this dataset are therefore the actual time to blindness in months, 35 | minus the minimum possible time to event (6.5 months). Censoring was 36 | caused by death, dropout, or end of the study. 37 | } 38 | \references{ 39 | Huster, Brookmeyer and Self, Biometrics, 1989. 40 | 41 | American Journal of Ophthalmology, 1976, 81:4, pp 383-396 42 | } 43 | \examples{ 44 | # juvenile diabetes is defined as and age less than 20 45 | juvenile <- 1*(diabetic$age < 20) 46 | coxph(Surv(time, status) ~ trt + juvenile, cluster= id, 47 | data= diabetic) 48 | } 49 | \keyword{datasets} 50 | \keyword{survival} -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/man/figures/logo.png -------------------------------------------------------------------------------- /man/gbsg.Rd: -------------------------------------------------------------------------------- 1 | \name{gbsg} 2 | \alias{gbsg} 3 | \docType{data} 4 | \title{Breast cancer data sets used in Royston and Altman (2013)} 5 | \description{ 6 | The \code{gbsg} data set contains patient records from a 1984-1989 trial 7 | conducted by the German Breast Cancer Study Group (GBSG) of 720 patients 8 | with node positive breast cancer; it retains the 686 patients with 9 | complete data for the prognostic variables. 10 | } 11 | \usage{gbsg 12 | data(cancer, package="survival") 13 | } 14 | \format{ 15 | A data set with 686 observations and 11 variables. 16 | \describe{ 17 | \item{\code{pid}}{patient identifier} 18 | \item{\code{age}}{age, years} 19 | \item{\code{meno}}{menopausal status (0= premenopausal, 1= postmenopausal)} 20 | \item{\code{size}}{tumor size, mm} 21 | \item{\code{grade}}{tumor grade} 22 | \item{\code{nodes}}{number of positive lymph nodes} 23 | \item{\code{pgr}}{progesterone receptors (fmol/l)} 24 | \item{\code{er}}{estrogen receptors (fmol/l)} 25 | \item{\code{hormon}}{hormonal therapy, 0= no, 1= yes} 26 | \item{\code{rfstime}}{recurrence free survival time; days to first of reccurence, death or last follow-up} 27 | \item{\code{status}}{0= alive without recurrence, 1= recurrence or 28 | death} 29 | }} 30 | \details{ 31 | These data sets are used in the paper by Royston and Altman. 32 | The Rotterdam data is used to create a fitted model, and the GBSG data for 33 | validation of the model. The paper gives references for the data source. 34 | } 35 | \seealso{ 36 | \code{\link{rotterdam}} 37 | } 38 | \references{ 39 | Patrick Royston and Douglas Altman, External validation of a Cox prognostic 40 | model: principles and methods. BMC Medical Research Methodology 2013, 13:33 41 | } 42 | \keyword{datasets} 43 | \keyword{survival} 44 | -------------------------------------------------------------------------------- /man/heart.Rd: -------------------------------------------------------------------------------- 1 | \name{heart} 2 | \docType{data} 3 | \alias{jasa1} 4 | \alias{jasa} 5 | \alias{heart} 6 | \title{Stanford Heart Transplant data} 7 | \description{Survival of patients on the waiting list for the Stanford 8 | heart transplant program.} 9 | \usage{heart 10 | data(heart, package="survival")} 11 | \format{ 12 | jasa: original data 13 | \tabular{ll}{ 14 | birth.dt:\tab birth date \cr 15 | accept.dt:\tab acceptance into program \cr 16 | tx.date:\tab transplant date \cr 17 | fu.date:\tab end of followup \cr 18 | fustat:\tab dead or alive \cr 19 | surgery:\tab prior bypass surgery\cr 20 | age: \tab age (in years)\cr 21 | futime:\tab followup time\cr 22 | wait.time:\tab time before transplant\cr 23 | transplant:\tab transplant indicator\cr 24 | mismatch:\tab mismatch score\cr 25 | hla.a2:\tab particular type of mismatch\cr 26 | mscore:\tab another mismatch score\cr 27 | reject:\tab rejection occurred\cr 28 | } 29 | 30 | jasa1, heart: processed data 31 | \tabular{ll}{ 32 | start, stop, event: \tab Entry and exit time and status for this interval of time\cr 33 | age:\tab age-48 years\cr 34 | year:\tab year of acceptance (in years after 1 Nov 1967)\cr 35 | surgery:\tab prior bypass surgery 1=yes\cr 36 | transplant: \tab received transplant 1=yes\cr 37 | id:\tab patient id\cr 38 | } 39 | } 40 | \seealso{\code{\link{stanford2}}} 41 | \source{ 42 | J Crowley and M Hu (1977), 43 | Covariance analysis of heart transplant survival data. 44 | \emph{Journal of the American Statistical Association}, 45 | \bold{72}, 27--36. 46 | } 47 | \keyword{datasets} 48 | \keyword{survival} 49 | -------------------------------------------------------------------------------- /man/is.ratetable.Rd: -------------------------------------------------------------------------------- 1 | \name{is.ratetable} 2 | \alias{is.ratetable} 3 | \alias{Math.ratetable} 4 | \alias{Ops.ratetable} 5 | \title{ 6 | Verify that an object is of class ratetable. 7 | } 8 | \description{ 9 | The function verifies not only the \code{class} attribute, but the 10 | structure of the object. 11 | } 12 | \usage{ 13 | is.ratetable(x, verbose=FALSE) 14 | } 15 | \arguments{ 16 | \item{x}{ 17 | the object to be verified. 18 | } 19 | \item{verbose}{ 20 | if \code{TRUE} and the object is not a ratetable, 21 | then return a character string describing the way(s) in which \code{x} 22 | fails to be a proper ratetable object. 23 | } 24 | } 25 | \value{ 26 | returns \code{TRUE} if \code{x} is a ratetable, and \code{FALSE} or a description if it is not. 27 | } 28 | \details{ 29 | Rate tables are used by the \code{pyears} and \code{survexp} functions, and normally 30 | contain death rates for some population, categorized by age, sex, or other 31 | variables. They have a fairly rigid structure, and the \code{verbose} option 32 | can help in creating a new rate table. 33 | } 34 | \seealso{ 35 | \code{\link{pyears}}, \code{\link{survexp}}. 36 | } 37 | \examples{ 38 | is.ratetable(survexp.us) # True 39 | is.ratetable(lung) # False 40 | } 41 | 42 | \keyword{survival} 43 | -------------------------------------------------------------------------------- /man/kidney.Rd: -------------------------------------------------------------------------------- 1 | \name{kidney} 2 | \alias{kidney} 3 | \title{Kidney catheter data} 4 | \description{ 5 | Data on the recurrence times to infection, at the point of insertion of 6 | the catheter, for kidney patients using portable dialysis equipment. 7 | Catheters may be removed for reasons other than infection, in which case 8 | the observation is censored. Each patient has exactly 2 observations. 9 | 10 | This data has often been used to illustrate the use of random effects 11 | (frailty) in a survival model. However, one of the males (id 21) is a 12 | large outlier, with much longer survival than his peers. If this 13 | observation is removed no evidence remains for a random subject effect. 14 | } 15 | \usage{ 16 | kidney 17 | # or 18 | data(cancer, package="survival") 19 | } 20 | \format{ 21 | \tabular{ll}{ 22 | patient:\tab id\cr 23 | time:\tab time\cr 24 | status:\tab event status\cr 25 | age:\tab in years\cr 26 | sex:\tab 1=male, 2=female\cr 27 | disease:\tab disease type (0=GN, 1=AN, 2=PKD, 3=Other)\cr 28 | frail:\tab frailty estimate from original paper\cr 29 | }} 30 | \section{Note}{ 31 | The original paper ignored the issue of tied times and so is not 32 | exactly reproduced by the survival package. 33 | } 34 | \examples{ 35 | kfit <- coxph(Surv(time, status)~ age + sex + disease + frailty(id), kidney) 36 | kfit0 <- coxph(Surv(time, status)~ age + sex + disease, kidney) 37 | kfitm1 <- coxph(Surv(time,status) ~ age + sex + disease + 38 | frailty(id, dist='gauss'), kidney) 39 | } 40 | \source{ 41 | CA McGilchrist, CW Aisbett (1991), 42 | Regression with frailty in survival analysis. 43 | \emph{Biometrics} \bold{47}, 461--66. 44 | } 45 | \keyword{survival} 46 | -------------------------------------------------------------------------------- /man/levels.Surv.Rd: -------------------------------------------------------------------------------- 1 | \name{levels.Surv} 2 | \alias{levels.Surv} 3 | \title{Return the states of a multi-state Surv object 4 | } 5 | \description{ 6 | For a multi-state \code{Surv} object, this will return the names 7 | of the states. 8 | } 9 | \usage{ 10 | \method{levels}{Surv}(x) 11 | } 12 | \arguments{ 13 | \item{x}{a \code{Surv} object} 14 | } 15 | \value{ 16 | for a multi-state \code{Surv} object, the vector of state names 17 | (excluding censoring); or NULL for an ordinary \code{Surv} object 18 | } 19 | \examples{ 20 | y1 <- Surv(c(1,5, 9, 17,21, 30), 21 | factor(c(0, 1, 2,1,0,2), 0:2, c("censored", "progression", "death"))) 22 | levels(y1) 23 | 24 | y2 <- Surv(1:6, rep(0:1, 3)) 25 | y2 26 | levels(y2) 27 | } 28 | \keyword{ survival } 29 | -------------------------------------------------------------------------------- /man/logLik.coxph.Rd: -------------------------------------------------------------------------------- 1 | \name{logLik.coxph} 2 | \alias{logLik.coxph} 3 | \alias{logLik.survreg} 4 | \title{logLik method for a Cox model} 5 | \description{The logLik function for survival models} 6 | \usage{ 7 | \method{logLik}{coxph}(object, ...) 8 | \method{logLik}{survreg}(object, ...) 9 | } 10 | \arguments{ 11 | \item{object}{the result of a \code{coxph} or \code{survreg} fit} 12 | \item{\dots}{optional arguments for other instances of the method} 13 | } 14 | \details{ 15 | The logLik function is used by summary functions in R such as 16 | \code{AIC}. 17 | For a Cox model, this method returns the partial likelihood. 18 | The number of degrees of freedom (df) used by the fit and the effective 19 | number of observations (nobs) are added as attributes. 20 | Per Raftery and others, the effective number of observations is the 21 | taken to be the number of events in the data set. 22 | 23 | For a \code{survreg} model the proper value for the effective number 24 | of observations is still an open question (at least to this author). 25 | For right censored data the approach of \code{logLik.coxph} is the 26 | possible the most sensible, but for interval censored observations 27 | the result is unclear. The code currently does not add a \emph{nobs} 28 | attribute. 29 | } 30 | \value{an object of class \code{logLik}} 31 | 32 | \references{ 33 | Robert E. Kass and Adrian E. Raftery (1995). "Bayes Factors". J. 34 | American Statistical Assoc. 90 (430): 791. 35 | 36 | Raftery A.E. (1995), "Bayesian Model Selection in Social Research", 37 | Sociological methodology, 111-196. 38 | } 39 | \seealso{\code{\link{logLik}}} 40 | \author{Terry Therneau} 41 | 42 | \keyword{ survival} 43 | -------------------------------------------------------------------------------- /man/logan.Rd: -------------------------------------------------------------------------------- 1 | \name{logan} 2 | \docType{data} 3 | \alias{logan} 4 | \title{Data from the 1972-78 GSS data used by Logan} 5 | \usage{logan 6 | data(logan, package="survival") 7 | } 8 | \description{ 9 | Intergenerational occupational mobility data with covariates. 10 | } 11 | \format{ 12 | A data frame with 838 observations on the following 4 variables. 13 | \describe{ 14 | \item{occupation}{subject's occupation, a factor with levels 15 | \code{farm}, \code{operatives}, \code{craftsmen}, \code{sales}, 16 | and \code{professional}} 17 | \item{focc}{father's occupation} 18 | \item{education}{total years of schooling, 0 to 20} 19 | \item{race}{levels of \code{non-black} and \code{black}} 20 | } 21 | } 22 | \source{ 23 | General Social Survey data, see the web site for detailed information 24 | on the variables. 25 | \url{https://gss.norc.org/}. 26 | } 27 | \references{ 28 | Logan, John A. (1983). A Multivariate Model for Mobility Tables. 29 | \cite{American Journal of Sociology} 89: 324-349.} 30 | \keyword{datasets} 31 | -------------------------------------------------------------------------------- /man/mgus2.Rd: -------------------------------------------------------------------------------- 1 | \name{mgus2} 2 | \alias{mgus2} 3 | \docType{data} 4 | \title{Monoclonal gammopathy data} 5 | 6 | \description{Natural history of 1341 sequential patients with monoclonal 7 | gammopathy of undetermined significance (MGUS). This is a superset of 8 | the \code{mgus} data, at a later point in the accrual process 9 | } 10 | \usage{mgus2 11 | data(cancer, package="survival") 12 | } 13 | \format{ 14 | A data frame with 1384 observations on the following 10 variables. 15 | \describe{ 16 | \item{\code{id}}{subject identifier} 17 | \item{\code{age}}{age at diagnosis, in years} 18 | \item{\code{sex}}{a factor with levels \code{F} \code{M}} 19 | \item{\code{dxyr}}{year of diagnosis} 20 | \item{\code{hgb}}{hemoglobin} 21 | \item{\code{creat}}{creatinine} 22 | \item{\code{mspike}}{size of the monoclonal serum splike} 23 | \item{\code{ptime}}{time until progression to a plasma cell 24 | malignancy (PCM) or last contact, in months} 25 | \item{\code{pstat}}{occurrence of PCM: 0=no, 1=yes } 26 | \item{\code{futime}}{time until death or last contact, in months} 27 | \item{\code{death}}{occurrence of death: 0=no, 1=yes} 28 | } 29 | } 30 | \details{ 31 | This is an extension of the study found in the \code{mgus} data set, 32 | containing enrollment through 1994 and follow-up through 1999. 33 | } 34 | \source{Mayo Clinic data courtesy of Dr. Robert Kyle. All patient 35 | identifiers have been removed, age rounded to the nearest year, and 36 | follow-up times rounded to the nearest month.} 37 | \references{ 38 | R. Kyle, T. Therneau, V. Rajkumar, J. Offord, D. Larson, M. Plevak, 39 | and L. J. Melton III, A long-terms study of prognosis in monoclonal 40 | gammopathy of undertermined significance. New Engl J Med, 346:564-569 (2002). 41 | } 42 | \keyword{datasets} 43 | -------------------------------------------------------------------------------- /man/model.frame.coxph.Rd: -------------------------------------------------------------------------------- 1 | \name{model.frame.coxph} 2 | \Rdversion{1.1} 3 | \alias{model.frame.coxph} 4 | \title{Model.frame method for coxph objects} 5 | \description{ Recreate the model frame of a coxph fit. } 6 | \usage{ 7 | \method{model.frame}{coxph}(formula, ...) 8 | } 9 | \arguments{ 10 | \item{formula}{the result of a \code{coxph} fit} 11 | \item{\dots}{other arguments to \code{model.frame}} 12 | } 13 | \details{ 14 | For details, see the manual page for the generic function. 15 | This function would rarely be called by a user, it is mostly used 16 | inside functions like \code{residual} that need to recreate the data 17 | set from a model in order to do further calculations. 18 | } 19 | \value{the model frame used in the original fit, or a parallel one for 20 | new data. 21 | } 22 | \author{Terry Therneau} 23 | \seealso{\code{\link{model.frame}}} 24 | \keyword{ survival } 25 | -------------------------------------------------------------------------------- /man/model.matrix.coxph.Rd: -------------------------------------------------------------------------------- 1 | \name{model.matrix.coxph} 2 | \Rdversion{1.1} 3 | \alias{model.matrix.coxph} 4 | \title{ 5 | Model.matrix method for coxph models 6 | } 7 | \description{ 8 | Reconstruct the model matrix for a cox model. 9 | } 10 | \usage{ 11 | \method{model.matrix}{coxph}(object, data=NULL, contrast.arg = 12 | object$contrasts, ...) 13 | } 14 | %- maybe also 'usage' for other objects documented here. 15 | \arguments{ 16 | \item{object}{the result of a \code{coxph} model} 17 | \item{data}{optional, a data frame from which to obtain the data} 18 | \item{contrast.arg}{optional, a contrasts object describing how 19 | factors should be coded} 20 | \item{\dots}{other possible argument to \code{model.frame}} 21 | } 22 | \details{ 23 | When there is a \code{data} argument this function differs from most 24 | of the other \code{model.matrix} methods in that the response variable 25 | for the original formula is \emph{not} required to be in the data. 26 | 27 | If the data frame contains a \code{terms} attribute then it is 28 | assumed to be the result of a call to \code{model.frame}, otherwise 29 | a call to \code{model.frame} is applied with the data as an argument. 30 | } 31 | \value{ 32 | The model matrix for the fit 33 | } 34 | \author{Terry Therneau} 35 | \seealso{\code{\link{model.matrix}}} 36 | \examples{ 37 | fit1 <- coxph(Surv(time, status) ~ age + factor(ph.ecog), data=lung) 38 | xfit <- model.matrix(fit1) 39 | 40 | fit2 <- coxph(Surv(time, status) ~ age + factor(ph.ecog), data=lung, 41 | x=TRUE) 42 | all.equal(model.matrix(fit1), fit2$x) 43 | } 44 | \keyword{ survival } 45 | -------------------------------------------------------------------------------- /man/myeloma.Rd: -------------------------------------------------------------------------------- 1 | \name{myeloma} 2 | \alias{myeloma} 3 | \docType{data} 4 | \title{ 5 | Survival times of patients with multiple myeloma 6 | } 7 | \description{ 8 | Survival times of 3882 subjects with multiple myeloma, seen at Mayo 9 | Clinic from 1947--1996. 10 | } 11 | \usage{myeloma 12 | data("cancer", package="survival")} 13 | \format{ 14 | A data frame with 3882 observations on the following 5 variables. 15 | \describe{ 16 | \item{\code{id}}{subject identifier} 17 | \item{\code{year}}{year of entry into the study} 18 | \item{\code{entry}}{time from diagnosis of MM until entry (days)} 19 | \item{\code{futime}}{follow up time (days)} 20 | \item{\code{death}}{status at last follow-up: 0 = alive, 1 = death} 21 | } 22 | } 23 | \details{ 24 | Subjects who were diagnosed at Mayo will have \code{entry} =0, those who 25 | were diagnosed elsewhere and later referred will have positive values. 26 | } 27 | \references{ 28 | R. Kyle, Long term survival in multiple myeloma. 29 | New Eng J Medicine, 1997 30 | } 31 | \examples{ 32 | # Incorrect survival curve, which ignores left truncation 33 | fit1 <- survfit(Surv(futime, death) ~ 1, myeloma) 34 | # Correct curve 35 | fit2 <- survfit(Surv(entry, futime, death) ~1, myeloma) 36 | } 37 | \keyword{datasets} 38 | -------------------------------------------------------------------------------- /man/nwtco.Rd: -------------------------------------------------------------------------------- 1 | \name{nwtco} 2 | \alias{nwtco} 3 | \docType{data} 4 | \title{Data from the National Wilm's Tumor Study} 5 | \description{ 6 | Measurement error example. Tumor histology predicts 7 | survival, but prediction is stronger with central lab histology than 8 | with the local institution determination. 9 | } 10 | \usage{nwtco 11 | data(nwtco, package="survival") 12 | } 13 | \format{ 14 | A data frame with 4028 observations on the following 9 variables. 15 | \describe{ 16 | \item{\code{seqno}}{id number} 17 | \item{\code{instit}}{Histology from local institution} 18 | \item{\code{histol}}{Histology from central lab} 19 | \item{\code{stage}}{Disease stage} 20 | \item{\code{study}}{study} 21 | \item{\code{rel}}{indicator for relapse} 22 | \item{\code{edrel}}{time to relapse} 23 | \item{\code{age}}{age in months} 24 | \item{\code{in.subcohort}}{Included in the subcohort for the example in the 25 | paper} 26 | } 27 | } 28 | \references{ 29 | NE Breslow and N Chatterjee (1999), 30 | Design and analysis of two-phase studies with binary outcome applied 31 | to Wilms tumour prognosis. 32 | \emph{Applied Statistics} \bold{48}, 457--68. 33 | } 34 | \examples{ 35 | with(nwtco, table(instit,histol)) 36 | anova(coxph(Surv(edrel,rel)~histol+instit,data=nwtco)) 37 | anova(coxph(Surv(edrel,rel)~instit+histol,data=nwtco)) 38 | } 39 | \keyword{datasets} 40 | -------------------------------------------------------------------------------- /man/ovarian.Rd: -------------------------------------------------------------------------------- 1 | \name{ovarian} 2 | \alias{ovarian} 3 | \docType{data} 4 | \title{Ovarian Cancer Survival Data} 5 | \usage{ovarian 6 | data(cancer, package="survival") 7 | } 8 | \description{Survival in a randomised trial comparing two treatments for 9 | ovarian cancer} 10 | \format{ 11 | \tabular{ll}{ 12 | futime:\tab survival or censoring time\cr 13 | fustat:\tab censoring status\cr 14 | age: \tab in years\cr 15 | resid.ds:\tab residual disease present (1=no,2=yes)\cr 16 | rx:\tab treatment group\cr 17 | ecog.ps:\tab ECOG performance status (1 is better, see reference)\cr 18 | } 19 | } 20 | \source{Terry Therneau} 21 | \references{ 22 | Edmunson, J.H., Fleming, T.R., Decker, D.G., 23 | Malkasian, G.D., Jefferies, J.A., Webb, M.J., and Kvols, L.K., 24 | Different Chemotherapeutic Sensitivities and Host Factors Affecting 25 | Prognosis in Advanced Ovarian Carcinoma vs. Minimal Residual Disease. 26 | Cancer Treatment Reports, 63:241-47, 1979. 27 | } 28 | \keyword{datasets} 29 | \keyword{survival} 30 | -------------------------------------------------------------------------------- /man/plot.aareg.Rd: -------------------------------------------------------------------------------- 1 | \name{plot.aareg} 2 | \alias{plot.aareg} 3 | \title{ 4 | Plot an aareg object. 5 | } 6 | \description{ 7 | Plot the estimated coefficient function(s) from a fit 8 | of Aalen's additive regression model. 9 | } 10 | \usage{ 11 | \method{plot}{aareg}(x, se=TRUE, maxtime, type='s', ...) 12 | } 13 | \arguments{ 14 | \item{x}{ 15 | the result of a call to the \code{aareg} function 16 | } 17 | \item{se}{ 18 | if TRUE, standard error bands are included on the plot 19 | } 20 | \item{maxtime}{ 21 | upper limit for the x-axis. 22 | } 23 | \item{type}{ 24 | graphical parameter for the type of line, default is "steps". 25 | } 26 | \item{\dots }{ 27 | other graphical parameters such as line type, color, or axis labels. 28 | } 29 | } 30 | \section{Side Effects}{ 31 | A plot is produced on the current graphical device. 32 | } 33 | \section{References}{ 34 | Aalen, O.O. (1989). A linear regression model for the analysis of life times. 35 | Statistics in Medicine, 8:907-925. 36 | } 37 | \seealso{ 38 | aareg 39 | } 40 | 41 | -------------------------------------------------------------------------------- /man/print.aareg.Rd: -------------------------------------------------------------------------------- 1 | \name{print.aareg} 2 | \alias{print.aareg} 3 | \title{ 4 | Print an aareg object 5 | } 6 | \description{ 7 | Print out a fit of Aalen's additive regression model 8 | } 9 | \usage{ 10 | \method{print}{aareg}(x, maxtime, test=c("aalen", "nrisk"),scale=1,...) 11 | } 12 | \arguments{ 13 | \item{x}{ 14 | the result of a call to the \code{aareg} function 15 | } 16 | \item{maxtime}{ 17 | the upper time point to be used in the test for non-zero slope 18 | } 19 | \item{test}{ 20 | the weighting to be used in the test for non-zero slope. 21 | The default weights are based on the variance of each coefficient, as 22 | a function of time. The alternative weight is proportional to the number 23 | of subjects still at risk at each time point. 24 | } 25 | \item{scale}{scales the coefficients. 26 | For some data sets, the coefficients of the Aalen model will be very 27 | small (10-4); this simply multiplies the printed values by a constant, 28 | say 1e6, to make the printout easier to read.} 29 | \item{\dots}{for future methods} 30 | } 31 | \value{ 32 | the calling argument is returned. 33 | } 34 | \section{Side Effects}{ 35 | the results of the fit are displayed. 36 | } 37 | \details{ 38 | The estimated increments in the coefficient estimates can become quite 39 | unstable near the end of follow-up, due to the small number of observations 40 | still at risk in a data set. 41 | Thus, the test for slope will sometimes be more powerful if this last 42 | `tail' is excluded. 43 | } 44 | \section{References}{ 45 | Aalen, O.O. (1989). A linear regression model for the analysis of life times. 46 | Statistics in Medicine, 8:907-925. 47 | } 48 | \seealso{ 49 | aareg 50 | } 51 | \keyword{survival} 52 | % docclass is function 53 | % Converted by Sd2Rd version 37351. 54 | -------------------------------------------------------------------------------- /man/print.summary.coxph.Rd: -------------------------------------------------------------------------------- 1 | \name{print.summary.coxph} 2 | \alias{print.summary.coxph} 3 | \title{ 4 | Print method for summary.coxph objects 5 | } 6 | \description{ 7 | Produces a printed summary of a fitted coxph model 8 | } 9 | \usage{ 10 | \method{print}{summary.coxph}(x, digits=max(getOption("digits") - 3, 3), 11 | signif.stars = getOption("show.signif.stars"), expand=FALSE, ...) 12 | } 13 | \arguments{ 14 | \item{x}{ 15 | the result of a call to \code{summary.coxph} 16 | } 17 | \item{digits}{significant digits to print} 18 | \item{signif.stars}{ 19 | Show stars to highlight small p-values 20 | } 21 | \item{expand}{if the summary is for a multi-state coxph fit, print the 22 | results in an expanded format.} 23 | \item{\dots}{For future methods} 24 | } 25 | -------------------------------------------------------------------------------- /man/print.summary.survexp.Rd: -------------------------------------------------------------------------------- 1 | \name{print.summary.survexp} 2 | \alias{print.summary.survexp} 3 | \title{Print Survexp Summary} 4 | \description{ 5 | Prints the results of \code{summary.survexp} 6 | } 7 | \usage{ 8 | \method{print}{summary.survexp}(x, digits = max(options()$digits - 4, 3), ...) 9 | } 10 | \arguments{ 11 | \item{x}{ 12 | an object of class \code{summary.survexp}. 13 | } 14 | \item{digits}{ 15 | the number of digits to use in printing the result. 16 | } 17 | \item{\dots}{for future methods} 18 | } 19 | \value{ 20 | \code{x}, with the invisible flag set to prevent further printing. 21 | } 22 | \author{Terry Therneau} 23 | \seealso{\code{link{summary.survexp}}, \code{\link{survexp}}} 24 | \keyword{ survival } 25 | 26 | -------------------------------------------------------------------------------- /man/print.summary.survfit.Rd: -------------------------------------------------------------------------------- 1 | \name{print.summary.survfit} 2 | \alias{print.summary.survfit} 3 | \title{ 4 | Print Survfit Summary 5 | } 6 | \description{ 7 | Prints the result of \code{summary.survfit}. 8 | } 9 | \usage{ 10 | \method{print}{summary.survfit}(x, digits = max(options() $digits-4, 3), ...) 11 | } 12 | \arguments{ 13 | \item{x}{ 14 | an object of class \code{"summary.survfit"}, which is the result of the 15 | \code{summary.survfit} function. 16 | } 17 | \item{digits}{ 18 | the number of digits to use in printing the numbers. 19 | } 20 | \item{\dots}{for future methods} 21 | } 22 | \value{ 23 | \code{x}, with the invisible flag set to prevent printing. 24 | } 25 | \section{Side Effects}{ 26 | prints the summary created by \code{summary.survfit}. 27 | } 28 | \seealso{ 29 | \code{\link{options}}, \code{\link{print}}, \code{\link{summary.survfit}}. 30 | } 31 | \keyword{print} 32 | % docclass is function 33 | % Converted by Sd2Rd version 37351. 34 | -------------------------------------------------------------------------------- /man/ratetable.Rd: -------------------------------------------------------------------------------- 1 | \name{ratetable} 2 | \alias{ratetable} 3 | \title{Allow ratetable() terms in a model} 4 | \description{This function supports ratetable() terms in a model 5 | statement, within survexp and pyears. 6 | } 7 | \usage{ 8 | ratetable(...) 9 | } 10 | \arguments{ 11 | \item{\dots}{the named dimensions of a rate table} 12 | } 13 | \details{ 14 | This way of mapping a rate table's variable names to a user data frame 15 | has been superseded, instead use the \code{rmap} argument of the 16 | survexp, pyears, or survdiff routines. The function remains only to 17 | allow older code to be run. 18 | } 19 | \author{Terry Therneau} 20 | \keyword{survival} 21 | -------------------------------------------------------------------------------- /man/ratetableDate.Rd: -------------------------------------------------------------------------------- 1 | \name{ratetableDate} 2 | \alias{ratetableDate} 3 | \title{Convert date objects to ratetable form} 4 | \description{ 5 | This method converts dates from various forms into 6 | the internal form used in \code{ratetable} objects. 7 | } 8 | \usage{ 9 | ratetableDate(x) 10 | } 11 | \arguments{ 12 | \item{x}{a date. The function currently has methods for Date, date, 13 | POSIXt, timeDate, and chron objects. 14 | } 15 | } 16 | \details{ 17 | This function is useful for those who create new ratetables, but is 18 | normally invisible to users. 19 | It is used internally by the \code{survexp} and \code{pyears} 20 | functions to map the various date formats; if a new method is added 21 | then those routines will automatically be adapted to the new date type. 22 | } 23 | \value{a numeric vector, the number of days since 1/1/1960.} 24 | \author{Terry Therneau} 25 | \seealso{\code{\link{pyears}}, \code{\link{survexp}}} 26 | \keyword{survival} 27 | 28 | -------------------------------------------------------------------------------- /man/rats.Rd: -------------------------------------------------------------------------------- 1 | \name{rats} 2 | \alias{rats} 3 | \docType{data} 4 | \title{Rat treatment data from Mantel et al} 5 | \description{Rat treatment data from Mantel et al. 6 | Three rats were chosen from each of 100 litters, one of which was 7 | treated with a drug, and then all followed for tumor incidence. 8 | } 9 | \usage{rats 10 | data(cancer, package="survival") 11 | } 12 | \format{ 13 | \tabular{ll}{ 14 | litter:\tab litter number from 1 to 100\cr 15 | rx:\tab treatment,(1=drug, 0=control) \cr 16 | time:\tab time to tumor or last follow-up\cr 17 | status:\tab event status, 1=tumor and 0=censored\cr 18 | sex:\tab male or female 19 | } 20 | } 21 | \source{ 22 | N. Mantel, N. R. Bohidar and J. L. Ciminera. 23 | Mantel-Haenszel analyses of litter-matched time to response data, 24 | with modifications for recovery of interlitter information. 25 | Cancer Research, 37:3863-3868, 1977. 26 | } 27 | \references{ 28 | E. W. Lee, L. J. Wei, and D. Amato, 29 | Cox-type regression analysis for large number of small groups of 30 | correlated failure time observations, 31 | in "Survival Analysis, State of the Art", Kluwer, 1992. 32 | } 33 | \note{Since only 2/150 of the male rats have a tumor, most analyses use 34 | only females (odd numbered litters), e.g. Lee et al.} 35 | \keyword{survival} 36 | \keyword{datasets} 37 | -------------------------------------------------------------------------------- /man/rats2.Rd: -------------------------------------------------------------------------------- 1 | \name{rats2} 2 | \alias{rats2} 3 | \docType{data} 4 | \title{Rat data from Gail et al.} 5 | \description{48 rats were injected with a carcinogen, and then 6 | randomized to either drug or placebo. The number of tumors ranges 7 | from 0 to 13; all rats were censored at 6 months after randomization. 8 | } 9 | \usage{rats2 10 | data(cancer, package="survival") 11 | } 12 | \format{ 13 | \tabular{ll}{ 14 | rat:\tab id\cr 15 | trt:\tab treatment,(1=drug, 0=control) \cr 16 | observation:\tab within rat\cr 17 | start:\tab entry time\cr 18 | stop:\tab exit time\cr 19 | status:\tab event status, 1=tumor, 0=censored\cr 20 | } 21 | } 22 | \source{ 23 | MH Gail, TJ Santner, and CC Brown (1980), 24 | An analysis of comparative carcinogenesis experiments based on 25 | multiple times to tumor. 26 | \emph{Biometrics} \bold{36}, 255--266. 27 | } 28 | \keyword{survival} 29 | \keyword{datasets} 30 | -------------------------------------------------------------------------------- /man/stanford2.Rd: -------------------------------------------------------------------------------- 1 | \name{stanford2} 2 | \alias{stanford2} 3 | \docType{data} 4 | \title{More Stanford Heart Transplant data} 5 | \description{ 6 | This contains the Stanford Heart Transplant data in a different 7 | format. The main data set is in \code{\link{heart}}. 8 | } 9 | \usage{stanford2} 10 | \format{ 11 | \tabular{ll}{ 12 | id: \tab ID number\cr 13 | time:\tab survival or censoring time\cr 14 | status:\tab censoring status\cr 15 | age: \tab in years\cr 16 | t5: \tab T5 mismatch score\cr 17 | } 18 | } 19 | \seealso{ 20 | \code{\link{predict.survreg}}, 21 | \code{\link{heart}} 22 | } 23 | \source{ 24 | LA Escobar and WQ Meeker Jr (1992), 25 | Assessing influence in regression analysis with censored data. 26 | \emph{Biometrics} \bold{48}, 507--528. 27 | Page 519. 28 | } 29 | \keyword{datasets} 30 | \keyword{survival} 31 | -------------------------------------------------------------------------------- /man/strata.Rd: -------------------------------------------------------------------------------- 1 | \name{strata} 2 | \alias{strata} 3 | \title{ 4 | Identify Stratification Variables 5 | } 6 | \description{ 7 | This is a special function used in the context of the Cox survival model. 8 | It identifies stratification variables when they appear on the right hand 9 | side of a formula. 10 | } 11 | \usage{ 12 | strata(..., na.group=FALSE, shortlabel, sep=', ') 13 | } 14 | \arguments{ 15 | \item{\dots}{ 16 | any number of variables. All must be the same length. 17 | } 18 | \item{na.group}{ 19 | a logical variable, if \code{TRUE}, then missing values are treated as a 20 | distinct level of each variable. 21 | } 22 | \item{shortlabel}{if \code{TRUE} omit variable names from resulting 23 | factor labels. The default action is to omit the names if all of the 24 | arguments are factors, and none of them was named.} 25 | \item{sep}{ 26 | the character used to separate groups, in the created label 27 | } 28 | } 29 | \value{ 30 | a new factor, whose levels are all possible combinations of the factors 31 | supplied as arguments. 32 | } 33 | \details{ 34 | When used outside of a \code{coxph} formula the result of the function 35 | is essentially identical to the \code{interaction} function, 36 | though the labels from \code{strata} are often more verbose. 37 | } 38 | \seealso{ 39 | \code{\link{coxph}}, \code{\link{interaction}} 40 | } 41 | \examples{ 42 | a <- factor(rep(1:3,4), labels=c("low", "medium", "high")) 43 | b <- factor(rep(1:4,3)) 44 | levels(strata(b)) 45 | levels(strata(a,b,shortlabel=TRUE)) 46 | 47 | coxph(Surv(futime, fustat) ~ age + strata(rx), data=ovarian) 48 | } 49 | \keyword{survival} 50 | -------------------------------------------------------------------------------- /man/summary.survexp.Rd: -------------------------------------------------------------------------------- 1 | \name{summary.survexp} 2 | \alias{summary.survexp} 3 | \title{Summary function for a survexp object} 4 | \description{ 5 | Returns a list containing the values of the survival at 6 | specified times. 7 | } 8 | \usage{ 9 | \method{summary}{survexp}(object, times, scale = 1, ...) 10 | } 11 | \arguments{ 12 | \item{object}{ 13 | the result of a call to the \code{survexp} function 14 | } 15 | \item{times}{ 16 | vector of times; 17 | the returned matrix will contain 1 row for each time. 18 | Missing values are not allowed. 19 | } 20 | \item{scale}{ 21 | numeric value to rescale the survival time, e.g., if the input data to 22 | \code{survfit} were in 23 | days, \code{scale = 365.25} would scale the output to years. 24 | } 25 | \item{\dots}{For future methods} 26 | } 27 | \details{ 28 | A primary use of this function is to retrieve survival at fixed time 29 | points, which will be properly interpolated by the function. 30 | } 31 | \value{ 32 | a list with the following components: 33 | 34 | \item{surv}{ 35 | the estimate of survival at time t. 36 | } 37 | \item{time}{ 38 | the timepoints on the curve. 39 | } 40 | \item{n.risk}{ 41 | In expected survival each subject from the data set is matched to a 42 | hypothetical person from the parent population, matched on the 43 | characteristics of the parent population. 44 | The number at risk is the number of those hypothetical 45 | subject who are still part of the calculation. 46 | } 47 | } 48 | \author{Terry Therneau} 49 | \seealso{\code{\link{survexp}} 50 | } 51 | % Add one or more standard keywords, see file 'KEYWORDS' in the 52 | % R documentation directory. 53 | \keyword{ survival } 54 | -------------------------------------------------------------------------------- /man/survival-deprecated.Rd: -------------------------------------------------------------------------------- 1 | \name{survival-deprecated} 2 | \alias{survival-deprecated} 3 | \alias{survConcordance} 4 | \alias{survConcordance.fit} 5 | \title{Deprecated functions in package \pkg{survival}} 6 | \description{ 7 | These functions are temporarily retained for compatability with older programs, 8 | and may transition to defunct status. 9 | } 10 | \usage{ 11 | survConcordance(formula, data, weights, subset, na.action) # use concordance 12 | survConcordance.fit(y, x, strata, weight) # use concordancefit 13 | } 14 | \arguments{ 15 | \item{formula}{ 16 | a formula object, with the response on the left of a \code{~} operator, and 17 | the terms on the right. The response must be a survival object as 18 | returned by the \code{Surv} function. 19 | } 20 | \item{data}{a data frame 21 | } 22 | \item{weights,subset,na.action}{as for \code{coxph}} 23 | \item{x, y, strata, weight}{predictor, response, strata, and weight 24 | vectors for the direct call} 25 | } 26 | \seealso{ 27 | \code{\link{Deprecated}} 28 | } 29 | \keyword{survival} -------------------------------------------------------------------------------- /man/survreg.control.Rd: -------------------------------------------------------------------------------- 1 | \name{survreg.control} 2 | \alias{survreg.control} 3 | %- Also NEED an `\alias' for EACH other topic documented here. 4 | \title{Package options for survreg and coxph} 5 | \description{ 6 | This functions checks and packages the fitting options for 7 | \code{\link{survreg}} 8 | } 9 | \usage{ 10 | survreg.control(maxiter=30, rel.tolerance=1e-09, 11 | toler.chol=1e-10, iter.max, debug=0, outer.max=10) 12 | 13 | } 14 | %- maybe also `usage' for other objects documented here. 15 | \arguments{ 16 | \item{maxiter}{maximum number of iterations } 17 | \item{rel.tolerance}{relative tolerance to declare convergence } 18 | \item{toler.chol}{Tolerance to declare Cholesky decomposition singular} 19 | \item{iter.max}{same as \code{maxiter}} 20 | \item{debug}{print debugging information} 21 | \item{outer.max}{maximum number of outer iterations for choosing 22 | penalty parameters} 23 | } 24 | \value{ 25 | A list with the same elements as the input 26 | } 27 | 28 | \seealso{ \code{\link{survreg}}} 29 | \keyword{survival} 30 | 31 | -------------------------------------------------------------------------------- /man/survregDtest.Rd: -------------------------------------------------------------------------------- 1 | \name{survregDtest} 2 | \alias{survregDtest} 3 | \title{Verify a survreg distribution} 4 | \description{ 5 | This routine is called by \code{survreg} to verify that a distribution 6 | object is valid. 7 | } 8 | \usage{ 9 | survregDtest(dlist, verbose = F) 10 | } 11 | %- maybe also 'usage' for other objects documented here. 12 | \arguments{ 13 | \item{dlist}{the list describing a survival distribution} 14 | \item{verbose}{return a simple TRUE/FALSE from the test for validity 15 | (the default), or a verbose description of any flaws.} 16 | } 17 | \details{ 18 | If the \code{survreg} function rejects your user-supplied distribution 19 | as invalid, this routine will tell you why it did so. 20 | } 21 | \value{ 22 | TRUE if the distribution object passes the tests, and either FALSE or a 23 | vector of character strings if not. 24 | } 25 | \author{Terry Therneau} 26 | \seealso{\code{\link{survreg.distributions}}, \code{\link{survreg}}} 27 | \examples{ 28 | # An invalid distribution (it should have "init =" on line 2) 29 | # surveg would give an error message 30 | mycauchy <- list(name='Cauchy', 31 | init<- function(x, weights, ...) 32 | c(median(x), mad(x)), 33 | density= function(x, parms) { 34 | temp <- 1/(1 + x^2) 35 | cbind(.5 + atan(temp)/pi, .5+ atan(-temp)/pi, 36 | temp/pi, -2 *x*temp, 2*temp^2*(4*x^2*temp -1)) 37 | }, 38 | quantile= function(p, parms) tan((p-.5)*pi), 39 | deviance= function(...) stop('deviance residuals not defined') 40 | ) 41 | 42 | survregDtest(mycauchy, TRUE) 43 | } 44 | \keyword{survival} 45 | -------------------------------------------------------------------------------- /man/tcut.Rd: -------------------------------------------------------------------------------- 1 | \name{tcut} 2 | \alias{tcut} 3 | \alias{[.tcut} 4 | \alias{levels.tcut} 5 | \title{Factors for person-year calculations} 6 | \description{ 7 | Attaches categories for person-year calculations to a variable without 8 | losing the underlying continuous representation 9 | } 10 | \usage{ 11 | tcut(x, breaks, labels, scale=1) 12 | \method{levels}{tcut}(x) 13 | } 14 | \arguments{ 15 | \item{x}{numeric/date variable } 16 | \item{breaks}{breaks between categories, which are right-continuous } 17 | \item{labels}{labels for categories } 18 | \item{scale}{Multiply \code{x} and \code{breaks} by this.} 19 | } 20 | 21 | \value{ 22 | An object of class \code{tcut} 23 | } 24 | 25 | \seealso{ \code{\link{cut}}, \code{\link{pyears}} } 26 | 27 | \examples{ 28 | # For pyears, all time variable need to be on the same scale; but 29 | # futime is in months and age is in years 30 | test <- mgus2 31 | test$years <- test$futime/30.5 # follow-up in years 32 | 33 | # first grouping based on years from starting age (= current age) 34 | # second based on years since enrollment (all start at 0) 35 | test$agegrp <- tcut(test$age, c(0,60, 70, 80, 100), 36 | c("<=60", "60-70", "70-80", ">80")) 37 | test$fgrp <- tcut(rep(0, nrow(test)), c(0, 1, 5, 10, 100), 38 | c("0-1yr", "1-5yr", "5-10yr", ">10yr")) 39 | 40 | # death rates per 1000, by age group 41 | pfit1 <- pyears(Surv(years, death) ~ agegrp, scale =1000, data=test) 42 | round(pfit1$event/ pfit1$pyears) 43 | 44 | #death rates per 100, by follow-up year and age 45 | # there are excess deaths in the first year, within each age stratum 46 | pfit2 <- pyears(Surv(years, death) ~ fgrp + agegrp, scale =1000, data=test) 47 | round(pfit2$event/ pfit2$pyears) 48 | } 49 | \keyword{survival} 50 | 51 | -------------------------------------------------------------------------------- /man/tobin.Rd: -------------------------------------------------------------------------------- 1 | \name{tobin} 2 | \alias{tobin} 3 | \docType{data} 4 | \title{Tobin's Tobit data} 5 | \description{ 6 | Economists fit a parametric censored data model called the 7 | \sQuote{tobit}. These data are from Tobin's original paper. 8 | } 9 | \usage{tobin 10 | data(tobin, package="survival") 11 | } 12 | \format{ 13 | A data frame with 20 observations on the following 3 variables. 14 | \describe{ 15 | \item{durable}{Durable goods purchase} 16 | \item{age}{Age in years} 17 | \item{quant}{Liquidity ratio (x 1000)} 18 | } 19 | } 20 | \source{ 21 | J Tobin (1958), 22 | Estimation of relationships for limited dependent variables. 23 | \emph{Econometrica} \bold{26}, 24--36. 24 | } 25 | \examples{ 26 | tfit <- survreg(Surv(durable, durable>0, type='left') ~age + quant, 27 | data=tobin, dist='gaussian') 28 | 29 | predict(tfit,type="response") 30 | 31 | } 32 | \keyword{datasets} 33 | -------------------------------------------------------------------------------- /man/untangle.specials.Rd: -------------------------------------------------------------------------------- 1 | \name{untangle.specials} 2 | \alias{untangle.specials} 3 | \title{ 4 | Help Process the `specials' Argument of the `terms' Function. 5 | } 6 | \description{ 7 | Given a \code{terms} structure and a desired special name, this returns an 8 | index appropriate for subscripting the \code{terms} structure and another 9 | appropriate for the data frame. 10 | } 11 | \usage{ 12 | untangle.specials(tt, special, order=1) 13 | } 14 | \arguments{ 15 | \item{tt}{ 16 | a \code{terms} object. 17 | } 18 | \item{special}{ 19 | the name of a special function, presumably used in the terms object. 20 | } 21 | \item{order}{ 22 | the order of the desired terms. If set to 2, interactions with the special 23 | function will be included. 24 | }} 25 | \value{ 26 | a list with two components: 27 | \item{vars}{ 28 | a vector of variable names, as would be found in the data frame, of the 29 | specials. 30 | } 31 | \item{terms}{ 32 | a numeric vector, suitable for subscripting the terms structure, that indexes 33 | the terms in the expanded model formula which involve the special. 34 | }} 35 | \examples{ 36 | formula <- Surv(tt,ss) ~ x + z*strata(id) 37 | tms <- terms(formula, specials="strata") 38 | ## the specials attribute 39 | attr(tms, "specials") 40 | ## main effects 41 | untangle.specials(tms, "strata") 42 | ## and interactions 43 | untangle.specials(tms, "strata", order=1:2) 44 | } 45 | \keyword{survival} 46 | % Converted by Sd2Rd version 0.3-2. 47 | -------------------------------------------------------------------------------- /man/uspop2.Rd: -------------------------------------------------------------------------------- 1 | \name{uspop2} 2 | \alias{uspop2} 3 | \docType{data} 4 | \title{Projected US Population} 5 | \description{US population by age and sex, for 2000 through 2020} 6 | \format{ 7 | The data is a matrix with dimensions age, sex, and calendar year. 8 | Age goes from 0 through 100, where the value for age 100 is the total 9 | for all ages of 100 or greater. 10 | } 11 | \details{ This data is often used as a "standardized" population for 12 | epidemiology studies.} 13 | 14 | \source{ 15 | NP2008_D1: Projected Population by Single Year of Age, Sex, Race, and Hispanic 16 | Origin for the United States: July 1, 2000 to July 1, 2050, 17 | www.census.gov/population/projections. 18 | } 19 | \examples{ 20 | us50 <- uspop2[51:101,, "2000"] #US 2000 population, 50 and over 21 | age <- as.integer(dimnames(us50)[[1]]) 22 | smat <- model.matrix( ~ factor(floor(age/5)) -1) 23 | ustot <- t(smat) \%*\% us50 #totals by 5 year age groups 24 | temp <- c(50,55, 60, 65, 70, 75, 80, 85, 90, 95) 25 | dimnames(ustot) <- list(c(paste(temp, temp+4, sep="-"), "100+"), 26 | c("male", "female")) 27 | } 28 | \seealso{\code{\link{uspop}}} 29 | \keyword{datasets} 30 | -------------------------------------------------------------------------------- /man/vcov.coxph.Rd: -------------------------------------------------------------------------------- 1 | \name{vcov.coxph} 2 | \alias{vcov.coxph} 3 | \alias{vcov.survreg} 4 | \title{Variance-covariance matrix} 5 | \description{Extract and return the variance-covariance matrix.} 6 | \usage{ 7 | \method{vcov}{coxph}(object, complete=TRUE, ...) 8 | \method{vcov}{survreg}(object, complete=TRUE, ...) 9 | } 10 | \arguments{ 11 | \item{object}{a fitted model object} 12 | \item{complete}{logical indicating if the full variance-covariance 13 | matrix should be returned. This has an effect only for an 14 | over-determined fit where some of the coefficients are undefined, 15 | and \code{coef(object)} contains corresponding NA values. 16 | If \code{complete=TRUE} the returned matrix will have row/column for 17 | each coefficient, if FALSE it will contain rows/columns 18 | corresponding to the non-missing coefficients. 19 | The coef() function has a simpilar \code{complete} argument. 20 | } 21 | \item{\ldots}{additional arguments for method functions} 22 | } 23 | \value{a matrix} 24 | \details{ 25 | For the \code{coxph} and \code{survreg} functions the returned matrix 26 | is a particular generalized inverse: the row and column corresponding 27 | to any NA coefficients will be zero. This is a side effect of the 28 | generalized cholesky decomposion used in the unerlying compuatation. 29 | } 30 | \keyword{survival} 31 | 32 | -------------------------------------------------------------------------------- /man/veteran.Rd: -------------------------------------------------------------------------------- 1 | \name{veteran} 2 | \alias{veteran} 3 | \docType{data} 4 | \title{Veterans' Administration Lung Cancer study} 5 | \description{Randomised trial of two treatment regimens for lung cancer. 6 | This is a standard survival analysis data set.} 7 | \usage{veteran 8 | data(cancer, package="survival") 9 | } 10 | \format{ 11 | \tabular{ll}{ 12 | trt:\tab 1=standard 2=test\cr 13 | celltype:\tab 1=squamous, 2=smallcell, 3=adeno, 4=large\cr 14 | time:\tab survival time\cr 15 | status:\tab censoring status\cr 16 | karno:\tab Karnofsky performance score (100=good)\cr 17 | diagtime:\tab months from diagnosis to randomisation\cr 18 | age:\tab in years\cr 19 | prior:\tab prior therapy 0=no, 10=yes\cr 20 | } 21 | } 22 | \source{ 23 | D Kalbfleisch and RL Prentice (1980), 24 | \emph{The Statistical Analysis of Failure Time Data}. 25 | Wiley, New York. 26 | } 27 | \keyword{datasets} 28 | -------------------------------------------------------------------------------- /man/xtfrm.Surv.Rd: -------------------------------------------------------------------------------- 1 | \name{xtfrm.Surv} 2 | \alias{xtfrm.Surv} 3 | \alias{sort.Surv} 4 | \alias{order.Surv} 5 | \title{Sorting order for Surv objects} 6 | \description{ 7 | Sort survival objects into a partial order, which is the same one 8 | used internally for many of the calculations. 9 | } 10 | \usage{ 11 | \method{xtfrm}{Surv}(x) 12 | } 13 | \arguments{ 14 | \item{x}{a \code{Surv} object} 15 | } 16 | \details{ 17 | This creates a partial ordering of survival objects. 18 | The result is sorted in time order, for tied pairs of times right censored 19 | events come after observed events (censor after death), and left 20 | censored events are sorted before observed events. 21 | For counting process data \code{(tstart, tstop, status)} the ordering 22 | is by stop time, status, and start time, again with censoring last. 23 | Interval censored data is sorted using the midpoint of each interval. 24 | 25 | The \code{xtfrm} routine is used internally by \code{order} and 26 | \code{sort}, so these results carry over to those routines. 27 | } 28 | \value{a vector of integers which will have the same sort order as 29 | \code{x}. 30 | } 31 | \author{Terry Therneau} 32 | \seealso{\code{\link{sort}}, \code{\link{order}}} 33 | \examples{ 34 | test <- c(Surv(c(10, 9,9, 8,8,8,7,5,5,4), rep(1:0, 5)), Surv(6.2, NA)) 35 | test 36 | sort(test) 37 | } 38 | \keyword{survival} 39 | 40 | -------------------------------------------------------------------------------- /man/yates_setup.Rd: -------------------------------------------------------------------------------- 1 | \name{yates_setup} 2 | \alias{yates_setup} 3 | \title{Method for adding new models to the \code{yates} function. 4 | } 5 | \description{This is a method which is called by the \code{yates} 6 | function, in order to setup the code to handle a particular 7 | model type. Methods for glm, coxph, and default are part of 8 | the survival package. 9 | } 10 | \usage{ 11 | yates_setup(fit, \ldots) 12 | } 13 | %- maybe also 'usage' for other objects documented here. 14 | \arguments{ 15 | \item{fit}{a fitted model object} 16 | 17 | \item{\ldots}{optional arguments for some methods} 18 | } 19 | \details{ 20 | If the predicted value should be the linear predictor, the function 21 | should return NULL. The \code{yates} routine has particularly efficient 22 | code for this case. 23 | Otherwise it should return a prediction function or a list of two 24 | elements containing the prediction function and a summary function. 25 | The prediction function will be passed the linear predictor as a single 26 | argument and should return a vector of predicted values. 27 | } 28 | 29 | \author{Terry Therneau} 30 | \note{See the vignette on population prediction for more details.} 31 | \seealso{ 32 | \code{\link{yates}} 33 | } 34 | \keyword{ models } 35 | \keyword{ survival } 36 | -------------------------------------------------------------------------------- /noweb/Readme: -------------------------------------------------------------------------------- 1 | Some portions of the survival package have been written using the literate 2 | programming paradym. These are contained here, and have a .Rnw suffix. 3 | Long term, the plan is to have all of the code source here to maximize 4 | the documentation, and through it the reliability of the package. 5 | 6 | These files are processed using the noweb package, NOT by Sweave or knitr. 7 | The purpose of the latter two is to create reports that interweave text and 8 | exectuted results. The noweb package documents and writes out source code 9 | for functions. Use "make fun" to create the objects in ../R. (If you 10 | don't, changes here will have no effect on the final pacakge.) 11 | 12 | The file code.pdf is documentation for understanding the code, 13 | not how to use the survival functions for data analysis. For those who 14 | maintain the code it will be a big help, for everyone else I'd expect 15 | it to be boring. To create code.pdf type "make doc". 16 | 17 | Any .Rnw files that are not yet included in the Makefile are works in progress. 18 | 19 | A note on style: I prefer to use smaller "chunks" of code in my editor, and so 20 | this is broken up into a lot of pieces. That is neither right nor wrong, just 21 | my preference. Similarly, the Makefile creates many different .R files in the 22 | ../R directory. We could have a much simpler Makefile that created a single 23 | large "code.R" file, but I tend to add cat() and browser() calls to the .R when 24 | debugging, rather than the .Rnw, so I like smaller files there too. 25 | 26 | Terry Therneau 27 | -------------------------------------------------------------------------------- /noweb/noweb.sty: -------------------------------------------------------------------------------- 1 | % 2 | % The format files for the noweave package 3 | % It looks like a short form of Sweave.sty 4 | % 5 | \NeedsTeXFormat{LaTeX2e} 6 | \RequirePackage{fancyvrb,hyperref} 7 | %forward, backward, and both hyperlinks 8 | % nwhypf{my label}{text to put here}{label of forward link} 9 | % nwhypb{my label}{text to put here}{label of backwards link} 10 | % nwhyp {my label}{text to put here}{label of backwards link}{forward link label} 11 | \newcommand{\nwhypf}[3]{\hypertarget{#1}{$\langle$\textit{#2}}\hyperlink{#3}{$\rangle$}} 12 | \newcommand{\nwhypb}[3]{\hyperlink{#3}{$\langle$}\hypertarget{#1}{\textit{#2}$\rangle$}} 13 | \newcommand{\nwhyp}[4]{\hyperlink{#3}{$\langle$}\hypertarget{#1}{\textit{#2}}\hyperlink{#4}{$\rangle$}} 14 | % no hyperlink code reference 15 | \newcommand{\nwhypn}[1]{$\langle$\textit{#1}$\rangle$} 16 | % dummy out noweboptions, in case someone used them (they are part 17 | % of Ramsay's standalone version 18 | \newcommand{\noweboptions}[1]{} 19 | % The standard font for ~ used in formulas is ugly, redefine it 20 | % to the math mode symbol by making use of an active charcter trick 21 | % Leave the \, {, and } characters active 22 | %\newcommand{\twiddle}{\ensuremath{\sim}} 23 | \newcommand{\twiddle}{\textasciitilde} 24 | \DefineVerbatimEnvironment{nwchunk}{Verbatim}{commandchars=\\\{\},% 25 | codes={\catcode`~=\active},defineactive=\def~{\twiddle}} 26 | -------------------------------------------------------------------------------- /noweb/rates/usinfant.dat: -------------------------------------------------------------------------------- 1 | year,period,total.m, total.f, white.m, white.f, black.m, black.f 2 | 1999,0-24 hrs,6116 ,5045 ,3820 ,3158 ,2100 ,1691 3 | 1999,1-6 d,2140 ,1588 ,1507 ,1116 ,574 ,411 4 | 1999,7-27 d,2099 ,1740 ,1407 ,1156 ,623 ,521 5 | 1999,28-365 d,5291 ,3918 ,3463 ,2440 ,1600 ,1302 6 | 2000,0-24 hrs,6118 ,4985 ,3811 ,3147 ,2076 ,1655 7 | 2000,1-6 d,2243 ,1567 ,1549 ,1100 ,589 ,410 8 | 2000,7-27 d,2150 ,1713 ,1453 ,1141 ,620 ,493 9 | 2000,28-365 d,5207 ,4052 ,3364 ,2579 ,1616 ,1312 10 | 2001,0-24 hrs,6122 ,4776 ,3859 ,3052 ,2047 ,1559 11 | 2001,1-6 d,2139 ,1574 ,1513 ,1092 ,558 ,420 12 | 2001,7-27 d,1976 ,1678 ,1378 ,1119 ,520 ,481 13 | 2001,28-365 d,5240 ,4063 ,3349 ,2593 ,1639 ,1274 14 | 2002,0-24 hrs,6303 ,5063 ,4008 ,3198 ,2042 ,1661 15 | 2002,1-6 d,2050 ,1588 ,1497 ,1092 ,476 ,433 16 | 2002,7-27 d,2055 ,1688 ,1436 ,1123 ,536 ,498 17 | 2002,28-365 d,5309 ,3978 ,3492 ,2523 ,1598 ,1280 18 | 2003,0-24 hrs,6387 ,5082 ,4110 ,3295 ,2034 ,1581 19 | 2003,1-6 d,2123 ,1541 ,1503 ,1101 ,533 ,372 20 | 2003,7-27 d,2126 ,1634 ,1432 ,1054 ,607 ,513 21 | 2003,28-365 d,5266 ,3866 ,3455 ,2490 ,1566 ,1196 22 | 2004,0-24 hrs,6472 ,4974 ,4054 ,3169 ,2003 ,1575 23 | 2004,1-6 d,1826 ,1582 ,1421 ,1087 ,488 ,432 24 | 2004,7-27 d,2092 ,1647 ,1365 ,1102 ,633 ,491 25 | 2004,28-365 d,5328 ,4015 ,3425 ,2608 ,1645 ,1227 26 | 2005,"0-24 hrs",6212,5145,3884,3283,2059,1669 27 | 2005,"1-6 d",2129,1526,1497,1074,540,381 28 | 2005,"7-28 d",2103,1655,1415,1086,602,489 29 | 2005,"28-365 d",5574,4096,3675,2600,1666,1289 30 | 2006,"0-24 hrs",6331,5063,3996,3170,2061,1685 31 | 2006,"1-6 d",2041,1668,1440,1148,504,448 32 | 2006,"7-28 d",2192,1694,1427,1121,659,519 33 | 2006,"28-365 d",5416,4122,3482,2619,1662,1320 34 | 2007,"0-24 hrs",6346,5124,3971,3232,2089,1654 35 | 2007,"1-6 d",2061,1562,1423,1096,530,390 36 | 2007,"7-28 d",2180,1785,1451,1160,637,542 37 | 2007,"28-365 d",5706,4374,3695,2779,1719,1383 38 | -------------------------------------------------------------------------------- /noweb/tail: -------------------------------------------------------------------------------- 1 | \bibliographystyle{plain} 2 | \bibliography{refer} 3 | \end{document} 4 | -------------------------------------------------------------------------------- /src/agsurv4.c: -------------------------------------------------------------------------------- 1 | /* 2 | ** Compute the Kalbfleisch-Prentice estimate of a Cox model survival curve. 3 | ** This is not the default computation, so I don't worry about making the 4 | ** simple bisection solution below at all fast. 5 | ** See survival:Kalbfleisch-Prentice in the methods document 6 | */ 7 | #include "survS.h" 8 | #include "survproto.h" 9 | 10 | void agsurv4(int *ndeath, double *risk, double *wt, 11 | int *sn, double *denom, double *km) 12 | { 13 | int i,j,k, l; 14 | int n; /* number of unique death times */ 15 | double sumt, guess, inc; 16 | 17 | n = *sn; 18 | j =0; 19 | for (i=0; i0) { 27 | matrix[i][i] = 1/matrix[i][i]; /*this line inverts D */ 28 | for (j= (i+1); j 24 | int cholesky2(double **matrix, int n, double toler) 25 | { 26 | double temp; 27 | int i,j,k; 28 | double eps, pivot; 29 | int rank; 30 | int nonneg; 31 | 32 | nonneg=1; 33 | eps =0; 34 | for (i=0; i eps) eps = matrix[i][i]; 36 | for (j=(i+1); j=0; i--) { 35 | if (matrix[i][i]==0) y[i] =0; 36 | else { 37 | temp = y[i]/matrix[i][i]; 38 | for (j= i+1; j=0; i--) { 41 | if (matrix[i][i+m]==0) y[i+m] =0; 42 | else { 43 | temp = y[i+m]/matrix[i][i+m]; 44 | for (j= i+1; j=0; i--) { 51 | if (diag[i] == 0) y[i] =0; 52 | else { 53 | temp = y[i] / diag[i]; 54 | for (j=0; j 21 | 22 | void chsolve5(double **matrix, int n, double *y, int flag) { 23 | int i,j; 24 | double temp; 25 | 26 | /* 27 | ** solve L'z =y, 28 | */ 29 | if (flag <2) { 30 | for (i=0; i0) { 38 | /* 39 | ** solve D^{1/2}b =z 40 | */ 41 | for (i=0; i=0; i--) { 57 | temp = y[i]; 58 | for (j= i+1; j 15 | #include "survS.h" 16 | #include "survproto.h" 17 | 18 | SEXP collapse(SEXP y2, SEXP x2, SEXP istate2, SEXP id2, SEXP wt2, 19 | SEXP order2) { 20 | int i, j, k, k1, k2, n; 21 | 22 | double *time1, *time2, *status, *wt; 23 | int *istate, *id, *order, *x; 24 | int *i1, *i2; /* start and stop pointers */ 25 | SEXP outmat; 26 | 27 | n = LENGTH(istate2); 28 | time1 = REAL(y2); 29 | time2 = time1 + n; 30 | status = time2 + n; 31 | x = INTEGER(x2); 32 | istate = INTEGER(istate2); 33 | id = INTEGER(id2); 34 | wt = REAL(wt2); 35 | order = INTEGER(order2); 36 | 37 | i1= (int *) R_alloc(2*n, sizeof(int)); 38 | i2 = i1 + n; 39 | 40 | j=0; i=0; 41 | while (i0) df++; /* count up the df */ 22 | 23 | for (i=0; i< *ntest; i++) { 24 | for (j=0; j LARGE) return(LARGE); 37 | return (x); 38 | } 39 | -------------------------------------------------------------------------------- /src/dmatrix.c: -------------------------------------------------------------------------------- 1 | /* 2 | ** set up the indices so that C code can use x[i][j] notation for R 3 | ** matrices. Remember that R sees matrices in column order and C in 4 | ** row order, so every reference in the C code will be x[col][row]. 5 | ** 6 | ** array = pointer to the data 7 | ** nrow, ncol = number of rows and colums, from R's point of view. 8 | ** 9 | ** Sometime in 2015-2018 R allowed for matrices whose total number of 10 | ** elements is > 2^31, although the numer of columns and rows must be <2^31. 11 | ** On a 64 bit machine the array variable is of type *double 12 | ** which is a 64 bit integer; using "array += nrow" rather than 13 | ** "pointer[i] = array + i*nrow" is critical to avoiding an integer 14 | ** overflow. 15 | */ 16 | #include "survS.h" 17 | #include "survproto.h" 18 | 19 | double **dmatrix(double *array, int nrow, int ncol) 20 | { 21 | int i; 22 | double **pointer; 23 | 24 | pointer = (double **) ALLOC(ncol, sizeof(double *)); 25 | for (i=0; i notused[p1]) notused[p1] =1; 41 | else notused[p1] =0; 42 | } 43 | ndeath=0; 44 | istrat++; 45 | } 46 | else { 47 | for (; j= dtime; j++) { 48 | p1 = sort1[j]; 49 | if (ndeath > notused[p1]) notused[p1] =1; 50 | else notused[p1] =0; 51 | } 52 | } 53 | ndeath += status[p2]; 54 | notused[p1] = ndeath; 55 | } 56 | 57 | for (; j notused[p1]) notused[p1] =1; 61 | else notused[p1] =0; 62 | } 63 | 64 | return(notused); 65 | } 66 | 67 | 68 | 69 | -------------------------------------------------------------------------------- /src/residcsum.c: -------------------------------------------------------------------------------- 1 | /* 2 | ** A cumulative sums for each col of a matrix, resetting to 0 at each strata 3 | ** used by the residuals.survfit routines. If there were no strata, then 4 | ** apply(y, 2, cumsum) does the same thing. 5 | */ 6 | #include "survS.h" 7 | #include "survproto.h" 8 | SEXP residcsum(SEXP y2, SEXP strata2) { 9 | int i, j; 10 | int n, nc; 11 | double *y, temp; 12 | int *strata, cstrat; /* cstrat = current strata */ 13 | SEXP csum; 14 | 15 | PROTECT(csum= duplicate(y2)); 16 | 17 | n = nrows(y2); 18 | nc = ncols(y2); 19 | y = REAL(csum); 20 | strata = INTEGER(strata2); 21 | 22 | for (j=0; j 8 | 9 | /* 10 | ** Memory defined with ALLOC is removed automatically by S. 11 | ** That with "Calloc" I have to remove myself. Use the 12 | ** latter for objects that need to to persist between calls. 13 | */ 14 | #define ALLOC(a,b) R_alloc(a,b) 15 | #define CALLOC(a,b) R_Calloc(a,b) 16 | #define FREE(a) R_Free(a) 17 | -------------------------------------------------------------------------------- /src/survfit4.c: -------------------------------------------------------------------------------- 1 | /* 2 | ** C routine to do a small computation that is hard in Splus 3 | ** 4 | ** n = number of observations 5 | ** d = number of deaths 6 | ** x1, x2 = ingredients in the sums 7 | ** 8 | ** If d=0, then new x1 = new x2 =1 (fill in value) 9 | ** d=1, new x1 = 1/x1, 10 | ** new x2 = (1/x1)^2 11 | ** d=2, new x1 = (1/2) [ 1/x1 + 1/(x1 - x2/2)] 12 | ** new x2 = (1/2) [ same terms, squared] 13 | ** d=3 new x1 = (1/3) [ 1/x1 + 1/(x1 - x2/3) + 1/(x1 - 2*x2/3)] 14 | ** etc. 15 | */ 16 | 17 | #include "survS.h" 18 | #include "survproto.h" 19 | 20 | void survfit4(int *n, int *dd, double *x1, double *x2) { 21 | double temp, temp1, temp2; 22 | int i,j; 23 | double d; 24 | 25 | for (i=0; i< *n; i++) { 26 | d = dd[i]; 27 | if (d==0) { 28 | x1[i] =1; 29 | x2[i] =1; 30 | } 31 | else if (d==1){ 32 | temp = 1/x1[i]; 33 | x1[i] = temp; 34 | x2[i] = temp*temp; 35 | } 36 | else { 37 | temp1 = 1/x1[i]; 38 | temp2 = temp1 * temp1; 39 | for (j=1; j library(survival) 19 | > # 20 | > # Test of the clogit function, and indirectly of the exact option 21 | > # 22 | > # Data set logan has the occupation of fathers, we create a 23 | > # multinomial response 24 | > # 25 | > nresp <- length(levels(logan$occupation)) 26 | > n <- nrow(logan) 27 | > indx <- rep(1:n, nresp) 28 | > logan2 <- data.frame(logan[indx,], 29 | + id = indx, 30 | + occ2 = factor(rep(levels(logan$occupation), each=n))) 31 | > logan2$y <- (logan2$occupation == logan2$occ2) 32 | > 33 | > #We expect two NA coefficients, so ignore the warning 34 | > fit1 <- clogit(y ~ occ2 + occ2:education + occ2:race + strata(id), logan2) 35 | > 36 | > #since there is only one death per group, all methods are equal 37 | > dummy <- rep(1, nrow(logan2)) 38 | > fit2 <- coxph(Surv(dummy, y) ~ occ2 + occ2:education + occ2:race + strata(id), 39 | + logan2, method='breslow') 40 | > 41 | > all.equal(fit1$coefficients, fit2$coefficients) 42 | [1] TRUE 43 | > all.equal(fit1$loglik, fit2$loglik) 44 | [1] TRUE 45 | > all.equal(fit1$var, fit2$var) 46 | [1] TRUE 47 | > all.equal(fit1$residuals, fit2$residuals) 48 | [1] TRUE 49 | > 50 | > 51 | > proc.time() 52 | user system elapsed 53 | 0.424 0.020 0.441 54 | -------------------------------------------------------------------------------- /tests/coxsurv4.R: -------------------------------------------------------------------------------- 1 | library(survival) 2 | 3 | # Strata by covariate interactions, a case pointed out in early 2011 4 | # by Frank Harrell, which as it turns out had never been computed 5 | # correctly by any version of the package. Which shows how often this 6 | # case arises in practice. 7 | # 8 | aeq <- function(x, y, ...) all.equal(as.vector(x), as.vector(y)) 9 | fit1 <- coxph(Surv(time, status) ~ wt.loss + age*strata(sex) + strata(ph.ecog), 10 | data=lung) 11 | tdata <- data.frame(wt.loss=c(10,5,0,10, 15,20,25), 12 | age =c(50,60,50,60,70,40,21), 13 | sex =c(1,1,2,2,1,1,1), 14 | ph.ecog=c(0,0,1,1,2,2,2)) 15 | surv1 <- survfit(fit1, newdata=tdata) 16 | 17 | fit2 <- coxph(Surv(time, status) ~ wt.loss + age + I(age*0), data=lung, 18 | init=fit1$coefficients, iter=0, subset=(sex==1 & ph.ecog==0)) 19 | fit2$var <- fit1$var 20 | 21 | surv2 <- survfit(fit2, newdata=list(wt.loss=c(10,5), age=c(50,60))) 22 | s1 <- surv1[1:2] 23 | aeq(s1$surv, surv2$surv) #first a vector, second a matrix 24 | aeq(s1$std.err, surv2$std.err) 25 | aeq(s1[1]$time, surv2$time) 26 | aeq(s1[1]$n.event, surv2$n.event) 27 | 28 | fit3 <- coxph(Surv(time, status) ~ wt.loss + age + I(age*1), 29 | data=lung, init=fit1$coefficients, iter=0, 30 | subset=(sex==2 & ph.ecog==1)) 31 | fit3$var <- fit1$var 32 | surv3 <- survfit(fit3, newdata=list(wt.loss=c(0,10), age=c(50,60))) 33 | aeq(surv1[3:4]$surv, surv3$surv) 34 | aeq(surv1[3:4]$std, surv3$std) 35 | 36 | fit4 <- coxph(Surv(time, status) ~ wt.loss + age + I(age*0), 37 | data=lung, init=fit1$coefficients, iter=0, 38 | subset=(sex==1 & ph.ecog==2)) 39 | fit4$var <- fit1$var 40 | surv4 <- survfit(fit4, newdata=list(wt.loss=c(15,20,25), age=c(70,40,21))) 41 | 42 | aeq(surv1[5:7]$surv, surv4$surv) 43 | aeq(surv1[5:7]$std.err, surv4$std.err) 44 | aeq(surv1[5]$n.risk, surv4$n.risk) 45 | 46 | -------------------------------------------------------------------------------- /tests/data.interval: -------------------------------------------------------------------------------- 1 | This data set is to test interval censoring. It has 2 left censored, 14 2 | right censored, 2 exact and 8 interval censored observations, grafted onto 3 | covariates from the ovarian data set. 4 | "ltime","rtime","age","resid.ds","rx","ecog.ps" 5 | "1",NA,150,72.3315,2,1,1 6 | "2",NA,150,74.4932,2,1,1 7 | "3",146,166,66.4658,2,1,2 8 | "4",421,NA,53.3644,2,2,1 9 | "5",421,421,50.3397,2,1,1 10 | "6",448,NA,56.4301,1,1,2 11 | "7",454,474,56.937,2,2,2 12 | "8",465,485,59.8548,2,2,2 13 | "9",477,NA,64.1753,2,1,1 14 | "10",553,573,55.1781,1,2,2 15 | "11",628,648,56.7562,1,1,2 16 | "12",744,NA,50.1096,1,2,1 17 | "13",769,NA,59.6301,2,2,2 18 | "14",770,NA,57.0521,2,2,1 19 | "15",803,NA,39.2712,1,1,1 20 | "16",855,NA,43.1233,1,1,2 21 | "17",1040,NA,38.8932,2,1,2 22 | "18",1106,NA,44.6,1,1,1 23 | "19",1129,NA,53.9068,1,2,1 24 | "20",1206,NA,44.2055,2,2,1 25 | "21",1227,NA,59.589,1,2,2 26 | "22",258,278,74.5041,2,1,2 27 | "23",319,339,43.137,2,1,1 28 | "24",343,363,63.2192,1,2,2 29 | "25",375,375,64.4247,2,2,1 30 | "26",377,NA,58.3096,1,2,1 31 | -------------------------------------------------------------------------------- /tests/data.smoke: -------------------------------------------------------------------------------- 1 | 186.0 439.2 234.4 365.8 159.6 216.9 167.4 159.5 2 | 255.6 702.7 544.7 431.0 454.8 349.7 214.0 250.4 3 | 448.9 1132.4 945.2 728.8 729.4 590.2 447.3 436.6 4 | 733.7 1981.1 1177.7 1589.2 1316.5 1266.9 875.6 703.0 5 | 1119.4 3003.0 2244.9 3380.3 2374.9 1820.2 1669.1 1159.2 6 | 2070.5 4697.5 4255.3 5083.0 4485.0 3888.7 3184.3 2194.9 7 | 3675.3 7340.6 5882.4 6597.2 7707.5 4945.1 5618.0 4128.9 8 | 9 | 186.0 610.0 497.5 251.7 417.5 122.6 198.3 193.4 10 | 255.6 915.6 482.8 500.7 488.9 402.9 393.9 354.3 11 | 448.9 1391.0 1757.1 953.5 1025.8 744.0 668.5 537.8 12 | 733.7 2393.4 1578.4 1847.2 1790.1 1220.7 1100.0 993.3 13 | 1119.4 3497.9 2301.8 3776.6 2081.0 2766.4 2268.1 1230.7 14 | 2070.5 5861.3 3174.6 2974.0 3712.9 3988.8 3268.6 2468.9 15 | 3675.3 6250.0 4000.0 4424.8 7329.8 6383.0 7666.1 5048.1 16 | 17 | 18 | 125.7 225.6 0 433.9 212.0 107.2 135.9 91.0 19 | 177.3 353.8 116.8 92.1 289.5 200.9 121.3 172.1 20 | 244.8 542.8 287.4 259.5 375.9 165.8 202.2 247.2 21 | 397.7 858.0 1016.3 365.0 650.9 470.8 570.6 319.7 22 | 692.1 1496.2 1108.0 1348.5 1263.2 864.8 586.6 618.0 23 | 1160.0 2084.8 645.2 1483.1 1250.0 1126.3 1070.5 1272.1 24 | 2070.8 3319.5 0 2580.6 2590.7 3960.4 1666.7 1861.5 25 | 26 | 125.7 277.9 266.7 102.7 178.6 224.7 142.1 138.8 27 | 177.3 517.9 138.7 466.8 270.1 190.2 116.8 83.0 28 | 244.8 823.5 473.6 602.0 361.0 454.5 412.2 182.1 29 | 397.7 1302.9 1114.8 862.1 699.6 541.7 373.1 356.4 30 | 692.1 1934.9 2319.6 1250.0 1688.0 828.7 797.9 581.5 31 | 1160.0 2827.0 4635.8 2517.2 1687.3 2848.7 1621.2 1363.4 32 | 2070.8 4273.1 2409.6 5769.2 3125.0 2978.7 2803.7 2195.4 33 | 34 | -------------------------------------------------------------------------------- /tests/data.turbine: -------------------------------------------------------------------------------- 1 | NA 4 0 2 | 4 NA 39 3 | NA 10 4 4 | 10 NA 49 5 | NA 14 2 6 | 14 NA 31 7 | NA 18 7 8 | 18 NA 66 9 | NA 22 5 10 | 22 NA 25 11 | NA 26 9 12 | 26 NA 30 13 | NA 30 9 14 | 30 NA 33 15 | NA 34 6 16 | 34 NA 7 17 | NA 38 22 18 | 38 NA 12 19 | NA 42 21 20 | 42 NA 19 21 | NA 46 21 22 | 46 NA 15 23 | 24 | -------------------------------------------------------------------------------- /tests/difftest.R: -------------------------------------------------------------------------------- 1 | options(na.action=na.exclude) # preserve missings 2 | options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 3 | library(survival) 4 | 5 | # 6 | # Test some more features of surv.diff 7 | # 8 | # First, what happens when one group is a dummy 9 | # 10 | 11 | 12 | # 13 | # The AML data, with a third group of early censorings "tacked on" 14 | # 15 | aml3 <- list(time= c( 9, 13, 13, 18, 23, 28, 31, 34, 45, 48, 161, 16 | 5, 5, 8, 8, 12, 16, 23, 27, 30, 33, 43, 45, 17 | 1, 2, 2, 3, 3, 3, 4), 18 | status= c( 1,1,0,1,1,0,1,1,0,1,0, 1,1,1,1,1,0,1,1,1,1,1,1, 19 | 0,0,0,0,0,0,0), 20 | x = as.factor(c(rep("Maintained", 11), 21 | rep("Nonmaintained", 12), rep("Dummy",7) ))) 22 | 23 | aml3 <- data.frame(aml3) 24 | 25 | # These should give the same result (chisq, df), but the second has an 26 | # extra group 27 | survdiff(Surv(time, status) ~x, aml) 28 | survdiff(Surv(time, status) ~x, aml3) 29 | 30 | 31 | # 32 | # Now a test of the stratified log-rank 33 | # There are no tied times within institution, so the coxph program 34 | # can be used to give a complete test 35 | # 36 | fit <- survdiff(Surv(time, status) ~ pat.karno + strata(inst), lung) 37 | 38 | cfit <- coxph(Surv(time, status) ~ factor(pat.karno) + strata(inst), 39 | lung, iter=0) 40 | 41 | tdata <- na.omit(lung[,c('time', 'status', 'pat.karno', 'inst')]) 42 | 43 | temp1 <- tapply(tdata$status-1, list(tdata$pat.karno, tdata$inst), sum) 44 | temp1 <- ifelse(is.na(temp1), 0, temp1) 45 | temp2 <- tapply(cfit$resid, list(tdata$pat.karno, tdata$inst), sum) 46 | temp2 <- ifelse(is.na(temp2), 0, temp2) 47 | 48 | temp2 <- temp1 - temp2 49 | 50 | #Now temp1=observed, temp2=expected 51 | all.equal(c(temp1), c(fit$obs)) 52 | all.equal(c(temp2), c(fit$exp)) 53 | 54 | all.equal(fit$var[-1,-1], solve(cfit$var)) 55 | 56 | rm(tdata, temp1, temp2) 57 | -------------------------------------------------------------------------------- /tests/factor.R: -------------------------------------------------------------------------------- 1 | # 2 | # Ensure that factors work in prediction 3 | # 4 | library(survival) 5 | 6 | options(na.action="na.exclude") # preserve missings 7 | options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 8 | aeq <- function(x,y, ...) all.equal(as.vector(x), as.vector(y), ...) 9 | 10 | tfit <- coxph(Surv(time, status) ~ age + factor(ph.ecog), lung) 11 | p1 <- predict(tfit, type='risk') 12 | 13 | # Testing NA handling is important too 14 | keep <- (is.na(lung$ph.ecog) | lung$ph.ecog !=1) 15 | lung2 <- lung[keep,] 16 | p2 <- predict(tfit, type='risk', newdata=lung[keep,]) 17 | aeq(p1[keep], p2) 18 | 19 | # Same, for survreg 20 | tfit <- survreg(Surv(time, status) ~ age + factor(ph.ecog), lung) 21 | p1 <- predict(tfit, type='response') 22 | p2 <- predict(tfit, type='response', newdata=lung2) 23 | aeq(p1[keep], p2) 24 | 25 | 26 | # Now repeat it tossing the missings 27 | options(na.action=na.omit) 28 | keep2 <- (lung$ph.ecog[!is.na(lung$ph.ecog)] !=1) 29 | 30 | tfit2 <- survreg(Surv(time, status) ~ age + factor(ph.ecog), lung) 31 | p3 <- predict(tfit2, type='response') 32 | p4 <- predict(tfit2, type='response', newdata=lung2, na.action=na.omit) 33 | aeq(p3[keep2] , p4) 34 | -------------------------------------------------------------------------------- /tests/factor2.R: -------------------------------------------------------------------------------- 1 | library(survival) 2 | aeq <- function(x,y) all.equal(as.vector(x), as.vector(y)) 3 | options(na.action=na.exclude) 4 | # 5 | # More tests of factors in prediction, using a new data set 6 | # 7 | fit <- coxph(Surv(time, status) ~ factor(ph.ecog), lung) 8 | 9 | tdata <- data.frame(ph.ecog = factor(0:3)) 10 | p1 <- predict(fit, newdata=tdata, type='lp') 11 | p2 <- predict(fit, type='lp') 12 | aeq(p1, p2[match(0:3, lung$ph.ecog)]) 13 | 14 | fit2 <- coxph(Surv(time, status) ~ factor(ph.ecog) + factor(sex), lung) 15 | tdata <- expand.grid(ph.ecog = factor(0:3), sex=factor(1:2)) 16 | p1 <- predict(fit2, newdata=tdata, type='risk') 17 | 18 | xdata <- expand.grid(ph.ecog=factor(1:3), sex=factor(1:2)) 19 | p2 <- predict(fit2, newdata=xdata, type='risk') 20 | all.equal(p2, p1[c(2:4, 6:8)], check.attributes=FALSE) 21 | 22 | 23 | fit3 <- survreg(Surv(time, status) ~ factor(ph.ecog) + age, lung) 24 | tdata <- data.frame(ph.ecog=factor(0:3), age=50) 25 | predict(fit, type='lp', newdata=tdata) 26 | predict(fit3, type='lp', newdata=tdata) 27 | -------------------------------------------------------------------------------- /tests/fr_cancer.R: -------------------------------------------------------------------------------- 1 | options(na.action=na.exclude) # preserve missings 2 | options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 3 | library(survival) 4 | 5 | # 6 | # Here is a test case with multiple smoothing terms 7 | # 8 | 9 | fit0 <- coxph(Surv(time, status) ~ ph.ecog + age, lung) 10 | fit1 <- coxph(Surv(time, status) ~ ph.ecog + pspline(age,3), lung) 11 | fit2 <- coxph(Surv(time, status) ~ ph.ecog + pspline(age,4), lung) 12 | fit3 <- coxph(Surv(time, status) ~ ph.ecog + pspline(age,8), lung) 13 | 14 | 15 | 16 | fit4 <- coxph(Surv(time, status) ~ ph.ecog + pspline(wt.loss,3), lung) 17 | 18 | fit5 <-coxph(Surv(time, status) ~ ph.ecog + pspline(age,3) + 19 | pspline(wt.loss,3), lung) 20 | 21 | fit1 22 | fit2 23 | fit3 24 | fit4 25 | fit5 26 | 27 | rm(fit1, fit2, fit3, fit4, fit5) 28 | -------------------------------------------------------------------------------- /tests/fr_lung.R: -------------------------------------------------------------------------------- 1 | options(na.action=na.exclude) # preserve missings 2 | options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 3 | library(survival) 4 | 5 | # 6 | # A test with the lung data 7 | # This caused problems in one release 8 | 9 | # 10 | # First, get rid of some missings 11 | # 12 | lung2 <- na.omit(lung[c('time', 'status', 'wt.loss')]) 13 | 14 | # 15 | # Test the logliklihoods 16 | # 17 | fit <- coxph(Surv(time, status) ~ pspline(wt.loss,3), lung2, x=T) 18 | fit0<- coxph(Surv(time, status) ~ 1, lung2) 19 | fit1<- coxph(Surv(time, status) ~ fit$x, lung2, iter=0, init=fit$coef) 20 | 21 | all.equal(fit$loglik[1], fit0$loglik) 22 | all.equal(fit$loglik[2], fit1$loglik[2]) 23 | 24 | # 25 | # Check variances 26 | # 27 | imat <- solve(fit1$var) 28 | var2 <- fit$var %*% imat %*% fit$var 29 | all.equal(fit$var2, var2) 30 | -------------------------------------------------------------------------------- /tests/fr_lung.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 2.11.1 (2010-05-31) 3 | Copyright (C) 2010 The R Foundation for Statistical Computing 4 | ISBN 3-900051-07-0 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > options(na.action=na.exclude) # preserve missings 19 | > options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 20 | > library(survival) 21 | Loading required package: splines 22 | > 23 | > # 24 | > # A test with the lung data 25 | > # This caused problems in one release 26 | > 27 | > # 28 | > # First, get rid of some missings 29 | > # 30 | > lung2 <- na.omit(lung[c('time', 'status', 'wt.loss')]) 31 | > 32 | > # 33 | > # Test the logliklihoods 34 | > # 35 | > fit <- coxph(Surv(time, status) ~ pspline(wt.loss,3), lung2, x=T) 36 | > fit0<- coxph(Surv(time, status) ~ 1, lung2) 37 | > fit1<- coxph(Surv(time, status) ~ fit$x, lung2, iter=0, init=fit$coef) 38 | > 39 | > all.equal(fit$loglik[1], fit0$loglik) 40 | [1] TRUE 41 | > all.equal(fit$loglik[2], fit1$loglik[2]) 42 | [1] TRUE 43 | > 44 | > # 45 | > # Check variances 46 | > # 47 | > imat <- solve(fit1$var) 48 | > var2 <- fit$var %*% imat %*% fit$var 49 | > all.equal(fit$var2, var2) 50 | [1] TRUE 51 | > 52 | -------------------------------------------------------------------------------- /tests/fr_ovarian.R: -------------------------------------------------------------------------------- 1 | options(na.action=na.exclude) # preserve missings 2 | options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 3 | library(survival) 4 | 5 | # 6 | # Test on the ovarian data 7 | 8 | fit1 <- coxph(Surv(futime, fustat) ~ rx + age, ovarian) 9 | fit2 <- coxph(Surv(futime, fustat) ~ rx + pspline(age, df=2), 10 | data=ovarian) 11 | fit2$iter 12 | 13 | fit2$df 14 | 15 | fit2$history 16 | 17 | fit4 <- coxph(Surv(futime, fustat) ~ rx + pspline(age, df=4), 18 | data=ovarian) 19 | fit4 20 | 21 | 22 | -------------------------------------------------------------------------------- /tests/fr_rat1.R: -------------------------------------------------------------------------------- 1 | options(na.action=na.exclude) # preserve missings 2 | options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 3 | library(survival) 4 | 5 | # Tests using the rats data 6 | # 7 | # (Female rats, from Mantel et al, Cancer Research 37, 8 | # 3863-3868, November 77) 9 | 10 | rfit <- coxph(Surv(time,status) ~ rx + frailty(litter), rats, 11 | method='breslow', subset= (sex=='f')) 12 | rfit 13 | 14 | rfit$iter 15 | rfit$df 16 | rfit$history[[1]] 17 | 18 | rfit1 <- coxph(Surv(time,status) ~ rx + frailty(litter, theta=1), rats, 19 | method='breslow', subset=(sex=="f")) 20 | rfit1 21 | 22 | rfit2 <- coxph(Surv(time,status) ~ frailty(litter), rats, subset=(sex=='f')) 23 | rfit2 24 | -------------------------------------------------------------------------------- /tests/frailty.R: -------------------------------------------------------------------------------- 1 | library(survival) 2 | # 3 | # The constuction of a survival curve with sparse frailties 4 | # 5 | # In this case the coefficient vector is kept in two parts, the 6 | # fixed coefs and the (often very large) random effects coefficients 7 | # The survfit function treats the second set of coefficients as fixed 8 | # values, to avoid an unmanagable variance matrix, and behaves like 9 | # the second fit below. 10 | 11 | fit1 <- coxph(Surv(time, status) ~ age + frailty(inst), lung) 12 | sfit1 <- survfit(fit1) 13 | 14 | # A parallel model with the frailties treated as fixed offsets 15 | offvar <- fit1$frail[as.numeric(factor(lung$inst))] 16 | fit2 <- coxph(Surv(time, status) ~ age + offset(offvar),lung) 17 | fit2$var <- fit1$var #force variances to match 18 | 19 | all.equal(fit1$coef, fit2$coef) 20 | sfit2 <- survfit(fit2, newdata=list(age=fit1$means, offvar=0)) 21 | all.equal(sfit1$surv, sfit2$surv, tol=1e-7) 22 | all.equal(sfit1$var, sfit2$var) 23 | -------------------------------------------------------------------------------- /tests/frailty.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R Under development (unstable) (2019-05-15 r76504) -- "Unsuffered Consequences" 3 | Copyright (C) 2019 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > library(survival) 19 | > # 20 | > # The constuction of a survival curve with sparse frailties 21 | > # 22 | > # In this case the coefficient vector is kept in two parts, the 23 | > # fixed coefs and the (often very large) random effects coefficients 24 | > # The survfit function treats the second set of coefficients as fixed 25 | > # values, to avoid an unmanagable variance matrix, and behaves like 26 | > # the second fit below. 27 | > 28 | > fit1 <- coxph(Surv(time, status) ~ age + frailty(inst), lung) 29 | > sfit1 <- survfit(fit1) 30 | > 31 | > # A parallel model with the frailties treated as fixed offsets 32 | > offvar <- fit1$frail[as.numeric(factor(lung$inst))] 33 | > fit2 <- coxph(Surv(time, status) ~ age + offset(offvar),lung) 34 | > fit2$var <- fit1$var #force variances to match 35 | > 36 | > all.equal(fit1$coef, fit2$coef) 37 | [1] TRUE 38 | > sfit2 <- survfit(fit2, newdata=list(age=fit1$means, offvar=0)) 39 | > all.equal(sfit1$surv, sfit2$surv, tol=1e-7) 40 | [1] TRUE 41 | > all.equal(sfit1$var, sfit2$var) 42 | [1] TRUE 43 | > 44 | > proc.time() 45 | user system elapsed 46 | 0.768 0.040 0.807 47 | -------------------------------------------------------------------------------- /tests/frank.R: -------------------------------------------------------------------------------- 1 | library(survival) 2 | # 3 | # Check out intercept/interaction for Frank H 4 | # 5 | age2 <- lung$age - 50 6 | fit1 <- coxph(Surv(time, status) ~ age * strata(sex), lung) 7 | fit2 <- coxph(Surv(time, status) ~ age2*strata(sex), lung) 8 | 9 | tdata <- data.frame(age=50:60, age2=0:10, sex=c(1,2,1,2,1,2,1,2,1,2,1)) 10 | 11 | surv1 <- survfit(fit1, tdata) 12 | surv2 <- survfit(fit2, tdata) 13 | # The call won't match, nor the newdata data frame 14 | icall <- match(c("newdata", "call"), names(surv1)) 15 | all.equal(unclass(surv1)[-icall], unclass(surv2)[-icall]) 16 | 17 | 18 | # It should match what I get with a single strata fit 19 | 20 | fit3 <- coxph(Surv(time, status) ~ age, data=lung, 21 | init=fit1$coef[1], subset=(sex==1), iter=0) 22 | surv1b <- survfit(fit3, newdata=list(age=c(50,52, 54))) 23 | all.equal(c(surv1b$surv), surv1[c(1,3,5)]$surv) 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /tests/frank.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R Under development (unstable) (2023-05-10 r84417) -- "Unsuffered Consequences" 3 | Copyright (C) 2023 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > library(survival) 19 | > # 20 | > # Check out intercept/interaction for Frank H 21 | > # 22 | > age2 <- lung$age - 50 23 | > fit1 <- coxph(Surv(time, status) ~ age * strata(sex), lung) 24 | > fit2 <- coxph(Surv(time, status) ~ age2*strata(sex), lung) 25 | > 26 | > tdata <- data.frame(age=50:60, age2=0:10, sex=c(1,2,1,2,1,2,1,2,1,2,1)) 27 | > 28 | > surv1 <- survfit(fit1, tdata) 29 | > surv2 <- survfit(fit2, tdata) 30 | > # The call won't match, nor the newdata data frame 31 | > icall <- match(c("newdata", "call"), names(surv1)) 32 | > all.equal(unclass(surv1)[-icall], unclass(surv2)[-icall]) 33 | [1] TRUE 34 | > 35 | > 36 | > # It should match what I get with a single strata fit 37 | > 38 | > fit3 <- coxph(Surv(time, status) ~ age, data=lung, 39 | + init=fit1$coef[1], subset=(sex==1), iter=0) 40 | > surv1b <- survfit(fit3, newdata=list(age=c(50,52, 54))) 41 | > all.equal(c(surv1b$surv), surv1[c(1,3,5)]$surv) 42 | [1] TRUE 43 | > 44 | > 45 | > 46 | > 47 | > proc.time() 48 | user system elapsed 49 | 0.920 0.070 0.981 50 | -------------------------------------------------------------------------------- /tests/gray1.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/tests/gray1.rda -------------------------------------------------------------------------------- /tests/infcox.R: -------------------------------------------------------------------------------- 1 | options(na.action=na.exclude) # preserve missings 2 | options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 3 | library(survival) 4 | 5 | # 6 | # A test to exercise the "infinity" check on 2 variables 7 | # 8 | test3 <- data.frame(futime=1:12, fustat=c(1,0,1,0,1,0,0,0,0,0,0,0), 9 | x1=rep(0:1,6), x2=c(rep(0,6), rep(1,6))) 10 | 11 | # This will produce a warning message, which is the point of the test. 12 | # The variance is close to singular and gives different answers 13 | # on different machines 14 | fit3 <- coxph(Surv(futime, fustat) ~ x1 + x2, test3, iter=25) 15 | 16 | all(fit3$coef < -22) 17 | all.equal(round(fit3$log, 4),c(-6.8669, -1.7918)) 18 | 19 | # 20 | # Actual solution 21 | # time 1, 12 at risk, 3 each of x1/x2 = 00, 01, 10, 11 22 | # time 2, 10 at risk, 2, 3, 2 , 3 23 | # time 5, 8 at risk, 1, 3, 1, 3 24 | # Let r1 = exp(beta1), r2= exp(beta2) 25 | # loglik = -log(3 + 3r1 + 3r2 + 3 r1*r2) - log(2 + 2r1 + 3r2 + 3 r1*r2) - 26 | # log(1 + r1 + 3r2 + 3 r1*r2) 27 | true <- function(beta) { 28 | r1 <- exp(beta[1]) 29 | r2 <- exp(beta[2]) 30 | loglik <- -log(3*(1+ r1+ r2+ r1*r2)) - log(2+ 2*r1 + 3*r2 + 3*r1*r2) - 31 | log(1 + r1 + 3*r2 + 3*r1*r2) 32 | loglik 33 | } 34 | 35 | all.equal(fit3$loglik[2], true(fit3$coef), check.attributes=FALSE) 36 | -------------------------------------------------------------------------------- /tests/neardate.R: -------------------------------------------------------------------------------- 1 | library(survival) 2 | # the second data set is not sorted by id/date, on purpose 3 | 4 | df1 <- data.frame(id= 1:10, 5 | y1= as.Date(c("1992-01-01", "1996-01-01", "1997-03-20", 6 | "2000-01-01", "2001-01-01", "2004-01-01", 7 | "2014-03-27", "2014-01-30", "2000-08-01", 8 | "1997-04-29"))) 9 | 10 | df2 <- data.frame(id= c(1, 1, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9, 9, 9, 10, 11 | 3, 3, 6, 6, 8), 12 | y2= as.Date(c("1998-04-30", "2004-07-01", "1999-04-14", 13 | "2001-02-22", "2003-11-19", "2005-02-15", "2006-06-22", 14 | "2007-09-20", "2013-08-02", "2015-01-09", "2014-01-15", 15 | "2006-12-06", "1999-10-20", "2010-06-30", "1997-04-28", 16 | "1995-04-20", "1997-03-20", "1998-04-30", "1995-04-20", 17 | "2006-12-06"))) 18 | 19 | if (FALSE) { # plot for visual check 20 | plot(y2 ~ id, df2, ylim=range(c(df1$y1, df2$y2)), type='n') 21 | text(df2$id, df2$y2, as.numeric(1:nrow(df2))) 22 | points(y1~id, df1, col=2, pch='+') 23 | } 24 | 25 | i1 <- neardate(df1$id, df2$id, df1$y1, df2$y2) 26 | all.equal(i1, c(1, 3, 17, 5, 7, 8, 10, NA, 12, NA)) 27 | 28 | i2 <- neardate(df1$id, df2$id, df1$y1, df2$y2, best="prior") 29 | all.equal(i2, c(NA, NA, 17, NA, NA, 18, 9, 11, 13, 15)) 30 | 31 | indx <- order(df2$id, df2$y2) 32 | df3 <- df2[indx,] 33 | i3 <- neardate(df1$id, df3$id, df1$y1, df3$y2) 34 | all.equal(indx[i3], i1) 35 | 36 | i4 <- neardate(df1$id, df3$id, df1$y1, df3$y2, best="prior") 37 | all.equal(indx[i4], i2) 38 | 39 | indx <- c(2,3,10,9, 4,5, 7,8,1,6) 40 | df4 <- df1[indx,] 41 | i5 <- neardate(df4$id, df2$id, df4$y1, df2$y2) 42 | all.equal(i1[indx], i5) 43 | -------------------------------------------------------------------------------- /tests/nested.R: -------------------------------------------------------------------------------- 1 | library(survival) 2 | # 3 | # A test of nesting. It makes sure the model.frame is built correctly 4 | # 5 | tfun <- function(fit, mydata) { 6 | survfit(fit, newdata=mydata) 7 | } 8 | 9 | myfit <- coxph(Surv(time, status) ~ age + factor(sex), lung) 10 | 11 | temp1 <- tfun(myfit, lung[1:5,]) 12 | temp2 <- survfit(myfit, lung[1:5,]) 13 | indx <- match('call', names(temp1)) #the call components won't match 14 | 15 | all.equal(unclass(temp1)[-indx], unclass(temp2)[-indx]) 16 | 17 | -------------------------------------------------------------------------------- /tests/nested.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 2.15.2 (2012-10-26) -- "Trick or Treat" 3 | Copyright (C) 2012 The R Foundation for Statistical Computing 4 | ISBN 3-900051-07-0 5 | Platform: i686-pc-linux-gnu (32-bit) 6 | 7 | R is free software and comes with ABSOLUTELY NO WARRANTY. 8 | You are welcome to redistribute it under certain conditions. 9 | Type 'license()' or 'licence()' for distribution details. 10 | 11 | R is a collaborative project with many contributors. 12 | Type 'contributors()' for more information and 13 | 'citation()' on how to cite R or R packages in publications. 14 | 15 | Type 'demo()' for some demos, 'help()' for on-line help, or 16 | 'help.start()' for an HTML browser interface to help. 17 | Type 'q()' to quit R. 18 | 19 | > library(survival) 20 | Loading required package: splines 21 | > # 22 | > # A test of nesting. It makes sure the model.frame is built correctly 23 | > # 24 | > tfun <- function(fit, mydata) { 25 | + survfit(fit, newdata=mydata) 26 | + } 27 | > 28 | > myfit <- coxph(Surv(time, status) ~ age + factor(sex), lung) 29 | > 30 | > temp1 <- tfun(myfit, lung[1:5,]) 31 | > temp2 <- survfit(myfit, lung[1:5,]) 32 | > indx <- match('call', names(temp1)) #the call components won't match 33 | > 34 | > all.equal(unclass(temp1)[-indx], unclass(temp2)[-indx]) 35 | [1] TRUE 36 | > 37 | > 38 | > proc.time() 39 | user system elapsed 40 | 0.196 0.032 0.225 41 | -------------------------------------------------------------------------------- /tests/nsk.R: -------------------------------------------------------------------------------- 1 | library(survival) 2 | library(splines) 3 | 4 | # the nsk function should give the same solution as ns, but with a different 5 | # parameterization 6 | # 7 | xx <- runif(500, 1, 100) 8 | yy <- 10*log(xx) + rnorm(500, 0, 2) 9 | tdata <- data.frame(xx=xx, yy=yy) 10 | fit1 <- lm(yy ~ ns(xx, df=4), tdata, model=TRUE) 11 | fit2 <- lm(yy ~ nsk(xx, df=4, b=0), tdata) 12 | all.equal(predict(fit1), predict(fit2)) # same solution 13 | 14 | xattr <- attributes(fit1$model[[2]]) 15 | allknots <- sort(c(xattr$knots, xattr$Boundary.knots)) # knots that were used 16 | pred.knot <- predict(fit1, newdata=list(xx=allknots)) 17 | all.equal(pred.knot[-1] - pred.knot[1], coef(fit2)[-1], 18 | check.attributes = FALSE) 19 | 20 | -------------------------------------------------------------------------------- /tests/nsk.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R Under development (unstable) (2020-12-17 r79644) -- "Unsuffered Consequences" 3 | Copyright (C) 2020 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > library(survival) 19 | > library(splines) 20 | > 21 | > # the nsk function should give the same solution as ns, but with a different 22 | > # parameterization 23 | > # 24 | > xx <- runif(500, 1, 100) 25 | > yy <- 10*log(xx) + rnorm(500, 0, 2) 26 | > tdata <- data.frame(xx=xx, yy=yy) 27 | > fit1 <- lm(yy ~ ns(xx, df=4), tdata, model=TRUE) 28 | > fit2 <- lm(yy ~ nsk(xx, df=4, b=0), tdata) 29 | > all.equal(predict(fit1), predict(fit2)) # same solution 30 | [1] TRUE 31 | > 32 | > xattr <- attributes(fit1$model[[2]]) 33 | > allknots <- sort(c(xattr$knots, xattr$Boundary.knots)) # knots that were used 34 | > pred.knot <- predict(fit1, newdata=list(xx=allknots)) 35 | > all.equal(pred.knot[-1] - pred.knot[1], coef(fit2)[-1], 36 | + check.attributes = FALSE) 37 | [1] TRUE 38 | > 39 | > 40 | > proc.time() 41 | user system elapsed 42 | 0.857 0.036 0.887 43 | -------------------------------------------------------------------------------- /tests/overlap.R: -------------------------------------------------------------------------------- 1 | # 2 | # Make sure that useless intervals do not cause issues, i.e., any that do 3 | # not overlap at least one event time 4 | # 5 | library(survival) 6 | test2 <- data.frame(time1 =c(1, 2, 5, 2, 1, 7, 3, 4, 8, 8, 3), 7 | time2 =c(2, 3, 6, 7, 8, 9, 9, 9,14,17, 5), 8 | event =c(1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0), 9 | x =c(1, 0, 0, 1, 0, 1, 1, 1, 0, 0, 500) ) 10 | 11 | # The data set is the same as book3.R, except for the wild observation 12 | # with x=500 whose time interval of (4,5) overlaps no events. 13 | 14 | fit1 <- coxph(Surv(time1, time2, event) ~ x, test2, subset=(x<100)) 15 | fit2 <- coxph(Surv(time1, time2, event) ~ x, test2) 16 | 17 | ii <- match(c("coefficients", "var", "loglik", "score", "iter", 18 | "wald.test", "concordance"), names(fit1)) 19 | all.equal(fit1[ii], fit2[ii]) 20 | all.equal(c(fit1$residuals,0), fit2$residuals, check.attributes=FALSE) 21 | 22 | # The mean differs condiderably, and so to the linear predictors 23 | 24 | # Now the same with a penalized model 25 | fit3 <- coxph(Surv(time1, time2, event) ~ ridge(x, theta=.1), test2, 26 | subset= (x< 100)) 27 | fit4 <- coxph(Surv(time1, time2, event) ~ ridge(x, theta=.1), test2) 28 | fit5 <- coxph(Surv(time1,time2, event) ~ x, test2, 29 | iter=0, init=fit4$coef) 30 | 31 | all.equal(fit3[ii], fit4[ii]) 32 | all.equal(c(fit3$residuals,0), fit4$residuals, check.attributes=FALSE) 33 | all.equal(fit4$residuals, fit5$residuals) 34 | -------------------------------------------------------------------------------- /tests/r_lung.R: -------------------------------------------------------------------------------- 1 | options(na.action=na.exclude) # preserve missings 2 | options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 3 | library(survival) 4 | 5 | aeq <- function(x,y, ...) all.equal(as.vector(x), as.vector(y), ...) 6 | 7 | lfit2 <- survreg(Surv(time, status) ~ age + ph.ecog + strata(sex), lung) 8 | lfit3 <- survreg(Surv(time, status) ~ sex + (age+ph.ecog)*strata(sex), lung) 9 | 10 | lfit4 <- survreg(Surv(time, status) ~ age + ph.ecog , lung, 11 | subset=(sex==1)) 12 | lfit5 <- survreg(Surv(time, status) ~ age + ph.ecog , lung, 13 | subset=(sex==2)) 14 | 15 | if (exists('censorReg')) { 16 | lfit1 <- censorReg(censor(time, status) ~ age + ph.ecog + strata(sex),lung) 17 | aeq(lfit4$coef, lfit1[[1]]$coef) 18 | aeq(lfit4$scale, lfit1[[1]]$scale) 19 | aeq(c(lfit4$scale, lfit5$scale), sapply(lfit1, function(x) x$scale)) 20 | } 21 | aeq(c(lfit4$scale, lfit5$scale), lfit3$scale ) 22 | 23 | # 24 | # Test out ridge regression and splines 25 | # 26 | lfit0 <- survreg(Surv(time, status) ~1, lung) 27 | lfit1 <- survreg(Surv(time, status) ~ age + ridge(ph.ecog, theta=5), lung) 28 | lfit2 <- survreg(Surv(time, status) ~ sex + ridge(age, ph.ecog, theta=1), lung) 29 | lfit3 <- survreg(Surv(time, status) ~ sex + age + ph.ecog, lung) 30 | 31 | lfit0 32 | lfit1 33 | lfit2 34 | lfit3 35 | 36 | 37 | xx <- pspline(lung$age, nterm=3, theta=.3) 38 | xx <- matrix(unclass(xx), ncol=ncol(xx)) # the raw matrix 39 | lfit4 <- survreg(Surv(time, status) ~xx, lung) 40 | lfit5 <- survreg(Surv(time, status) ~age, lung) 41 | 42 | lfit6 <- survreg(Surv(time, status)~pspline(age, df=2), lung) 43 | 44 | lfit7 <- survreg(Surv(time, status) ~ offset(lfit6$lin), lung) 45 | 46 | lfit4 47 | lfit5 48 | lfit6 49 | signif(lfit7$coef,6) 50 | -------------------------------------------------------------------------------- /tests/r_scale.R: -------------------------------------------------------------------------------- 1 | options(na.action=na.exclude) # preserve missings 2 | options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 3 | library(survival) 4 | 5 | # 6 | # Verify that scale can be fixed at a value 7 | # coefs will differ slightly due to different iteration paths 8 | tol <- .001 9 | 10 | # Intercept only models 11 | fit1 <- survreg(Surv(time,status) ~ 1, lung) 12 | fit2 <- survreg(Surv(time,status) ~ 1, lung, scale=fit1$scale) 13 | all.equal(fit1$coef, fit2$coef, tolerance= tol) 14 | all.equal(fit1$loglik, fit2$loglik, tolerance= tol) 15 | 16 | # The two robust variance matrices are not the same, since removing 17 | # an obs has a different effect on the two models. This just 18 | # checks for failure, not for correctness 19 | fit3 <- survreg(Surv(time,status) ~ 1, lung, robust=TRUE) 20 | fit4 <- survreg(Surv(time,status) ~ 1, lung, scale=fit1$scale, robust=TRUE) 21 | 22 | 23 | # multiple covariates 24 | fit1 <- survreg(Surv(time,status) ~ age + ph.karno, lung) 25 | fit2 <- survreg(Surv(time,status) ~ age + ph.karno, lung, 26 | scale=fit1$scale) 27 | all.equal(fit1$coef, fit2$coef, tolerance=tol) 28 | all.equal(fit1$loglik[2], fit2$loglik[2], tolerance=tol) 29 | 30 | fit3 <- survreg(Surv(time,status) ~ age + ph.karno, lung, robust=TRUE) 31 | fit4 <- survreg(Surv(time,status) ~ age + ph.karno, lung, 32 | scale=fit1$scale, robust=TRUE) 33 | 34 | # penalized models 35 | fit1 <- survreg(Surv(time, status) ~ pspline(age), lung) 36 | fit2 <- survreg(Surv(time, status) ~ pspline(age), lung, scale=fit1$scale) 37 | all.equal(fit1$coef, fit2$coef, tolerance=tol) 38 | all.equal(fit1$loglik[2], fit2$loglik[2], tolerance=tol) 39 | 40 | fit3 <- survreg(Surv(time,status) ~ pspline(age) + ph.karno, lung, robust=TRUE) 41 | fit4 <- survreg(Surv(time,status) ~ pspline(age) + ph.karno, lung, 42 | scale=fit1$scale, robust=TRUE) 43 | 44 | 45 | -------------------------------------------------------------------------------- /tests/r_tdist.R: -------------------------------------------------------------------------------- 1 | options(na.action=na.exclude) # preserve missings 2 | options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 3 | library(survival) 4 | 5 | # 6 | # Test out the t-distribution 7 | # 8 | # First, a t-dist with 500 df should be nearly identical to the Gaussian 9 | 10 | fitig <- survreg(Surv(time, status)~voltage, 11 | dist = "gaussian", data = capacitor) 12 | fit1 <- survreg(Surv(time, status) ~ voltage, 13 | dist='t', parms=500, capacitor) 14 | fitig 15 | summary(fit1, corr=F) 16 | 17 | # A more realistic fit 18 | fit2 <- survreg(Surv(time, status) ~ voltage, 19 | dist='t', parms=5, capacitor) 20 | print(fit2) 21 | 22 | if (FALSE) { 23 | resid(fit2, type='response') 24 | resid(fit2, type='deviance') 25 | resid(fit2, type='working') 26 | resid(fit2, type='dfbeta') 27 | resid(fit2, type='dfbetas') 28 | resid(fit2, type='ldresp') 29 | resid(fit2, type='ldshape') 30 | resid(fit2, type='ldcase') 31 | resid(fit2, type='matrix') 32 | 33 | predict(fit2, type='link') 34 | predict(fit2, type='terms') 35 | predict(fit2, type='quantile') 36 | } 37 | -------------------------------------------------------------------------------- /tests/r_user.R: -------------------------------------------------------------------------------- 1 | options(na.action=na.exclude) #preserve length of missings 2 | library(survival) 3 | 4 | # 5 | # Check out using a "user specified" distribution 6 | # 7 | mydist <- c(survreg.distributions$extreme, survreg.distributions$weibull[-1]) 8 | mydist$name <- "Weibull2" 9 | mydist$dist <- NULL 10 | 11 | fit1 <- survreg(Surv(time, status) ~ age + ph.ecog, lung) 12 | fit2 <- survreg(Surv(time, status) ~ age + ph.ecog, lung, dist=mydist) 13 | 14 | all.equal(fit1$coef, fit2$coef) 15 | all.equal(fit1$var, fit2$var) 16 | 17 | # 18 | # And with an data set containing interval censoring 19 | # 20 | idat <- read.table('data.interval', skip=3, header=T, sep=',') 21 | 22 | fit1 <- survreg(Surv(ltime, rtime, type='interval2') ~ age + ecog.ps, idat) 23 | fit2 <- survreg(Surv(ltime, rtime, type='interval2') ~ age + ecog.ps, 24 | data=idat, dist=mydist) 25 | 26 | all.equal(fit1$coef, fit2$coef) 27 | all.equal(fit1$var, fit2$var) 28 | all.equal(fit1$log, fit2$log) 29 | 30 | -------------------------------------------------------------------------------- /tests/r_user.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 2.9.0 (2009-04-17) 3 | Copyright (C) 2009 The R Foundation for Statistical Computing 4 | ISBN 3-900051-07-0 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > options(na.action=na.exclude) #preserve length of missings 19 | > library(survival) 20 | Loading required package: splines 21 | > 22 | > # 23 | > # Check out using a "user specified" distribution 24 | > # 25 | > mydist <- c(survreg.distributions$extreme, survreg.distributions$weibull[-1]) 26 | > mydist$name <- "Weibull2" 27 | > mydist$dist <- NULL 28 | > 29 | > fit1 <- survreg(Surv(time, status) ~ age + ph.ecog, lung) 30 | > fit2 <- survreg(Surv(time, status) ~ age + ph.ecog, lung, dist=mydist) 31 | > 32 | > all.equal(fit1$coef, fit2$coef) 33 | [1] TRUE 34 | > all.equal(fit1$var, fit2$var) 35 | [1] TRUE 36 | > 37 | > # 38 | > # And with an data set containing interval censoring 39 | > # 40 | > idat <- read.table('data.interval', skip=3, header=T, sep=',') 41 | > 42 | > fit1 <- survreg(Surv(ltime, rtime, type='interval2') ~ age + ecog.ps, idat) 43 | > fit2 <- survreg(Surv(ltime, rtime, type='interval2') ~ age + ecog.ps, 44 | + data=idat, dist=mydist) 45 | > 46 | > all.equal(fit1$coef, fit2$coef) 47 | [1] TRUE 48 | > all.equal(fit1$var, fit2$var) 49 | [1] TRUE 50 | > all.equal(fit1$log, fit2$log) 51 | [1] TRUE 52 | > 53 | > 54 | -------------------------------------------------------------------------------- /tests/royston.R: -------------------------------------------------------------------------------- 1 | # Verify the values found in the Royston paper 2 | library(survival) 3 | 4 | pbc2 <- na.omit(pbc[,-1]) # no id variable, no missings 5 | 6 | pfit1 <- coxph(Surv(time, status==2) ~ . + log(bili) - bili, pbc2, 7 | ties="breslow") 8 | # backwards elimination was used to eliminate all but 8 9 | pfit2 <- coxph(Surv(time, status==2) ~ age + log(bili) + edema + albumin + 10 | stage + copper, data=pbc2, ties="breslow") 11 | 12 | temp <- rbind(royston(pfit1), royston(pfit1, adjust=TRUE), 13 | royston(pfit2), royston(pfit2, adjust=TRUE)) 14 | all.equal(round(temp[,1], 2), c(2.86, 2.56, 2.69, 2.59)) 15 | -------------------------------------------------------------------------------- /tests/royston.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R Under development (unstable) (2020-06-10 r78681) -- "Unsuffered Consequences" 3 | Copyright (C) 2020 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > # Verify the values found in the Royston paper 19 | > library(survival) 20 | > 21 | > pbc2 <- na.omit(pbc[,-1]) # no id variable, no missings 22 | > 23 | > pfit1 <- coxph(Surv(time, status==2) ~ . + log(bili) - bili, pbc2, 24 | + ties="breslow") 25 | > # backwards elimination was used to eliminate all but 8 26 | > pfit2 <- coxph(Surv(time, status==2) ~ age + log(bili) + edema + albumin + 27 | + stage + copper, data=pbc2, ties="breslow") 28 | > 29 | > temp <- rbind(royston(pfit1), royston(pfit1, adjust=TRUE), 30 | + royston(pfit2), royston(pfit2, adjust=TRUE)) 31 | > all.equal(round(temp[,1], 2), c(2.86, 2.56, 2.69, 2.59)) 32 | [1] TRUE 33 | > 34 | > proc.time() 35 | user system elapsed 36 | 0.824 0.052 0.868 37 | -------------------------------------------------------------------------------- /tests/sexpm.save: -------------------------------------------------------------------------------- 1 | # Test the sexpm functions that are used for fast matrix exponentials 2 | # 3 | library(Matrix) 4 | library(survival) 5 | aeq <- function(x, y, ...) all.equal(as.vector(x),as.vector(y), ...) 6 | 7 | nfun <- length(sexpm) 8 | times <- c(.1, 1, 5) 9 | test1 <- matrix(FALSE, nfun, length(times), 10 | dimnames=list(names(sexpm), paste0("t=", times))) 11 | test2 <- test1 12 | eps <- 1e-8 13 | 14 | dtest <- function(x, tmat, time= 1.3, eps=1e-8) { 15 | # Check a derivative 16 | if (missing(tmat)) { 17 | tmat <- matrix(0, x$nstate, x$nstate) 18 | tmat[x$nonzero] <- runif(length(x$nonzero), .1, 3) 19 | diag(tmat) <- -rowSums(tmat) 20 | } 21 | else { 22 | if (!aeq(dim(tmat), c(x$nstate, x$nstate))) stop("invalid tmat") 23 | diag(tmat) <- diag(tmat) - rowSums(tmat) 24 | } 25 | 26 | d1 <- x$deriv(tmat, time) 27 | d2 <- 0*d1 28 | nz <- x$nonzero 29 | exp1 <- as.matrix(expm(tmat* time)) 30 | 31 | for (j in 1:length(nz)) { 32 | temp <- tmat 33 | temp[nz[j]] <- temp[nz[j]] + eps 34 | diag(temp) <- diag(temp) - rowSums(temp) 35 | exp2 <- as.matrix(expm(temp* time)) 36 | d2[,,j] <- (exp2 - exp1)/eps 37 | } 38 | list(d1=d1, d2=d2) 39 | } 40 | 41 | for (i in 1:nfun) { 42 | j <- sexpm[[i]] 43 | tmat <- matrix(0, j$nstate, j$nstate) 44 | tmat[j$nonzero] <- runif(length(j$nonzero), .1, 4) 45 | diag(tmat) <- -rowSums(tmat) 46 | 47 | dtemp <- logical(length(j$nonzero)) 48 | for (k in 1:length(times)) { 49 | m1 <- j$mexp(tmat, times[k]) 50 | m2 <- expm(tmat*times[k]) 51 | test1[i,k] <- isTRUE(aeq(m1, as.matrix(m2))) 52 | # now derivatives 53 | temp <- dtest(j, tmat, times[k], eps) 54 | test2[i,k] <- isTRUE(aeq(temp$d1, temp$d2, tol=sqrt(eps))) 55 | } 56 | } 57 | 58 | all(test1) # should all be TRUE 59 | all(test2) 60 | -------------------------------------------------------------------------------- /tests/singtest.R: -------------------------------------------------------------------------------- 1 | options(na.action=na.exclude) # preserve missings 2 | options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 3 | library(survival) 4 | 5 | # 6 | # A simple test of an overdetermined system 7 | # Should give a set of NA coefficients 8 | # 9 | test1 <- data.frame(time= c(4, 3,1,1,2,2,3), 10 | status=c(1,NA,1,0,1,1,0), 11 | x= c(0, 2,1,1,1,0,0)) 12 | 13 | temp <- rep(0:3, rep(7,4)) 14 | 15 | stest <- data.frame(start = 10*temp, 16 | stop = 10*temp + test1$time, 17 | status = rep(test1$status,4), 18 | x = c(test1$x+ 1:7, rep(test1$x,3)), 19 | epoch = rep(1:4, rep(7,4))) 20 | 21 | # Will create a warning about a singular X matrix 22 | fit1 <- coxph(Surv(start, stop, status) ~ x * factor(epoch), stest) 23 | fit1$coef # elements 2:4 should be NA 24 | all.equal(is.na(fit1$coef), c(F,T,T,T,F,F,F), check.attributes=FALSE) 25 | -------------------------------------------------------------------------------- /tests/singtest.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R Under development (unstable) (2018-04-09 r74565) -- "Unsuffered Consequences" 3 | Copyright (C) 2018 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > options(na.action=na.exclude) # preserve missings 19 | > options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 20 | > library(survival) 21 | > 22 | > # 23 | > # A simple test of an overdetermined system 24 | > # Should give a set of NA coefficients 25 | > # 26 | > test1 <- data.frame(time= c(4, 3,1,1,2,2,3), 27 | + status=c(1,NA,1,0,1,1,0), 28 | + x= c(0, 2,1,1,1,0,0)) 29 | > 30 | > temp <- rep(0:3, rep(7,4)) 31 | > 32 | > stest <- data.frame(start = 10*temp, 33 | + stop = 10*temp + test1$time, 34 | + status = rep(test1$status,4), 35 | + x = c(test1$x+ 1:7, rep(test1$x,3)), 36 | + epoch = rep(1:4, rep(7,4))) 37 | > 38 | > # Will create a warning about a singular X matrix 39 | > fit1 <- coxph(Surv(start, stop, status) ~ x * factor(epoch), stest) 40 | > fit1$coef # elements 2:4 should be NA 41 | x factor(epoch)2 factor(epoch)3 factor(epoch)4 42 | 0.1041579 NA NA NA 43 | x:factor(epoch)2 x:factor(epoch)3 x:factor(epoch)4 44 | 1.5726996 1.5726996 1.5726996 45 | > all.equal(is.na(fit1$coef), c(F,T,T,T,F,F,F), check.attributes=FALSE) 46 | [1] TRUE 47 | > 48 | > proc.time() 49 | user system elapsed 50 | 0.668 0.040 0.704 51 | -------------------------------------------------------------------------------- /tests/strata2.R: -------------------------------------------------------------------------------- 1 | # 2 | # New tests 4/2010 to validate strata by covariate interactions 3 | # 4 | library(survival) 5 | options(na.action=na.exclude) # preserve missings 6 | options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 7 | aeq <- function(x,y) all.equal(as.vector(x), as.vector(y)) 8 | 9 | tdata <- lung 10 | tdata$sex <- lung$sex +3 11 | 12 | # Both of these should produce warning messages about singular X, since there 13 | # are ph.ecog=3 subjects in only 1 of the strata. 14 | # Does not affect the test 15 | fit1 <- coxph(Surv(time, status) ~ age + sex:strata(ph.ecog), lung) 16 | fit2 <- coxph(Surv(time, status) ~ age + sex:strata(ph.ecog), tdata) 17 | 18 | aeq(fit1$coef, fit2$coef) 19 | aeq(fit1$var, fit2$var) 20 | aeq(predict(fit1), predict(fit2)) 21 | -------------------------------------------------------------------------------- /tests/strata2.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R Under development (unstable) (2018-04-09 r74565) -- "Unsuffered Consequences" 3 | Copyright (C) 2018 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > # 19 | > # New tests 4/2010 to validate strata by covariate interactions 20 | > # 21 | > library(survival) 22 | > options(na.action=na.exclude) # preserve missings 23 | > options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 24 | > aeq <- function(x,y) all.equal(as.vector(x), as.vector(y)) 25 | > 26 | > tdata <- lung 27 | > tdata$sex <- lung$sex +3 28 | > 29 | > # Both of these should produce warning messages about singular X, since there 30 | > # are ph.ecog=3 subjects in only 1 of the strata. 31 | > # Does not affect the test 32 | > fit1 <- coxph(Surv(time, status) ~ age + sex:strata(ph.ecog), lung) 33 | > fit2 <- coxph(Surv(time, status) ~ age + sex:strata(ph.ecog), tdata) 34 | > 35 | > aeq(fit1$coef, fit2$coef) 36 | [1] TRUE 37 | > aeq(fit1$var, fit2$var) 38 | [1] TRUE 39 | > aeq(predict(fit1), predict(fit2)) 40 | [1] TRUE 41 | > 42 | > proc.time() 43 | user system elapsed 44 | 0.692 0.036 0.727 45 | -------------------------------------------------------------------------------- /tests/stratatest.R: -------------------------------------------------------------------------------- 1 | options(na.action=na.exclude) # preserve missings 2 | options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 3 | library(survival) 4 | 5 | # 6 | # Trivial test of stratified residuals 7 | # Make a second strata = replicate of the first, and I should get the 8 | # exact same answers 9 | test1 <- data.frame(time= c(9, 3,1,1,6,6,8), 10 | status=c(1,NA,1,0,1,1,0), 11 | x= c(0, 2,1,1,1,0,0)) 12 | test2 <- data.frame(start=c(1, 2, 5, 2, 1, 7, 3, 4, 8, 8), 13 | stop =c(2, 3, 6, 7, 8, 9, 9, 9,14,17), 14 | event=c(1, 1, 1, 1, 1, 1, 1, 0, 0, 0), 15 | x =c(1, 0, 0, 1, 0, 1, 1, 1, 0, 0) ) 16 | 17 | temp <- as.matrix(test1) 18 | n <- nrow(temp) 19 | ndead<- sum(test1$status[!is.na(test1$status)]) 20 | temp <- data.frame(rbind(temp, temp)) #later releases of S have rbind.data.frame 21 | tstrat <- rep(1:2, c(n,n)) 22 | 23 | fit1 <- coxph(Surv(time, status) ~x, test1) 24 | fit2 <- coxph(Surv(time, status) ~x + strata(tstrat), temp) 25 | 26 | all.equal(resid(fit1) , (resid(fit2))[1:n]) 27 | all.equal(resid(fit1, type='score') , (resid(fit2, type='score'))[1:n]) 28 | all.equal(resid(fit1, type='schoe') , (resid(fit2, type='schoe'))[1:ndead]) 29 | 30 | 31 | #AG model 32 | temp <- as.matrix(test2) 33 | n <- nrow(temp) 34 | ndead<- sum(test2$event[!is.na(test2$event)]) 35 | temp <- data.frame(rbind(temp, temp)) 36 | tstrat <- rep(1:2, c(n,n)) 37 | 38 | fit1 <- coxph(Surv(start, stop, event) ~x, test2) 39 | fit2 <- coxph(Surv(start, stop, event) ~x + strata(tstrat), temp) 40 | 41 | all.equal(resid(fit1) , (resid(fit2))[1:n]) 42 | all.equal(resid(fit1, type='score') , (resid(fit2, type='score'))[1:n]) 43 | all.equal(resid(fit1, type='schoe') , (resid(fit2, type='schoe'))[1:ndead]) 44 | -------------------------------------------------------------------------------- /tests/surv.R: -------------------------------------------------------------------------------- 1 | # 2 | library(survival) 3 | 4 | # Some simple tests of the Surv function 5 | # The first two are motivated by a bug, pointed out by Kevin Buhr, 6 | # where a mixture of NAs and invalid values didn't work right 7 | # Even for the simplest things a test case is good. 8 | # All but the third should produce warning messages 9 | aeq <- function(x,y) all.equal(as.vector(x), as.vector(y)) 10 | temp <- Surv(c(1, 10, 20, 30), c(2, NA, 0, 40), c(1,1,1,1)) 11 | aeq(temp, c(1,10,NA,30, 2,NA,0,40, 1,1,1,1)) 12 | 13 | temp <- Surv(c(1, 10, 20, 30), c(2, NA, 0, 40), type='interval2') 14 | aeq(temp, c(1,10,20,30, 2,1,1,40, 3,0,NA,3)) 15 | 16 | #No error 17 | temp <- Surv(1:5) 18 | aeq(temp, c(1:5, 1,1,1,1,1)) 19 | 20 | temp1 <- Surv(c(1,10,NA, 30, 30), c(1,NA,10,20, 40), type='interval2') 21 | temp2 <- Surv(c(1,10,10,30,30), c(9, NA, 5, 20,40), c(1, 0, 2,3,3), 22 | type='interval') 23 | aeq(temp1, temp2) 24 | aeq(temp1, c(1,10,10,30,30, 1,1,1,1, 40, 1,0,2,NA,3)) 25 | 26 | # Use of inf 27 | temp1 <- Surv(c(1,10,NA, 30, 30), c(1,NA,10,30, 40), type='interval2') 28 | temp2 <- Surv(c(1,10,-Inf, 30, 30), c(1,Inf,10,30, 40), type='interval2') 29 | aeq(temp1, temp2) 30 | 31 | # Verify sorting and order routines 32 | # These fail in 3.4, succeed in 3.5 due to a system change in how 33 | # xtfrm.Surv is used. 34 | x1 <- Surv(c(4, 6, 3, 2, 1, NA, 2), c(1,0, NA, 0,1,1,1)) 35 | all.equal(order(x1), c(5,7, 4, 1, 2, 3, 6)) 36 | all.equal(order(x1, decreasing=TRUE), c(2,1,4,7,5, 3, 6)) 37 | all.equal(sort(x1), x1[c(5,7,4,1,2)]) 38 | 39 | x2 <- Surv(c(4, 6, 3, 2, 1, NA, 2), c(1,0, NA, 0,1,1,1), type='left') 40 | all.equal(order(x2), c(5,4, 7, 1, 2, 3, 6)) 41 | 42 | x3 <- Surv(c(1,5,NA,7, 9), c(6, 6, 4, NA, 9), type="interval2") 43 | all.equal(sort(x3), x3[c(1,3,2,4,5)]) 44 | 45 | x4 <- Surv(c(1,5,6,5,2, 4), c(3, 7, 7, 6, 3, NA), factor(c(1, 2, 0, 1, 1, 0))) 46 | all.equal(sort(x4), x4[c(1, 5, 4, 2,3)]) 47 | all.equal(sort(x4, na.last=FALSE), x4[c(6,1,5,4,2,3)]) 48 | -------------------------------------------------------------------------------- /tests/survfit2.R: -------------------------------------------------------------------------------- 1 | library(survival) 2 | # 3 | # Check out the Dory&Korn confidence interval option 4 | # 5 | tdata <- data.frame(time= 1:10, 6 | status=c(1,0,1,0,1,0,0,0,1,0)) 7 | 8 | fit1 <- survfit(Surv(time, status) ~1, tdata, conf.lower='modified') 9 | fit2 <- survfit(Surv(time, status) ~1, tdata) 10 | 11 | stdlow <- fit2$std.err * sqrt(c(1, 10/9, 1, 8/7, 1, 6/5, 6/4, 6/3, 1, 2/1)) 12 | lower <- exp(log(fit2$surv) - qnorm(.975)*stdlow) 13 | all.equal(fit1$lower, lower, check.attributes=FALSE) 14 | -------------------------------------------------------------------------------- /tests/survfit2.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R Under development (unstable) (2019-01-23 r76006) -- "Unsuffered Consequences" 3 | Copyright (C) 2019 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > library(survival) 19 | > # 20 | > # Check out the Dory&Korn confidence interval option 21 | > # 22 | > tdata <- data.frame(time= 1:10, 23 | + status=c(1,0,1,0,1,0,0,0,1,0)) 24 | > 25 | > fit1 <- survfit(Surv(time, status) ~1, tdata, conf.lower='modified') 26 | > fit2 <- survfit(Surv(time, status) ~1, tdata) 27 | > 28 | > stdlow <- fit2$std.err * sqrt(c(1, 10/9, 1, 8/7, 1, 6/5, 6/4, 6/3, 1, 2/1)) 29 | > lower <- exp(log(fit2$surv) - qnorm(.975)*stdlow) 30 | > all.equal(fit1$lower, lower, check.attributes=FALSE) 31 | [1] TRUE 32 | > 33 | > proc.time() 34 | user system elapsed 35 | 0.748 0.036 0.786 36 | -------------------------------------------------------------------------------- /tests/testnull.R: -------------------------------------------------------------------------------- 1 | options(na.action=na.exclude) # preserve missings 2 | options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 3 | library(survival) 4 | 5 | # 6 | # A test of NULL models 7 | # 8 | fit1 <- coxph(Surv(stop, event) ~ rx + strata(number), bladder, iter=0) 9 | fit2 <- coxph(Surv(stop, event) ~ strata(number), bladder) 10 | 11 | all.equal(fit1$loglik[2], fit2$loglik) 12 | all.equal(fit1$resid, fit2$resid) 13 | 14 | 15 | fit1 <- coxph(Surv(start, stop, event) ~ rx + strata(number), bladder2, iter=0) 16 | fit2 <- coxph(Surv(start, stop, event) ~ strata(number), bladder2) 17 | 18 | all.equal(fit1$loglik[2], fit2$loglik) 19 | all.equal(fit1$resid, fit2$resid) 20 | -------------------------------------------------------------------------------- /tests/testnull.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 2.7.1 (2008-06-23) 3 | Copyright (C) 2008 The R Foundation for Statistical Computing 4 | ISBN 3-900051-07-0 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > options(na.action=na.exclude) # preserve missings 19 | > options(contrasts=c('contr.treatment', 'contr.poly')) #ensure constrast type 20 | > library(survival) 21 | Loading required package: splines 22 | > 23 | > # 24 | > # A test of NULL models 25 | > # 26 | > fit1 <- coxph(Surv(stop, event) ~ rx + strata(number), bladder, iter=0) 27 | > fit2 <- coxph(Surv(stop, event) ~ strata(number), bladder) 28 | > 29 | > all.equal(fit1$loglik[2], fit2$loglik) 30 | [1] TRUE 31 | > all.equal(fit1$resid, fit2$resid) 32 | [1] TRUE 33 | > 34 | > 35 | > fit1 <- coxph(Surv(start, stop, event) ~ rx + strata(number), bladder2, iter=0) 36 | > fit2 <- coxph(Surv(start, stop, event) ~ strata(number), bladder2) 37 | > 38 | > all.equal(fit1$loglik[2], fit2$loglik) 39 | [1] TRUE 40 | > all.equal(fit1$resid, fit2$resid) 41 | [1] TRUE 42 | > 43 | -------------------------------------------------------------------------------- /tests/tiedtime.R: -------------------------------------------------------------------------------- 1 | library(survival) 2 | 3 | # 4 | # The survival code was failing for certain data sets when called as 5 | # survfit(Surv(time2-time1, status) ~ ...... 6 | # The issue was how tied floating point numbers are handled, and the 7 | # fact that unique(x), factor(x) and tapply(x) are not guarranteed to 8 | # all be the same. 9 | # This test fails in survival 2.36-5, fixed in 2.36-6. Data sets that 10 | # can cause it are few and far between. 11 | # 12 | 13 | load('ties.rda') 14 | x <- time2 -time1 15 | 16 | # Here is the heart of the old problem 17 | # length(unique(x))== length(table(x)) 18 | # And the prior fix which worked ALMOST always 19 | # x <- round(x, 15) 20 | # length(unique(round(x,15)))== length(table(round(x,15))) 21 | 22 | fit1 <- survfit(Surv(x) ~1) 23 | length(fit1$time) == length(fit1$surv) 24 | 25 | 26 | # a second test, once "rounding.R" 27 | 28 | tdata <- data.frame(time=c(1,2, sqrt(2)^2, 2, sqrt(2)^2), 29 | status=rep(1,5), 30 | group=c(1,1,1,2,2)) 31 | fit <- survfit(Surv(time, status) ~ group, data=tdata) 32 | 33 | all.equal(sum(fit$strata), length(fit$time)) 34 | -------------------------------------------------------------------------------- /tests/ties.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survival/36b56a5d8014d3a5ed29fb111303955e3e28f13f/tests/ties.rda -------------------------------------------------------------------------------- /tests/update.R: -------------------------------------------------------------------------------- 1 | library(survival) 2 | 3 | # the way a +cluster() term is handled in coxph has implications for update. 4 | 5 | fit1 <- coxph(Surv(time, status) ~ age, cluster= inst, lung) 6 | fit2 <- coxph(Surv(time, status) ~ age + cluster(inst), lung) 7 | all.equal(fit1, fit2) 8 | 9 | fit3 <- coxph(Surv(time, status) ~ age + sex + cluster(inst), lung) 10 | 11 | test1 <- update(fit1, .~ .+ sex) 12 | all.equal(test1, fit3) 13 | 14 | # Gives a spurious warning message 15 | test2 <- update(fit1, . ~ age + sex + cluster(inst), lung) 16 | all.equal(test2, fit3) 17 | 18 | -------------------------------------------------------------------------------- /tests/update.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R Under development (unstable) (2019-08-23 r77061) -- "Unsuffered Consequences" 3 | Copyright (C) 2019 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > library(survival) 19 | > 20 | > # the way a +cluster() term is handled in coxph has implications for update. 21 | > 22 | > fit1 <- coxph(Surv(time, status) ~ age, cluster= inst, lung) 23 | > fit2 <- coxph(Surv(time, status) ~ age + cluster(inst), lung) 24 | > all.equal(fit1, fit2) 25 | [1] TRUE 26 | > 27 | > fit3 <- coxph(Surv(time, status) ~ age + sex + cluster(inst), lung) 28 | > 29 | > test1 <- update(fit1, .~ .+ sex) 30 | > all.equal(test1, fit3) 31 | [1] TRUE 32 | > 33 | > # Gives a spurious warning message 34 | > test2 <- update(fit1, . ~ age + sex + cluster(inst), lung) 35 | Warning message: 36 | In coxph(formula = Surv(time, status) ~ age + sex + cluster(inst), : 37 | cluster appears both in a formula and as an argument, formula term ignored 38 | > all.equal(test2, fit3) 39 | [1] TRUE 40 | > 41 | > 42 | > proc.time() 43 | user system elapsed 44 | 0.751 0.039 0.791 45 | -------------------------------------------------------------------------------- /tests/yates2.R: -------------------------------------------------------------------------------- 1 | library(survival) 2 | # Tests for glm 3 | 4 | gfit1 <- glm(skips ~ Mask* Opening + Solder, data=solder, poisson) 5 | yg1 <- yates(gfit1, ~Mask) 6 | yg2 <- yates(gfit1, ~ Mask, predict='response') 7 | -------------------------------------------------------------------------------- /vignettes/multi.Rnw: -------------------------------------------------------------------------------- 1 | \documentclass{article} 2 | \usepackage{Sweave} 3 | \usepackage{amsmath} 4 | \title{Multi-state models as a data exploration tool} 5 | \author{Terry Therneau} 6 | %\VignetteIndexEntry{Multi-state survival curves} 7 | 8 | \begin{document} 9 | \maketitle 10 | 11 | This vignette has been absorbed into the overall `survival' vignette. 12 | \end{document} 13 | --------------------------------------------------------------------------------