[med-svn] [r-cran-etm] 05/07: New upstream version 0.6-2
Andreas Tille
tille at debian.org
Thu Oct 19 10:30:27 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-etm.
commit 8aad6a4365ae3056f09d9204ca999e9832aa0654
Author: Andreas Tille <tille at debian.org>
Date: Thu Oct 19 12:29:02 2017 +0200
New upstream version 0.6-2
---
ChangeLog | 147 ++++++++++
DESCRIPTION | 14 +
MD5 | 67 +++++
NAMESPACE | 20 ++
R/ci.transfo.R | 68 +++++
R/clos.R | 172 +++++++++++
R/etm.R | 335 +++++++++++++++++++++
R/etmCIF.R | 77 +++++
R/extract.R | 67 +++++
R/ggtransfo.etm.R | 36 +++
R/lines.etm.R | 58 ++++
R/misc.R | 59 ++++
R/plot.clos.etm.R | 56 ++++
R/plot.etm.R | 89 ++++++
R/plot.etmCIF.R | 127 ++++++++
R/prepare.los.data.R | 107 +++++++
R/print.clos.etm.R | 15 +
R/print.etm.R | 29 ++
R/print.etmCIF.R | 39 +++
R/print.summary.etm.R | 20 ++
R/pseudo_clos.R | 178 ++++++++++++
R/summary.etm.R | 42 +++
R/summary.etmCIF.R | 46 +++
R/transfoData.R | 118 ++++++++
R/xyplot.etm.R | 46 +++
build/vignette.rds | Bin 0 -> 243 bytes
data/abortion.txt.gz | Bin 0 -> 4612 bytes
data/fourD.rda | Bin 0 -> 9467 bytes
data/los.data.csv.gz | Bin 0 -> 3189 bytes
data/sir.cont.txt.gz | Bin 0 -> 10609 bytes
debian/README.source | 22 --
debian/README.test | 8 -
debian/changelog | 18 --
debian/compat | 1 -
debian/control | 25 --
debian/copyright | 30 --
debian/docs | 3 -
debian/rules | 3 -
debian/source/format | 1 -
debian/tests/control | 3 -
debian/tests/run-unit-test | 39 ---
debian/watch | 2 -
inst/CITATION | 20 ++
inst/doc/etmCIF_tutorial.R | 115 ++++++++
inst/doc/etmCIF_tutorial.Rnw | 302 +++++++++++++++++++
inst/doc/etmCIF_tutorial.pdf | Bin 0 -> 164890 bytes
man/abortion.Rd | 35 +++
man/clos.Rd | 145 ++++++++++
man/closPseudo.Rd | 116 ++++++++
man/etm.Rd | 198 +++++++++++++
man/etmCIF.Rd | 69 +++++
man/etmprep.Rd | 96 ++++++
man/fourD.Rd | 47 +++
man/ggtransfo.Rd | 128 ++++++++
man/lines.etm.Rd | 51 ++++
man/los.data.Rd | 30 ++
man/phiPseudo.Rd | 70 +++++
man/plot.clos.etm.Rd | 53 ++++
man/plot.etm.Rd | 73 +++++
man/plot.etmCIF.Rd | 84 ++++++
man/prepare.los.data.Rd | 35 +++
man/print.clos.etm.Rd | 25 ++
man/print.etm.Rd | 29 ++
man/print.etmCIF.Rd | 26 ++
man/sir.cont.Rd | 56 ++++
man/summary.etm.Rd | 48 +++
man/summary.etmCIF.Rd | 43 +++
man/tra.Rd | 58 ++++
man/trprob_trcov.Rd | 74 +++++
man/xyplot.etm.Rd | 43 +++
src/cov_dna.c | 96 ++++++
src/los_etm.cc | 195 +++++++++++++
src/matrix.cc | 490 +++++++++++++++++++++++++++++++
src/matrix.h | 124 ++++++++
src/risk_set_etm.c | 42 +++
tests/test.etmCIF.R | 142 +++++++++
tests/test.etmCIF.Rout.save | 516 +++++++++++++++++++++++++++++++++
tests/tests.etm.R | 220 ++++++++++++++
tests/tests.etm.Rout.save | 659 ++++++++++++++++++++++++++++++++++++++++++
vignettes/etmCIF_tutorial.Rnw | 302 +++++++++++++++++++
80 files changed, 6887 insertions(+), 155 deletions(-)
diff --git a/ChangeLog b/ChangeLog
new file mode 100644
index 0000000..3186c21
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,147 @@
+9-12-2014 Arthur Allignol <arthur.allignol at uni-ulm.de>
+
+ * help page for ggtransfo + exmaples
+ * ggplot2 in suggest
+ * remove changeLOS from suggest. Update tests and
+ help pages accordingly
+ * rerun of the tests
+
+7-10-2014 Arthur Allignol <arthur.allignol at uni-ulm.de>
+
+ Version 0.6-2
+ * etm: Implementation of the variance of CIF with Lai and Ying
+ transformation.
+
+24-3-2014 Arthur Allignol <arthur.allignol at uni-ulm.de>
+
+ Version 0.6-1
+ * etmprep: Bug fix in error handling of the start argument
+ * etmprep: Bug fix in the dealing of to and from when state
+ names are given
+
+2013-9-19 Arthur Allignol <arthur.allignol at uni-ulm.de>
+
+ * Version number 0.6
+ * NEW: pseudo value regression for excess LoS (see closPseudo)
+
+2012-04-02 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * new version 0.5-3
+ * clos: All references to the changeLOS package removed from the doc
+ * etm: removed the use of .internal()
+
+2011-11-3 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * etm: *EXPERIMENTAL* Product limit modification following Lai and Ying
+
+2010-12-6 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * New version 0.5-2
+ * sir.cont: Two new covariates age and sex
+
+2010-11-24 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * New version number 0.5-1
+ * CITATION: new file
+
+2010-11-3 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * fourD : New data set
+ * etmCIF and methods print, summary, plot: New functions
+ Lead to add survival package in the dependencies
+ * etm: Fixed warning message when no censoring but still defined in the call
+ * etm and methods: Fix to deal with more complicated state names (e.g.,
+ with characters with spaces)
+ * vignette: A vignette on etmCIF has been added. Has a view towards CIFs for pregnancy data
+
+2009-11-11 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * lines.etm: New function
+
+ * plot.etm: Rewritten.
+ Possibility to draw confidence intervals.
+
+ * xyplot.etm: Consistency checking on tr.choice argument modified.
+
+2009-8-21 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * Bug fix: in clos.cp and clos.nocp, O's were not in the right place for computing
+ the weighted summary when P(X_s = 1) . P(X_s = 0) = 0
+
+2009-7-30 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * print.etm and print.summary.etm now return nothing,
+ while before they returned x with the invisible flag set
+
+ * Choice of the transformation for the confidence intervals
+ in the avec.cov function is now done with switch instead of
+ using several ifs
+
+ * Bug correction: Tests on the tr.choice argument in xyplot,
+ trprob and trcov methods was done comparing it to the rownames
+ of the covariance matrix, which didn't make sense when etm was
+ called with argument covariance set to FALSE, and thrown an error
+ even if tr.choice was good.
+
+2009-7-28 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * New function etmprep that transform data in the wide format
+ into the long format, in a way suitable for using the etm function.
+
+ * New generics trprob and trcov and methods for etm objects.
+
+2009-6-12 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * New plot function for clos.etm objects
+
+2009-6-9 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * New aw argument to clos. Whether use alternative weighting
+ to compute the expected change in LOS
+ * Implementation of the alternative weighting
+
+2009-6-8 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * New argument to etm: delta.na which decides whether to include in
+ the output the increments of the Nelson-Aalen estimator
+ * Implementation of the Change of Length of Stay following changeLOS
+ package. Though here, it works with left-truncated data, and
+ doesn't require competing outcomes
+
+2009-4-9 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * New internal function ci.transfo() that transforms etm objects and computes pointwise CIs
+ * Modification of summary.etm that now uses ci.transform
+ * Modification of xyplot.etm. Uses ci.transform, and plots CI
+ * New data set abortion
+
+2009-2-4 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * bug correction
+
+2009-1-9 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * Modification of sir.cont.Rd
+
+2008-12-9 Arthur Allignol <arthur.allignol at fdm.uni-freiburg>
+
+ * Modification of print and summary
+ new arguments
+ * cov.dna now in C
+
+2008-11-19 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * Modification of the print an summary methods
+ * Now result of summary is printed via print.summary.etm()
+ * In etm: better handling when there's no event between (s, t]
+
+2008-10-14 Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+ * Bug correction: now works when there is only 1 transient state.
+ * Modification of the part which transforms the data into counting process
+ * Modification of the C++ routine
+ that is now faster nd computes the increments
+ of the Nelson-Aalen estimator
+ * Add a plot function
+
+
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..2dc45d4
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,14 @@
+Package: etm
+Title: Empirical Transition Matrix
+Version: 0.6-2
+Author: Arthur Allignol
+Description: Matrix of transition probabilities for any time-inhomogeneous multistate model with finite state space
+Maintainer: Arthur Allignol <arthur.allignol at uni-ulm.de>
+License: GPL (>= 2)
+Depends: R (>= 2.14), survival
+Imports: lattice
+Suggests: ggplot2, kmi, geepack
+Packaged: 2014-12-09 13:12:40 UTC; arthur
+NeedsCompilation: yes
+Repository: CRAN
+Date/Publication: 2014-12-09 14:57:15
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..7bbf074
--- /dev/null
+++ b/MD5
@@ -0,0 +1,67 @@
+d669fb109b9e87292da9d4201b52c7c9 *ChangeLog
+a90f15f200f43e7d4e7723ef95a37763 *DESCRIPTION
+a0e69954bb848fa110ca164c01c07848 *NAMESPACE
+c769759089889310b44037f7e19f70e7 *R/ci.transfo.R
+161631858c05a6977a4d54263bb78266 *R/clos.R
+d139e9461403cfe36837c0439720c1a7 *R/etm.R
+3181f08b7c8e6c9c306ef4b299deca2f *R/etmCIF.R
+91c190eca501eb828fb96f4fd476519f *R/extract.R
+441c49e0a746a7db6a8a4a1215b751fd *R/ggtransfo.etm.R
+34526139ea7e43e28181a7a04624b279 *R/lines.etm.R
+02a37d5e97f248e95c43dcdac6388624 *R/misc.R
+294bf2ed86d5a09fb528b776e0350eb9 *R/plot.clos.etm.R
+d8cba6e584cbfb681e5e23d99f9315fc *R/plot.etm.R
+13326457eca65d52983c2d6694026c3d *R/plot.etmCIF.R
+20031106830e8896903538717169541a *R/prepare.los.data.R
+f18f5b80b9470edaa72732e1852b3c81 *R/print.clos.etm.R
+f293e5e4a831f1636abf65446b5a3f6c *R/print.etm.R
+f087d944a523516bee415d5bdab898d0 *R/print.etmCIF.R
+cf52ae3579e299ad0a6f57d998c960b0 *R/print.summary.etm.R
+9639135f498d9298226ae02df87db62c *R/pseudo_clos.R
+6b60e2b1f5e65ecf5480fd858cae7e98 *R/summary.etm.R
+e65aacbc0b2bf7de232d5a419dc4e820 *R/summary.etmCIF.R
+1c0e9ec7428a9f91839b880b22ec7565 *R/transfoData.R
+ccbc25c8a47d56c4961cba60d48d9671 *R/xyplot.etm.R
+2aaf40c683563d5bf3db07140fde8e94 *build/vignette.rds
+476bcb434771e9b96558abd030d09396 *data/abortion.txt.gz
+6ab49cb48191ac4da0f54e4804f19ea1 *data/fourD.rda
+dcae240445955c2f848e08eb333100c2 *data/los.data.csv.gz
+baba7e394ff9255728343ee4dc10b546 *data/sir.cont.txt.gz
+36b4ecf2f670d7cc5dbd8ffc8393bf39 *inst/CITATION
+c04ec76345a113c49c88ff0015dd6976 *inst/doc/etmCIF_tutorial.R
+1d3dd06a96abe63ec23af1df8a759eda *inst/doc/etmCIF_tutorial.Rnw
+d5d343bc22b8b2afc41e7dff0b76a999 *inst/doc/etmCIF_tutorial.pdf
+5541acbfe1040be8fbb765e7d2f193fe *man/abortion.Rd
+298fe0940bb5d53ace5a0e9d4cb790e6 *man/clos.Rd
+e986af8cf8fbeaaf64fd080cb74f6014 *man/closPseudo.Rd
+d10655aab3b4473c458db8a728c9cd42 *man/etm.Rd
+87813817aac9adb8355c24aa48acf1df *man/etmCIF.Rd
+24e166bb6e78e768b8686a2348afadaa *man/etmprep.Rd
+fd38028a1eabb4129f91a55efe1b1ea1 *man/fourD.Rd
+49df768ad47ee3ddb9b92fe2ee7b5500 *man/ggtransfo.Rd
+fb345ee72450087492d23b43bb67f33e *man/lines.etm.Rd
+c1b89e51669d0c7a05cced57bcb65931 *man/los.data.Rd
+150641802b829978725aadc8fd7f7f95 *man/phiPseudo.Rd
+b47923be875349fadae3ab51e17b3561 *man/plot.clos.etm.Rd
+47989b691389928ae10d0aaa2c4c95c9 *man/plot.etm.Rd
+3306d47cd6d768ca9869f4b544ace52f *man/plot.etmCIF.Rd
+37ece37de86bb13e66c65dd32fe9f884 *man/prepare.los.data.Rd
+73575602cc041aea49b64a0fff90e29f *man/print.clos.etm.Rd
+3de6acf45b4d863641b46b8d99cbab83 *man/print.etm.Rd
+9e459a95d651bc276391c0dfdf6f58cf *man/print.etmCIF.Rd
+474d026085ee1807de4de6426dcf549c *man/sir.cont.Rd
+fe0facea35751ae612521566750302b5 *man/summary.etm.Rd
+83bcbc426557dcec08f02a99eae3f229 *man/summary.etmCIF.Rd
+c7061cba7c3e3106b2074ca58beba9fb *man/tra.Rd
+6dd847e3ac794979dce68bc193d7018b *man/trprob_trcov.Rd
+b8d5092f9391804dce102fd1998e28df *man/xyplot.etm.Rd
+c7f5114c2954466b8fda5207bd5c7ee5 *src/cov_dna.c
+4ac9ec1ce02d321c61c28e18fbd49e15 *src/los_etm.cc
+a58cd565dd706afa4346ddd996a82959 *src/matrix.cc
+bef22e0261a86cdd7d4044ac94c550e5 *src/matrix.h
+d4c110cdbcab77b2f6a7b123065726df *src/risk_set_etm.c
+3d17b4ab9ed7ca8a3663c169d20e251b *tests/test.etmCIF.R
+272293fad90eb63d397f365a49a4fd6f *tests/test.etmCIF.Rout.save
+5bc88e30c083317f1f35cc2de10ae812 *tests/tests.etm.R
+b39cb79846ef3382614861486df05be5 *tests/tests.etm.Rout.save
+1d3dd06a96abe63ec23af1df8a759eda *vignettes/etmCIF_tutorial.Rnw
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..8f97db7
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,20 @@
+import(lattice, survival, parallel)
+export(etm, summary.etm, clos, trcov, trprob, ggtransfo, etmprep,
+ etmCIF, summary.etmCIF, closPseudo, phiPseudo,
+ tra_ill, tra_ill_comp, tra_comp, tra_surv, prepare.los.data)
+S3method(xyplot, etm)
+S3method(print, etm)
+S3method(summary, etm)
+S3method(print, summary.etm)
+S3method(plot, etm)
+S3method(lines, etm)
+S3method(print, clos.etm)
+S3method(plot, clos.etm)
+S3method(trprob, etm)
+S3method(trcov, etm)
+S3method(print, etmCIF)
+S3method(plot, etmCIF)
+S3method(summary, etmCIF)
+S3method(print, summary.etmCIF)
+S3method(ggtransfo, etm)
+useDynLib(etm, risk_set_etm, cov_dna, los_cp, los_nocp)
diff --git a/R/ci.transfo.R b/R/ci.transfo.R
new file mode 100644
index 0000000..edf30da
--- /dev/null
+++ b/R/ci.transfo.R
@@ -0,0 +1,68 @@
+sans.cov <- function(i, object, trs.sep) {
+ P <- object$est[trs.sep[i, 1], trs.sep[i, 2], ]
+ time <- object$time
+ n.event <- object$n.event[trs.sep[i, 1], trs.sep[i, 2], ]
+ n.risk <- object$n.risk[, trs.sep[i, 1]]
+ data.frame(P, time, n.risk, n.event)
+}
+
+avec.cov <- function(i, object, transfo, trs.sep, trs, level) {
+ P <- object$est[trs.sep[i, 1], trs.sep[i, 2], ]
+ time <- object$time
+ n.event <- object$n.event[trs.sep[i, 1], trs.sep[i, 2], ]
+ n.risk <- object$n.risk[, trs.sep[i, 1]]
+ var <- object$cov[trs[[i]], trs[[i]], ]
+ alpha <- qnorm(level + (1 - level) / 2)
+ switch(transfo[i],
+ "linear" = {
+ lower <- P - alpha * sqrt(var)
+ upper <- P + alpha * sqrt(var)
+ },
+ "log" = {
+ lower <- exp(log(P) - alpha * sqrt(var) / P)
+ upper <- exp(log(P) + alpha * sqrt(var) / P)
+ },
+ "cloglog" = {
+ lower <- 1 - (1 - P)^(exp(alpha * (sqrt(var) / ((1 - P) * log(1 - P)))))
+ upper <- 1 - (1 - P)^(exp(-alpha * (sqrt(var) / ((1 - P) * log(1 - P)))))
+ },
+ "log-log" = {
+ lower <- P^(exp(-alpha * (sqrt(var) / (P * log(P)))))
+ upper <- P^(exp(alpha * (sqrt(var) / (P * log(P)))))
+ })
+ lower <- pmax(lower, 0)
+ upper <- pmin(upper, 1)
+ data.frame(P, time, var, lower, upper, n.risk, n.event)
+}
+
+
+ci.transfo <- function(object, tr.choice, level = 0.95, transfo = "linear") {
+ if (!inherits(object, "etm")) {
+ stop ("'x' must be of class 'etm'")
+ }
+ lt <- length(tr.choice)
+ trs <- tr.choice
+ trs.sep <- lapply(trs, strsplit, split = " ")
+ ## Fixing separation of states with names including a space
+ for (i in seq_along(trs.sep)) {
+ if (length(trs.sep[[i]][[1]]) == 2) {
+ next
+ } else {
+ tt <- charmatch(trs.sep[[i]][[1]], object$state.names, nomatch = 0)
+ trs.sep[[i]][[1]] <- object$state.names[tt]
+ }
+ }
+ trs.sep <- matrix(unlist(trs.sep), length(trs.sep), 2, byrow = TRUE)
+ if (length(transfo) != lt)
+ transfo <- rep(transfo[1], lt)
+ if (is.null(object$cov)) {
+ res <- lapply(seq_len(lt), sans.cov, object = object, trs.sep = trs.sep)
+ }
+ else {
+ res <- lapply(seq_len(lt), avec.cov, object = object, transfo = transfo,
+ trs.sep = trs.sep, trs = trs, level = level)
+ }
+ names(res) <- tr.choice
+ res
+}
+
diff --git a/R/clos.R b/R/clos.R
new file mode 100644
index 0000000..fe03c77
--- /dev/null
+++ b/R/clos.R
@@ -0,0 +1,172 @@
+### To be used for competing endpoints
+clos.cp <- function(x, tr.mat, aw, ratio) {
+ dims <- dim(x$est)
+ los <- matrix(rep(x$time, 3), ncol = 3, byrow = FALSE)
+ phi2 <- matrix(data=c(x$time, rep(0, dims[3]), rep(0, dims[3])),
+ ncol=3, byrow=FALSE)
+ phi3 <- matrix(data=c(x$time, rep(0, dims[3]), rep(0, dims[3])),
+ ncol=3, byrow=FALSE)
+ ind.cens <- apply(x$n.event, 3, function(r) all(r == 0))
+ tau <- max(x$time[ind.cens], x$time)
+
+ out <- .C(los_cp,
+ as.double(x$time),
+ as.double(tr.mat),
+ as.integer(dims[3]),
+ as.integer(dims[1]),
+ as.integer(dims[2]),
+ los1 = as.double(los[,2]),
+ los0 = as.double(los[,3]),
+ phi2case = as.double(phi2[,2]),
+ phi2control = as.double(phi2[,3]),
+ phi3case = as.double(phi3[,2]),
+ phi3control = as.double(phi3[,3]),
+ as.double(tau))
+
+ los[, 2] <- out$los0
+ los[, 3] <- out$los1
+ phi2[, 3] <- out$phi2case; phi2[, 2] <- out$phi2control
+ phi3[, 3] <- out$phi3case; phi3[, 2] <- out$phi3control
+ indi <- apply(x$n.event, 3, function(x) {sum(x[1, ]) != 0})
+ wait.times <- x$time[indi]
+ wait.prob <- x$est["0", "0", ][indi]
+ my.weights <- diff(c(0, 1 - wait.prob))
+
+ pp <- x$n.risk[-1, ]
+ ev.last <- apply(x$n.event[, , dims[3]], 1, sum)[1:2]
+ pp <- rbind(pp, pp[nrow(pp), ] - ev.last)
+ filtre <- pp[, 1] <= 0 | pp[, 2] <= 0
+
+ tmp <- list(los, phi2, phi3)
+ estimates <- lapply(tmp, function(z) {
+ if (ratio) {
+ ldiff <- z[, 3] / z[, 2]
+ } else {
+ ldiff <- z[, 3] - z[, 2]
+ }
+ ldiff[filtre] <- 0
+ estimate <- matrix(ldiff[is.element(z[, 1], wait.times)], nrow = 1) %*%
+ matrix(my.weights, ncol=1)
+ estimate
+ })
+
+ e.phi.w1 <- e.phi.w23 <- my.weights1 <- my.weights23 <- NULL
+ if (aw) {
+ cif1 <- cumsum(c(1, x$est["0", "0", 1:(dims[3] - 1)]) * tr.mat[1, 2, ])
+ my.weights1 <- diff(c(0, cif1[indi])) / cif1[length(cif1)]
+ cif23 <- cumsum(c(1, x$est["0", "0", 1:(dims[3] - 1)]) *
+ (tr.mat[1, 3, ] + tr.mat[1, 4, ]))
+ my.weights23 <- diff(c(0, cif23[indi])) / cif23[length(cif23)]
+ weights.aw <- list(my.weights1, my.weights23)
+ estimates.aw <- lapply(weights.aw, function(z) {
+ ldiff <- los[, 3] - los[, 2]
+ ldiff[filtre] <- 0
+ estimate <- matrix(ldiff[is.element(los[, 1], wait.times)], nrow = 1) %*%
+ matrix(z, ncol = 1)
+ estimate
+ })
+ e.phi.w1 <- estimates.aw[[1]]
+ e.phi.w23 <- estimates.aw[[2]]
+ }
+
+ res <- list(e.phi = estimates[[1]], phi.case = los[, 3],
+ phi.control = los[, 2], e.phi2 = estimates[[2]],
+ phi2.case = phi2[, 3], phi2.control = phi2[, 2],
+ e.phi3 = estimates[[3]], phi3.case = phi3[, 3],
+ phi3.control = phi3[, 2], weights = my.weights,
+ w.time = wait.times, time = x$time, e.phi.weights.1 = e.phi.w1,
+ e.phi.weights.other = e.phi.w23, weights.1 = my.weights1,
+ weights.other = my.weights23)
+ res
+}
+
+
+### To be used for single endpoint
+clos.nocp <- function(x, tr.mat, aw, ratio) {
+ dims <- dim(x$est)
+ los <- matrix(rep(x$time, 3), ncol = 3, byrow = FALSE)
+ tau <- max(x$time)
+
+ out <- .C(los_nocp,
+ as.double(x$time),
+ as.double(tr.mat),
+ as.integer(dims[3]),
+ as.integer(dims[1]),
+ as.integer(dims[2]),
+ los1 = as.double(los[,2]),
+ los0 = as.double(los[,3]),
+ as.double(tau))
+
+ los[, 2] <- out$los0
+ los[, 3] <- out$los1
+ indi <- apply(x$n.event, 3, function(x) {sum(x[1, ]) != 0})
+ wait.times <- x$time[indi]
+ wait.prob <- x$est["0", "0", ][indi]
+
+ pp <- x$n.risk[-1, ]
+ ev.last <- apply(x$n.event[, , dims[3]], 1, sum)[1:2]
+ pp <- rbind(pp, pp[nrow(pp), ] - ev.last)
+ filtre <- pp[, 1] <= 0 | pp[, 2] <= 0
+
+ if (ratio) {
+ los.diff <- los[, 3] / los[, 2]
+ } else {
+ los.diff <- los[, 3] - los[, 2]
+ }
+ los.diff[filtre] <- 0
+ my.weights <- diff(c(0, 1 - wait.prob))
+ estimate <- matrix(los.diff[is.element(los[, 1], wait.times)], nrow = 1) %*%
+ matrix(my.weights, ncol=1)
+
+ e.phi.w1 <- e.phi.w2 <- my.weights1 <- my.weights2 <- NULL
+ if (aw) {
+ cif1 <- cumsum(c(1, x$est["0", "0", 1:(dims[3] - 1)]) * tr.mat[1, 2, ])
+ my.weights1 <- diff(c(0, cif1[indi])) / cif1[length(cif1)]
+ cif2 <- cumsum(c(1, x$est["0", "0", 1:(dims[3] - 1)]) * tr.mat[1, 3, ])
+ my.weights2 <- diff(c(0, cif2[indi])) / cif2[length(cif2)]
+ weights.aw <- list(my.weights1, my.weights2)
+ estimates.aw <- lapply(weights.aw, function(z) {
+ ldiff <- los[, 3] - los[, 2]
+ ldiff[filtre] <- 0
+ estimate <- matrix(ldiff[is.element(los[, 1], wait.times)], nrow = 1) %*%
+ matrix(z, ncol = 1)
+ estimate
+ })
+ e.phi.w1 <- estimates.aw[[1]]
+ e.phi.w2 <- estimates.aw[[2]]
+ }
+
+ res <- list(e.phi = estimate[[1]], phi.case = los[, 3],
+ phi.control = los[, 2], weights = my.weights,
+ w.time = wait.times, time = x$time, e.phi.weights.1 = e.phi.w1,
+ e.phi.weights.other = e.phi.w2, weights.1 = my.weights1,
+ weights.other = my.weights2)
+ res
+}
+
+
+
+
+clos <- function(x, aw = FALSE, ratio = FALSE) {
+ if (!inherits(x, "etm")) {
+ stop("'x' must be an 'etm' object")
+ }
+ if (is.null(x$delta.na)) {
+ stop("Needs the increment of the Nelson-Aalen estimator")
+ }
+ absorb <- setdiff(levels(x$trans$to), levels(x$trans$from))
+ transient <- unique(x$state.names[!(x$state.names %in% absorb)])
+ if (!(length(transient) == 2 && length(absorb) %in% c(1, 2)))
+ stop("The multistate model must have 2 transient states \n and 1 or 2 absorbing states")
+ dims <- dim(x$est)
+ comp.risk <- FALSE
+ if (dims[1] == 4) comp.risk <- TRUE
+ I <- diag(1, dims[1])
+ tr.mat <- array(apply(x$delta.na, 3, "+", I), dim = dims)
+ if (comp.risk) {
+ res <- clos.cp(x, tr.mat, aw, ratio)
+ }
+ else res <- clos.nocp(x, tr.mat, aw, ratio)
+ class(res) <- "clos.etm"
+ res
+}
diff --git a/R/etm.R b/R/etm.R
new file mode 100644
index 0000000..b0bf1b5
--- /dev/null
+++ b/R/etm.R
@@ -0,0 +1,335 @@
+prodint <- function(dna, times, first, last, indi) {
+ I <- array(0, dim=dim(dna)[c(1, 2)])
+ diag(I) <- 1
+ if (first >= last) {
+ est <- array(I, dim=c(dim(dna)[c(1, 2)], 1))
+ time <- NULL
+ } else {
+ est <- array(0, dim=c(dim(dna)[c(1, 2)], (last-first+1)))
+ est[, , 1] <- I + dna[, , first] * indi[1]
+ j <- 2
+ for (i in (first + 1):last) {
+ est[, , j] <- est[, , j-1] %*% (I + dna[, , i] * indi[j])
+ j <- j + 1
+ }
+ time <- times[first:last]
+ }
+ list(est=est, time=time)
+}
+
+
+
+#################################################
+### Variance Lai and Ying for competing risks ###
+#################################################
+
+var.ly <- function(est, state.names, nrisk, nev, times, first, last, indi) {
+
+ if (first >= last) {
+ return(NULL)
+
+ } else {
+
+ nCompRisks <- length(state.names) - 1
+
+ ## prepare what we need
+ cif <- n.event <- matrix(nrow = last - first + 1, ncol = nCompRisks)
+ nev <- nev[, , first:last]
+ nrisk <- nrisk[first:last, ]
+ time <- times[first:last]
+ lt <- length(time)
+
+ for (i in seq_len(last - first + 1)) {
+ cif[i, ] <- est[1, 2:(nCompRisks + 1), i]
+ n.event[i, ] <- nev[1, 2:(nCompRisks + 1), i]
+ }
+ sminus <- c(1, est[1, 1, 1:(last - first)])
+ S <- est[1, 1, ]
+
+ ## create the matrix of covariances
+ out <- array(0, dim = c((nCompRisks + 1)^2, (nCompRisks + 1)^2, (last-first+1)))
+
+ ## get the indices on where to put the variance
+ pos <- sapply(1:length(state.names), function(i) {
+ paste(state.names, state.names[i])
+ })
+ pos <- matrix(pos)
+ dimnames(out) <- list(pos, pos, time)
+ pos.cp <- sapply(seq_along(state.names), function(i)
+ paste(state.names[1], state.names[i], sep = " "))[-1]
+ ind.cp <- which(pos %in% pos.cp, arr.ind = TRUE)
+
+ ## the real shebang
+ for (i in seq_along(ind.cp)) {
+ for (j in seq_len(lt)) {
+ f <- cif[1:j, i]
+ s <- sminus[1:j]
+ spasminus <- S[1:j]
+ y <- nrisk[1:j, 1]
+ dn <- rowSums(array(n.event[1:j, ], dim = c(j, nCompRisks)))
+ dnt <- n.event[1:j, i]
+ indi.loop <- indi[1:j]
+ ## from biomJ paper eq. (6)
+ vly <- sum(((f[j] - f)^2 / (y - dn)) * (dn/y) * indi.loop +
+ s^2/y^3 * (y - dnt - 2 * (y - dn) * ((f[j] - f)/spasminus)) * dnt * indi.loop)
+ out[ind.cp[i], ind.cp[i], j] <- vly
+ }
+ }
+ }
+
+ return(out)
+}
+
+
+####################################
+### Variance of the AJ estimator ###
+####################################
+
+var.aj <- function(est, dna, nrisk, nev, times, first, last) {
+ d <- dim(nev)[1]
+ if (first >= last) {
+ return(NULL)
+ } else {
+ out <- array(0, dim=c(dim(dna)[c(1, 2)]^2, (last-first+1)))
+ cov.dna <- matrix(.C(cov_dna,
+ as.double(nrisk[first, ]),
+ as.double(nev[, , first]),
+ as.integer(d),
+ cov = double(d^2 * d^2)
+ )$cov, d^2, d^2)
+ bI <- diag(1, d^2)
+ out[, , 1] <- bI %*% cov.dna %*% bI
+ Id <- diag(1, d)
+ for (i in 1:length(times[(first + 1):last])) {
+ step <- first + i
+ cov.dna <- matrix(.C(cov_dna,
+ as.double(nrisk[step, ]),
+ as.double(nev[, , step]),
+ as.integer(d),
+ cov = double(d^2 * d^2)
+ )$cov, d^2, d^2)
+ out[, , i + 1] <- (t(Id + dna[, , step]) %x% Id) %*% out[, , i] %*%
+ ((Id + dna[, , step]) %x% Id) +
+ (Id %x% est[, , i]) %*% cov.dna %*% (Id %x% t(est[, , i]))
+ }
+ }
+ return(out)
+}
+
+
+
+###########
+### etm ###
+###########
+
+etm <- function(data, state.names, tra, cens.name, s, t="last",
+ covariance=TRUE, delta.na = TRUE, modif = FALSE,
+ alpha = 1/4, c = 1) {
+
+ if (missing(data))
+ stop("Argument 'data' is missing with no default")
+ if (missing(tra))
+ stop("Argument 'tra' is missing with no default")
+ if (missing(state.names))
+ stop("Argument 'state.names' is missing with no default")
+ if (missing(cens.name))
+ stop("Argument 'cens.name' is missing with no default")
+ if (missing(s))
+ stop("Argument 's' is missing with no default")
+ if (!is.data.frame(data))
+ stop("Argument 'data' must be a data.frame")
+ if (!(xor(sum(c("id", "from", "to", "time") %in% names(data)) != 4,
+ sum(c("id", "from", "to", "entry", "exit") %in% names(data)) != 5)))
+ stop("'data' must contain the right variables")
+ if (nrow(tra) != ncol(tra))
+ stop("Argument 'tra' must be a quadratic matrix.")
+ if (sum(diag(tra)) > 0)
+ stop("transitions into the same state are not allowed")
+ if (nrow(tra) != length(state.names)) {
+ stop("The row number of 'tra' must be equal to the number of states.")
+ }
+ if (!is.logical(tra)) {
+ stop("'tra' must be a matrix of logical values, which describes the possible transitions.")
+ }
+ if (length(state.names) != length(unique(state.names))) {
+ stop("The state names must be unique.")
+ }
+ if (!(is.null(cens.name))) {
+ if (cens.name %in% state.names) {
+ stop("The name of the censoring variable just is a name of the model states.")
+ }
+ }
+
+ ## if modif TRUE, check that the model is competing risks. else
+ ## set to false and issue a warning
+ if (modif == TRUE && covariance == TRUE) {
+ ## check for competing risks
+ tr.cp <- tra_comp(length(state.names) - 1)
+ if (any(dim(tra) != dim(tr.cp)) | (all(dim(tra) == dim(tr.cp)) && !all(tra == tr.cp))) {
+ covariance <- FALSE
+ warning("The variance of the estimator with the Lay and Ying transformation is only computed for competing risks data")
+ }
+ }
+
+### transitions
+ colnames(tra) <- rownames(tra) <- state.names
+ t.from <- lapply(1:dim(tra)[2], function(i) {
+ rep(rownames(tra)[i], sum(tra[i, ]))
+ })
+ t.from <- unlist(t.from)
+ t.to <- lapply(1:dim(tra)[2], function(i) {
+ colnames(tra)[tra[i, ]==TRUE]
+ })
+ t.to <- unlist(t.to)
+ trans <- data.frame(from=t.from, to=t.to)
+ namen <- paste(trans[, 1], trans[, 2])
+
+ ## test on transitions
+ test <- unique(paste(data$from, data$to))
+ if (!(is.null(cens.name))) {
+ ref <- c(paste(trans$from, trans$to), paste(unique(trans$from), cens.name))
+ } else {
+ ref <- paste(trans$from, trans$to)
+ }
+ ref.wo.cens <- paste(trans$from, trans$to)
+ if (!(all(test %in% ref)==TRUE))
+ stop("There is undefined transitions in the data set")
+ if (sum(as.character(data$from)==as.character(data$to)) > 0)
+ stop("Transitions into the same state are not allowed")
+ if (!(all(ref.wo.cens %in% test) == TRUE))
+ warning("You may have specified more possible transitions than actually present in the data")
+
+ n <- length(unique(data$id))
+### data.frame transformation
+ data$id <- if (is.character(data$id)) as.factor(data$id) else data$id
+ data$from <- as.factor(data$from)
+ data$to <- as.factor(data$to)
+ if (!(is.null(cens.name))) {
+ data$from <- factor(data$from, levels = c(cens.name, state.names), ordered = TRUE)
+ levels(data$from) <- 0:length(state.names)
+ data$to <- factor(data$to, levels = c(cens.name, state.names), ordered = TRUE)
+ levels(data$to) <- 0:length(state.names)
+ } else{
+ data$from <- factor(data$from, levels = state.names, ordered = TRUE)
+ levels(data$from) <- 1:length(state.names)
+ data$to <- factor(data$to, levels = state.names, ordered = TRUE)
+ levels(data$to) <- 1:length(state.names)
+ }
+
+### if not, put like counting process data
+ if ("time" %in% names(data)) {
+ data <- data[order(data$id, data$time), ]
+ idd <- as.integer(data$id)
+ entree <- double(length(data$time))
+ masque <- rbind(1, apply(as.matrix(idd), 2, diff))
+ entree <- c(0, data$time[1:(length(data$time) - 1)]) * (masque == 0)
+ data <- data.frame(id = data$id, from = data$from,
+ to = data$to, entry = entree, exit = data$time)
+ if (sum(data$entry < data$exit) != nrow(data))
+ stop("Exit time from a state must be > entry time")
+ } else {
+ if (sum(data$entry < data$exit) != nrow(data))
+ stop("Exit time from a state must be > entry time")
+ }
+
+### Computation of the risk set and dN
+ ttime <- c(data$entry, data$exit)
+ times <- sort(unique(ttime))
+ data$from <- as.integer(as.character(data$from))
+ data$to <- as.integer(as.character(data$to))
+ temp <- .C(risk_set_etm,
+ as.integer(nrow(data)),
+ as.integer(length(times)),
+ as.integer(c(dim(tra), length(times))),
+ as.double(times),
+ as.integer(data$from),
+ as.integer(data$to),
+ as.double(data$entry),
+ as.double(data$exit),
+ nrisk=integer(dim(tra)[1] * length(times)),
+ ncens=integer(dim(tra)[1] * length(times)),
+ nev=integer(dim(tra)[1] * dim(tra)[2] * length(times)),
+ dna=double(dim(tra)[1] * dim(tra)[2] * length(times)))
+
+ nrisk <- matrix(temp$nrisk, ncol=dim(tra)[1], nrow=length(times))
+ ncens <- matrix(temp$ncens, ncol=dim(tra)[1], nrow=length(times))
+ nev <- array(temp$nev, dim=c(dim(tra), length(times)))
+ dna <- array(temp$dna, dim=c(dim(tra), length(times)))
+ ii <- seq_len(dim(tra)[1])
+ for (i in seq_along(times)) {
+ dna[cbind(ii, ii, i)] <- -(.rowSums(nev[, , i], dim(nev)[1], dim(nev)[1], FALSE))/nrisk[i, ]
+ ## dna[cbind(ii, ii, i)] <- -(rowSums(nev[, , i])/nrisk[i, ])
+ }
+ dna[is.nan(dna)] <- 0
+
+### computation of the Aalen-Johansen estimator
+ if (t=="last") t <- times[length(times)]
+ if (!(0 <= s & s < t))
+ stop("'s' and 't' must be positive, and s < t")
+ if (t <= times[1] | s >= times[length(times)])
+ stop("'s' or 't' is an invalid time")
+ first <- length(times[times <= s]) + 1
+ last <- length(times[times <= t])
+
+ if (first >= last) {
+ est <- list()
+ est$est <- array(diag(1, dim(tra)[1], dim(tra)[2]), c(dim(tra), 1))
+ dimnames(est$est) <- list(state.names, state.names, t)
+ est$time <- NULL
+ var <- NULL
+ nrisk <- matrix(nrisk[last, ], 1, dim(tra)[1])
+ nev <- array(0, dim(tra))
+
+ } else {
+
+ aa <- nrisk[first:last, ]
+ if (modif) {
+ which.compute <- as.integer(aa >= c * n^alpha)
+ } else {
+ which.compute <- rep(1, length(aa))
+ }
+ est <- prodint(dna, times, first, last, which.compute)
+
+ if (covariance == TRUE) {
+ if (modif == FALSE) {
+ var <- var.aj(est$est, dna, nrisk, nev, times, first, last)
+ pos <- sapply(1:length(state.names), function(i) {
+ paste(state.names, state.names[i])
+ })
+ pos <- matrix(pos)
+ dimnames(var) <- list(pos, pos, est$time)
+
+ } else {
+
+ var <- var.ly(est$est, state.names, nrisk, nev, times, first, last, which.compute)
+ }
+
+ } else {
+ var <- NULL
+ }
+
+ if (delta.na) {
+ delta.na <- dna[, , first:last]
+ }
+ else delta.na <- NULL
+
+ nrisk <- nrisk[first:last, ]
+ nev <- nev[, , first:last]
+ dimnames(est$est) <- list(state.names, state.names, est$time)
+ dimnames(nev) <- list(state.names, state.names, est$time)
+ }
+
+ colnames(nrisk) <- state.names
+ nrisk <- nrisk[, !(colnames(nrisk) %in%
+ setdiff(unique(trans$to), unique(trans$from))),
+ drop = FALSE]
+
+ res <- list(est = est$est, cov = var, time = est$time, s =s, t = t,
+ trans = trans, state.names = state.names,
+ cens.name = cens.name,
+ n.risk = nrisk, n.event = nev, delta.na = delta.na,
+ ind.n.risk = ceiling(c * n^alpha))
+ class(res) <- "etm"
+ res
+}
+
diff --git a/R/etmCIF.R b/R/etmCIF.R
new file mode 100644
index 0000000..de1e306
--- /dev/null
+++ b/R/etmCIF.R
@@ -0,0 +1,77 @@
+### Wrapper around etm for easier computation of cumulative incidence
+### functions
+
+etmCIF <- function(formula, data, etype, subset, na.action, failcode = 1) {
+
+ if (missing(data)) stop("A data frame in which to interpret the formula must be supplied")
+ if (missing(etype)) stop("'etype' is missing, with no default")
+
+ Call <- match.call()
+
+ ## arg.etype <- deparse(substitute(etype))
+
+ mfnames <- c('formula', 'data', 'etype', 'subset', 'na.action')
+ temp <- Call[c(1, match(mfnames, names(Call), nomatch=0))]
+ temp[[1]] <- as.name("model.frame")
+ m <- eval.parent(temp)
+
+ n <- nrow(m)
+ y <- model.extract(m, 'response')
+ if (!is.Surv(y)) stop("Response must be a survival object")
+
+ etype <- model.extract(m, "etype")
+ ## cov <- model.matrix(formula, m)
+ name.strata <- attr(attr(m, "terms"), "term.labels")
+ if (length(name.strata) == 0) {
+ cova <- rep(1, n)
+ } else {
+ cova <- m[[name.strata]]
+ }
+
+ ## need to deal with etype when that's a fucking factor
+ if (!is.factor(etype)) etype <- factor(etype)
+ levels(etype) <- c(levels(etype), "cens")
+
+ ## Creating data set for using etm
+ if (attr(y, "type") == "right") {
+ etype[y[, 2] == 0] <- "cens"
+ entry <- rep(0, n)
+ exit <- y[, 1]
+ } else {
+ etype[y[, 3] == 0] <- "cens"
+ entry <- y[, 1]
+ exit <- y[, 2]
+ }
+ etype <- etype[, drop = TRUE]
+ from <- rep(0, n)
+ to <- etype
+ id <- seq_len(n)
+ ## cov <- cov[, ncol(cov)]
+ dat.etm <- data.frame(id = id,
+ from = from,
+ to = to,
+ entry = entry,
+ exit = exit,
+ cov = cova)
+
+ ## Now, let's use etm
+ tab.cov <- sort(unique(dat.etm$cov))
+
+ state.names <- as.character(c(0, as.character(sort(unique(etype[etype != "cens"])))))
+ tra <- matrix(FALSE, length(state.names), length(state.names))
+ tra[1, 2:length(state.names)] <- TRUE
+
+ cifs <- lapply(seq_along(tab.cov), function(i) {
+ etm(dat.etm[dat.etm$cov == tab.cov[i], ], state.names, tra, "cens", 0)
+ })
+
+ X <- matrix(tab.cov, nrow = 1, dimnames = list(name.strata))
+ if (ncol(X) > 1)
+ names(cifs) <- paste(rownames(X), X, sep = "=")
+ cifs$failcode <- failcode
+ cifs$call <- Call
+ cifs$X <- X
+ class(cifs) <- "etmCIF"
+
+ cifs
+}
diff --git a/R/extract.R b/R/extract.R
new file mode 100644
index 0000000..f23973d
--- /dev/null
+++ b/R/extract.R
@@ -0,0 +1,67 @@
+trprob <- function(x, ...) {
+ UseMethod("trprob")
+}
+
+trcov <- function(x, ...) {
+ UseMethod("trcov")
+}
+
+trprob.etm <- function(x, tr.choice, timepoints, ...) {
+ if (!inherits(x, "etm"))
+ stop("'x' must be a 'etm' object")
+ if (!is.character(tr.choice))
+ stop("'tr.choice' must be a character vector")
+ if (length(tr.choice) != 1)
+ stop("The function only extracts 1 transition probability")
+ pos <- sapply(1:length(x$state.names), function(i) {
+ paste(x$state.names, x$state.names[i])
+ })
+ pos <- matrix(pos)
+ if (!(tr.choice %in% pos))
+ stop("'tr.choice' not in the possible transitions")
+ trans.sep <- strsplit(tr.choice, " ")
+ if (length(trans.sep[[1]]) != 2) {
+ tt <- charmatch(trans.sep[[1]], x$state.names, nomatch = 0)
+ trans.sep[[1]] <- x$state.names[tt]
+ }
+ trans.sep <- unlist(trans.sep)
+
+ if (missing(timepoints)) {
+ tmp <- x$est[trans.sep[1], trans.sep[2], ]
+ }
+ else {
+ ind <- findInterval(timepoints, x$time)
+ tmp <- numeric(length(timepoints))
+ place <- which(ind != 0)
+ tmp[place] <- x$est[trans.sep[1], trans.sep[2], ind]
+ }
+ tmp
+}
+
+trcov.etm <- function(x, tr.choice, timepoints, ...) {
+ if (!inherits(x, "etm"))
+ stop("'x' must be a 'etm' object")
+ if (!is.character(tr.choice))
+ stop("'tr.choice' must be a character vector")
+ if (!(length(tr.choice) %in% c(1, 2)))
+ stop("'tr.choice' must be of length 1 or 2")
+ pos <- sapply(1:length(x$state.names), function(i) {
+ paste(x$state.names, x$state.names[i])
+ })
+ pos <- matrix(pos)
+ if (!all((tr.choice %in% pos)))
+ stop("'tr.choice' not in the possible transitions")
+ if (length(tr.choice) == 1) {
+ tr.choice <- rep(tr.choice, 2)
+ }
+ if (missing(timepoints)) {
+ tmp <- x$cov[tr.choice[1], tr.choice[2], ]
+ }
+ else {
+ ind <- findInterval(timepoints, x$time)
+ tmp <- numeric(length(timepoints))
+ place <- which(ind != 0)
+ tmp[place] <- x$cov[tr.choice[1], tr.choice[2], ind]
+ }
+ tmp
+}
diff --git a/R/ggtransfo.etm.R b/R/ggtransfo.etm.R
new file mode 100644
index 0000000..1735d7b
--- /dev/null
+++ b/R/ggtransfo.etm.R
@@ -0,0 +1,36 @@
+### Function to transform a etm object into something usable for ggplot ###
+### Arthur Allignol <arthur.allignol at uni-ulm.de ###
+
+ggtransfo <- function(x, ...) {
+ UseMethod("ggtransfo")
+}
+
+ggtransfo.etm <- function(x, tr.choice, ...) {
+
+ if (!inherits(x, "etm"))
+ stop("'x' must be a 'etm' object")
+
+ sx <- summary(x, ...)
+
+ if (missing(tr.choice)) tr.choice <- names(sx)
+ sx <- sx[tr.choice]
+
+ sx_display <- do.call(rbind, lapply(seq_along(tr.choice), function(i) {
+ tmp <- sx[[i]]
+ tmp$trans <- tr.choice[i]
+
+ tmp$timemax <- c(tmp$time[-1], max(tmp$time) + 1)
+ tmp
+ }))
+
+ sx_display
+}
+
+
+### test
+## aa <- ggtransfo(tr.prob, "0 1")
+
+## p <- ggplot(aa) +
+## geom_step(aes(x = time, y = P)) +
+## geom_rect(aes(xmin = time, xmax = timemax, ymin = lower, ymax = upper),
+## alpha = 0.3)
diff --git a/R/lines.etm.R b/R/lines.etm.R
new file mode 100644
index 0000000..b98a402
--- /dev/null
+++ b/R/lines.etm.R
@@ -0,0 +1,58 @@
+lines.etm <- function(x, tr.choice, col = 1, lty,
+ conf.int = FALSE, level = 0.95, ci.fun = "linear",
+ ci.col = col, ci.lty = 3, ...) {
+
+ if (!inherits(x, "etm")) {
+ stop("'x' must be of class 'etm'")
+ }
+
+ ufrom <- unique(x$trans$from)
+ uto <- unique(x$trans$to)
+ absorb <- setdiff(uto, ufrom)
+ nam1 <- dimnames(x$est)[[1]]
+ nam2 <- dimnames(x$est)[[2]]
+ pos <- c(paste(nam1[!(nam1 %in% as.character(absorb))],
+ nam2[!(nam2 %in% as.character(absorb))]),
+ paste(x$trans$from, x$trans$to))
+ if (missing(tr.choice)) tr.choice <- pos
+
+ ref <- sapply(1:length(x$state.names), function(i) {
+ paste(x$state.names, x$state.names[i])
+ })
+ ref <- matrix(ref)
+ if (sum(tr.choice %in% ref == FALSE) > 0)
+ stop("Argument 'tr.choice' and possible transitions must match")
+
+ temp <- ci.transfo(x, tr.choice, level, ci.fun)
+
+ lt <- length(temp)
+
+ if (missing(lty)) {
+ lty <- seq_len(lt)
+ }
+ else if (length(lty) < lt) {
+ lty <- lty * rep(1, lt)
+ }
+ if (length(col) < lt)
+ col <- col * rep(1, lt)
+
+ for (i in seq_len(lt)) {
+ lines(temp[[i]]$time, temp[[i]]$P, type = "s",
+ col = col[i], lty = lty[i], ...)
+ }
+
+ if (conf.int && !is.null(x$cov)) {
+ if (length(ci.col) < lt)
+ ci.col <- ci.col * rep(1, lt)
+ if (length(ci.lty) < lt)
+ ci.lty <- ci.lty * rep(1, lt)
+ for (i in seq_len(lt)) {
+ lines(temp[[i]]$time, temp[[i]]$lower, type = "s",
+ col = ci.col[i], lty = ci.lty[i], ...)
+ lines(temp[[i]]$time, temp[[i]]$upper, type = "s",
+ col = ci.col[i], lty = ci.lty[i], ...)
+ }
+ }
+
+ invisible()
+}
diff --git a/R/misc.R b/R/misc.R
new file mode 100644
index 0000000..21ac9e3
--- /dev/null
+++ b/R/misc.R
@@ -0,0 +1,59 @@
+### Some useful miscellaneous functions ###
+
+tra_ill <- function(state.names = c("0", "1", "2")) {
+
+ if (length(state.names) != 3)
+ stop("An illness-death model has 3 states")
+
+ tra <- matrix(FALSE, ncol = 3, nrow = 3,
+ dimnames = list(state.names, state.names))
+ tra[1, 2:3] <- TRUE
+ tra[2, 3] <- TRUE
+ tra
+}
+
+tra_ill_comp <- function(nComp = 2,
+ state.names = as.character(seq(0, nComp + 1, 1))) {
+
+ if (nComp == 1)
+ stop("No competing risks. Use 'tra_ill' instead")
+
+ nstates <- length(state.names)
+ if (length(state.names) != nComp + 2)
+ stop(paste("Something is wrong with 'state.names'. The specified multistate model has ",
+ nComp + 2L, " states", sep = ""))
+
+ tra <- matrix(FALSE, nstates, nstates,
+ dimnames = list(state.names, state.names))
+ tra[1, 2:nstates] <- TRUE
+ tra[2, 3:nstates] <- TRUE
+ tra
+}
+
+tra_comp <- function(nComp = 2,
+ state.names = as.character(seq(0, nComp))) {
+
+ if (nComp == 1)
+ stop("That's not a competing risks model. Use 'tra_surv' instead")
+ nstates <- length(state.names)
+ if (nstates != nComp + 1L)
+ stop(paste("Something is wrong with 'state.names'. The specified multistate model has ",
+ nComp + 1L, " states", sep = ""))
+
+ tra <- matrix(FALSE, nstates, nstates,
+ dimnames = list(state.names, state.names))
+ tra[1, 2:nstates] <- TRUE
+ tra
+}
+
+tra_surv <- function(state.names = c("0", "1")) {
+
+ if (length(state.names) != 2)
+ stop("Survival model has 2 states")
+
+ tra <- matrix(FALSE, ncol = 2, nrow = 2,
+ dimnames = list(state.names, state.names))
+ tra[1, 2] <- TRUE
+ tra
+}
+
diff --git a/R/plot.clos.etm.R b/R/plot.clos.etm.R
new file mode 100644
index 0000000..d4a6494
--- /dev/null
+++ b/R/plot.clos.etm.R
@@ -0,0 +1,56 @@
+plot.clos.etm <- function(x, xlab = "Time",
+ ylab.e = "Expected LOS", ylab.w = "Weights",
+ xlim, ylim.e, ylim.w, col.e = c(1, 2), col.w = 1,
+ lty.e = c(1, 1), lty.w = 1, legend = TRUE,
+ legend.pos, curvlab, legend.bty = "n", ...) {
+ if (!inherits(x, "clos.etm")) {
+ stop("'x' must be a 'clos.etm' object")
+ }
+ if (missing(xlim)) {
+ xlim <- c(0, max(x$w.time))
+ }
+ if (missing(ylim.e)) {
+ ylim.e <- c(0, max(c(x$phi.case, x$phi.control)))
+ }
+ if (missing(ylim.w)) {
+ ylim.w <- c(0, max(x$weights))
+ }
+ def.par <- par(no.readonly = TRUE)
+ on.exit(par(def.par))
+ split.screen(figs=matrix(c(rep(0,2), rep(1,2), c(0, 0.6), c(0.7, 1)), ncol=4))
+ screen(2)
+ op <- par(mar=c(2, 5, 2, 1))
+ plot(c(0,x$w.time), c(0, x$weights), type = "s", axes = FALSE, lty = lty.w, xlim = xlim,
+ ylim = ylim.w , xlab = xlab , ylab = ylab.w, col=col.w, ...)
+ axis(side=2)
+ box()
+ par(op)
+ screen(1)
+ op <- par(mar=c(5, 5, 4, 1))
+ plot(x$time, x$phi.case, type = "s", lty = lty.e[1], xlim = xlim,
+ ylim = ylim.e, xlab = xlab, ylab = ylab.e, col = col.e[1], ...)
+ lines(x$time, x$phi.control, type = "s", lty = lty.e[2], col = col.e[2], ...)
+ par(op)
+ if (legend == TRUE) {
+ if (missing(legend.pos))
+ legend.pos <- "bottomright"
+ if (missing(curvlab))
+ curvlab <- c("Intermediate event by time t", "No intermediate event by time t")
+ if (is.list(legend.pos)) legend.pos <- unlist(legend.pos)
+ if (length(legend.pos) == 1) {
+ xx <- legend.pos
+ yy <- NULL
+ }
+ if (length(legend.pos) == 2) {
+ xx <- legend.pos[1]
+ yy <- legend.pos[2]
+ }
+ args <- list(...)
+ ii <- pmatch(names(args),
+ names(formals("legend")[-charmatch("bty",names(formals("legend")))]))
+ do.call("legend", c(list(xx, yy, curvlab, col = col.e, lty = lty.e, bty = legend.bty),
+ args[!is.na(ii)]))
+ }
+ close.screen(all.screens = TRUE)
+ invisible()
+}
diff --git a/R/plot.etm.R b/R/plot.etm.R
new file mode 100644
index 0000000..de7bbed
--- /dev/null
+++ b/R/plot.etm.R
@@ -0,0 +1,89 @@
+plot.etm <- function(x, tr.choice, xlab = "Time", ylab = "Transition Probability",
+ col = 1, lty, xlim, ylim, conf.int = FALSE, level = 0.95,
+ ci.fun = "linear", ci.col = col, ci.lty = 3,
+ legend = TRUE, legend.pos, curvlab, legend.bty = "n", ...) {
+
+ if (!inherits(x, "etm"))
+ stop("'x' must be a 'etm' object")
+
+ ufrom <- unique(x$trans$from)
+ uto <- unique(x$trans$to)
+ absorb <- setdiff(uto, ufrom)
+ nam1 <- dimnames(x$est)[[1]]
+ nam2 <- dimnames(x$est)[[2]]
+ pos <- c(paste(nam1[!(nam1 %in% as.character(absorb))],
+ nam2[!(nam2 %in% as.character(absorb))]),
+ paste(x$trans$from, x$trans$to))
+ if (missing(tr.choice)) tr.choice <- pos
+
+ ref <- sapply(1:length(x$state.names), function(i) {
+ paste(x$state.names, x$state.names[i])
+ })
+ ref <- matrix(ref)
+ if (sum(tr.choice %in% ref == FALSE) > 0)
+ stop("Argument 'tr.choice' and possible transitions must match")
+
+ temp <- ci.transfo(x, tr.choice, level, ci.fun)
+
+ lt <- length(temp)
+
+ if (missing(lty)) {
+ lty <- seq_len(lt)
+ }
+ else if (length(lty) < lt) {
+ lty <- lty * rep(1, lt)
+ }
+ if (length(col) < lt)
+ col <- col * rep(1, lt)
+
+ if (missing(xlim)) {
+ xlim <- c(0, max(sapply(temp, function(x) max(x$time))))
+ }
+ if (missing(ylim)) {
+ ylim <- c(0, 1)
+ }
+
+ plot(xlim, ylim, xlab = xlab, ylab = ylab,
+ xlim = xlim, ylim = ylim, type = "n", ...)
+
+ for (i in seq_len(lt)) {
+ lines(temp[[i]]$time, temp[[i]]$P, type = "s",
+ col = col[i], lty = lty[i], ...)
+ }
+
+ if (conf.int && !is.null(x$cov)) {
+ if (length(ci.col) < lt)
+ ci.col <- ci.col * rep(1, lt)
+ if (length(ci.lty) < lt)
+ ci.lty <- ci.lty * rep(1, lt)
+ for (i in seq_len(lt)) {
+ lines(temp[[i]]$time, temp[[i]]$lower, type = "s",
+ col = ci.col[i], lty = ci.lty[i], ...)
+ lines(temp[[i]]$time, temp[[i]]$upper, type = "s",
+ col = ci.col[i], lty = ci.lty[i], ...)
+ }
+ }
+
+ if (legend) {
+ if (missing(legend.pos))
+ legend.pos <- "topleft"
+ if (missing(curvlab))
+ curvlab <- tr.choice
+ if (is.list(legend.pos)) legend.pos <- unlist(legend.pos)
+ if (length(legend.pos) == 1) {
+ xx <- legend.pos
+ yy <- NULL
+ }
+ if (length(legend.pos) == 2) {
+ xx <- legend.pos[1]
+ yy <- legend.pos[2]
+ }
+ args <- list(...)
+ ii <- pmatch(names(args),
+ names(formals("legend")[-charmatch("bty",names(formals("legend")))]))
+ do.call("legend", c(list(xx, yy, curvlab, col=col, lty=lty, bty = legend.bty),
+ args[!is.na(ii)]))
+ }
+
+ invisible()
+}
diff --git a/R/plot.etmCIF.R b/R/plot.etmCIF.R
new file mode 100644
index 0000000..9a0c06c
--- /dev/null
+++ b/R/plot.etmCIF.R
@@ -0,0 +1,127 @@
+plot.etmCIF <- function(x, which.cif, xlim, ylim,
+ ylab = "Cumulative Incidence", xlab = "Time",
+ col = 1, lty, lwd = 1, ci.type = c("none", "bars", "pointwise"),
+ ci.fun = "cloglog", ci.col = col, ci.lty = 3,
+ legend = TRUE, legend.pos, curvlab, legend.bty = "n",
+ pos.ci = 27, ci.lwd = 3,
+ ...) {
+
+ if (!inherits(x, "etmCIF")) {
+ stop("'x' must be of class 'etmCIF'")
+ }
+ ci.type <- match.arg(ci.type)
+
+ tr.choice <- paste(x[[1]]$trans[, 1], x[[1]]$trans[, 2])
+ l.x <- NCOL(x$X)
+ n.trans <- length(tr.choice)
+
+ if (missing(which.cif)) {
+ tr.choice <- paste(0, x$failcode, sep = " ")
+ } else {
+ tr.choice <- paste(0, which.cif, sep = " ")
+ ## A small test on tr.choice
+ ref <- sapply(1:length(x[[1]]$state.names), function(i) {
+ paste(x[[1]]$state.names, x[[1]]$state.names[i])
+ })
+ ref <- matrix(ref)
+ if (sum(tr.choice %in% ref == FALSE) > 0)
+ stop("Argument 'which.cif' and causes of failure must match")
+ }
+
+ n.what <- length(tr.choice)
+
+ max.time <- max(sapply(x[1:l.x], function(ll) {
+ max(ll$time)
+ }))
+
+ if (missing(ylim)) ylim <- c(0, 1)
+ if (missing(xlim)) xlim <- c(0, max.time)
+ if (missing(lty)) {
+ lty <- seq_len(n.what * l.x)
+ }
+ else if (length(lty) < (l.x * n.what)) {
+ lty <- lty * rep(1, l.x * n.what)
+ }
+ if (length(col) < l.x * n.what)
+ col <- col * rep(1, l.x * n.what)
+
+ conf.int <- if (ci.type == "pointwise") TRUE else FALSE
+ if (ci.type != "none") {
+ if (missing(ci.col)) {
+ ci.col <- col
+ } else {
+ if (length(ci.col) < (l.x * n.what)) {
+ ci.col <- ci.col * rep(1, l.x * n.what)
+ }
+ }
+ if (missing(ci.lty)) {
+ ci.lty <- lty
+ } else {
+ if (length(ci.lty) < (l.x * n.what)) {
+ ci.lty <- ci.lty * rep(1, l.x * n.what)
+ }
+ }
+ }
+
+ plot(xlim, ylim, xlab = xlab, ylab = ylab,
+ xlim = xlim, ylim = ylim, type = "n", ...)
+
+ summx <- lapply(x[1:l.x], summary, ci.fun = ci.fun)
+
+ if (length(pos.ci) < l.x) pos.ci <- rep(pos.ci, l.x)
+
+ for (i in seq_len(l.x)) {
+ for (j in seq_along(tr.choice)) {
+ lines(x[[i]], tr.choice = tr.choice[j],
+ col = col[j + (i - 1) * n.what], lty = lty[j + (i - 1) * n.what],
+ lwd = lwd, conf.int = conf.int,...)
+
+ if (ci.type == "bars") {
+ ind <- findInterval(pos.ci[i], summx[[i]][[tr.choice[j]]]$time)
+ segments(pos.ci[i], summx[[i]][[tr.choice[j]]]$lower[ind],
+ pos.ci[i], summx[[i]][[tr.choice[j]]]$upper[ind],
+ lwd = ci.lwd, col = ci.col[j + (i - 1) * n.what],
+ lty = ci.lty[j + (i - 1) * n.what],...)
+ }
+ }
+ }
+
+ if (legend) {
+ if (missing(legend.pos)) {
+ legend.pos <- "topleft"
+ }
+ if (missing(curvlab)) {
+ cdc <- sapply(strsplit(sub("\\s", "|", tr.choice), "\\|"),
+ "[", 2)
+## cdc <- sapply(strsplit(tr.choice, " "), "[", 2)
+ if (l.x == 1) {
+ curvlab <- paste("CIF ", cdc, sep = "")
+ } else {
+ if (length(cdc) == 1) {
+ curvlab <- paste("CIF ", cdc, "; ", rownames(x$X), "=", x$X, sep = "")
+ } else {
+ curvlab <- as.vector(sapply(seq_along(x$X), function(j){
+ paste("CIF ", cdc, "; ", rownames(x$X), "=", x$X[j], sep = "")
+ }))
+ }
+ }
+ }
+ if (is.list(legend.pos)) legend.pos <- unlist(legend.pos)
+ if (length(legend.pos) == 1) {
+ xx <- legend.pos
+ yy <- NULL
+ }
+ if (length(legend.pos) == 2) {
+ xx <- legend.pos[1]
+ yy <- legend.pos[2]
+ }
+ args <- list(...)
+ ii <- pmatch(names(args),
+ names(formals("legend")[-charmatch("bty",names(formals("legend")))]))
+ do.call("legend", c(list(xx, yy, curvlab, col=col, lty=lty, lwd = lwd, bty = legend.bty),
+ args[!is.na(ii)]))
+ }
+
+ invisible()
+
+}
diff --git a/R/prepare.los.data.R b/R/prepare.los.data.R
new file mode 100644
index 0000000..7c4bc63
--- /dev/null
+++ b/R/prepare.los.data.R
@@ -0,0 +1,107 @@
+"prepare.los.data" <-
+function(x) {
+## --------------------------------------------------------------------------------
+## Title: R-function prepare.los.data()
+## ---------------------------------------------------------------------------------
+## Author: Matthias Wangler
+## mw at imbi.uni-freiburg.de
+## Institute of Med. Biometry and Med. Computer Science
+## Stefan-Meier-Strasse 26, D-79104 Freiburg,
+## http://www.imbi.uni-freiburg.de
+## ---------------------------------------------------------------------------------
+## Description: Read and prepare a data set which can be passed to the function clos
+## ---------------------------------------------------------------------------------
+## Required Packages: -
+## ---------------------------------------------------------------------------------
+## Usage: prepare.los.data( x )
+##
+## x: data.frame of the form data.frame( id, j.01, j.02, j.03, j.12, j.13, cens):
+##
+## id: id (patient id, admision id, ...)
+## j.01: observed time for jump from "0" to "1"
+## j.02: observed time for jump from "0" to "2"
+## j.03: observed time for jump from "0" to "3"
+## j.12: observed time for jump from "1" to "2"
+## j.13: observed time for jump from "1" to "3"
+## cens: observed time for censoring
+## ---------------------------------------------------------------------------------
+## Value: data.frame of the form data.frame(id, from, to, time ):
+##
+## id: id (patient id, admision id)
+## from: the state from where a transition occurs
+## to: the state to which a transition occurs
+## time: the time a transition occurs
+## oid: the observation id
+## ---------------------------------------------------------------------------------
+## Notes: It's possible that the same patient, person or object was observed several
+## times (e.g. bootstrap).
+## So for each observation the same id recieves different observation id's.
+## ---------------------------------------------------------------------------------
+## Example: > data(los.data)
+## > my.observ <- prepare.los.data(x=los.data)
+## ---------------------------------------------------------------------------------
+## License: GPL 2
+##----------------------------------------------------------------------------------
+## History: 20.06.2004, Matthias Wangler
+## first version
+## ---------------------------------------------------------------------------------
+
+ ## check the passed parameters
+ if( missing(x) )
+ {
+ stop("Argument 'x' is missing, with no defaults.")
+ }
+ if( !is.data.frame(x) )
+ {
+ stop("Argument 'x' must be a 'data.frame'.")
+ }
+
+ ## check the number of columns of the passed data.frame x
+ if( dim(x)[2] != 7 )
+ {
+ stop("The passed data.frame 'x' doesn't include 7 columns.")
+ }
+
+ ## compute variables cens.0 for admissions censored in the initial state 0
+ ## and cens.1 for admissions censored in state 1
+
+ x$cens.0 <- x$cens
+ x$cens.0[is.finite(x[,2])] <- Inf
+
+ x$cens.1 <- x$cens
+ x$cens.1[is.infinite(x[,2])] <- Inf
+
+
+ x <- x[,c(1,2,3,4,5,6,8,9)]
+
+
+ id <- c(x[,1][x[,2] != Inf], x[,1][x[,3] != Inf],x[,1][x[,4] != Inf],
+ x[,1][x[,5] != Inf], x[,1][x[,6] != Inf],x[,1][x[,7] != Inf],
+ x[,1][x[,8] != Inf])
+
+ from <- c(rep("0",length(x[,2][x[,2] != Inf])), rep("0",length(x[,3][x[,3] != Inf])),
+ rep("0",length(x[,4][x[,4] != Inf])), rep("1",length(x[,5][x[,5] != Inf])),
+ rep("1",length(x[,6][x[,6] != Inf])), rep("0",length(x[,7][x[,7] != Inf])),
+ rep("1",length(x[,8][x[,8] != Inf])))
+
+ to <- c(rep("1",length(x[,2][x[,2] != Inf])), rep("2",length(x[,3][x[,3] != Inf])),
+ rep("3",length(x[,4][x[,4] != Inf])), rep("2",length(x[,5][x[,5] != Inf])),
+ rep("3",length(x[,6][x[,6] != Inf])), rep("cens",length(x[,7][x[,7] != Inf])),
+ rep("cens",length(x[,8][x[,8] != Inf])))
+
+ time <- c(x[,2][x[,2] != Inf], x[,3][x[,3] != Inf],x[,4][x[,4] != Inf],
+ x[,5][x[,5] != Inf], x[,6][x[,6] != Inf],x[,7][x[,7] != Inf],
+ x[,8][x[,8] != Inf])
+
+ ## observation id
+ x$oid <- 1:length(x[,1])
+
+ oid <- c(x[,9][x[,2] != Inf], x[,9][x[,3] != Inf],x[,9][x[,4] != Inf],
+ x[,9][x[,5] != Inf], x[,9][x[,6] != Inf],x[,9][x[,7] != Inf],
+ x[,9][x[,8] != Inf])
+
+ observ <- data.frame(id, from, to, time, oid)
+
+ return(observ)
+}
+
diff --git a/R/print.clos.etm.R b/R/print.clos.etm.R
new file mode 100644
index 0000000..04b29d6
--- /dev/null
+++ b/R/print.clos.etm.R
@@ -0,0 +1,15 @@
+print.clos.etm <- function(x, ...) {
+ if (!inherits(x, "clos.etm")) {
+ stop("'x' must be of class 'clos.etm'")
+ }
+ cat("The expected change in length of stay is:\n")
+ cat(paste(round(x$e.phi, 3)), "\n")
+ if (!is.null(x$e.phi.weights.1)) {
+ cat("\nAlternative weighting:\n\n")
+ cat(paste("Expected change in LOS with weight.1:",
+ round(x$e.phi.weights.1, 3), "\n", sep = " "))
+ cat(paste("Expected change in LOS with weight.other:",
+ round(x$e.phi.weights.other, 3), "\n", sep = " "))
+ }
+ invisible()
+}
diff --git a/R/print.etm.R b/R/print.etm.R
new file mode 100644
index 0000000..c6a379c
--- /dev/null
+++ b/R/print.etm.R
@@ -0,0 +1,29 @@
+print.etm <- function(x, covariance = TRUE, whole = TRUE, ...) {
+ if (!inherits(x, "etm"))
+ stop("'x' must be of class 'etm'")
+ absorb <- setdiff(levels(x$trans$to), levels(x$trans$from))
+ transient <- unique(x$state.names[!(x$state.names %in% absorb)])
+ cat(paste("Multistate model with", length(transient), "transient state(s)\n",
+ "and", length(absorb), "absorbing state(s)\n\n", sep = " "))
+ cat("Possible transitions:\n")
+ print(x$trans, row.names = FALSE)
+ cat("\n")
+ cat(paste("Estimate of P(", x$s, ", ", x$t, ")\n", sep = ""))
+ print(x$est[, , dim(x$est)[3]]); cat("\n")
+ if (!is.null(x$cov) & covariance == TRUE) {
+ if (whole) {
+ cat(paste("Estimate of cov(P(", x$s, ", ", x$t, "))\n", sep = ""))
+ print(x$cov[, , dim(x$cov)[3]])
+ }
+ else {
+ cov <- x$cov[, , dim(x$cov)[3]][rowSums(x$cov[, , dim(x$cov)[3]]) != 0, ]
+ cova <- cov[, colSums(cov) != 0]
+ cat(paste("Estimate of cov(P(", x$s, ", ", x$t, "))\n", sep = ""))
+ print(cova)
+ }
+ }
+ invisible()
+}
+
+
+
diff --git a/R/print.etmCIF.R b/R/print.etmCIF.R
new file mode 100644
index 0000000..ac2fe85
--- /dev/null
+++ b/R/print.etmCIF.R
@@ -0,0 +1,39 @@
+### Print Method for cif.etm objects
+print.etmCIF <- function(x, ...) {
+
+ if (!inherits(x, "etmCIF")) {
+ stop("'x' must be of class 'etmCIF'")
+ }
+
+ cat("Call: "); dput(x$call); cat("\n")
+
+ if (ncol(x$X) > 1) {
+ cat("Covariate: ", rownames(x$X), "\n")
+ cat("\tlevels: ", x$X, "\n\n")
+ }
+
+ l.trans <- nrow(x[[1]]$trans)
+ l.x <- length(x$X)
+
+ zzz <- lapply(seq_len(l.x), function(i) {
+ temp <- summary(x[[i]])
+ mat <- matrix(0, ncol = 4, nrow = l.trans)
+ for (j in seq_len(l.trans)) {
+ n.temp <- nrow(temp[[j]])
+ mat[j, 1] <- temp[[j]][n.temp, "time"]
+ mat[j, 2] <- temp[[j]][n.temp, "P"]
+ mat[j, 3] <- sqrt(temp[[j]][n.temp, "var"])
+ mat[j, 4] <- sum(temp[[j]][, "n.event"])
+ }
+
+ rownames(mat) <- paste("CIF ", sapply(strsplit(sub("\\s", "|", names(temp)[1:l.trans]), "\\|"),
+ "[", 2), sep = "")
+ colnames(mat) <- c("time", "P", "se(P)", "n.event")
+ if (ncol(x$X) > 1) {
+ cat("\n", paste(rownames(x$X), " = ", x$X[i], sep = ""), "\n")
+ }
+ print(mat)
+ })
+
+ invisible()
+}
diff --git a/R/print.summary.etm.R b/R/print.summary.etm.R
new file mode 100644
index 0000000..b3bb8b5
--- /dev/null
+++ b/R/print.summary.etm.R
@@ -0,0 +1,20 @@
+print.summary.etm <- function(x, ...) {
+ if (!inherits(x, "summary.etm"))
+ stop("'x' must be of class 'summary.etm'")
+ if ("t" %in% names(x)) {
+ cat(paste("No events between", x$s, "and", x$t, "\n\n", sep = " "))
+ print(x$P[, , 1])
+ }
+ else {
+ time <- x[[1]]$time
+ qtime <- quantile(time, probs = c(0, 0.25, 0.5, 0.75, 0.9, 1))
+ ind <- findInterval(qtime, time)
+
+ for (i in seq_along(x)) {
+ cat(paste("Transition", names(x)[i], "\n", sep = " "))
+ print(x[[i]][ind, ], row.names = FALSE)
+ cat("\n")
+ }
+ }
+ invisible()
+}
diff --git a/R/pseudo_clos.R b/R/pseudo_clos.R
new file mode 100644
index 0000000..e69405a
--- /dev/null
+++ b/R/pseudo_clos.R
@@ -0,0 +1,178 @@
+### Function to compute the pseudo values
+## Modelling will be done in another function to offer more
+## flexibility
+### Author: Arthur Allignol <arthur.allignol at fdm.uni-freiburg.de>
+
+closPseudo <- function(data, state.names, tra, cens.name, s = 0,
+ formula, aw = FALSE, ratio = FALSE, ncores = 1) {
+
+ ## take care of the formula argument
+ call <- match.call()
+ m <- match.call(expand.dots = FALSE)
+ temp <- c("", "formula", "data", "id", "subset", "na.action")
+ m <- m[match(temp, names(m), nomatch = 0)]
+ Terms <- if (missing(data)) terms(formula)
+ else terms(formula, data = data)
+ m$formula <- Terms
+ m[[1]] <- as.name("model.frame")
+ m <- eval(m, parent.frame())
+
+ ids <- unique(data$id)
+ n <- length(ids)
+
+ ## theta. From there we'll see what kind of model it is
+ ## is no alternative weights, NULL
+ ## No competing risks: not in the list
+ theta <- unlist(clos(etm(data = data, state.names = state.names, tra = tra,
+ cens.name = cens.name, s = 0, covariance = FALSE),
+ aw = aw, ratio = ratio)[c("e.phi", "e.phi.weights.1",
+ "e.phi.weights.other",
+ "e.phi2", "e.phi3")])
+
+ competing <- "e.phi2" %in% names(theta)
+
+ ## Compute pseudo values, and store results depending of competing
+ ## and aw
+ ## TODO: ACTUALLY COMPUTE THE PSEUDO VALUES
+ namen <- c("ps.e.phi", "ps.e.phi.weights.1", "ps.e.phi.weights.other",
+ "ps.e.phi2", "ps.e.phi3")
+
+ psMatrix <- parallel::mclapply(seq_along(ids), function(i) {
+ temp <- clos(etm(data = data[!(data$id %in% ids[i]), ],
+ state.names = state.names, tra = tra,
+ cens.name = cens.name, s = 0, covariance = FALSE),
+ aw = aw, ratio = ratio)
+
+ cbind(temp$e.phi, temp$e.phi.weights.1, temp$e.phi.weights.other,
+ temp$e.phi2, temp$e.phi3)
+ }, mc.cores = ncores)
+ ##} else {
+ ## psMatrix <- lapply(seq_along(ids), function(i) {
+ ## temp <- clos(etm(data = data[!(data$id %in% ids[i]), ],
+ ## state.names = state.names, tra = tra,
+ ## cens.name = cens.name, s = 0, covariance = FALSE),
+ ## aw = aw, ratio = ratio)
+
+ ## cbind(temp$e.phi, temp$e.phi.weights.1, temp$e.phi.weights.other,
+ ## temp$e.phi2, temp$e.phi3)
+ ## })
+ ## }
+
+ psMatrix <- data.frame(do.call(rbind, psMatrix))
+
+ psMatrix <- lapply(seq_along(psMatrix), function(i) {
+ n * theta[i] - (n - 1) * psMatrix[, i]
+ })
+ psMatrix <- do.call(cbind, psMatrix)
+ colnames(psMatrix) <- namen[c(TRUE, aw, aw, competing, competing)]
+ ## the pseudo values n * ref - (n - 1) * temp
+ ## psMatrix <- matrix(apply(psMatrix, 1, function(x) n * theta - (n - 1) * x),
+ ## nrow = dim(psMatrix)[1], ncol = dim(psMatrix)[2])
+ ## colnames(psMatrix) <- namen[c(TRUE, aw, aw, competing, competing)]
+
+ cov <- m[!duplicated(data$id), , drop = FALSE]
+ colnames(cov) <- attr(Terms, "term.labels")
+
+ theta <- matrix(theta, nrow = 1)
+ colnames(theta) <- c("e.phi", "e.phi.weights.1",
+ "e.phi.weights.other", "e.phi2",
+ "e.phi3")[c(TRUE, aw, aw, competing, competing)]
+
+ zzz <- list(pseudoData = data.frame(id = ids, psMatrix, cov),
+ theta = theta, aw = aw, call = call)
+ class(zzz) <- "closPseudo"
+
+ zzz
+}
+
+
+### A function to compute the pseudo obs on phi instead on change in
+### LoS directly
+
+phiPseudo <- function(data, state.names, tra, cens.name, s = 0,
+ formula, timepoints, ncores = 1) {
+
+ ## take care of the formula argument
+ call <- match.call()
+ m <- match.call(expand.dots = FALSE)
+ temp <- c("", "formula", "data", "id", "subset", "na.action")
+ m <- m[match(temp, names(m), nomatch = 0)]
+ Terms <- if (missing(data)) terms(formula)
+ else terms(formula, data = data)
+ m$formula <- Terms
+ m[[1]] <- as.name("model.frame")
+ m <- eval(m, parent.frame())
+
+ ids <- unique(data$id)
+ n <- length(ids)
+ nt <- length(timepoints)
+
+ ref <- as.matrix(predictPhi(clos(etm(data = data, state.names = state.names, tra = tra,
+ cens.name = cens.name, s = 0, covariance = FALSE),
+ aw = FALSE), timepoints)[, c("phi", "phi.case",
+ "phi.control", "phiR")])
+
+ ref <- apply(ref, 2, rep, n)
+ psd <- matrix(0, nrow = n * nt, ncol = 6)
+
+ temp <- parallel::mclapply(seq_along(ids), function(i) {
+ as.matrix(predictPhi(clos(etm(data = data[!(data$id %in% ids[i]), ],
+ state.names = state.names, tra = tra,
+ cens.name = cens.name, s = 0, covariance = FALSE),
+ aw = FALSE), timepoints)[, c("phi", "phi.case",
+ "phi.control", "phiR")])
+ }, mc.cores = ncores)
+ ## } else {
+ ## temp <- lapply(seq_along(ids), function(i) {
+ ## as.matrix(predictPhi(clos(etm(data = data[!(data$id %in% ids[i]), ],
+ ## state.names = state.names, tra = tra,
+ ## cens.name = cens.name, s = 0, covariance = FALSE),
+ ## aw = FALSE), timepoints)[, c("phi", "phi.case",
+ ## "phi.control", "phiR")])
+ ## })
+ ## }
+
+ temp <- do.call(rbind, temp)
+
+ for (i in seq_len(4)) {
+ psd[, i + 2] <- n * ref[, i] - (n - 1) * temp[, i]
+ }
+ psd[, 1] <- as.vector(mapply(rep, ids, nt))
+ psd[, 2] <- rep(timepoints, n)
+ psd <- as.data.frame(psd)
+ names(psd) <- c("id", "time", "ps.phi", "ps.phi.case",
+ "ps.phi.control", "ps.phiR")
+
+ cov <- as.matrix(m[!duplicated(data$id), , drop = FALSE])
+ cov <- matrix(mapply(rep, cov, nt), dim(psd)[1], dim(cov)[2])
+ cov <- as.data.frame(cov)
+ colnames(cov) <- attr(Terms, "term.labels")
+
+ zzz <- list(pseudoData = data.frame(psd, cov),
+ phi = data.frame(id = psd[, 1], ref, time = timepoints),
+ ps = data.frame(id = psd[, 1], temp, time = timepoints),
+ call = call)
+ class(zzz) <- "phiPseudo"
+
+ zzz
+}
+
+predictPhi <- function(object, timepoints) {
+ if (!inherits(object, "clos.etm")) stop("gtfo")
+
+ if (missing(timepoints)) stop("I want timepoints!!!")
+
+ ## phi <- object$phi.case - object$phi.control
+
+ ind <- findInterval(timepoints, object$time)
+ tmp.case <- tmp.control <- numeric(length(timepoints))
+ place <- which(ind != 0)
+ tmp.case[place] <- object$phi.case[ind]
+ tmp.control[place] <- object$phi.control[ind]
+
+ data.frame(phi.case = tmp.case, phi.control = tmp.control,
+ phi = tmp.case - tmp.control,
+ phiR = tmp.case / tmp.control, time = timepoints)
+}
+
+
diff --git a/R/summary.etm.R b/R/summary.etm.R
new file mode 100644
index 0000000..ff6e4eb
--- /dev/null
+++ b/R/summary.etm.R
@@ -0,0 +1,42 @@
+summary.etm <- function(object, all = FALSE, ci.fun = "linear", level = 0.95, ...) {
+ if (!inherits(object, "etm"))
+ stop("'object' must be of class 'etm'")
+ if (is.null(object$time)) {
+ res <- list(P = object$est, s = object$s, t = object$t)
+ class(res) <- "summary.etm"
+ return(res)
+ }
+ if (level <= 0 | level > 1) {
+ stop ("'level' must be between 0 and 1")
+ }
+ ref <- c("linear", "log", "cloglog", "log-log")
+ if (sum(ci.fun %in% ref == FALSE) != 0) {
+ stop("'ci.fun' is not correct. See help page")
+ }
+ if (all) {
+ ind <- object$est != 0
+ indi <- apply(ind, c(1, 2), function(temp){all(temp == FALSE)})
+ tmp <- which(indi == FALSE, arr.ind = TRUE)
+ tmp <- tmp[order(tmp[, 1]), ]
+ namen <- list(rownames(indi), colnames(indi))
+ trs <- lapply(seq_len(NROW(tmp)), function(i) {
+ paste(namen[[1]][tmp[i, 1]], namen[[2]][tmp[i, 2]], sep = " ")
+ })
+ trs <- cbind(trs)
+ absorb <- setdiff(levels(object$tran$to), levels(object$trans$from))
+ for (i in seq_along(absorb))
+ trs <- trs[-grep(paste("^", absorb[i], sep =""), trs, perl = TRUE)]
+ }
+ else {
+ dtrs <- diag(outer(object$state.names, object$state.names, paste))
+ absorb <- setdiff(levels(object$tran$to), levels(object$trans$from))
+ for (i in seq_along(absorb))
+ dtrs <- dtrs[-grep(paste("^", absorb[i], sep =""), dtrs, perl = TRUE)]
+ tmp <- paste(object$trans[, 1], object$trans[, 2])
+ trs <- c(tmp, dtrs)
+ }
+ res <- ci.transfo(object, trs, level, ci.fun)
+ class(res) <- "summary.etm"
+ res
+}
+
diff --git a/R/summary.etmCIF.R b/R/summary.etmCIF.R
new file mode 100644
index 0000000..6aabeff
--- /dev/null
+++ b/R/summary.etmCIF.R
@@ -0,0 +1,46 @@
+### Summary function for etmCIF objects
+
+summary.etmCIF <- function(object, ci.fun = "cloglog", level = 0.95, ...) {
+
+ if (!inherits(object, "etmCIF")) {
+ stop("'object' must be of class 'etmCIF'")
+ }
+
+ l.X <- ncol(object$X)
+ l.trans <- nrow(object[[1]]$trans)
+
+ temp <- lapply(object[seq_len(l.X)], function(ll) {
+ aa <- summary(ll, ci.fun = ci.fun, level = level, ...)[seq_len(l.trans)]
+ names(aa) <- paste("CIF ", sapply(strsplit(sub("\\s", "|", names(aa)[1:l.trans]), "\\|"),
+ "[", 2), sep = "")
+ aa
+ })
+
+ class(temp) <- "summary.etmCIF"
+ temp
+}
+
+
+### ... and the print function
+print.summary.etmCIF <- function(x, ...) {
+
+ if (!inherits(x, "summary.etmCIF")) {
+ stop("'x' must be of class 'summary.etmCIF'")
+ }
+
+ for (i in seq_along(x)) {
+ cat("\n\t", names(x)[i], "\n\n")
+ time <- x[[i]][[1]]$time
+ qtime <- quantile(time, probs = c(0, 0.25, 0.5, 0.75, 0.9, 1))
+ ind <- findInterval(qtime, time)
+ for (j in seq_along(x[[i]])) {
+ cat(names(x[[i]][j]), "\n")
+ print(x[[i]][[j]][ind, ], row.names = FALSE)
+ cat("\n")
+ }
+ }
+
+ invisible()
+}
+
+
diff --git a/R/transfoData.R b/R/transfoData.R
new file mode 100644
index 0000000..7d1a368
--- /dev/null
+++ b/R/transfoData.R
@@ -0,0 +1,118 @@
+### Function to prepare the data in way
+### that they can be used in etm()
+
+etmprep <- function(time, status, data, tra, state.names, cens.name = NULL,
+ start = NULL, id = NULL, keep) {
+
+ if (nrow(tra) != ncol(tra))
+ stop("'tra' must be quadratic")
+
+ ## What are the possible transitions, transient and absorbing states
+ if (missing(state.names)) {
+ state.names <- as.character(0:(dim(tra)[2] - 1))
+ }
+
+ ls <- length(state.names); n <- nrow(data)
+ if (ls != dim(tra)[2])
+ stop("Discrepancy between 'tra' and the number of states specified in 'state.names'")
+
+ if (length(time) != ls) {
+ stop("The length of 'time' must be equal to the number of states")
+ }
+
+ colnames(tra) <- rownames(tra) <- state.names
+ t.from <- lapply(1:dim(tra)[2], function(i) {
+ rep(rownames(tra)[i], sum(tra[i, ]))
+ })
+ t.from <- unlist(t.from)
+ t.to <- lapply(1:dim(tra)[2], function(i) {
+ colnames(tra)[tra[i, ]==TRUE]
+ })
+ t.to <- unlist(t.to)
+ trans <- data.frame(from=t.from, to=t.to)
+ absorb <- setdiff(levels(trans$to), levels(trans$from))
+ transient <- unique(state.names[!(state.names %in% absorb)])
+
+ ## extract informations in time
+ ind <- match(time[!is.na(time)], names(data))
+ if (any(is.na(ind)))
+ stop("At least one element in 'time' is not in 'data'")
+ indd <- which(time %in% names(data))
+ time <- matrix(NA, n, ls)
+ time[, indd] <- as.matrix(data[, ind])
+
+ ## extract infos in status
+ if (length(status) != ls) {
+ stop("The length of 'status' must be equal to the number of states")
+ }
+ ind <- match(status[!is.na(status)], names(data))
+ if (any(is.na(ind)))
+ stop("At least one element in 'status' is not in 'data'")
+ indd <- which(status %in% names(data))
+ status <- matrix(NA, n, ls)
+ status[, indd] <- as.matrix(data[, ind])
+
+ if (is.null(start)) {
+ start.state <- rep(state.names[1], n)
+ start.time <- rep(0, n)
+ } else {
+ if ((length(start$state) != nrow(data)) | (length(start$time) != nrow(data)))
+ stop("'start$state' or 'start$time' are not as long as the data")
+ if (!all(unique(start$state) %in% state.names))
+ stop("'start$state' not in 'state.names'")
+ start.state <- start$state
+ start.time <- start$time
+ }
+
+ if (is.null(id)) {
+ id <- seq_len(n)
+ } else id <- data[, id]
+
+ if (!missing(keep)) {
+ cova <- data[, keep, drop = FALSE]
+ } else keep <- NULL
+
+ ## let's try to start the real work
+ newdata <- lapply(seq_len(n), function(i) {
+ ind <- which(status[i, ] != 0)
+ li <- length(ind)
+ if (li == 0) {
+ from <- start.state[i]
+ to <- cens.name
+ entry <- start.time[i]
+ exit <- time[i, ncol(time)]
+ idd <- id[i]
+ } else {
+ from <- c(start.state[i], state.names[ind[-li]])
+ to <- state.names[ind]
+ entry <- c(start.time[i], time[i, ind[-li]])
+ exit <- time[i, ind]
+ idd <- rep(id[i], length(exit))
+ if (to[length(to)] %in% transient) {
+ from <- c(from, to[length(to)])
+ to <- c(to, cens.name)
+ entry <- c(entry, exit[length(exit)])
+ exit <- c(exit, time[i, ncol(time)])
+ idd <- c(idd, id[i])
+ }
+ }
+
+ if (is.null(keep)) {
+ tmp <- data.frame(idd, entry, exit, from, to)
+ } else {
+ aa <- matrix(apply(cova[i, , drop = FALSE], 2, rep, length(exit)),
+ length(exit), ncol(cova))
+ tmp <- data.frame(idd, entry, exit, from, to, aa)
+ }
+ tmp
+ })
+ newdata <- do.call(rbind, newdata)
+ names(newdata) <- c("id", "entry", "exit", "from", "to", keep)
+ if (is.factor(newdata$from) || is.factor(newdata$to)) {
+ aa <- unique(c(levels(newdata$from), levels(newdata$to)))
+ newdata$from <- factor(as.character(newdata$from), levels = aa)
+ newdata$to <- factor(as.character(newdata$to), levels = aa)
+ }
+
+ newdata
+}
diff --git a/R/xyplot.etm.R b/R/xyplot.etm.R
new file mode 100644
index 0000000..87ff9e6
--- /dev/null
+++ b/R/xyplot.etm.R
@@ -0,0 +1,46 @@
+xyplot.etm <- function(x, data = NULL, tr.choice, col = c(1, 1, 1), lty = c(1, 3, 3),
+ xlab="Time", ylab = "Transition probability",
+ conf.int = TRUE, ci.fun = "linear", level = 0.95, ...) {
+
+ if (!inherits(x, "etm"))
+ stop("Argument 'x' must be of class 'etm'")
+
+ ref <- sapply(1:length(x$state.names), function(i) {
+ paste(x$state.names, x$state.names[i])
+ })
+ ref <- matrix(ref)
+
+ if (missing(tr.choice)) {
+ ufrom <- unique(x$trans$from)
+ uto <- unique(x$trans$to)
+ absorb <- setdiff(uto, ufrom)
+ nam1 <- dimnames(x$est)[[1]]
+ nam2 <- dimnames(x$est)[[2]]
+ pos <- c(paste(nam1[!(nam1 %in% as.character(absorb))],
+ nam2[!(nam2 %in% as.character(absorb))]),
+ paste(x$trans$from, x$trans$to))
+ tr.choice <- pos
+ }
+
+ if (sum(tr.choice %in% ref == FALSE) > 0)
+ stop("Argument 'tr.choice' and possible transitions must match")
+
+ temp <- ci.transfo(x, tr.choice, level, ci.fun)
+
+ for (i in seq_along(temp)) {
+ temp[[i]]$cov <- names(temp)[i]
+ }
+ temp <- do.call(rbind, temp)
+ temp$cov <- factor(temp$cov, levels = tr.choice)
+
+ if (conf.int) {
+ aa <- xyplot(temp$P + temp$lower + temp$upper ~ temp$time | temp$cov,
+ type = "s", col = col, lty = lty, xlab = xlab, ylab = ylab, ...)
+ }
+ else {
+ aa <- xyplot(temp$P ~ temp$time | temp$cov, type = "s",
+ col = col, lty = lty, xlab = xlab, ylab = ylab, ...)
+ }
+
+ aa
+}
diff --git a/build/vignette.rds b/build/vignette.rds
new file mode 100644
index 0000000..3539ad6
Binary files /dev/null and b/build/vignette.rds differ
diff --git a/data/abortion.txt.gz b/data/abortion.txt.gz
new file mode 100644
index 0000000..4672ec8
Binary files /dev/null and b/data/abortion.txt.gz differ
diff --git a/data/fourD.rda b/data/fourD.rda
new file mode 100644
index 0000000..6ae1a6c
Binary files /dev/null and b/data/fourD.rda differ
diff --git a/data/los.data.csv.gz b/data/los.data.csv.gz
new file mode 100644
index 0000000..d38f76a
Binary files /dev/null and b/data/los.data.csv.gz differ
diff --git a/data/sir.cont.txt.gz b/data/sir.cont.txt.gz
new file mode 100644
index 0000000..afc6619
Binary files /dev/null and b/data/sir.cont.txt.gz differ
diff --git a/debian/README.source b/debian/README.source
deleted file mode 100644
index 2da1085..0000000
--- a/debian/README.source
+++ /dev/null
@@ -1,22 +0,0 @@
-Explanation for binary files inside source package according to
- http://lists.debian.org/debian-devel/2013/09/msg00332.html
-
-The source packages contains some binary RData files which are
-documented inside the according manpages
-
-Files: data/fourD.rda
-Documentation: man/fourD.Rd
- Data from the placebo group of the 4D study. This study aimed at
- comparing atorvastatin to placebo for patients with type 2 diabetes
- and receiving hemodialysis in terms of cariovascular events. The
- primary endpoint was a composite of
- death from cardiac causes, stroke and non-fatal myocardial infarction.
- Competing event was death from other causes.
- .
- Wanner, C., Krane, V., Maerz, W., Olschewski, M., Mann, J., Ruf, G.,
- Ritz, E (2005). Atorvastatin in patients with type 2 diabetes mellitus
- undergoing hemodialysis. New England Journal of Medicine, 353(3),
- 238--248.
-
- -- Andreas Tille <tille at debian.org> Thu, 24 Sep 2015 09:59:03 +0200
-
diff --git a/debian/README.test b/debian/README.test
deleted file mode 100644
index 55a9142..0000000
--- a/debian/README.test
+++ /dev/null
@@ -1,8 +0,0 @@
-Notes on how this package can be tested.
-────────────────────────────────────────
-
-To run the unit tests provided by the package you can do
-
- sh run-unit-test
-
-in this directory.
diff --git a/debian/changelog b/debian/changelog
deleted file mode 100644
index 82bee93..0000000
--- a/debian/changelog
+++ /dev/null
@@ -1,18 +0,0 @@
-r-cran-etm (0.6-2-3) unstable; urgency=medium
-
- * Make test more tolerant against different output to compare with
-
- -- Andreas Tille <tille at debian.org> Fri, 29 Apr 2016 09:36:56 +0200
-
-r-cran-etm (0.6-2-2) unstable; urgency=medium
-
- * Fix autopkgtest
- * cme fix dpkg-control
-
- -- Andreas Tille <tille at debian.org> Wed, 27 Apr 2016 21:22:03 +0200
-
-r-cran-etm (0.6-2-1) unstable; urgency=low
-
- * Initial release (closes: #799928)
-
- -- Andreas Tille <tille at debian.org> Thu, 24 Sep 2015 14:09:06 +0200
diff --git a/debian/compat b/debian/compat
deleted file mode 100644
index ec63514..0000000
--- a/debian/compat
+++ /dev/null
@@ -1 +0,0 @@
-9
diff --git a/debian/control b/debian/control
deleted file mode 100644
index 07f7008..0000000
--- a/debian/control
+++ /dev/null
@@ -1,25 +0,0 @@
-Source: r-cran-etm
-Maintainer: Debian Med Packaging Team <debian-med-packaging at lists.alioth.debian.org>
-Uploaders: Andreas Tille <tille at debian.org>
-Section: gnu-r
-Testsuite: autopkgtest
-Priority: optional
-Build-Depends: debhelper (>= 9),
- cdbs,
- r-base-dev,
- r-cran-lattice,
- r-cran-survival
-Standards-Version: 3.9.8
-Vcs-Browser: https://anonscm.debian.org/viewvc/debian-med/trunk/packages/R/r-cran-etm/trunk/
-Vcs-Svn: svn://anonscm.debian.org/debian-med/trunk/packages/R/r-cran-etm/trunk/
-Homepage: https://cran.r-project.org/web/packages/etm/
-
-Package: r-cran-etm
-Architecture: any
-Depends: ${shlibs:Depends},
- ${R:Depends},
- r-cran-lattice,
- r-cran-survival
-Description: GNU R empirical transition matrix
- This GNU R package provides matrix of transition probabilities for any
- time-inhomogeneous multistate model with finite state space.
diff --git a/debian/copyright b/debian/copyright
deleted file mode 100644
index 4cb11c2..0000000
--- a/debian/copyright
+++ /dev/null
@@ -1,30 +0,0 @@
-Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
-Upstream-Name: etm
-Upstream-Contact: Arthur Allignol <arthur.allignol at uni-ulm.de>
-Source: http://cran.r-project.org/src/contrib/
-
-Files: *
-Copyright: 2008-2014 Arthur Allignol <arthur.allignol at uni-ulm.de>
-License: GPL-2+
-
-Files: debian/*
-Copyright: 2015 Andreas Tille <tille at debian.org>
-License: GPL-2+
-
-License: GPL-2+
- This program is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 2 of the License, or
- (at your option) any later version.
- .
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- .
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
- .
- On Debian systems, the complete text of the GNU General Public
- License can be found in `/usr/share/common-licenses/GPL'.
-
diff --git a/debian/docs b/debian/docs
deleted file mode 100644
index 3adf0d6..0000000
--- a/debian/docs
+++ /dev/null
@@ -1,3 +0,0 @@
-debian/README.test
-debian/tests/run-unit-test
-tests
diff --git a/debian/rules b/debian/rules
deleted file mode 100755
index 2fbba2d..0000000
--- a/debian/rules
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/usr/bin/make -f
-
-include /usr/share/R/debian/r-cran.mk
diff --git a/debian/source/format b/debian/source/format
deleted file mode 100644
index 163aaf8..0000000
--- a/debian/source/format
+++ /dev/null
@@ -1 +0,0 @@
-3.0 (quilt)
diff --git a/debian/tests/control b/debian/tests/control
deleted file mode 100644
index d2aa55a..0000000
--- a/debian/tests/control
+++ /dev/null
@@ -1,3 +0,0 @@
-Tests: run-unit-test
-Depends: @
-Restrictions: allow-stderr
diff --git a/debian/tests/run-unit-test b/debian/tests/run-unit-test
deleted file mode 100644
index affe6d0..0000000
--- a/debian/tests/run-unit-test
+++ /dev/null
@@ -1,39 +0,0 @@
-#!/bin/sh -e
-
-pkg=r-cran-etm
-
-# The saved result files do contain some differences in metadata and we also
-# need to ignore version differences of R
-filter() {
- grep -v -e '^R version' \
- -e '^Copyright (C)' \
- -e '^Platform: ' \
- -e '^ISBN 3' \
- -e '^Loading required package: lattice' \
- -e '^Loading required package: splines' \
- $1 | \
- sed -e '/^> *proc\.time()$/,$d' \
- -e '/^ Natural language support but running in an English locale/,+1d'
-}
-
-if [ "$ADTTMP" = "" ] ; then
- ADTTMP=`mktemp -d /tmp/${pkg}-test.XXXXXX`
-fi
-cd $ADTTMP
-cp /usr/share/doc/${pkg}/tests/* $ADTTMP
-find . -name "*.gz" -exec gunzip \{\} \;
-for htest in `ls *.R | sed 's/\.R$//'` ; do
- LC_ALL=C R --no-save < ${htest}.R 2>&1 | tee > ${htest}.Rout
- filter ${htest}.Rout.save > ${htest}.Rout.save_
- filter ${htest}.Rout > ${htest}.Rout_
- diff -u ${htest}.Rout.save_ ${htest}.Rout_
- if [ ! $? ] ; then
- echo "Test ${htest} failed"
- exit 1
- else
- echo "Test ${htest} passed"
- fi
-done
-rm -f $ADTTMP/*
-
-exit 0
diff --git a/debian/watch b/debian/watch
deleted file mode 100644
index 29459fb..0000000
--- a/debian/watch
+++ /dev/null
@@ -1,2 +0,0 @@
-version=3
-http://cran.r-project.org/src/contrib/etm_([-\d.]*)\.tar\.gz
diff --git a/inst/CITATION b/inst/CITATION
new file mode 100644
index 0000000..667a1bf
--- /dev/null
+++ b/inst/CITATION
@@ -0,0 +1,20 @@
+citHeader("To cite etm in publications use:")
+
+citEntry(entry = "Article",
+ title = "Empirical Transition Matrix of Multi-State Models: The {etm} Package",
+ author = personList(as.person("Arthur Allignol"),
+ as.person("Martin Schumacher"),
+ as.person("Jan Beyersmann")),
+ journal = "Journal of Statistical Software",
+ year = "2011",
+ volume = "38",
+ number = "4",
+ pages = "1--15",
+ url = "http://www.jstatsoft.org/v38/i04/",
+
+ textVersion =
+ paste("Arthur Allignol, Martin Schumacher, Jan Beyersmann (2011).",
+ "Empirical Transition Matrix of Multi-State Models: The etm Package.",
+ "Journal of Statistical Software, 38(4), 1-15.",
+ "URL http://www.jstatsoft.org/v38/i04/.")
+)
diff --git a/inst/doc/etmCIF_tutorial.R b/inst/doc/etmCIF_tutorial.R
new file mode 100644
index 0000000..2786278
--- /dev/null
+++ b/inst/doc/etmCIF_tutorial.R
@@ -0,0 +1,115 @@
+### R code from vignette source 'etmCIF_tutorial.Rnw'
+
+###################################################
+### code chunk number 1: etmCIF_tutorial.Rnw:34-36
+###################################################
+require(etm)
+data(abortion)
+
+
+###################################################
+### code chunk number 2: etmCIF_tutorial.Rnw:50-51
+###################################################
+head(abortion)
+
+
+###################################################
+### code chunk number 3: etmCIF_tutorial.Rnw:95-98
+###################################################
+cif.abortion <- etmCIF(Surv(entry, exit, cause != 0) ~ group,
+ abortion, etype = cause, failcode = 3)
+cif.abortion
+
+
+###################################################
+### code chunk number 4: etmCIF_tutorial.Rnw:107-108
+###################################################
+s.cif.ab <- summary(cif.abortion)
+
+
+###################################################
+### code chunk number 5: etmCIF_tutorial.Rnw:115-116
+###################################################
+s.cif.ab
+
+
+###################################################
+### code chunk number 6: etmCIF_tutorial.Rnw:128-129
+###################################################
+plot(cif.abortion)
+
+
+###################################################
+### code chunk number 7: etmCIF_tutorial.Rnw:144-147
+###################################################
+plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6),
+ ci.type = "bars", pos.ci = 27, col = c(1, 2), ci.lwd = 6,
+ lwd = 2, lty = 1, cex = 1.3)
+
+
+###################################################
+### code chunk number 8: etmCIF_tutorial.Rnw:166-169
+###################################################
+plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6),
+ ci.type = "bars", pos.ci = c(27, 28), col = c(1, 1), ci.lwd = 6,
+ lwd = 2, lty = c(2, 1), cex = 1.3)
+
+
+###################################################
+### code chunk number 9: etmCIF_tutorial.Rnw:182-184
+###################################################
+plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.5),
+ ci.type = "pointwise", col = c(1, 2), lwd = 2, lty = 1, cex = 1.3)
+
+
+###################################################
+### code chunk number 10: etmCIF_tutorial.Rnw:199-205
+###################################################
+plot(cif.abortion, which.cif = c(1, 2), ylim = c(0, 0.8), lwd = 2,
+ col = c(1, 1, 2, 2), lty = c(1, 2, 1, 2), legend = FALSE)
+legend(0, 0.8, c("Control", "Exposed"), col = c(1, 2), lty = 1,
+ bty = "n", lwd = 2)
+legend(0, 0.7, c("ETOP", "Life Birth"), col = 1, lty = c(1, 2),
+ bty = "n", lwd = 2)
+
+
+###################################################
+### code chunk number 11: etmCIF_tutorial.Rnw:225-231
+###################################################
+abortion$status <- with(abortion, ifelse(cause == 2, "life birth",
+ ifelse(cause == 1, "ETOP", "spontaneous abortion")))
+abortion$status <- factor(abortion$status)
+
+abortion$treat <- with(abortion, ifelse(group == 0, "control", "exposed"))
+abortion$treat <- factor(abortion$treat)
+
+
+###################################################
+### code chunk number 12: etmCIF_tutorial.Rnw:236-239
+###################################################
+new.cif <- etmCIF(Surv(entry, exit, status != 0) ~ treat, abortion,
+ etype = status, failcode = "spontaneous abortion")
+new.cif
+
+
+###################################################
+### code chunk number 13: etmCIF_tutorial.Rnw:260-261
+###################################################
+trprob(new.cif[[1]], "0 spontaneous abortion", c(1, 10, 27))
+
+
+###################################################
+### code chunk number 14: etmCIF_tutorial.Rnw:275-276 (eval = FALSE)
+###################################################
+## lines(cif.abortion[[2]], tr.choice = "0 1", col = 2, lwd = 2)
+
+
+###################################################
+### code chunk number 15: etmCIF_tutorial.Rnw:281-285
+###################################################
+plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6),
+ ci.type = "bars", pos.ci = c(27, 28), col = c(1, 1), ci.lwd = 6,
+ lwd = 2, lty = c(2, 1), cex = 1.3)
+lines(cif.abortion[[2]], tr.choice = "0 1", col = 2, lwd = 2)
+
+
diff --git a/inst/doc/etmCIF_tutorial.Rnw b/inst/doc/etmCIF_tutorial.Rnw
new file mode 100644
index 0000000..d75ccd1
--- /dev/null
+++ b/inst/doc/etmCIF_tutorial.Rnw
@@ -0,0 +1,302 @@
+%\VignetteIndexEntry{Computing Cumulative Incidence Functions with the etmCIF Function}
+
+\documentclass{article}
+
+\usepackage{amsmath, amssymb}
+\usepackage{graphicx}
+\usepackage{url}
+\usepackage[pdftex]{color}
+\usepackage[round]{natbib}
+
+\SweaveOpts{keep.source=TRUE,eps=FALSE}
+
+\title{Computing Cumulative Incidence Functions with the {\tt etmCIF}
+ Function, with a view Towards Pregnancy Applications}
+
+\author{Arthur Allignol}
+
+\date{}
+
+\begin{document}
+
+\maketitle
+
+\section{Introduction}
+
+This paper documents the use of the {\tt etmCIF} function to compute
+the cumulative incidence function (CIF) in pregnancy data.
+
+\section{Data Example}
+
+The data set {\tt abortion}, included in the {\bf etm} package will be
+used to illustrate the computation of the CIFs. We first load the {\bf
+ etm} package and the data set.
+<<>>=
+require(etm)
+data(abortion)
+@
+
+Briefly, the data set contains information on \Sexpr{nrow(abortion)}
+pregnant women collected prospectively by the Teratology Information
+Service of Berlin, Germany \citep{meister}. Among these pregnant women,
+\Sexpr{with(abortion, table(group)[2])} were exposed therapeutically
+to coumarin derivatives, a class of orally active anticoagulant, and
+\Sexpr{with(abortion, table(group)[1])} women served as
+controls. Coumarin derivatives are suspected to increase the number of
+spontaneous abortions. Competing events are elective abortion (ETOP) and
+life birth.
+
+Below is an excerpt of the data set
+<<>>=
+head(abortion)
+@
+
+{\tt id} is the individual number, {\tt entry} is the gestational age
+at which the women entered the study, {\tt exit} is the gestational
+age at the end of pregnancy, {\tt group} is the group membership (0
+for controls and 1 for the women exposed to coumarin derivatives) and
+{\tt cause} is the cause of end of pregnancy (1 for induced abortion, 2 for
+life birth and 3 for spontaneous abortion.)
+
+\section{Computing and plotting the CIFs}
+
+\subsection{The {\tt etmCIF} function}
+
+The CIFs are computed using the {\tt etmCIF} function. It is a
+wrapper around the {\tt etm} function, meant
+to facilitate the computation of the CIFs. {\tt etmCIF} takes as arguments
+\begin{itemize}
+\item {\tt formula}: A formula consisting of a {\tt Surv} object on
+ the left of a {\tt ~} operator, and the group covariate on the
+ right. A {\tt Surv} object is for example created this way: {\tt
+ Surv(entry, exit, cause != 0)}. We need to specify the entry
+ time ({\tt entry}), the gestational age at end of pregnancy ({\tt
+ exit}), and an event indicator ({\tt cause != 0}). The latter
+ means that any value different from 0 in {\tt cause} will be
+ considered as an event -- which is the case in our example, as we
+ don't have censoring.
+
+\item {\tt data}: A data set in which to interpret the terms of the
+ formula. In our case, it will be {\tt abortion}.
+
+\item {\tt etype}: Competing risks event indicator. When the status
+ indicator is 1 (or TRUE) in the formula, {\tt etype} describes the
+ type of event, otherwise, for censored observation, the value of
+ {\tt etype} is ignored.
+
+\item {\tt failcode}: Indicates the failure type of interest. Default
+ is one. This option is only interesting for some features of the
+ plot function.
+\end{itemize}
+
+\subsection{Estimation and display of the CIFs}
+
+We know compute the CIFs
+<<>>=
+cif.abortion <- etmCIF(Surv(entry, exit, cause != 0) ~ group,
+ abortion, etype = cause, failcode = 3)
+cif.abortion
+@
+
+Above is the display provided by the {\tt print} function. It gives,
+at the last event time, the probabilities ({\tt P}) standard errors
+({\tt se(P)}), and the total number of events ({\tt n.event}) for the
+three possible pregnancy outcomes and for both groups.
+
+More information is provided by the {\tt summary} function.
+<<>>=
+s.cif.ab <- summary(cif.abortion)
+@
+
+The function returns a list of data.frames that contain probabilities,
+variances, pointwise confidence intervals, number at risk and number
+of events for each event times. the {\tt print} function displays this
+information for some selected event times.
+<<>>=
+s.cif.ab
+@
+
+\subsection{Plotting the CIFs}
+
+Interest lies in the CIFs of spontaneous abortion. We display them
+using the {\tt plot} function, which by default, plots only the the
+CIFs for the event of interest, i.e., the one specified in {\tt
+ failcode}.
+\setkeys{Gin}{width=0.9\textwidth}
+\begin{figure}[!htb]
+\begin{center}
+<<fig = TRUE, width = 10, height = 10>>=
+plot(cif.abortion)
+@
+\caption{CIFs of spontaneous abortion for the controls (solid line)
+ and the exposed (dashed line), using the default settings of the
+ {\tt plot} function.}
+\end{center}
+\end{figure}
+
+\clearpage
+
+We now add confidence intervals taken at week 27, plus a
+bit of customisation.
+\setkeys{Gin}{width=0.9\textwidth}
+\begin{figure}[!htb]
+\begin{center}
+<<fig = TRUE, width = 10, height = 10>>=
+plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6),
+ ci.type = "bars", pos.ci = 27, col = c(1, 2), ci.lwd = 6,
+ lwd = 2, lty = 1, cex = 1.3)
+@
+\caption{CIFs of spontaneous abortion for the controls (black) and the
+ exposed (red), along with pointwise confidence intervals taken at
+ week 27.}
+\end{center}
+\end{figure}
+
+\clearpage
+
+When the figure is to be in black and white, or when the confidence
+intervals are not as separated as in this example, it might be a good
+idea to shift slightly one of the bar representing the confidence
+interval, so that the two bars don't overlap. This might be done
+manipulating the {\tt pos.ci} argument:
+
+\setkeys{Gin}{width=0.9\textwidth}
+\begin{figure}[!htb]
+\begin{center}
+<<fig = TRUE, width = 10, height = 10>>=
+plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6),
+ ci.type = "bars", pos.ci = c(27, 28), col = c(1, 1), ci.lwd = 6,
+ lwd = 2, lty = c(2, 1), cex = 1.3)
+@
+\caption{CIFs of spontaneous abortion for the controls (dashed line) and the
+ exposed (solid line), along with pointwise confidence intervals.}\label{decalage}
+\end{center}
+\end{figure}
+
+\clearpage
+
+Pointwise confidence intervals can also be plotted for the whole
+follow-up period.
+\begin{figure}[!htb]
+\begin{center}
+<<fig = TRUE, width = 10, height = 10>>=
+plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.5),
+ ci.type = "pointwise", col = c(1, 2), lwd = 2, lty = 1, cex = 1.3)
+@
+\caption{Same as the last pictures, except for the confidence
+ intervals, that are displayed for the whole follow-up period.}
+\end{center}
+\end{figure}
+
+\clearpage
+
+CIFs for other pregnancy outcomes can also be plotted using the {\tt
+ which.cif} arguments. For instance, for plotting the CIFs of ETOP
+and life birth on the same graph, we specify {\tt which.cif = c(1, 2)}
+in the call to {\tt plot}.
+\begin{figure}[!htb]
+\begin{center}
+<<fig = TRUE, width = 10, height = 10>>=
+plot(cif.abortion, which.cif = c(1, 2), ylim = c(0, 0.8), lwd = 2,
+ col = c(1, 1, 2, 2), lty = c(1, 2, 1, 2), legend = FALSE)
+legend(0, 0.8, c("Control", "Exposed"), col = c(1, 2), lty = 1,
+ bty = "n", lwd = 2)
+legend(0, 0.7, c("ETOP", "Life Birth"), col = 1, lty = c(1, 2),
+ bty = "n", lwd = 2)
+@
+\end{center}
+\caption{CIFs of ETOP (solid lines) and life birth (dashed lines) for
+ the exposed, in red, and the controls, in black.}
+\end{figure}
+
+\clearpage
+
+\subsection{Some More Features}
+
+\paragraph{Competing event names}
+
+For those who don't like using plain numbers for naming the competing
+events or the group allocation, it is of course possible to give more
+informative names, either as factors or character vectors. For
+instance, we define a new group variable that takes value {\tt 'control'}
+or {\tt 'exposed'}, and we give more informative names for the pregnancy
+outcomes.
+
+<<>>=
+abortion$status <- with(abortion, ifelse(cause == 2, "life birth",
+ ifelse(cause == 1, "ETOP", "spontaneous abortion")))
+abortion$status <- factor(abortion$status)
+
+abortion$treat <- with(abortion, ifelse(group == 0, "control", "exposed"))
+abortion$treat <- factor(abortion$treat)
+@
+
+We can compute the CIFs as before, taking care of changing the {\tt failcode} argument.
+
+<<>>=
+new.cif <- etmCIF(Surv(entry, exit, status != 0) ~ treat, abortion,
+ etype = status, failcode = "spontaneous abortion")
+new.cif
+@
+
+The {\tt summary} and {\tt plot} functions will work as before, except
+for a more informative outcome from scratch.
+
+\paragraph{Taking advantage of the miscellaneous functions defined for
+ {\tt etm} objects}
+
+The {\tt etmCIF} function uses the more general {\tt etm} machinery
+for computing the CIFs. Thus the returned {\tt etmCIF} object is for
+part a list of {\tt etm} objects (one for each covariate level). It is
+therefore relatively easy to use the methods defined for {\tt etm} on
+{\tt etmCIF} objects.
+
+An example would be to use the {\tt trprob} function to extract the
+CIF of spontaneous abortion for the controls. This function takes as
+arguments an {\tt etm} object, the transition we are interested in, in
+the form ``from to'' (the state a patient comes from is automatically
+defined as being 0 in {\tt etmCIF}), and possibly some time points.
+Using {\tt new.cif} from the example above:
+<<>>=
+trprob(new.cif[[1]], "0 spontaneous abortion", c(1, 10, 27))
+@
+We applied the {\tt trprob} function to the {\tt etm} object for the
+controls (which is in the first item of the output, for the exposed in
+the second). The transition of interest is from {\tt 0} to {\tt
+ spontaneous abortion}, and we want the CIF at weeks 1, 10 and 27
+(just put nothing if you want the CIF for all time points).
+
+Another example would be to use the {\tt lines} function to add a CIF
+to an existing plot. The following code snippet adds the CIF of ETOP
+for the exposed to Figure \ref{decalage}. That's the {\tt tr.choice}
+arguments that defines which CIF to pick. It works in the same way as
+in the {\tt trprob} function.
+
+<<eval = FALSE>>=
+lines(cif.abortion[[2]], tr.choice = "0 1", col = 2, lwd = 2)
+@
+\setkeys{Gin}{width=0.9\textwidth}
+\begin{figure}[!htb]
+\begin{center}
+<<echo = FALSE, fig = TRUE, width = 10, height = 10>>=
+plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6),
+ ci.type = "bars", pos.ci = c(27, 28), col = c(1, 1), ci.lwd = 6,
+ lwd = 2, lty = c(2, 1), cex = 1.3)
+lines(cif.abortion[[2]], tr.choice = "0 1", col = 2, lwd = 2)
+@
+\caption{Figure \ref{decalage} along with the CIF of ETOP for the exposed in red.}
+\end{center}
+\end{figure}
+
+\clearpage
+
+\begin{thebibliography}{1}
+\bibitem[Meister and Schaefer, 2008]{meister}
+ Meister, R. and Schaefer, C. (2008).
+ \newblock Statistical methods for estimating the probability of spontaneous
+ abortion in observational studies--analyzing pregnancies exposed to coumarin
+ derivatives.
+ \newblock {\em Reproductive Toxicology}, 26(1):31--35.
+\end{thebibliography}
+
+\end{document}
diff --git a/inst/doc/etmCIF_tutorial.pdf b/inst/doc/etmCIF_tutorial.pdf
new file mode 100644
index 0000000..fb4f54c
Binary files /dev/null and b/inst/doc/etmCIF_tutorial.pdf differ
diff --git a/man/abortion.Rd b/man/abortion.Rd
new file mode 100644
index 0000000..135b9a7
--- /dev/null
+++ b/man/abortion.Rd
@@ -0,0 +1,35 @@
+\name{abortion}
+\alias{abortion}
+\docType{data}
+\title{Pregnancies exposed to coumarin derivatives}
+\description{
+ Outcomes of pregnancies exposed to coumarin derivatives. The aim is to
+ investigate whether exposition to coumarin derivatives increases the
+ probability of spontaneous abortions. Apart from spontaneous abortion,
+ pregnancy may end in induced abortion or live birth, leading to a
+ competing risks situation. Moreover, data are left-truncated as women
+ usually enter the study several weeks after conception.
+}
+\usage{data(abortion)}
+\format{
+ A data frame with 1186 observations on the following 5 variables.
+ \describe{
+ \item{\code{id}}{Identification number}
+ \item{\code{entry}}{Entry times into the cohort}
+ \item{\code{exit}}{Event times}
+ \item{\code{group}}{Group. 0: control, 1: exposed to coumarin
+ derivatives}
+ \item{\code{cause}}{Cause of failure. 1: induced abortion, 2: life
+ birth, 3: spontaneous abortion}
+ }
+}
+\source{
+ Meiester, R. and Schaefer, C (2008). Statistical methods for
+ estimating the probability of spontaneous abortion in observational
+ studies -- Analyzing pregnancies exposed to coumarin
+ derivatives. Reproductive Toxicology, 26, 31--35
+}
+\examples{
+data(abortion)
+}
+\keyword{datasets}
diff --git a/man/clos.Rd b/man/clos.Rd
new file mode 100644
index 0000000..ec4f9d2
--- /dev/null
+++ b/man/clos.Rd
@@ -0,0 +1,145 @@
+\name{clos}
+\alias{clos}
+\title{Change in Length of Stay}
+\description{
+ The function estimates the expected change in length of stay (LOS)
+ associated with an intermediate event.
+}
+\usage{
+clos(x, aw = FALSE, ratio = FALSE)
+}
+\arguments{
+ \item{x}{An object of class \code{etm}. Argument \code{delta.na} in
+ \code{\link{etm}} must be set to \code{TRUE} in order to use this
+ function.}
+ \item{aw}{Logical. Whether to compute the expected change of LOS using
+ alternative weighting. Default is \code{FALSE}.}
+ \item{ratio}{Logical. Compute the ratio of the expected length-of-stay
+ given instermediate event status instead of a difference. Default
+ value is \code{FALSE}}
+}
+
+\details{
+ The approach for evaluating the impact of an intermediate
+ event on the expected change in length of stay is based on Schulgen
+ and Schumacher (1996). They suggested to consider the difference of
+ the expected subsequent stay given infectious status at time s.
+
+ Extensions to the methods of Schulgen and Schumacher and the earlier
+ implementation in the \pkg{changeLOS} include the possibility to
+ compute the extra length of stay both for competing endpoints and the
+ more simple case of one absorbing state, as well as the possibility to
+ compute this quantity for left-truncated data.
+}
+
+\value{
+ An object of class \code{clos.etm} with the following components:
+ \item{e.phi}{Change in length of stay}
+ \item{phi.case}{Estimates of \eqn{E(\mbox{LOS} | X_s =
+ \mbox{intermediate event})}{E(LOS | X_s = intermediate event)} for
+ all observed transition times \eqn{s}{s}, where
+ \eqn{X_s}{X_s}denotes the state by time \eqn{s}{s}}
+ \item{phi.control}{Estimates of \eqn{E(\mbox{LOS} | X_s =
+ \mbox{initial state})}{E(LOS|X_s = initial state)} for
+ all observed transition times \eqn{s}{s}.}
+ \item{e.phi2}{Weighted average of the difference between
+ \code{phi2.case} and \code{phi2.control}.}
+ \item{phi2.case}{Estimates of \eqn{E(\mbox{LOS}
+ \mathbf{1}(X_{\mbox{LOS}} = \mbox{discharge}) | X_s =
+ \mbox{intermediate event})}{E(LOS \strong{1}(X_LOS = discharge)|X_s =
+ intermediate event)}, where \eqn{\mathbf{1}}{\strong{1}} denotes
+ the indicator function.}
+ \item{phi2.control}{\eqn{E(\mbox{LOS}
+ \mathbf{1}(X_{\mbox{LOS}} = \mbox{discharge}) | X_s =
+ \mbox{initial state})}{E(LOS \strong{1}(X_LOS = discharge)|X_s =
+ initial state)}.}
+ \item{e.phi3}{Weighted average of the difference between
+ \code{phi3.case} and \code{phi3.control}.}
+ \item{phi3.case}{Estimates of \eqn{E(\mbox{LOS}
+ \mathbf{1}(X_{\mbox{LOS}} = \mbox{death}) | X_s =
+ \mbox{intermediate event})}{E(LOS \strong{1}(X_LOS = death)|X_s =
+ intermediate event)}.}
+ \item{phi3.control}{\eqn{E(\mbox{LOS}
+ \mathbf{1}(X_{\mbox{LOS}} = \mbox{death}) | X_s =
+ \mbox{initial state})}{E(LOS \strong{1}(X_LOS = death)|X_s =
+ initial state)}.}
+ \item{weights}{Weights used to compute the weighted averages.}
+ \item{w.time}{Times at which the weights are computed.}
+ \item{time}{All transition times.}
+ \item{e.phi.weights.1}{Expected change in LOS using \code{weights.1}}
+ \item{e.phi.weights.other}{Expected change in LOS using
+ \code{weights.other}}
+ \item{weights.1}{Weights corresponding to the conditional waiting
+ time in the intial state given one experiences the intermediate event.}
+ \item{weights.other}{Weights corresponding to the conditional
+ waiting time given one does not experience the intermediate event.}
+}
+
+\references{
+ G Schulgen and M Schumacher (1996). Estimation of prolongation of
+ hospital stay attributable to nosocomial infections. \emph{Lifetime
+ Data Analysis} 2, 219-240.
+
+ J Beyersmann, P Gastmeier, H Grundmann, S Baerwolf, C Geffers,
+ M Behnke, H Rueden, and M Schumacher (2006). Use of Multistate
+ Models to Assess Prolongation of Intensive Care Unit Stay Due to
+ Nosocomial Infection. \emph{Infection Control and Hospital
+ Epidemiology} 27, 493-499.
+
+ Allignol A, Schumacher M, Beyersmann J: Estimating summary functionals
+ in multistate models with an application to hospital infection
+ data. \emph{Computation Stat}, 2011; 26: 181-197.
+
+ M Wrangler, J Beyersmann and M Schumacher (2006). changeLOS: An
+ R-package for change in length of hospital stay based on the
+ Aalen-Johansen estimator. \emph{R News} 6(2), 31--35.
+}
+
+\author{Arthur Allignol \email{arthur.allignol at uni-ulm.de},
+ Matthias Wangler, Jan Beyersmann}
+\seealso{\code{\link{etm}}}
+\examples{
+data(los.data)
+
+## putting los.data in the long format
+my.observ <- prepare.los.data(x=los.data)
+
+tra <- matrix(FALSE, 4, 4)
+tra[1, 2:4] <- TRUE
+tra[2, 3:4] <- TRUE
+
+tr.prob <- etm(my.observ, c("0","1","2","3"), tra, NULL, 0)
+
+cLOS <- etm::clos(tr.prob)
+plot(cLOS)
+
+
+### Compute bootstrapped SE
+
+## function that performs the bootstrap
+## nboot: number of bootstrap samples. Other arguments are as in etm()
+boot.clos <- function(data, state.names, tra, cens.name, s = 0, nboot) {
+ res <- double(nboot)
+ for (i in seq_len(nboot)) {
+ index <- sample(unique(data$id), replace = TRUE)
+ inds <- new.id <- NULL
+ for (j in seq_along(index)){
+ ind <- which(data$id == index[j])
+ new.id <- c(new.id, rep(j, length(ind)))
+ inds <- c(inds, ind)
+ }
+ dboot <- cbind(data[inds, ], new.id)
+ dboot[, which(names(dboot) == "id")]
+ dboot$id <- dboot$new.id
+ tr.prob <- etm(dboot, state.names, tra, cens.name, s, cova = FALSE)
+ res[i] <- etm::clos(tr.prob)$e.phi
+ }
+ res
+}
+
+## bootstrap
+se <- sqrt(var(boot.clos(my.observ, c("0","1","2","3"), tra, NULL, 0,
+ nboot = 10)))
+}
+
+\keyword{survival}
diff --git a/man/closPseudo.Rd b/man/closPseudo.Rd
new file mode 100644
index 0000000..70f8fb0
--- /dev/null
+++ b/man/closPseudo.Rd
@@ -0,0 +1,116 @@
+\name{closPseudo}
+\alias{closPseudo}
+
+\title{
+ Pseudo Value Regression for the Extra Length-of-Stay
+}
+\description{
+ Pseudo Value Regression for the Extra Length-of-Stay
+}
+\usage{
+closPseudo(data, state.names, tra, cens.name, s = 0, formula,
+ aw = FALSE, ratio = FALSE, ncores = 1)
+}
+\arguments{
+ \item{data}{
+ data.frame of the form data.frame(id,from,to,time)
+ or (id,from,to,entry,exit)
+ \describe{
+ \item{id:}{patient id}
+ \item{from:}{the state from where the transition occurs}
+ \item{to:}{the state to which a transition occurs}
+ \item{time:}{time when a transition occurs}
+ \item{entry:}{entry time in a state}
+ \item{exit:}{exit time from a state}
+ }
+ }
+ \item{state.names}{A vector of characters giving the states names.}
+ \item{tra}{A quadratic matrix of logical values describing the possible
+ transitions within the multistate model.}
+ \item{cens.name}{ A character giving the code for censored
+ observations in the column 'to' of \code{data}. If there is no
+ censored observations in your data, put 'NULL'.}
+ \item{s}{Starting value for computing the transition probabilities.}
+ \item{formula}{A formula with the covariates at the right of a
+ \code{~} operator. Leave the left part empty.}
+ \item{aw}{Logical. Whether to compute the expected change of LOS using
+ alternative weighting. Default is \code{FALSE}.}
+ \item{ratio}{Logical. Compute the ratio of the expected length-of-stay
+ given instermediate event status instead of a difference. Default
+ value is \code{FALSE}}
+ \item{ncores}{Number of cores used if doing parallel computation using
+ the \pkg{parallel} package}
+}
+\details{
+ The function calculates the pseudo-observations for the extra
+ length-of-stay for each individual. These pseudo-observations can then
+ be used to fit a direct regression model using generalized estimating
+ equation (e.g., package \pkg{geepack}).
+
+ Computation of the pseudo-observations can be parallelised using the
+ \code{mclapply} function of the \pkg{parallel} package. See argument
+ \code{ncores}.
+}
+\value{
+ An object of class \code{closPseudo} with the following components:
+ \item{pseudoData}{a data.frame containing \code{id}, computed pseudo
+ values (see details) and the covariates as specified in the formula}
+ \item{theta}{Estimates of excess LoS in the whole sample}
+ \item{aw}{like in the function call}
+ \item{call}{Function call}
+}
+
+\references{
+ Andersen, P.K, Klein, J.P, Rosthoj, S. (2003). Generalised
+ linear models for correlated pseudo-observations,
+ with applications to multi-state models. \emph{Biometrika},
+ 90(1):15--27.
+}
+
+\author{
+ Arthur Allignol \email{arthur.allignol at uni-ulm.de}
+}
+
+\seealso{
+ \code{\link[parallel]{mclapply}}, \code{\link[etm]{clos}}
+}
+\examples{
+library(kmi)
+
+## data in kmi package
+data(icu.pneu)
+my.icu.pneu <- icu.pneu
+
+my.icu.pneu <- my.icu.pneu[order(my.icu.pneu$id, my.icu.pneu$start), ]
+masque <- diff(my.icu.pneu$id)
+
+my.icu.pneu$from <- 0
+my.icu.pneu$from[c(1, masque) == 0] <- 1
+
+my.icu.pneu$to2 <- my.icu.pneu$event
+my.icu.pneu$to2[my.icu.pneu$status == 0] <- "cens"
+my.icu.pneu$to2[c(masque, 1) == 0] <- 1
+
+
+my.icu.pneu$to <- ifelse(my.icu.pneu$to2 \%in\% c(2, 3), 2,
+ my.icu.pneu$to2)
+
+my.icu.pneu <- my.icu.pneu[, c("id", "start", "stop", "from", "to",
+ "to2", "age", "sex")]
+names(my.icu.pneu)[c(2, 3)] <- c("entry", "exit")
+
+## computation of the pseudo-observations
+\dontrun{
+ps.icu.pneu <- closPseudo(my.icu.pneu, c("0", "1", "2"), tra_ill(), "cens",
+ formula = ~ sex + age)
+
+## regression model using geepack
+require(geepack)
+fit <- geeglm(ps.e.phi ~ sex + age, id = id, data = ps.icu.pneu$pseudoData,
+ family = gaussian)
+
+summary(fit)
+}
+}
+
+\keyword{survival}
diff --git a/man/etm.Rd b/man/etm.Rd
new file mode 100644
index 0000000..ce36b47
--- /dev/null
+++ b/man/etm.Rd
@@ -0,0 +1,198 @@
+\name{etm}
+\alias{etm}
+
+\title{Computation of the empirical transition matrix}
+\description{
+ This function computes the empirical transition matrix, also called
+ Aalen-Johansen estimator, of the transition probability matrix of any
+ multistate model. The covariance matrix is also computed.
+}
+\usage{
+etm(data, state.names, tra, cens.name, s, t = "last",
+ covariance = TRUE, delta.na = TRUE, modif = FALSE,
+ alpha = 1/4, c = 1)
+}
+\arguments{
+ \item{data}{ data.frame of the form data.frame(id,from,to,time)
+ or (id,from,to,entry,exit)
+ \describe{
+ \item{id:}{patient id}
+ \item{from:}{the state from where the transition occurs}
+ \item{to:}{the state to which a transition occurs}
+ \item{time:}{time when a transition occurs}
+ \item{entry:}{entry time in a state}
+ \item{exit:}{exit time from a state}
+ }
+ This data.frame is transition-oriented, \emph{i.e.} it contains one
+ row per transition, and possibly several rows per patient. Specifying
+ an entry and exit time permits to take into account left-truncation. }
+ \item{state.names}{A vector of characters giving the states names.}
+ \item{tra}{A quadratic matrix of logical values describing the possible
+ transitions within the multistate model. }
+ \item{cens.name}{ A character giving the code for censored
+ observations in the column 'to' of \code{data}. If there is no
+ censored observations in your data, put 'NULL'.}
+ \item{s}{Starting value for computing the transition probabilities.}
+ \item{t}{Ending value. Default is "last", meaning that the transition
+ probabilities are computed over \eqn{(s, t]}{(s, t]}, \eqn{t}{t}
+ being the last time in the data set.}
+ \item{covariance}{Logical. Decide whether or not computing the
+ covariance matrix. May be useful for, say, simulations, as the variance
+ computation is a bit long. Default is TRUE.}
+ \item{delta.na}{Logical. Whether to export the array containing the
+ increments of the Nelson-Aalen estimator. Default is \code{TRUE}.}
+ \item{modif}{Logical. Whether to apply the modification of Lai and
+ Ying for small risk sets}
+ \item{alpha}{Constant}
+ \item{c}{Constant}
+}
+\details{
+ Data are considered to arise from a time-inhomogeneous Markovian
+ multistate model with finite state space, and possibly subject to
+ independent right-censoring and left-truncation.
+
+ The matrix of the transition probabilities is estimated by the
+ Aalen-Johansen estimator / empirical transition matrix (Andersen et
+ al., 1993), which is the product integral over the time period
+ \eqn{(s, t]}{(s, t]} of I + the matrix of the increments of the
+ Nelson-Aalen estimates of the cumulative transition hazards. The
+ \eqn{(i, j)-th}{(i, j)-th} entry of the empirical transition matrix
+ estimates the transition probability of being in state \eqn{j}{j} at
+ time \eqn{t}{t} given that one has been in state j at time \eqn{s}{s}.
+
+ The covariance matrix is computed using the recursion formula (4.4.19)
+ in Anderson et al. (1993, p. 295). This estimator of the covariance
+ matrix is an estimator of the Greenwood type.
+
+ If the multistate model is not Markov, but censorship is entirely
+ random, the Aalen-Johansen estimator still consistently estimates the
+ state occupation probabilities of being in state \eqn{i}{i} at time
+ \eqn{t}{t} (Datta & Satten, 2001; Glidden, 2002)
+
+
+ }
+\value{
+ \item{est}{Transition probability estimates. This is a 3 dimension
+ array with the first dimension being the state from where transitions
+ occur, the second the state to which transitions occur, and the
+ last one being the event times.}
+ \item{cov}{Estimated covariance matrix. Each cell of the matrix gives
+ the covariance between the transition probabilities given by the
+ rownames and the colnames, respectively.}
+ \item{time}{Event times at which the transition probabilities are
+ computed. That is all the observed times between \eqn{(s, t]}{(s, t]}.}
+ \item{s}{Start of the time interval.}
+ \item{t}{End of the time interval.}
+ \item{trans}{A \code{data.frame} giving the possible transitions.}
+ \item{state.names}{A vector of character giving the state names.}
+ \item{cens.name}{How the censored observation are coded in the data
+ set.}
+ \item{n.risk}{Matrix indicating the number of individuals at risk just
+ before an event}
+ \item{n.event}{Array containing the number of transitions at each
+ times}
+ \item{delta.na}{A 3d array containing the increments of the
+ Nelson-Aalen estimator.}
+ \item{ind.n.risk}{When \code{modif} is true, risk set size for which
+ the indicator function is 1}
+}
+\references{
+ Beyersmann J, Allignol A, Schumacher M: Competing Risks and Multistate
+ Models with R (Use R!), Springer Verlag, 2012 (Use R!)
+
+ Allignol, A., Schumacher, M. and Beyersmann, J. (2011).
+ Empirical Transition Matrix of Multi-State Models: The etm Package.
+ \emph{Journal of Statistical Software}, 38.
+
+ Andersen, P.K., Borgan, O., Gill, R.D. and Keiding,
+ N. (1993). \emph{Statistical models based on counting
+ processes}. Springer Series in Statistics. New York, NY: Springer.
+
+ Aalen, O. and Johansen, S. (1978). An empirical transition matrix for
+ non-homogeneous Markov chains based on censored
+ observations. \emph{Scandinavian Journal of Statistics}, 5: 141-150.
+
+ Gill, R.D. and Johansen, S. (1990). A survey of product-integration
+ with a view towards application in survival analysis. \emph{Annals of
+ statistics}, 18(4): 1501-1555.
+
+ Datta, S. and Satten G.A. (2001). Validity of the Aalen-Johansen
+ estimators of stage occupation probabilities and Nelson-Aalen
+ estimators of integrated transition hazards for non-Markov
+ models. \emph{Statistics and Probability Letters}, 55(4): 403-411.
+
+ Glidden, D. (2002). Robust inference for event probabilities with
+ non-Markov data. \emph{Biometrics}, 58: 361-368.
+}
+\author{Arthur Allignol, \email{arthur.allignol at uni-ulm.de}}
+
+\note{Transitions into a same state, mathematically superfluous, are not
+ allowed. If transitions into the same state are detected in the data,
+ the function will stop. Equally, \code{diag(tra)} must be set to
+ FALSE, see the example below.}
+
+\seealso{\code{\link{print.etm}}, \code{\link{summary.etm}}, \code{\link{sir.cont}},
+ \code{\link{xyplot.etm}}}
+
+\examples{
+data(sir.cont)
+
+# Modification for patients entering and leaving a state
+# at the same date
+# Change on ventilation status is considered
+# to happen before end of hospital stay
+sir.cont <- sir.cont[order(sir.cont$id, sir.cont$time), ]
+for (i in 2:nrow(sir.cont)) {
+ if (sir.cont$id[i]==sir.cont$id[i-1]) {
+ if (sir.cont$time[i]==sir.cont$time[i-1]) {
+ sir.cont$time[i-1] <- sir.cont$time[i-1] - 0.5
+ }
+ }
+}
+
+### Computation of the transition probabilities
+# Possible transitions.
+tra <- matrix(ncol=3,nrow=3,FALSE)
+tra[1, 2:3] <- TRUE
+tra[2, c(1, 3)] <- TRUE
+
+# etm
+tr.prob <- etm(sir.cont, c("0", "1", "2"), tra, "cens", 1)
+
+tr.prob
+summary(tr.prob)
+
+# plotting
+if (require("lattice")) {
+xyplot(tr.prob, tr.choice=c("0 0", "1 1", "0 1", "0 2", "1 0", "1 2"),
+ layout=c(2, 3), strip=strip.custom(bg="white",
+ factor.levels=
+ c("0 to 0", "1 to 1", "0 to 1", "0 to 2", "1 to 0", "1 to 2")))
+}
+
+### example with left-truncation
+
+data(abortion)
+
+# Data set modification in order to be used by etm
+names(abortion) <- c("id", "entry", "exit", "from", "to")
+abortion$to <- abortion$to + 1
+
+## computation of the matrix giving the possible transitions
+tra <- matrix(FALSE, nrow = 5, ncol = 5)
+tra[1:2, 3:5] <- TRUE
+
+## etm
+fit <- etm(abortion, as.character(0:4), tra, NULL, s = 0)
+
+## plot
+xyplot(fit, tr.choice = c("0 0", "1 1", "0 4", "1 4"),
+ ci.fun = c("log-log", "log-log", "cloglog", "cloglog"),
+ strip = strip.custom(factor.levels = c("P(T > t) -- control",
+ "P(T > t) -- exposed",
+ "CIF spontaneous abortion -- control",
+ "CIF spontaneous abortion --
+exposed")))
+}
+
+\keyword{survival}
diff --git a/man/etmCIF.Rd b/man/etmCIF.Rd
new file mode 100644
index 0000000..d14bab2
--- /dev/null
+++ b/man/etmCIF.Rd
@@ -0,0 +1,69 @@
+\name{etmCIF}
+\alias{etmCIF}
+\title{
+ Cumulative incidence functions of competing risks
+}
+\description{
+ \code{etmCIF} is a wrapper around the \code{etm} function for
+ facilitating the computation of the cumulative incidence functions in
+ the competing risks framework.
+}
+\usage{
+etmCIF(formula, data, etype, subset, na.action, failcode = 1)
+}
+\arguments{
+ \item{formula}{A \code{formula} object, that must have a \code{Surv}
+ object on the left of ~ operator, and a discrete covariate (or 1) on
+ the right. The status indicator should be 1 (or TRUE) for an event
+ (whatever the type of this event, 0 (or FALSE) for censored
+ observations.)}
+ \item{data}{A data.frame in which to interpret the terms of the
+ formula}
+ \item{etype}{Competing risks event indicator. When the status
+ indicator is 1 (or TRUE) in the formula, \code{etype} describes the
+ type of event, otherwise, for censored observation, the value of
+ \code{etype} is ignored}
+ \item{subset}{Expression saying that only a subset of the data should
+ be used.}
+ \item{na.action}{Missing-data filter function. Default is
+ \code{options()$na.action}.}
+ \item{failcode}{Indicates the failure type of interest. Default is
+ one. This option is only relevant for some options of the
+ \code{plot} function.}
+}
+\details{
+ This function computes the cumulative incidence functions in a
+ competing risks setting using the \code{etm} machinery, without having
+ to specify the matrix of possible transitions and using the more usual
+ formula specification with \code{Surv}
+}
+\value{
+ Returns a list of \code{etm} objects (1 per covariate level) plus
+ additional informations:
+ \item{failcode}{As in function call}
+ \item{call}{Function call}
+ \item{X}{A matrix giving the name of the covariate (if present) and
+ the levels of this covariate.}
+}
+\author{
+ Arthur Allignol \email{arthur.alignol at uni-ulm.de}
+}
+\seealso{
+ \code{\link{etm}}, \code{\link{print.etmCIF}},
+ \code{\link{summary.etmCIF}}, \code{\link{plot.etmCIF}}
+}
+\examples{
+data(abortion)
+
+cif.ab <- etmCIF(Surv(entry, exit, cause != 0) ~ group, abortion,
+ etype = cause, failcode = 3)
+
+cif.ab
+
+plot(cif.ab, ci.type = "bars", pos.ci = 24,
+ col = c(1, 2), lty = 1, curvlab = c("Control", "Exposed"))
+
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{survival}
\ No newline at end of file
diff --git a/man/etmprep.Rd b/man/etmprep.Rd
new file mode 100644
index 0000000..45cb0d3
--- /dev/null
+++ b/man/etmprep.Rd
@@ -0,0 +1,96 @@
+\name{etmprep}
+\Rdversion{1.1}
+\alias{etmprep}
+\title{
+ Data transformation function for using etm
+}
+\description{
+ The function transforms a data set in the wide format (i.e., one raw
+ per subject) into the long format (i.e., one raw per transition, and
+ possibly several raws per subjects) in a suitable way for using the
+ \code{etm} function
+}
+\usage{
+etmprep(time, status, data, tra, state.names, cens.name = NULL,
+start = NULL, id = NULL, keep)
+}
+\arguments{
+ \item{time}{A character vector giving the name of the columns
+ containing the transition times or last follow-up times. The
+ length of \code{time} have to be equal to the number of states, some
+ elements may be NA. See Details.}
+ \item{status}{A character vector giving the name of the columns
+ indicating whether a state has been visited (0 if not, 1
+ otherwise).}
+ \item{data}{A data frame in which to look for the columns specified in
+ \code{time} and \code{status}.}
+ \item{tra}{A quadratic matrix of logical values describing the
+ possible transitions within the multistate model. The \eqn{(i,
+ j)}{(i, j)}th element of \code{tra} is TRUE if a transition from
+ state \eqn{i}{i} to state \eqn{j}{j} is possible, FALSE
+ otherwise. The diagonal must be set to FALSE.}
+ \item{state.names}{A vector of characters giving the states names. If
+ missing, state names are set to be 0:(number of states).}
+ \item{cens.name}{A character string specifying how censored
+ observations will be indicated in the new data set. Default is NULL,
+ i.e., no censored observation.}
+ \item{start}{A list containing two elements, \code{state} and
+ \code{time}, giving the starting states and times for all
+ individuals. Default is NULL, in which case all individuals are
+ considered to start in the initial state at time 0.}
+ \item{id}{A character string specifying in which column of \code{data}
+ the user ids are. Default is NULL, and the ids will be \code{1:n}.}
+ \item{keep}{A character vector indicating the column names of the
+ covariate one might want to keep in the new data.frame.}
+}
+\details{
+ This function only works for irreversible acyclic Markov processes.
+ Therefore, the multistate model will have initial
+ states, into which no transition are possible. For these, NAs are
+ allowed in \code{time} and \code{status}.
+}
+\value{
+ The function returns a data.frame suitable for using the \code{etm}
+ function. The data frame contains the following components:
+ \item{id}{Individual id number}
+ \item{entry}{Entry time into a state}
+ \item{exit}{Exit time from a state}
+ \item{from}{State from which a transition occurs}
+ \item{to}{State into which a transition occurs}
+ \item{\dots}{Further columns specified in \code{keep}}
+}
+\author{
+ Arthur Allignol, \email{arthur.allignol at uni-ulm.de}
+}
+\seealso{
+ \code{\link{etm}}
+}
+\examples{
+### creation of fake data in the wild format, following an illness-death model
+## transition times
+tdisease <- c(3, 4, 3, 6, 8, 9)
+tdeath <- c(6, 9, 8, 6, 8, 9)
+
+## transition status
+stat.disease <- c(1, 1, 1, 0, 0, 0)
+stat.death <- c(1, 1, 1, 1, 1, 0)
+
+## a covariate that we want to keep in the new data
+cova <- rbinom(6, 1, 0.5)
+
+dat <- data.frame(tdisease, tdeath,
+ stat.disease, stat.death,
+ cova)
+
+## Possible transitions
+tra <- matrix(FALSE, 3, 3)
+tra[1, 2:3] <- TRUE
+tra[2, 3] <- TRUE
+
+## data preparation
+newdat <- etmprep(c(NA, "tdisease", "tdeath"),
+ c(NA, "stat.disease", "stat.death"),
+ data = dat, tra = tra, cens.name = "cens")
+}
+\keyword{datagen}
+\keyword{manip}
diff --git a/man/fourD.Rd b/man/fourD.Rd
new file mode 100644
index 0000000..58060f0
--- /dev/null
+++ b/man/fourD.Rd
@@ -0,0 +1,47 @@
+\name{fourD}
+\alias{fourD}
+\docType{data}
+\title{
+ Placebo data from the 4D study
+}
+\description{
+ Data from the placebo group of the 4D study. This study aimed at
+ comparing atorvastatin to placebo for patients with type 2 diabetes
+ and receiving hemodialysis in terms of cariovascular events. The
+ primary endpoint was a composite of
+ death from cardiac causes, stroke and non-fatal myocardial infarction.
+ Competing event was death from other causes.
+}
+\usage{data(fourD)}
+\format{
+ A data frame with 636 observations on the following 7 variables.
+ \describe{
+ \item{\code{id}}{Patients' id number}
+ \item{\code{sex}}{Patients' gender}
+ \item{\code{age}}{Patients' age}
+ \item{\code{medication}}{Character vector indicating treatment
+ affiliation. Here only equal to \code{"Placebo"}}
+ \item{\code{status}}{Status at the end of the follow-up. 1 for the
+ event of interest, 2 for death from other causes and 0 for
+ censored observations}
+ \item{\code{time}}{Survival time}
+ \item{\code{treated}}{Numeric vector indicated whether patients are
+ treated or not. Here always equal to zero}
+ }
+}
+
+\source{
+ Wanner, C., Krane, V., Maerz, W., Olschewski, M., Mann, J., Ruf, G.,
+ Ritz, E (2005). Atorvastatin in patients with type 2 diabetes mellitus
+ undergoing hemodialysis. New England Journal of Medicine, 353(3),
+ 238--248.
+}
+\references{
+ Allignol, A., Schumacher, M., Wanner, C., Dreschler, C. and
+ Beyersmann, J. (2010). Understanding competing risks: a simulation
+ point of view. Research report.
+}
+\examples{
+data(fourD)
+}
+\keyword{datasets}
diff --git a/man/ggtransfo.Rd b/man/ggtransfo.Rd
new file mode 100644
index 0000000..bd503ce
--- /dev/null
+++ b/man/ggtransfo.Rd
@@ -0,0 +1,128 @@
+\name{ggtransfo.etm}
+\alias{ggtransfo.etm}
+\alias{ggtransfo}
+
+\title{
+ Prepare etm output for plotting with ggplot2
+}
+\description{
+ The \code{ggtransfo} function permits to transform the output of
+ \code{etm} such that transition probabilities along with confidence
+ intervals can be plotted more easily using the \pkg{ggplot2} package.
+}
+\usage{
+ggtransfo(x, ...)
+
+\S3method{ggtransfo}{etm}(x, tr.choice, ...)
+}
+
+\arguments{
+ \item{x}{An object of class 'etm'}
+ \item{tr.choice}{Character vector of the form 'c("from to","from
+ to")' specifying which transitions should be plotted. Default, all
+ the transition probabilities are plotted}
+ \item{\dots}{Further arguments. In particular for
+ \code{\link{summary.etm}} that is called internally}
+}
+
+\value{
+ A data frame with the same variables returned by
+ \code{\link{summary.etm}}. Addtional variables are
+ \item{trans}{transition type. In the same format as given by
+ \code{tr.choice}}
+ \item{timemax}{Lagged transition times for drawing confidence
+ intervals with \code{geom_rect}}
+
+}
+\author{
+ Arthur Allignol, \email{arthur.allignol at uni-ulm.de}
+}
+
+\seealso{
+\code{\link{etm}}, \code{\link[ggplot2]{ggplot}},
+\code{\link[ggplot2]{geom_rect}} \code{\link[ggplot2]{geom_step}}
+}
+\examples{
+data(sir.cont)
+
+# Modification for patients entering and leaving a state
+# at the same date
+# Change on ventilation status is considered
+# to happen before end of hospital stay
+sir.cont <- sir.cont[order(sir.cont$id, sir.cont$time), ]
+for (i in 2:nrow(sir.cont)) {
+ if (sir.cont$id[i]==sir.cont$id[i-1]) {
+ if (sir.cont$time[i]==sir.cont$time[i-1]) {
+ sir.cont$time[i-1] <- sir.cont$time[i-1] - 0.5
+ }
+ }
+}
+
+### Computation of the transition probabilities
+# Possible transitions.
+tra <- matrix(ncol=3,nrow=3,FALSE)
+tra[1, 2:3] <- TRUE
+tra[2, c(1, 3)] <- TRUE
+
+# etm
+tr.prob <- etm(sir.cont, c("0", "1", "2"), tra, "cens", 1)
+
+to_plot <- ggtransfo(tr.prob, tr.choice = c("0 1", "1 0"))
+
+\dontrun{
+require(ggplot2)
+print(ggplot(to_plot, aes(x = time, y = P)) +
+ facet_grid(. ~ trans) +
+ geom_step() +
+ geom_rect(aes(xmin = time, xmax = timemax, ymin = lower, ymax = upper),
+ alpha = 0.5)
+)
+}
+
+## abortion
+data(abortion)
+
+cif.ab <- etmCIF(Surv(entry, exit, cause != 0) ~ group, abortion,
+ etype = cause, failcode = 3)
+
+pcif.ab <- lapply(cif.ab[1:2], ggtransfo,
+ tr.choice = c("0 1", "0 2", "0 3"),
+ ci.fun = "cloglog")
+
+pcif.ab[[1]]$Group <- "Control"
+pcif.ab[[2]]$Group <- "Exposed"
+
+pcif.ab <- do.call(rbind, pcif.ab)
+pcif.ab$Group <- factor(pcif.ab$Group)
+pcif.ab$Group <- relevel(pcif.ab$Group, ref = "Exposed")
+pcif.ab$out <- factor(pcif.ab$trans, labels = c("Spontaneous abortion",
+ "Induced abortion",
+ "Live birth"),
+ ordered = TRUE)
+
+\dontrun{
+require(ggplot2)
+
+ggplot(pcif.ab, aes(x = time, y = P)) +
+ facet_grid(. ~ out) +
+ geom_step(aes(colour = Group), size = 1.3) +
+ geom_rect(aes(xmin = time, xmax = timemax, ymin = lower, ymax = upper, fill = Group),
+ alpha = 0.5) +
+ scale_x_continuous("Week of gestation", limits = c(0, 45)) +
+ scale_y_continuous("CIF", limits = c(0, 1), breaks = seq(0, 1, 0.1)) +
+ theme(axis.text.x = element_text(size = 18),
+ axis.title.x = element_text(size = 18),
+ axis.text.y = element_text(size = 18),
+ axis.title.y = element_text(size = 18),
+ strip.text = element_text(size = 18, face = 2),
+ legend.text = element_text(size = 18),
+ legend.title = element_blank(),
+ legend.position = "top",
+ panel.background = element_rect(fill = grey(.93))) +
+ scale_colour_brewer(type = "qual", palette = 6) +
+ scale_fill_brewer(type = "qual", palette = 6)
+}
+}
+
+\keyword{hplot}
+\keyword{dplot}
diff --git a/man/lines.etm.Rd b/man/lines.etm.Rd
new file mode 100644
index 0000000..0455e93
--- /dev/null
+++ b/man/lines.etm.Rd
@@ -0,0 +1,51 @@
+\name{lines.etm}
+\alias{lines.etm}
+
+\title{
+ Lines method for 'etm' objects
+}
+\description{
+ Lines method for \code{etm} objects
+}
+
+\usage{
+\S3method{lines}{etm}(x, tr.choice, col = 1, lty,
+ conf.int = FALSE, level = 0.95, ci.fun = "linear",
+ ci.col = col, ci.lty = 3, ...)
+}
+
+\arguments{
+ \item{x}{An object of class \code{etm}.}
+ \item{tr.choice}{character vector of the form \code{c("from to","from to")}
+ specifying which transitions should be plotted. By default, all the
+ direct transition probabilities are plotted}
+ \item{col}{Vector of colours. Default is black.}
+ \item{lty}{Vector of line type. Default is 1:number of transitions}
+ \item{conf.int}{Logical specifying whether to plot confidence
+ intervals. Default is FALSE.}
+ \item{level}{Level of the confidence interval. Default is 0.95.}
+ \item{ci.fun}{Transformation applied to the confidence intervals. It
+ could be different for all transition probabilities, though if
+ \code{length(ci.fun) != number of transitions}, only \code{ci.fun[1]}
+ will be used. Possible choices are "linear", "log", "log-log" and
+ "cloglog". Default is "linear".}
+ \item{ci.col}{Colours of the confidence intervals. Default value is
+ the same as \code{col}.}
+ \item{ci.lty}{Line types for the confidence intervals. Default is 3.}
+ \item{\dots}{Further arguments for \code{lines}.}
+}
+
+\value{
+ No value returned.
+}
+
+\author{
+ Arthur Allignol, \email{arthur.allignol at uni-ulm.de}
+}
+
+\seealso{
+ \code{\link{etm}}, \code{\link{plot.etm}}, \code{\link{xyplot.etm}}
+}
+
+\keyword{hplot}
+\keyword{survival}
diff --git a/man/los.data.Rd b/man/los.data.Rd
new file mode 100644
index 0000000..d918bf5
--- /dev/null
+++ b/man/los.data.Rd
@@ -0,0 +1,30 @@
+\name{los.data}
+\docType{data}
+\alias{los.data}
+\title{Length of hospital stay}
+
+\description{ The \code{los.data} data frame has 756 rows, one row for
+ each patient, and 7 columns.
+}
+
+\usage{data(los.data)}
+
+\format{A data frame with the following columns:
+ \describe{
+ \item{adm.id}{ admision id of the patient}
+ \item{j.01}{ observed time for jump from 0 (initial state) to 1
+ (intermediate state)}
+ \item{j.02}{ observed time for jump from 0 to 2 (discharge)}
+ \item{j.03}{ observed time for jump from 0 to 3 (death)}
+ \item{j.12}{ observed time for jump from 1 to 2}
+ \item{j.13}{ observed time for jump from 1 to 3}
+ \item{cens}{ censoring time (either in initial or intermediate state) }
+ }
+}
+
+\examples{
+data(los.data)
+my.data <- prepare.los.data(los.data)
+}
+
+\keyword{datasets}
diff --git a/man/phiPseudo.Rd b/man/phiPseudo.Rd
new file mode 100644
index 0000000..87fccae
--- /dev/null
+++ b/man/phiPseudo.Rd
@@ -0,0 +1,70 @@
+\name{phiPseudo}
+\alias{phiPseudo}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+ Pseudo Value Regression for the Expected Excess Length of Stay
+}
+\description{
+ Pseudo value regression for the expected excess length of stay for
+ each landmark time
+}
+\usage{
+phiPseudo(data, state.names, tra, cens.name, s = 0, formula, timepoints, ncores = 1)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{data}{A data.frame in a format suitable for \code{\link{etm}}.}
+ \item{state.names}{A vector of characters giving the states names.}
+ \item{tra}{A quadratic matrix of logical values describing the possible
+ transitions within the multistate model.}
+ \item{cens.name}{ A character giving the code for censored
+ observations in the column 'to' of \code{data}. If there is no
+ censored observations in your data, put \code{NULL}}
+ \item{s}{Starting time for computing the transition probabilities.}
+ \item{formula}{A formula with the covariates at the right of a
+ \code{~} operator. The left hand side can be left empty.}
+ \item{timepoints}{Landmark time points at which the pseudo values are
+ computed.}
+ \item{ncores}{Number of cores used if doing parallel computation using
+ the \pkg{parallel} package}
+}
+
+\details{
+ The function calculates the pseudo-observations for the extra
+ length-of-stay at several landmark time points for each
+ individual. These pseudo-observations can then
+ be used to fit a direct regression model using generalized estimating
+ equation (e.g., package \pkg{geepack}).
+
+ Computation of the pseudo-observations can be parallelised using the
+ \code{mclapply} function of the \pkg{parallel} package. See argument
+ \code{ncores}.
+}
+\value{
+ An object of class \code{phiPseudo} with the following components:
+ \item{pseudoData}{a data.frame containing \code{id}, computed pseudo
+ values (see details) and the covariates as specified in the formula}
+ \item{phi}{Estimates of excess LoS in the whole sample}
+ \item{ps}{}
+}
+\references{
+ Andersen, P.K, Klein, J.P, Rosthoj, S. (2003). Generalised
+ linear models for correlated pseudo-observations,
+ with applications to multi-state models. \emph{Biometrika},
+ 90(1):15--27.
+}
+
+\author{
+ Arthur Allignol \email{arthur.allignol at uni-ulm.de}
+}
+
+\seealso{
+ \code{\link[parallel]{mclapply}}, \code{\link[etm]{clos}}
+}
+
+\examples{
+## TODO
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{survival}
diff --git a/man/plot.clos.etm.Rd b/man/plot.clos.etm.Rd
new file mode 100644
index 0000000..f991143
--- /dev/null
+++ b/man/plot.clos.etm.Rd
@@ -0,0 +1,53 @@
+\name{plot.clos.etm}
+\Rdversion{1.1}
+\alias{plot.clos.etm}
+\title{
+ Plot method for 'clos.etm' objects
+}
+\description{
+ Plot method for objects of class \code{clos.etm}.
+}
+\usage{
+\S3method{plot}{clos.etm}(x, xlab = "Time", ylab.e = "Expected LOS",
+ylab.w = "Weights", xlim, ylim.e, ylim.w, col.e = c(1, 2), col.w = 1,
+lty.e = c(1, 1), lty.w = 1, legend = TRUE, legend.pos, curvlab,
+legend.bty = "n", ...)
+}
+\arguments{
+ \item{x}{An object of class \code{clos.etm}}
+ \item{xlab}{Label for the x-axis}
+ \item{ylab.e}{Label for the y-axis in the plot of the expected LOS}
+ \item{ylab.w}{Label for the y-axis in the plot of the weights}
+ \item{xlim}{Limits of x-axis for the plots}
+ \item{ylim.e}{Limits of the y-axis for the expected LOS plot}
+ \item{ylim.w}{Limits of the y-axis for the weights plot}
+ \item{col.e}{Vector of colours for the plot of expected LOS}
+ \item{col.w}{Vector of colours for the plot of the weights}
+ \item{lty.e}{Vector of line type for the plot of expected LOS}
+ \item{lty.w}{Vector of line type for the plot of the weights}
+ \item{legend}{Logical. Whether to draw a legend for the plot of
+ expected LOS}
+ \item{legend.pos}{A vector giving the legend's position. See
+ \code{\link{legend}} for details}
+ \item{curvlab}{Character or expression vector to appear in the
+ legend. Default is \code{c("Intermediate event by time t", "No
+ intermediate event by time t")}}
+ \item{legend.bty}{Box type for the legend}
+ \item{\dots}{Further arguments for plot}
+}
+\details{
+ Two graphs are drawn. The lower graph displays the expected LOS for
+ patients who have experienced the intermediate event and for those who
+ have not. The upper graph displays the weights used to compute
+ the weighted average.
+}
+\value{
+ No value returned
+}
+\author{
+ Arthur Allignol \email{arthur.allignol at uni-ulm.de}, Matthias Wangler
+}
+\seealso{
+ \code{\link{clos}}
+}
+\keyword{hplot}
\ No newline at end of file
diff --git a/man/plot.etm.Rd b/man/plot.etm.Rd
new file mode 100644
index 0000000..787e607
--- /dev/null
+++ b/man/plot.etm.Rd
@@ -0,0 +1,73 @@
+\name{plot.etm}
+\alias{plot.etm}
+
+\title{Plot method for an etm object}
+\description{
+ Plot method for an object of class 'etm'. It draws the estimated
+ transition probabilities in a basic scatterplot.
+}
+\usage{
+\S3method{plot}{etm}(x, tr.choice, xlab = "Time",
+ ylab = "Transition Probability", col = 1, lty, xlim, ylim,
+ conf.int = FALSE, level = 0.95, ci.fun = "linear",
+ ci.col = col, ci.lty = 3,
+ legend = TRUE, legend.pos, curvlab, legend.bty = "n", ...)
+}
+\arguments{
+ \item{x}{An object of class 'etm'}
+ \item{tr.choice}{ character vector of the form 'c("from to","from
+ to")' specifying which transitions should be plotted. Default, all
+ the transition probabilities are plotted}
+ \item{xlab}{x-axis label. Default is "Time"}
+ \item{ylab}{y-axis label. Default is "Transition Probability"}
+ \item{col}{Vector of colour. Default is black}
+ \item{lty}{Vector of line type. Default is 1:number of transitions}
+ \item{xlim}{Limits of x-axis for the plot}
+ \item{ylim}{Limits of y-axis for the plot}
+ \item{conf.int}{Logical. Whether to display pointwise confidence
+ intervals. Default is FALSE.}
+ \item{level}{Level of the conficence intervals. Default is 0.95.}
+ \item{ci.fun}{Transformation applied to the confidence intervals. It
+ could be different for all transition probabilities, though if
+ \code{length(ci.fun) != number of transitions}, only \code{ci.fun[1]}
+ will be used. Possible choices are "linear", "log", "log-log" and
+ "cloglog". Default is "linear".}
+ \item{ci.col}{Colour of the confidence intervals. Default is
+ \code{col}.}
+ \item{ci.lty}{Line type of the confidence intervals. Default is 3.}
+ \item{legend}{A logical specifying if a legend should be added}
+ \item{legend.pos}{A vector giving the legend's position. See
+ \code{\link{legend}} for further details}
+ \item{curvlab}{A character or expression vector to appear in the
+ legend. Default is the name of the transitions}
+ \item{legend.bty}{Box type for the legend}
+ \item{\dots}{Further arguments for plot}
+}
+\value{
+ No value returned
+}
+\author{Arthur Allignol, \email{arthur.allignol at uni-ulm.de}}
+\seealso{\code{\link{plot.default}}, \code{\link{legend}}, \code{\link{etm}} }
+\examples{
+data(sir.cont)
+
+# Modification for patients entering and leaving a state
+# at the same date
+sir.cont <- sir.cont[order(sir.cont$id, sir.cont$time), ]
+for (i in 2:nrow(sir.cont)) {
+ if (sir.cont$id[i]==sir.cont$id[i-1]) {
+ if (sir.cont$time[i]==sir.cont$time[i-1]) {
+ sir.cont$time[i-1] <- sir.cont$time[i-1] - 0.5
+ }
+ }
+}
+
+tra <- matrix(ncol=3,nrow=3,FALSE)
+tra[1, 2:3] <- TRUE
+tra[2, c(1, 3)] <- TRUE
+
+my.etm <- etm(sir.cont,c("0","1","2"),tra,"cens", s = 0)
+
+plot(my.etm, tr.choice = c("0 0"))
+}
+\keyword{hplot}
diff --git a/man/plot.etmCIF.Rd b/man/plot.etmCIF.Rd
new file mode 100644
index 0000000..1fb5cd5
--- /dev/null
+++ b/man/plot.etmCIF.Rd
@@ -0,0 +1,84 @@
+\name{plot.etmCIF}
+\alias{plot.etmCIF}
+\title{
+ Plot cumulative incidence functions
+}
+\description{
+ Plot function for \code{etmCIF} objects. The function plots cumulative
+ incidence curves, possibly with pointwise confidence intervals.
+}
+\usage{
+\S3method{plot}{etmCIF}(x, which.cif, xlim, ylim,
+ ylab = "Cumulative Incidence", xlab = "Time", col = 1, lty, lwd = 1,
+ ci.type = c("none", "bars", "pointwise"), ci.fun = "cloglog",
+ ci.col = col, ci.lty = 3, legend = TRUE, legend.pos, curvlab,
+ legend.bty = "n", pos.ci = 27, ci.lwd = 3, ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+ \item{x}{A \code{etmCIF} object}
+ \item{which.cif}{A numeric vector indicating which CIFs should be
+ plotted. When missing, only the CIF of interest is plotted
+ (determined through the \code{failcode} argument in \code{\link{etmCIF}}.)}
+ \item{xlim}{x-axis limits for the plot. By default, \code{c(0, max(time))}}
+ \item{ylim}{y-axis limits. Default is \code{c(0, 1)}}
+ \item{ylab}{Label for y-axis. Default is \code{"Cumulative Incidence"}}
+ \item{xlab}{Label for x-axis. Default is "Time"}
+ \item{col}{Vector describing colours used for the CIF curves. Default
+ is black}
+ \item{lty}{Vector of line type}
+ \item{lwd}{Thickness of the lines}
+ \item{ci.type}{One of \code{c("none", "bars",
+ "pointwise")}. \code{none} plots no confidence interval,
+ \code{bars} plots the confidence intervals in the form of a segment
+ for one time point, and \code{pointwise} draws pointwise confidence
+ intervals for the whole follow-up period.}
+ \item{ci.fun}{Transformation used for the confidence intervals. Default is
+ "clolog", and is a better choice for cumulative incidences. Other
+ choices are "log" and "log-log"}
+ \item{ci.col}{Colour for the pointwise confidence interval
+ curves. Default is same as the CIF curves}
+ \item{ci.lty}{Line type for the confidence intervals. Default is 3}
+ \item{legend}{Logical. Whether to draw a legend. Default is \code{TRUE}}
+ \item{legend.pos}{A vector giving the legend's position. See
+ \code{\link{legend}} for further details}
+ \item{curvlab}{A character or expression vector to appear in the
+ legend. Default is CIF + event label}
+ \item{legend.bty}{Box type for the legend. Default is none ("n")}
+ \item{pos.ci}{If \code{ci.type = "bars"}, vector of integers indicating at which
+ time point to put the confidence interval bars. Default is 27}
+ \item{ci.lwd}{Thickness of the confidence interval segment (for
+ \code{ci.type = "bars"})}
+ \item{\dots}{Further graphical arguments}
+}
+\details{
+ The function relies on \code{plot.etm} and \code{lines.etm} with more
+ or less the same options. Exception is the drawing of the confidence
+ intervals, for which several displays are possible.
+}
+\value{
+ No value returned
+}
+\author{
+ Arthur Allignol \email{arthur.allignol at uni-ulm.de}
+}
+\seealso{
+ \code{\link{etmCIF}}, \code{\link{plot.etm}}, \code{\link{lines.etm}}
+}
+\examples{
+data(abortion)
+
+cif.ab <- etmCIF(Surv(entry, exit, cause != 0) ~ group, abortion,
+ etype = cause, failcode = 3)
+
+cif.ab
+
+plot(cif.ab, ci.type = "bars", pos.ci = 24,
+ col = c(1, 2), lty = 1, curvlab = c("Control", "Exposed"))
+
+plot(cif.ab, which = c(1, 2))
+}
+% Add one or more standard keywords, see file 'KEYWORDS' in the
+% R documentation directory.
+\keyword{hplot}
+\keyword{survival}
diff --git a/man/prepare.los.data.Rd b/man/prepare.los.data.Rd
new file mode 100644
index 0000000..bf7598d
--- /dev/null
+++ b/man/prepare.los.data.Rd
@@ -0,0 +1,35 @@
+\name{prepare.los.data}
+\alias{prepare.los.data}
+\title{Prepare the data for clos}
+\description{Prepare data to be passed to clos() in package etm.}
+\usage{prepare.los.data(x) }
+\arguments{
+ \item{x}{data.frame of the form data.frame(id, j.01, j.02, j.03, j.12, j.13, cens):
+ \describe{
+ \item{id:}{id (patient id, admision id)}
+ \item{j.01:}{observed time for jump from 0 to 1}
+ \item{j.02:}{observed time for jump from 0 to 2}
+ \item{j.03:}{observed time for jump from 0 to 3}
+ \item{j.12:}{observed time for jump from 1 to 2}
+ \item{j.13:}{observed time for jump from 1 to 3}
+ \item{cens:}{censoring time (either in initial or intermediate state)}
+ }
+ }
+}
+\value{ a data.frame of the form data.frame(id, from, to, time, oid):
+ \item{id:}{ id (patient id, admision id)}
+ \item{from:}{ the state from where a transition occurs}
+ \item{to:}{ the state to which a transition occurs}
+ \item{time:}{ time of the transition}
+ \item{oid:}{ the observation id}
+}
+
+\author{ Matthias Wangler}
+\seealso{ \code{\link[etm]{clos}}}
+\examples{
+data(los.data)
+my.observ <- prepare.los.data(x=los.data)
+}
+
+\keyword{datasets}
+\keyword{manip}
diff --git a/man/print.clos.etm.Rd b/man/print.clos.etm.Rd
new file mode 100644
index 0000000..18d1f2d
--- /dev/null
+++ b/man/print.clos.etm.Rd
@@ -0,0 +1,25 @@
+\name{print.clos.etm}
+\alias{print.clos.etm}
+\title{
+ Print function for 'clos.etm' objects
+}
+\description{
+ Print method for object of class \code{clos.etm}
+}
+\usage{
+\S3method{print}{clos.etm}(x, ...)
+}
+\arguments{
+ \item{x}{An object of class \code{clos.etm}}
+ \item{\dots}{Further arguments}
+}
+\value{
+ No value returned
+}
+\author{
+ Arthur Allignol, \email{arthur.allignol at uni-ulm.de}
+}
+\seealso{
+ \code{\link{clos}}
+}
+\keyword{print}
\ No newline at end of file
diff --git a/man/print.etm.Rd b/man/print.etm.Rd
new file mode 100644
index 0000000..f17e7bf
--- /dev/null
+++ b/man/print.etm.Rd
@@ -0,0 +1,29 @@
+\name{print.etm}
+\alias{print.etm}
+\title{Print method for object of class 'etm'}
+\description{
+ Print method for objects of class \code{etm}.
+}
+\usage{
+\S3method{print}{etm}(x, covariance = TRUE, whole = TRUE, ...)
+}
+\arguments{
+ \item{x}{An object of class \code{etm}.}
+ \item{covariance}{Whether print the covariance matrix. Default is
+ TRUE}
+ \item{whole}{Whether to plot the entire covariance matrix. If set to
+ FALSE, rows and columns containing only 0 will be removed for
+ printing.}
+ \item{\dots}{Further arguments for print or summary.}
+}
+\details{
+ The function prints a matrix giving the possible transitions, along
+ with the estimates of \eqn{P(s, t)}{P(s, t)} and \eqn{cov(P(s,
+ t))}{cov(P(s, t))}.
+}
+\value{
+ No value returned
+}
+\author{Arthur Allignol, \email{arthur.allignol at uni-ulm.de}}
+\seealso{\code{\link{etm}}}
+\keyword{print}
diff --git a/man/print.etmCIF.Rd b/man/print.etmCIF.Rd
new file mode 100644
index 0000000..77639f6
--- /dev/null
+++ b/man/print.etmCIF.Rd
@@ -0,0 +1,26 @@
+\name{print.etmCIF}
+\alias{print.etmCIF}
+\title{
+ Print function for cifETM objects
+}
+\description{
+ Print method for \code{cifETM} objects
+}
+\usage{
+\S3method{print}{etmCIF}(x, ...)
+}
+\arguments{
+ \item{x}{An object of class \code{etmCIF}}
+ \item{\dots}{Further arguments}
+}
+\value{
+ No value returned
+}
+\author{
+ Arthur Allignol \email{arthur.allignol at uni-ulm.de}
+}
+\seealso{
+ \code{\link{etmCIF}}
+}
+\keyword{survival}
+\keyword{print}
diff --git a/man/sir.cont.Rd b/man/sir.cont.Rd
new file mode 100644
index 0000000..f5cdb8f
--- /dev/null
+++ b/man/sir.cont.Rd
@@ -0,0 +1,56 @@
+\name{sir.cont}
+\docType{data}
+\alias{sir.cont}
+\title{Ventilation status in intensive care unit patients}
+\description{
+ Time-dependent ventilation status for intensive care unit (ICU)
+ patients, a random sample from the SIR-3 study.
+}
+\usage{
+data(sir.cont)
+}
+\format{
+ A data frame with 1141 rows and 6 columns:
+ \describe{
+ \item{id:}{Randomly generated patient id}
+ \item{from:}{State from which a transition occurs}
+ \item{to:}{State to which a transition occurs}
+ \item{time:}{Time when a transition occurs}
+ \item{age:}{Age at inclusion}
+ \item{sex:}{Sex. \code{F} for female and \code{M} for male}
+ }
+
+ The possible states are:
+
+ 0: No ventilation
+
+ 1: Ventilation
+
+ 2: End of stay
+
+ And \code{cens} stands for censored observations.
+}
+
+\details{
+ This data frame consists in a random sample of the SIR-3 cohort
+ data. It focuses on the effect of ventilation on the length of stay
+ (combined endpoint discharge/death). Ventilation status is considered
+ as a transcient state in an illness-death model.
+
+ The data frame is directly formated to be used with the \code{etm}
+ function, i.e. it is transition-oriented with one row per transition.
+}
+
+\references{
+ Beyersmann, J., Gastmeier, P., Grundmann, H.,
+ Baerwolff, S., Geffers, C., Behnke, M.,
+ Rueden, H., and Schumacher, M. Use of multistate
+ models to assess prolongation of intensive care unit stay due to
+ nosocomial infection. \emph{Infection Control and Hospital
+ Epidemiology}, 27:493-499, 2006.
+}
+
+\examples{
+data(sir.cont)
+}
+\keyword{datasets}
\ No newline at end of file
diff --git a/man/summary.etm.Rd b/man/summary.etm.Rd
new file mode 100644
index 0000000..39eda2c
--- /dev/null
+++ b/man/summary.etm.Rd
@@ -0,0 +1,48 @@
+\name{summary.etm}
+\alias{summary.etm}
+\alias{print.summary.etm}
+\title{Summary methods for an 'etm' object}
+\description{
+ Summary method for objects of class \code{etm}
+}
+\usage{
+\S3method{summary}{etm}(object, all = FALSE,
+ ci.fun = "linear", level = 0.95, ...)
+\S3method{print}{summary.etm}(x, ...)
+}
+\arguments{
+ \item{object}{An object of class \code{etm}.}
+ \item{all}{If set to TRUE, a data.frame will be computed for all
+ transitions that are not 0 in the empirical transition matrix.}
+ \item{ci.fun}{A character vector specifying the transformation to be
+ applied to the pointwise confidence intervals. It could be different
+ for each transition probability, though if \code{length(ci.fun) !=
+ number of transitions}, only \code{ci.fun[1]} will be used. The
+ function displays the transition probabilities in the following
+ order: first the direct transitions in alphabetical order, e.g., 0 to
+ 1, 0 to 2, 1 to 2, ..., then the state occupation probabilities in
+ alphabetical order, e.g., 0 to 0, 1 to 1, ... The
+ possible transformations are "linear", "log", "log-log" and
+ "cloglog". Default is "linear".}
+ \item{level}{Level of the two-sided confidence intervals. Default is
+ 0.95.}
+ \item{x}{A \code{summary.cpf} object}
+ \item{\dots}{Further arguments}
+}
+\value{
+ A list of data.frames giving the transition probability and stage
+ occupation probability estimates. List items are named after the
+ possible transition.
+ \item{P}{Transition probability estimates}
+ \item{var}{Variance estimates}
+ \item{lower}{Lower confidence limit}
+ \item{upper}{Upper confidence limit}
+ \item{time}{Transition times}
+ \item{n.risk}{Number of individuals at risk of experiencing a transition
+ just before time \eqn{t}{t}}
+ \item{n.event}{Number of events at time \eqn{t}{t}}
+}
+\author{Arthur Allignol \email{arthur.allignol at uni-ulm.de}}
+\seealso{\code{\link{etm}}}
+\keyword{methods}
+\keyword{print}
diff --git a/man/summary.etmCIF.Rd b/man/summary.etmCIF.Rd
new file mode 100644
index 0000000..5148ee5
--- /dev/null
+++ b/man/summary.etmCIF.Rd
@@ -0,0 +1,43 @@
+\name{summary.etmCIF}
+\alias{summary.etmCIF}
+\alias{print.summary.etmCIF}
+\title{
+ Summary function for cifETM
+}
+\description{
+ Summary function for objects of class \code{cifETM}
+}
+\usage{
+\S3method{summary}{etmCIF}(object, ci.fun = "cloglog",
+ level = 0.95, ...)
+\S3method{print}{summary.etmCIF}(x, ...)
+}
+\arguments{
+ \item{object}{An object of class \code{etmCIF}}
+ \item{ci.fun}{Transformation applied to the pointwise confidence
+ intervals. On of \code{"linear", "log", "log-log",
+ "cloglog"}. Default is \code{"cloglog"}.}
+ \item{level}{Level of the confidence intervals. Default is 0.95.}
+ \item{x}{An object of class \code{cifETM}.}
+ \item{\dots}{Further arguments}
+}
+\value{
+ A data.frame per covariate level and competing event
+ \item{P}{Transition probability estimates}
+ \item{var}{Variance estimates}
+ \item{lower}{Lower confidence limit}
+ \item{upper}{Upper confidence limit}
+ \item{time}{Transition times}
+ \item{n.risk}{Number of individuals at risk of experiencing a transition
+ just before time \eqn{t}{t}}
+ \item{n.event}{Number of events at time \eqn{t}{t}}
+}
+\author{
+ Arthur Allignol \email{arthur.allignol at uni-ulm.de}
+}
+\seealso{
+ \code{\link{etmCIF}}
+}
+\keyword{method}
+\keyword{print}
+\keyword{survival}
diff --git a/man/tra.Rd b/man/tra.Rd
new file mode 100644
index 0000000..580b567
--- /dev/null
+++ b/man/tra.Rd
@@ -0,0 +1,58 @@
+\name{tra}
+\alias{tra}
+\alias{tra_ill}
+\alias{tra_ill_comp}
+\alias{tra_comp}
+\alias{tra_surv}
+
+\title{
+ Matrix of possible transitions
+}
+\description{
+ Miscellaneous functions that compute the matrix of possible
+ transitions used as argument in the \code{etm} function.
+}
+\usage{
+tra_ill(state.names = c("0", "1", "2"))
+tra_ill_comp(nComp = 2,
+ state.names = as.character(seq(0, nComp + 1, 1)))
+tra_comp(nComp = 2,
+ state.names = as.character(seq(0, nComp)))
+tra_surv(state.names = c("0", "1"))
+}
+
+\arguments{
+ \item{state.names}{A vector of characters giving the states names}
+ \item{nComp}{For the competing risks models, the number of competing
+ events}
+}
+\details{
+ These functions compute the matrix of possible transitions that is
+ used as argument in, e.g., the \code{etm} function. \code{tra_surv} is
+ for the usual survival model, \code{tra_comp} for the competing risks
+ model, \code{tra_ill} for the illness-death model and
+ \code{tra_ill_comp} for the illness-death model with competing
+ terminal events. By default, state names are from 0 to \dots
+}
+\value{
+ A quadratic matrix with \code{TRUE} if a transition is possible,
+ \code{FALSE} otherwise.
+}
+
+\author{
+ Arthur Allignol \email{arthur.allignol at uni-ulm.de}
+}
+
+\seealso{
+ \code{\link{etm}}
+}
+\examples{
+tra_ill()
+
+## competing risks model with 4 competing events non-default state names
+tra_comp(4, state.names = c("healthy", "Cardiac problems", "Cancer",
+ "Rhenal failure", "Other"))
+}
+
+\keyword{survival}
+\keyword{miscellaneous}
diff --git a/man/trprob_trcov.Rd b/man/trprob_trcov.Rd
new file mode 100644
index 0000000..42d7d81
--- /dev/null
+++ b/man/trprob_trcov.Rd
@@ -0,0 +1,74 @@
+\name{trprob.etm}
+\Rdversion{1.1}
+\alias{trprob.etm}
+\alias{trprob}
+\alias{trcov}
+\alias{trcov.etm}
+\title{
+ Function to extract transition probabilities and (co)variance
+}
+\description{
+ The \code{trprob} method is used to extract transition probabilities,
+ while \code{trcov} is used to obtain the (co)variance.
+}
+\usage{
+\S3method{trprob}{etm}(x, tr.choice, timepoints, ...)
+\S3method{trcov}{etm}(x, tr.choice, timepoints, ...)
+}
+\arguments{
+ \item{x}{An object of class \code{etm}.}
+ \item{tr.choice}{A character vector of the form "from to" describing
+ for which transition one wishes to obtain the transition probabilities
+ or covariance estimates. For \code{trprob}, \code{tr.choice} must be
+ of length 1, while it can be of length 2 for \code{trcov}.}
+ \item{timepoints}{Time points at which one want the estimates. When
+ missing, estimates are obtained for all event times.}
+ \item{\dots}{Further arguments.}
+}
+\value{
+ A vector containing the transition probabilities or covariance
+ estimates either at the time specified in \code{timepoints} or at all
+ transition times.
+}
+\author{
+ Arthur Allignol, \email{arthur.allignol at uni-ulm.de}
+}
+\seealso{
+ \code{\link{etm}}
+}
+\examples{
+data(sir.cont)
+
+# Modification for patients entering and leaving a state
+# at the same date
+# Change on ventilation status is considered
+# to happen before end of hospital stay
+sir.cont <- sir.cont[order(sir.cont$id, sir.cont$time), ]
+for (i in 2:nrow(sir.cont)) {
+ if (sir.cont$id[i]==sir.cont$id[i-1]) {
+ if (sir.cont$time[i]==sir.cont$time[i-1]) {
+ sir.cont$time[i-1] <- sir.cont$time[i-1] - 0.5
+ }
+ }
+}
+
+### Computation of the transition probabilities
+# Possible transitions.
+tra <- matrix(ncol=3,nrow=3,FALSE)
+tra[1, 2:3] <- TRUE
+tra[2, c(1, 3)] <- TRUE
+
+# etm
+fit.etm <- etm(sir.cont, c("0", "1", "2"), tra, "cens", 0)
+
+## extract P_01(0, t) and variance
+p01 <- trprob(fit.etm, "0 1")
+var.p01 <- trcov(fit.etm, "0 1")
+
+## covariance between P_00 and P_01
+cov.00.01 <- trcov(fit.etm, c("0 0", "0 1"))
+
+## P_01 at some time points
+trprob(fit.etm, "0 1", c(0, 15, 50, 100))
+}
+\keyword{methods}
\ No newline at end of file
diff --git a/man/xyplot.etm.Rd b/man/xyplot.etm.Rd
new file mode 100644
index 0000000..4544908
--- /dev/null
+++ b/man/xyplot.etm.Rd
@@ -0,0 +1,43 @@
+\name{xyplot.etm}
+\alias{xyplot.etm}
+\title{xyplot method for object of class 'etm'}
+\description{
+ xyplot function for objects of class \code{etm}. Estimates of the
+ transition probabilities are plotted as a function of time for all the
+ transitions specified by the user.
+}
+\usage{
+\S3method{xyplot}{etm}(x, data = NULL, tr.choice, col = c(1, 1, 1),
+ lty = c(1, 3, 3), xlab = "Time",
+ ylab = "Transition probability",
+ conf.int = TRUE, ci.fun = "linear", level = 0.95, ...)
+}
+\arguments{
+ \item{x}{An object of class \code{etm}.}
+ \item{data}{\emph{Useless}.}
+ \item{tr.choice}{A character vector of the form c("from to", "from
+ to", ...) specifying the transition probabilities to be plotted. By
+ default, all the direct transition probabilities are displayed.}
+ \item{col}{Vector of colours for the curves.}
+ \item{lty}{Vector of line types.}
+ \item{xlab}{x-axis label. Default is "Time".}
+ \item{ylab}{y-axis label. Default is "Estimated transition
+ probability".}
+ \item{conf.int}{Logical. Whether to draw pointwise confidence
+ intervals. Default is TRUE.}
+ \item{ci.fun}{A character vector specifying the transformation to be
+ applied to the pointwise confidence intervals. It could be different
+ for each transition probability, though if \code{length(ci.fun) !=
+ length(tr.choice)}, only \code{ci.fun[1]} will be used. The
+ possible transformations are "linear", "log", "log-log" and
+ "cloglog". Default is "linear".}
+ \item{level}{Level of the two-sided confidence intervals. Default is
+ 0.95.}
+ \item{\dots}{Further arguments for \code{xyplot}.}
+}
+\value{
+ An object of class \code{trellis}.
+}
+\author{Arthur Allignol, \email{arthur.allignol at uni-ulm.de}}
+\seealso{\code{\link{etm}}, \code{\link[lattice]{xyplot}}}
+\keyword{hplot}
diff --git a/src/cov_dna.c b/src/cov_dna.c
new file mode 100644
index 0000000..669d41f
--- /dev/null
+++ b/src/cov_dna.c
@@ -0,0 +1,96 @@
+#include <R.h>
+#include <stdio.h>
+#include <math.h>
+
+void cov_dna(double *nrisk, double *nev, int *dd, double *cov) {
+
+ const int d = *dd;
+ const int D = pow(d, 2);
+ double temp_cov[D][D];
+ double t_cov[D*D];
+ double sum_nev[d];
+ int a, b, i, j, k, l, e, f;
+ double nr = 0;
+ double temp[d][d];
+
+
+ /* Initialisation */
+ for (a = 0; a < d; ++a) {
+ sum_nev[a] = 0;
+ for (b = 0; b < d; ++b) {
+ temp[a][b] = 0.0;
+ }
+ }
+ for (a = 0; a < D; ++a) {
+ for (b = 0; b < D; ++b) {
+ temp_cov[a][b] = 0.0;
+ t_cov[a + D*b] = 0.0;
+ }
+ }
+
+
+ for (a = 0; a < d; ++a) {
+ for (b = 0; b < d; ++b) {
+ sum_nev[a] += nev[a + d * b];
+ }
+ }
+ /******************/
+
+ /* loops on the blocks */
+ for (i = 0; i < d; ++i) {
+ for (j = 0; j < d; ++j) {
+
+ /* loops in the blocks */
+ for (k = 0; k < d; ++k) {
+ for (l = 0; l < d; ++l) {
+ if (nrisk[k] != 0) {
+ nr = pow(nrisk[k], 3);
+ if (k == l) {
+ if (k == i) {
+ if (l == j) {
+ temp[k][l] = ((nrisk[k] - sum_nev[k]) * sum_nev[k]) / nr;
+ }
+ else {
+ temp[k][l] = -(((nrisk[k] - sum_nev[k]) * nev[k + j * d]) / nr);
+ }
+ }
+ else {
+ if (i != k && j != k) {
+ if (i == j) {
+ temp[k][l] = ((nrisk[k] - nev[k + i*d]) * nev[k + i*d])/ nr;
+ }
+ else {
+ temp[k][l] = (-nev[k + i*d] * nev[k + j*d]) / nr;
+ }
+ }
+ }
+ }
+ }
+
+ temp_cov[i * d + k][j * d + l] = temp[k][l];
+ for (e = 0; e < d; ++e) {
+ for (f = 0; f < d; ++f) {
+ temp[e][f] = 0.0;
+ }
+ }
+ }
+ }
+ }
+ }
+
+ for (i = 0; i < D; ++i) {
+ for (j = 0; j < D; ++j) {
+ t_cov[i + j*D] = temp_cov[i][j];
+ }
+ }
+
+ for (i = 0; i < D; ++i) {
+ for (j = 0; j < D; ++j) {
+ if (t_cov[j * D + i] != 0.0) {
+ cov[j * D + i] = t_cov[j * D + i];
+ cov[i * D + j] = t_cov[j * D + i];
+ t_cov[j * D + i] = cov[j * D + i];
+ }
+ }
+ }
+}
diff --git a/src/los_etm.cc b/src/los_etm.cc
new file mode 100644
index 0000000..33cde9f
--- /dev/null
+++ b/src/los_etm.cc
@@ -0,0 +1,195 @@
+#include "matrix.h"
+
+
+extern "C" {
+
+ void los_cp (double* times, // transition times
+ double* ma, // transition matrices
+ int* len, // number of transitions
+ int* rows, // row number of transition matrice
+ int* cols, // colum nnumber of transition matrice
+ double* los1, // LOS given state 1
+ double* los0, // LOS given state 0
+ double* phi2case,
+ double* phi2control,
+ double* phi3case,
+ double* phi3control,
+ double* tau
+ ) {
+
+ Vector Times(times,*len);
+
+ Array Ma(ma,*rows,*cols,*len );
+
+ Vector Los1(los1, *len);
+ Los1[*len] = *tau;
+
+ Vector Los0(los0,*len);
+ Los0[*len] = *tau;
+
+ Vector Phi2case(phi2case,*len);
+
+ Vector Phi2control(phi2control,*len);
+
+ Vector Phi3case(phi3case,*len);
+
+ Vector Phi3control(phi3control,*len);
+
+
+ Matrix Diag(*rows, *cols);
+ Diag.identity();
+
+ Array A;
+ A.push_back(Diag);
+
+ Array A2;
+ A2.push_back(Diag);
+
+ Vector T;
+ T.push_back(*tau);
+
+ Vector T2;
+
+ for(int i = (Times.size() - 2); i >= 0; --i) {
+ itVector vpos = T.begin();
+ T.insert(vpos, Times[i+1]);
+
+ itVector vpos2 = T2.begin();
+ T2.insert(vpos2, Times[i+1]);
+
+ Vector Diff = T.diff();
+
+ A = Ma[i+1]*A;
+
+ Vector a11;
+ Vector a00;
+ Vector a01;
+
+ for(int j = 0; j < A.size(); ++j) {
+ a11.push_back( A[j][1][1] );
+ a00.push_back( A[j][0][0] );
+ a01.push_back( A[j][0][1] );
+ }
+
+ Los1[i] = Times[i+1] + scalar(Diff, a11);
+
+ Los0[i] = Times[i+1] + scalar(Diff, (a00 + a01));
+
+ if( i == (Times.size() - 2)) {
+ Phi2case[i] = Times[(Times.size()-1)] * A[(A.size()-1)][1][2];
+
+ Phi3case[i] = Times[(Times.size()-1)] * A[(A.size()-1)][1][3];
+ }
+ else {
+ Vector Diff2 = T2.diff();
+
+ //cout << Diff2 << endl;
+
+ A2 = Ma[i+1]*A2;
+
+ Vector a12;
+ Vector a13;
+
+ for(int l = 0; l < A2.size(); ++l) {
+ a12.push_back( A2[l][1][2] );
+ a13.push_back( A2[l][1][3] );
+ }
+
+ Phi2case[i] = (Times[(Times.size()-1)] * A[(A.size()-1)][1][2]) - scalar(Diff2, a12);
+
+ Phi3case[i] = (Times[(Times.size()-1)] * A[(A.size()-1)][1][3]) - scalar(Diff2, a13);
+
+
+ // stack identity matrix on top for the next loop
+ itArray apos2 = A2.begin();
+ A2.insert(apos2, Diag);
+ }
+
+ Phi2control[i] = A[(A.size()-1)][1][2] * Los0[i];
+
+ Phi3control[i] = A[(A.size()-1)][1][3] * Los0[i];
+
+ // stack identity matrix on top for the next loop
+ itArray apos = A.begin();
+ A.insert(apos, Diag);
+ }
+
+ Los1.as_double(los1);
+
+ Los0.as_double(los0);
+
+ Phi2case.as_double(phi2case);
+
+ Phi2control.as_double(phi2control);
+
+ Phi3case.as_double(phi3case);
+
+ Phi3control.as_double(phi3control);
+ }
+}
+
+
+/* To be called when there's no competing risks */
+extern "C" {
+
+ void los_nocp(double *times,
+ double *ma,
+ int *len,
+ int *rows,
+ int *cols,
+ double *los1,
+ double *los0,
+ double *tau) {
+
+
+ Vector Times(times,*len);
+
+ Array Ma(ma,*rows,*cols,*len );
+
+ Vector Los1(los1, *len);
+ Los1[*len] = *tau;
+
+ Vector Los0(los0,*len);
+ Los0[*len] = *tau;
+
+ Matrix Diag(*rows, *cols);
+ Diag.identity();
+
+ Array A;
+ A.push_back(Diag);
+
+ Vector T;
+ T.push_back(*tau);
+
+ for(int i = (Times.size() - 2); i >= 0; --i) {
+ itVector vpos = T.begin();
+ T.insert(vpos, Times[i+1]);
+
+ Vector Diff = T.diff();
+
+ A = Ma[i+1]*A;
+
+ Vector a11;
+ Vector a00;
+ Vector a01;
+
+ for(int j = 0; j < A.size(); ++j) {
+ a11.push_back( A[j][1][1] );
+ a00.push_back( A[j][0][0] );
+ a01.push_back( A[j][0][1] );
+ }
+
+ Los1[i] = Times[i+1] + scalar(Diff, a11);
+
+ Los0[i] = Times[i+1] + scalar(Diff, (a00 + a01));
+
+ // stack identity matrix on top for the next loop
+ itArray apos = A.begin();
+ A.insert(apos, Diag);
+ }
+
+ Los1.as_double(los1);
+
+ Los0.as_double(los0);
+ }
+}
diff --git a/src/matrix.cc b/src/matrix.cc
new file mode 100644
index 0000000..aba39d0
--- /dev/null
+++ b/src/matrix.cc
@@ -0,0 +1,490 @@
+#include "matrix.h"
+
+
+/*
+ Vector class definitions
+*/
+Vector::Vector():dVector(){
+}
+
+Vector::Vector(const int n):dVector(n){
+}
+
+Vector::Vector(double* v, const int n):dVector(){
+ for(int i=0;i<n;i++){
+ push_back(v[i]);
+ }
+}
+
+// ostream& operator<<(ostream& s, const Vector& v) {
+// if( v.size() > 0 ) s << "(";
+
+// for(int i=0;i<v.size();i++){
+
+// s << v[i] ;
+
+// if( i < (v.size()-1) ) {
+// s << ", ";
+// }
+// else {
+// s << ")"<<endl;
+// }
+// }
+
+// return s;
+// }
+
+Vector operator*(double x, const Vector& v) {
+ int i;
+ Vector ans(v.size());
+ for(i=0;i<v.size();i++) ans[i]= x*v[i];
+ return ans;
+}
+
+Vector operator*(const Vector& v, double x) {
+ int i;
+ Vector ans(v.size());
+ for(i=0;i<v.size();i++) ans[i]= x*v[i];
+ return ans;
+}
+
+Vector Vector::operator +(const Vector& v) {
+ int i;
+
+ if( this->size() != v.size()) {
+ // cout << "VECTOR Error: You're trying to add vectors of different sizes\n";
+ // cout << v << endl;;
+ // cout << *this << endl;
+
+ return Vector();
+ }
+
+ Vector sum(this->size());
+ for(i=0;i<this->size();i++) sum[i] = this->at(i)+v[i];
+ return sum;
+}
+
+Vector Vector::operator -(const Vector& v) {
+ int i;
+
+ if( this->size() != v.size()) {
+ // cout << "VECTOR Error: You're trying to subtract vectors of different sizes\n";
+ // cout << v << endl;;
+ // cout << *this << endl;
+
+ return Vector();
+ }
+
+ Vector sum(this->size());
+ for(i=0;i<this->size();i++) sum[i] = this->at(i)-v[i];
+ return sum;
+
+}
+
+Vector Vector::operator*(const Vector& v) {
+ int i;
+
+ if( this->size() != v.size()) {
+ // cout << "VECTOR Error: You're trying to multiply vectors of different sizes\n";
+ // cout << v << endl;;
+ // cout << *this << endl;
+
+ return Vector();
+ }
+
+ Vector p(this->size());
+ for(i=0;i<this->size();i++) p[i] = this->at(i)*v[i];
+ return p;
+}
+
+double scalar(const Vector& v1, const Vector& v2) {
+ int i;
+
+ double p = 0.0;
+
+ if( v1.size() != v2.size()) {
+ // cout << "VECTOR Error: You're trying to multiply vectors of different sizes\n";
+ // cout << v1 << endl;;
+ // cout << v2 << endl;
+
+ return p;
+ }
+
+ for(i=0;i<v1.size();i++) p += v1[i]*v2[i];
+ return p;
+}
+
+double Vector::max(void)const {
+ double max=this->at(0);
+ for(int i=1;i<this->size();i++) if(this->at(i) > max) max=this->at(i);
+ return max;
+}
+
+double Vector::min(void)const {
+ double min=this->at(0);
+ for(int i=1;i<this->size();i++) if(this->at(i) < min) min=this->at(i);
+ return min;
+}
+
+double Vector::mean()const {
+ double sum=0;
+ for(int i=0;i<this->size();i++) sum += this->at(i);
+ return sum/(this->size());
+}
+
+void Vector::zero(void) {
+ for(int i=0;i<this->size();i++) this->at(i)=0.0;
+
+ return;
+}
+
+double Vector::norm(void) const
+{
+ double s=0.0;
+ for(int i=0;i<this->size();i++) s+= this->at(i)*this->at(i);
+ return sqrt(s);
+}
+
+Vector Vector::diff() const
+{
+ int len = this->size();
+
+ if( len > 1 ) {
+ Vector v(len-1);
+
+ for(int i=0; i < (len - 1); i++){
+ v[i] = this->at(i+1) - this->at(i);
+ }
+
+ return v;
+ }
+
+ return Vector();
+}
+
+void Vector::as_double(double* a)
+{
+ for( int i=0; i<this->size(); i++ ) {
+ a[i] = this->at(i);
+ }
+}
+
+/*
+ Matrix class definitions
+*/
+Matrix::Matrix():dMatrix(){
+}
+
+Matrix::Matrix(const int n):dMatrix(n){
+}
+
+Matrix::Matrix(const int r,const int c)
+{
+ Vector v(c);
+
+ for(int i=0;i<r;i++) {
+ push_back(v);
+ }
+}
+
+Matrix::Matrix(double* m, const int r, const int c)
+{
+ for(int i=0;i<r;i++){
+ Vector v(c);
+
+ for(int j=0;j<c;j++) {
+ v[j]=m[i+(j*r)];
+ }
+
+ push_back(v);
+ }
+}
+
+// ostream& operator<<(ostream& s,const Matrix& m)
+// {
+// for(int i=0; i<m.size();i++) s << m[i];
+// return s;
+// }
+
+
+Matrix Matrix::operator*(const Matrix& m)
+{
+ if(this->size() == 0 || m.size() == 0 ) return Matrix();
+ int rows = this->size();
+ int cols = (this->at(0)).size();
+ int m_rows = m.size();
+ int m_cols = (m.at(0)).size();
+
+ if(cols != m_rows) {
+ // cout << "MATRIX Error: Matrix Matrix::operator*(const Matrix& m):" << endl;
+ // cout << "matrices are the wrong size: " << cols << ", " << m_rows << endl;
+
+ return Matrix();
+ }
+
+ Matrix ans(rows,m_cols);
+
+ for(int i=0;i<rows;i++) {
+ for(int j=0;j<m_cols;j++) {
+ ans[i][j]=0.0;
+ for(int k=0;k<cols;k++){
+ ans[i][j] += (this->at(i)).at(k)*m[k][j];
+ }
+ }
+ }
+
+ return ans;
+}
+
+Vector Matrix::operator*(const Vector& v)
+{
+ if(this->size() == 0 || v.size() == 0 ) return Vector();
+ int rows = this->size();
+ int cols = (this->at(0)).size();
+
+
+ if(cols != v.size()) {
+ // cout << "MATRIX Error: multiplying matrix times Vector with wrong sizes\n";
+ return Vector();
+ }
+
+ Vector ans(rows);
+
+ for(int i=0;i<rows;i++){
+ ans[i]=0.0;
+ for(int j=0;j<cols;j++) ans[i] += (this->at(i)).at(j)*v[j];
+ }
+
+ return ans;
+}
+
+Matrix operator*(const double x, const Matrix& m)
+{
+ if( m.size() == 0 ) return Matrix();
+
+ int m_rows = m.size();
+ int m_cols = (m.at(0)).size();
+
+
+ Matrix a(m_rows,m_cols);
+
+ for(int i=0; i<a.size();i++){
+ a[i]= x*m[i];
+ }
+
+ return a;
+}
+
+Matrix operator*(const Matrix& m, const double x)
+{
+ if( m.size() == 0 ) return Matrix();
+
+ int m_rows = m.size();
+ int m_cols = (m.at(0)).size();
+
+
+ Matrix a(m_rows,m_cols);
+
+ for(int i=0; i<a.size();i++){
+ a[i]= x*m[i];
+ }
+
+ return a;
+}
+
+
+Matrix Matrix::operator+(const Matrix& m)
+{
+ if(this->size() == 0 || m.size() == 0 ) return Matrix();
+ int rows = this->size();
+ int cols = (this->at(0)).size();
+ int m_rows = m.size();
+ int m_cols = (m.at(0)).size();
+
+
+ if(rows!= m_rows || cols != m_cols) {
+ // cout << "MATRIX Error: you're trying to add matrices of different sizes\n";
+ return Matrix();
+ }
+
+ Matrix ans(m_rows, m_cols);
+
+ for(int i=0;i<m_rows;i++){
+ for(int j=0;j<m_cols;j++){
+ ans[i][j] = (this->at(i)).at(j) + m[i][j];
+ }
+ }
+
+ return ans;
+}
+
+Matrix Matrix::operator-(const Matrix& m)
+{
+ if(this->size() == 0 || m.size() == 0 ) return Matrix();
+ int rows = this->size();
+ int cols = (this->at(0)).size();
+ int m_rows = m.size();
+ int m_cols = (m.at(0)).size();
+
+
+ if(rows!= m_rows || cols != m_cols) {
+ // cout << "MATRIX Error: you're trying to add matrices of different sizes\n";
+ return Matrix();
+ }
+
+ Matrix ans(m_rows, m_cols);
+
+ for(int i=0;i<m_rows;i++){
+ for(int j=0;j<m_cols;j++){
+ ans[i][j] = (this->at(i)).at(j) - m[i][j];
+ }
+ }
+
+ return ans;
+}
+
+void Matrix::zero(void)
+{
+ if(this->size() == 0 ) return;
+
+ int rows = this->size();
+ int cols = (this->at(0)).size();
+
+ for(int i=0;i<rows;i++) {
+
+ for(int j=0;j<cols;j++) {
+ (this->at(i)).at(j)=0.0;
+ }
+
+ }
+
+ return;
+
+}
+
+void Matrix::identity(void)
+{
+ if(this->size() == 0 ) return;
+
+ int rows = this->size();
+ int cols = (this->at(0)).size();
+
+
+ if(rows!=cols) {
+ // cout << "MATRIX Error: Matrix::identity(): Matrix not square\n";
+ }
+
+
+ zero();
+
+ for(int i=0;i<rows;i++) (this->at(i)).at(i)=1.0;
+
+ return;
+}
+
+void Matrix::as_double(double* a)
+{
+ int rows = this->size();
+
+ for( int i=0; i<rows; i++ ) {
+
+ int cols = (this->at(i)).size();
+
+ for( int j=0; j<cols; j++ ) {
+
+ a[i+(j*rows)] = (this->at(i)).at(j);
+
+ }
+ }
+}
+
+
+
+/*
+ Array class definitions
+*/
+Array::Array():dArray(){
+}
+
+Array::Array(const int len):dArray(len){
+}
+
+Array::Array(const int rows, const int cols, const int len)
+{
+ Matrix m(rows, cols);
+
+ for(int i=0;i<len;i++) {
+ push_back(m);
+ }
+}
+
+Array::Array(double*a, const int rows, const int cols, const int len)
+{
+
+ for( int k=0; k<len; k++ ) {
+
+ Matrix m( rows, cols );
+
+ for( int i=0; i<rows; i++ ) {
+ for( int j=0; j<cols; j++ ) {
+ m[i][j] = a[(i+(j*rows)) + k*(rows*cols)] ;
+ }
+ }
+
+ push_back(m);
+ }
+}
+
+// ostream& operator<<(ostream& s, Array a)
+// {
+// for(int i=0; i<a.size();i++) {
+// s << a[i] << endl;
+// }
+
+// return s;
+// }
+
+void Array::as_double(double* a)
+{
+ int len = this->size();
+
+ for( int k=0; k<len; k++ ) {
+
+ int rows = (this->at(k)).size();
+
+ for( int i=0; i<rows; i++ ) {
+
+ int cols = ((this->at(k)).at(i)).size();
+
+ for( int j=0; j<cols; j++ ) {
+ a[(i+(j*rows)) + k*(rows*cols)] = ((this->at(k)).at(i)).at(j);
+ }
+ }
+ }
+}
+
+Array operator*(const Matrix& m, const Array& a)
+{
+ int len = a.size();
+
+ Array aj;
+
+ for( int k=0; k<len; k++ ) {
+ aj.push_back((Matrix)m * (Matrix)a[k]);
+ }
+
+ return aj;
+}
+
+Array operator*(const Array& a, const Matrix& m)
+{
+ int len = a.size();
+
+ Array aj;
+
+ for( int k=0; k<len; k++ ) {
+ aj.push_back((Matrix)a[k] * (Matrix)m);
+ }
+
+ return aj;
+}
diff --git a/src/matrix.h b/src/matrix.h
new file mode 100644
index 0000000..3ec867e
--- /dev/null
+++ b/src/matrix.h
@@ -0,0 +1,124 @@
+#ifndef MATRIX
+#define MATRIX
+
+/* #include <iostream> */
+#include <vector>
+
+#include <math.h>
+
+
+using namespace std;
+
+
+class Vector;
+class Matrix;
+
+
+typedef vector< double, allocator<double> > dVector; // vector of doubles (double vectorx)
+typedef dVector::iterator itVector;
+
+typedef vector<Vector> dMatrix; // vector of double vectors (double Matrix)
+typedef dMatrix::iterator itMatrix;
+
+typedef vector<Matrix> dArray; // vector of double matrices (Array of double matrices)
+typedef dArray::iterator itArray;
+
+class Vector : public dVector
+{
+public:
+ Vector();
+
+ Vector(const int n);
+
+ Vector(double* v, const int n);
+
+// friend ostream& operator <<(ostream& s, const Vector& v);
+
+ Vector operator +(const Vector& v);
+
+ Vector operator -(const Vector& v);
+
+ friend Vector operator*(double x, const Vector& v);
+
+ friend Vector operator*(const Vector& v, double x);
+
+ Vector operator*(const Vector& v);
+
+ friend double scalar(const Vector& v1, const Vector& v2);
+
+ double max()const;
+
+ double min()const;
+
+ double mean()const;
+
+ void zero(void);
+
+ double norm(void)const;
+
+ Vector diff() const;
+
+ void as_double(double* a);
+
+};
+
+class Matrix: public dMatrix
+{
+
+public:
+
+ //constructor
+ Matrix();
+
+ Matrix(const int n);
+
+ Matrix(const int r,const int c);
+
+ Matrix(double* m, const int r,const int c);
+
+/* friend ostream& operator<<(ostream& s, const Matrix& m); */
+
+ Matrix operator*(const Matrix& m);
+
+ Vector operator*(const Vector& v);
+
+ friend Matrix operator*(const double, const Matrix& m);
+
+ friend Matrix operator*(const Matrix& m, const double);
+
+ Matrix operator+(const Matrix& m);
+
+ Matrix operator-(const Matrix& m);
+
+ void zero(void);
+
+ void identity(void);
+
+ void as_double(double* a);
+
+};
+
+
+class Array : public dArray
+{
+
+ public:
+ Array();
+
+ Array(const int l);
+
+ Array(const int r,const int c, const int l);
+
+ Array(double*a, const int r, const int c, const int l);
+
+ friend Array operator*(const Matrix& m, const Array& a);
+
+ friend Array operator*(const Array& a, const Matrix& m);
+
+ /* friend ostream& operator<<(ostream& s,Array a); */
+
+ void as_double(double* a);
+
+};
+
+#endif
diff --git a/src/risk_set_etm.c b/src/risk_set_etm.c
new file mode 100644
index 0000000..99c96b5
--- /dev/null
+++ b/src/risk_set_etm.c
@@ -0,0 +1,42 @@
+#include <R.h>
+
+void risk_set_etm(int *n, int *lt, int *dim_nev, double *times,
+ int *from, int *to, double *entry, double *exit,
+ int *nrisk, int *ncens, int *nev, double *dna) {
+
+ const int ltimes = *lt;
+ const int dim_trans = dim_nev[1];
+ const int nb = *n;
+ int i, j, t;
+
+ /* Computation of the risk set and transition matrix */
+
+ for (j=0; j < nb; ++j) {
+ for (i=0; i < ltimes; ++i) {
+ if (entry[j] < times[i] && exit[j] >= times[i]) {
+ nrisk[i + *lt * (from[j] - 1)] += 1;
+ }
+ if (exit[j] == times[i] && to[j] != 0) {
+ nev[dim_nev[1] * dim_nev[1]*i + from[j] - 1 + dim_nev[1] * (to[j] - 1)] += 1;
+ break;
+ }
+ }
+ }
+
+ for (i = 0; i < dim_trans; ++i) {
+ nrisk[i * (*lt)] = nrisk[i * (*lt) + 1];
+ }
+
+ /* Nelson-Aalen increments */
+ for (t = 0; t < ltimes; ++t) {
+ for (j = 0; j < dim_trans; ++j) {
+ for (i = 0; i < dim_trans; ++i) {
+ if (nrisk[i * (*lt) + t] != 0) {
+ dna[dim_nev[1] * dim_nev[1] * t + j * dim_nev[1] + i] =
+ (double) nev[dim_nev[1] * dim_nev[1] * t + j * dim_nev[1]+i] / (double) nrisk[i*(*lt)+t];
+ }
+ }
+ }
+ }
+}
+
diff --git a/tests/test.etmCIF.R b/tests/test.etmCIF.R
new file mode 100644
index 0000000..dc95f90
--- /dev/null
+++ b/tests/test.etmCIF.R
@@ -0,0 +1,142 @@
+### test file for etmCIF.
+### Really simple tests and comparison with etm
+
+require(etm)
+
+data(abortion)
+
+from <- rep(0, nrow(abortion))
+to <- abortion$cause
+entry <- abortion$entry
+exit <- abortion$exit
+id <- 1:nrow(abortion)
+data <- data.frame(id, from, to, entry, exit, group = abortion$group)
+
+## Computation of the CIFs with etm
+tra <- matrix(FALSE, 4, 4)
+tra[1, 2:4] <- TRUE
+
+cif.control <- etm(data[data$group == 0, ], c("0", "1", "2", "3"),
+ tra, NULL, 0)
+cif.exposed <- etm(data[data$group == 1, ], c("0", "1", "2", "3"),
+ tra, NULL, 0)
+
+
+## Computation of the CIFs with etmCIF
+
+netm <- etmCIF(Surv(entry, exit, cause != 0) ~ group, abortion,
+ etype = cause, failcode = 3)
+
+### let's do some comparisons :-)
+
+all.equal(trprob(cif.control, "0 3"), netm[[1]]$est["0", "3", ])
+all.equal(trprob(cif.control, "0 2"), netm[[1]]$est["0", "2", ])
+all.equal(trprob(cif.control, "0 1"), netm[[1]]$est["0", "1", ])
+
+all.equal(trprob(cif.exposed, "0 3"), netm[[2]]$est["0", "3", ])
+all.equal(trprob(cif.exposed, "0 2"), netm[[2]]$est["0", "2", ])
+all.equal(trprob(cif.exposed, "0 1"), netm[[2]]$est["0", "1", ])
+
+
+all.equal(trcov(cif.control, "0 3"), netm[[1]]$cov["0 3", "0 3", ])
+all.equal(trcov(cif.control, "0 2"), netm[[1]]$cov["0 2", "0 2", ])
+all.equal(trcov(cif.control, "0 1"), netm[[1]]$cov["0 1", "0 1", ])
+
+all.equal(trcov(cif.exposed, "0 3"), netm[[2]]$cov["0 3", "0 3", ])
+all.equal(trcov(cif.exposed, "0 2"), netm[[2]]$cov["0 2", "0 2", ])
+all.equal(trcov(cif.exposed, "0 1"), netm[[2]]$cov["0 1", "0 1", ])
+
+
+netm
+
+## test on the summary
+snetm <- summary(netm)
+
+snetm
+
+all.equal(unname(trprob(cif.control, "0 3")), snetm[[1]][[3]]$P)
+all.equal(unname(trprob(cif.control, "0 2")), snetm[[1]][[2]]$P)
+all.equal(unname(trprob(cif.control, "0 1")), snetm[[1]][[1]]$P)
+
+all.equal(unname(trprob(cif.exposed, "0 3")), snetm[[2]][[3]]$P)
+all.equal(unname(trprob(cif.exposed, "0 2")), snetm[[2]][[2]]$P)
+all.equal(unname(trprob(cif.exposed, "0 1")), snetm[[2]][[1]]$P)
+
+scif.control <- summary(cif.control, ci.fun = "cloglog")
+scif.exposed <- summary(cif.exposed, ci.fun = "cloglog")
+
+all.equal(scif.control[[3]]$lower, snetm[[1]][[3]]$lower)
+all.equal(scif.control[[3]]$upper, snetm[[1]][[3]]$upper)
+
+all.equal(scif.exposed[[3]]$lower, snetm[[2]][[3]]$lower)
+all.equal(scif.exposed[[3]]$upper, snetm[[2]][[3]]$upper)
+
+
+### test with factors in the input
+abortion$status <- with(abortion, ifelse(cause == 2, "life birth",
+ ifelse(cause == 1, "ETOP", "spontaneous abortion")))
+
+abortion$status <- factor(abortion$status)
+
+netm.factor <- etmCIF(Surv(entry, exit, status != "cens") ~ group, abortion,
+ etype = status, failcode = "spontaneous abortion")
+
+
+all.equal(trprob(cif.control, "0 3"), netm.factor[[1]]$est["0", "spontaneous abortion", ])
+all.equal(trprob(cif.control, "0 2"), netm.factor[[1]]$est["0", "life birth", ])
+
+netm.factor
+
+summary(netm.factor)
+
+### test with group as a character vector
+abortion$ttt <- with(abortion, ifelse(group == 0, "control", "exposed"))
+abortion$ttt <- factor(abortion$ttt)
+
+netm.ttt <- etmCIF(Surv(entry, exit, status != "cens") ~ ttt, abortion,
+ etype = status, failcode = "spontaneous abortion")
+
+all.equal(trprob(cif.control, "0 3"), netm.ttt[[1]]$est["0", "spontaneous abortion", ])
+all.equal(trprob(cif.control, "0 2"), netm.ttt[[1]]$est["0", "life birth", ])
+
+netm.ttt
+
+summary(netm.ttt)
+
+
+### A couple of comparisons with simulated data
+set.seed(1313)
+time <- rexp(100)
+to <- rbinom(100, 2, prob = c(1/3, 1/3, 1/3))
+from <- rep(11, 100)
+id <- 1:100
+cov <- rbinom(100, 1, 0.5)
+
+dat.s <- data.frame(id, time, from, to, cov)
+
+traa <- matrix(FALSE, 3, 3)
+traa[1, 2:3] <- TRUE
+
+aa0 <- etm(dat.s[dat.s$cov == 0, ], c("11", "1", "2"), traa, "0", 0)
+aa1 <- etm(dat.s[dat.s$cov == 1, ], c("11", "1", "2"), traa, "0", 0)
+aa <- etm(dat.s, c("11", "1", "2"), traa, "0", 0)
+
+test <- etmCIF(Surv(time, to != 0) ~ 1, dat.s, etype = to)
+
+test.c <- etmCIF(Surv(time, to != 0) ~ cov, dat.s, etype = to)
+
+all.equal(trprob(aa, "11 1"), test[[1]]$est["0", "1", ])
+all.equal(trprob(aa, "11 2"), test[[1]]$est["0", "2", ])
+
+all.equal(trprob(aa0, "11 1"), test.c[[1]]$est["0", "1", ])
+all.equal(trprob(aa0, "11 2"), test.c[[1]]$est["0", "2", ])
+
+all.equal(trprob(aa1, "11 1"), test.c[[2]]$est["0", "1", ])
+all.equal(trprob(aa1, "11 2"), test.c[[2]]$est["0", "2", ])
+
+test
+
+test.c
+
+summary(test)
+summary(test.c)
diff --git a/tests/test.etmCIF.Rout.save b/tests/test.etmCIF.Rout.save
new file mode 100644
index 0000000..03ef5fd
--- /dev/null
+++ b/tests/test.etmCIF.Rout.save
@@ -0,0 +1,516 @@
+
+R version 2.14.1 (2011-12-22)
+Copyright (C) 2011 The R Foundation for Statistical Computing
+ISBN 3-900051-07-0
+Platform: x86_64-pc-linux-gnu (64-bit)
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+ Natural language support but running in an English locale
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> ### test file for etmCIF.
+> ### Really simple tests and comparison with etm
+>
+> require(etm)
+Loading required package: etm
+Loading required package: lattice
+Loading required package: survival
+Loading required package: splines
+>
+> data(abortion)
+>
+> from <- rep(0, nrow(abortion))
+> to <- abortion$cause
+> entry <- abortion$entry
+> exit <- abortion$exit
+> id <- 1:nrow(abortion)
+> data <- data.frame(id, from, to, entry, exit, group = abortion$group)
+>
+> ## Computation of the CIFs with etm
+> tra <- matrix(FALSE, 4, 4)
+> tra[1, 2:4] <- TRUE
+>
+> cif.control <- etm(data[data$group == 0, ], c("0", "1", "2", "3"),
++ tra, NULL, 0)
+> cif.exposed <- etm(data[data$group == 1, ], c("0", "1", "2", "3"),
++ tra, NULL, 0)
+>
+>
+> ## Computation of the CIFs with etmCIF
+>
+> netm <- etmCIF(Surv(entry, exit, cause != 0) ~ group, abortion,
++ etype = cause, failcode = 3)
+>
+> ### let's do some comparisons :-)
+>
+> all.equal(trprob(cif.control, "0 3"), netm[[1]]$est["0", "3", ])
+[1] TRUE
+> all.equal(trprob(cif.control, "0 2"), netm[[1]]$est["0", "2", ])
+[1] TRUE
+> all.equal(trprob(cif.control, "0 1"), netm[[1]]$est["0", "1", ])
+[1] TRUE
+>
+> all.equal(trprob(cif.exposed, "0 3"), netm[[2]]$est["0", "3", ])
+[1] TRUE
+> all.equal(trprob(cif.exposed, "0 2"), netm[[2]]$est["0", "2", ])
+[1] TRUE
+> all.equal(trprob(cif.exposed, "0 1"), netm[[2]]$est["0", "1", ])
+[1] TRUE
+>
+>
+> all.equal(trcov(cif.control, "0 3"), netm[[1]]$cov["0 3", "0 3", ])
+[1] TRUE
+> all.equal(trcov(cif.control, "0 2"), netm[[1]]$cov["0 2", "0 2", ])
+[1] TRUE
+> all.equal(trcov(cif.control, "0 1"), netm[[1]]$cov["0 1", "0 1", ])
+[1] TRUE
+>
+> all.equal(trcov(cif.exposed, "0 3"), netm[[2]]$cov["0 3", "0 3", ])
+[1] TRUE
+> all.equal(trcov(cif.exposed, "0 2"), netm[[2]]$cov["0 2", "0 2", ])
+[1] TRUE
+> all.equal(trcov(cif.exposed, "0 1"), netm[[2]]$cov["0 1", "0 1", ])
+[1] TRUE
+>
+>
+> netm
+Call: etmCIF(formula = Surv(entry, exit, cause != 0) ~ group, data = abortion,
+ etype = cause, failcode = 3)
+
+Covariate: group
+ levels: 0 1
+
+
+ group = 0
+ time P se(P) n.event
+CIF 1 43 0.04015931 0.009257784 20
+CIF 2 43 0.79905931 0.022186468 924
+CIF 3 43 0.16078139 0.021326113 69
+
+ group = 1
+ time P se(P) n.event
+CIF 1 42 0.2851118 0.04249308 38
+CIF 2 42 0.3525651 0.04213898 92
+CIF 3 42 0.3623231 0.04947340 43
+>
+> ## test on the summary
+> snetm <- summary(netm)
+>
+> snetm
+
+ group=0
+
+CIF 1
+ P time var lower upper n.risk n.event
+ 0.00000000 4 0.000000e+00 0.00000000 0.00000000 18 0
+ 0.03895488 13 8.444048e-05 0.02448808 0.06169378 645 1
+ 0.04015931 23 8.570657e-05 0.02551262 0.06293875 819 0
+ 0.04015931 33 8.570657e-05 0.02551262 0.06293875 885 0
+ 0.04015931 39 8.570657e-05 0.02551262 0.06293875 716 0
+ 0.04015931 43 8.570657e-05 0.02551262 0.06293875 6 0
+
+CIF 2
+ P time var lower upper n.risk n.event
+ 0.00000000 4 0.000000e+00 0.000000000 0.00000000 18 0
+ 0.00000000 13 0.000000e+00 0.000000000 0.00000000 645 0
+ 0.00000000 23 0.000000e+00 0.000000000 0.00000000 819 0
+ 0.01354288 33 1.216141e-05 0.008169604 0.02241009 885 6
+ 0.32201590 39 2.469805e-04 0.292313907 0.35391574 716 165
+ 0.79905931 43 4.922394e-04 0.753968839 0.84061317 6 6
+
+CIF 3
+ P time var lower upper n.risk n.event
+ 0.0000000 4 0.0000000000 0.0000000 0.0000000 18 0
+ 0.1504675 13 0.0004551293 0.1135970 0.1979013 645 1
+ 0.1570366 23 0.0004553237 0.1199469 0.2041947 819 0
+ 0.1599039 33 0.0004549788 0.1227389 0.2069247 885 0
+ 0.1607814 39 0.0004548031 0.1235965 0.2077571 716 0
+ 0.1607814 43 0.0004548031 0.1235965 0.2077571 6 0
+
+
+ group=1
+
+CIF 1
+ P time var lower upper n.risk n.event
+ 0.0000000 4 0.000000000 0.0000000 0.0000000 8 0
+ 0.2604775 12 0.001785362 0.1879526 0.3542503 94 5
+ 0.2811533 21 0.001802770 0.2074197 0.3742279 93 1
+ 0.2851118 32 0.001805662 0.2111650 0.3780568 90 0
+ 0.2851118 38 0.001805662 0.2111650 0.3780568 71 0
+ 0.2851118 42 0.001805662 0.2111650 0.3780568 6 0
+
+CIF 2
+ P time var lower upper n.risk n.event
+ 0.00000000 4 0.000000e+00 0.000000000 0.00000000 8 0
+ 0.00000000 12 0.000000e+00 0.000000000 0.00000000 94 0
+ 0.00000000 21 0.000000e+00 0.000000000 0.00000000 93 0
+ 0.01541036 32 6.016217e-05 0.005730041 0.04110307 90 1
+ 0.13034947 38 5.576254e-04 0.090999609 0.18489993 71 12
+ 0.35256510 42 1.775693e-03 0.276882073 0.44177471 6 6
+
+CIF 3
+ P time var lower upper n.risk n.event
+ 0.0000000 4 0.000000000 0.0000000 0.0000000 8 0
+ 0.3143493 12 0.002571501 0.2266494 0.4254211 94 1
+ 0.3507019 21 0.002482739 0.2627692 0.4576195 93 0
+ 0.3584918 32 0.002459261 0.2706266 0.4644770 90 0
+ 0.3584918 38 0.002459261 0.2706266 0.4644770 71 0
+ 0.3623231 42 0.002447617 0.2744987 0.4678544 6 0
+
+>
+> all.equal(unname(trprob(cif.control, "0 3")), snetm[[1]][[3]]$P)
+[1] TRUE
+> all.equal(unname(trprob(cif.control, "0 2")), snetm[[1]][[2]]$P)
+[1] TRUE
+> all.equal(unname(trprob(cif.control, "0 1")), snetm[[1]][[1]]$P)
+[1] TRUE
+>
+> all.equal(unname(trprob(cif.exposed, "0 3")), snetm[[2]][[3]]$P)
+[1] TRUE
+> all.equal(unname(trprob(cif.exposed, "0 2")), snetm[[2]][[2]]$P)
+[1] TRUE
+> all.equal(unname(trprob(cif.exposed, "0 1")), snetm[[2]][[1]]$P)
+[1] TRUE
+>
+> scif.control <- summary(cif.control, ci.fun = "cloglog")
+> scif.exposed <- summary(cif.exposed, ci.fun = "cloglog")
+>
+> all.equal(scif.control[[3]]$lower, snetm[[1]][[3]]$lower)
+[1] TRUE
+> all.equal(scif.control[[3]]$upper, snetm[[1]][[3]]$upper)
+[1] TRUE
+>
+> all.equal(scif.exposed[[3]]$lower, snetm[[2]][[3]]$lower)
+[1] TRUE
+> all.equal(scif.exposed[[3]]$upper, snetm[[2]][[3]]$upper)
+[1] TRUE
+>
+>
+> ### test with factors in the input
+> abortion$status <- with(abortion, ifelse(cause == 2, "life birth",
++ ifelse(cause == 1, "ETOP", "spontaneous abortion")))
+>
+> abortion$status <- factor(abortion$status)
+>
+> netm.factor <- etmCIF(Surv(entry, exit, status != "cens") ~ group, abortion,
++ etype = status, failcode = "spontaneous abortion")
+>
+>
+> all.equal(trprob(cif.control, "0 3"), netm.factor[[1]]$est["0", "spontaneous abortion", ])
+[1] TRUE
+> all.equal(trprob(cif.control, "0 2"), netm.factor[[1]]$est["0", "life birth", ])
+[1] TRUE
+>
+> netm.factor
+Call: etmCIF(formula = Surv(entry, exit, status != "cens") ~ group,
+ data = abortion, etype = status, failcode = "spontaneous abortion")
+
+Covariate: group
+ levels: 0 1
+
+
+ group = 0
+ time P se(P) n.event
+CIF ETOP 43 0.04015931 0.009257784 20
+CIF life birth 43 0.79905931 0.022186468 924
+CIF spontaneous abortion 43 0.16078139 0.021326113 69
+
+ group = 1
+ time P se(P) n.event
+CIF ETOP 42 0.2851118 0.04249308 38
+CIF life birth 42 0.3525651 0.04213898 92
+CIF spontaneous abortion 42 0.3623231 0.04947340 43
+>
+> summary(netm.factor)
+
+ group=0
+
+CIF ETOP
+ P time var lower upper n.risk n.event
+ 0.00000000 4 0.000000e+00 0.00000000 0.00000000 18 0
+ 0.03895488 13 8.444048e-05 0.02448808 0.06169378 645 1
+ 0.04015931 23 8.570657e-05 0.02551262 0.06293875 819 0
+ 0.04015931 33 8.570657e-05 0.02551262 0.06293875 885 0
+ 0.04015931 39 8.570657e-05 0.02551262 0.06293875 716 0
+ 0.04015931 43 8.570657e-05 0.02551262 0.06293875 6 0
+
+CIF life birth
+ P time var lower upper n.risk n.event
+ 0.00000000 4 0.000000e+00 0.000000000 0.00000000 18 0
+ 0.00000000 13 0.000000e+00 0.000000000 0.00000000 645 0
+ 0.00000000 23 0.000000e+00 0.000000000 0.00000000 819 0
+ 0.01354288 33 1.216141e-05 0.008169604 0.02241009 885 6
+ 0.32201590 39 2.469805e-04 0.292313907 0.35391574 716 165
+ 0.79905931 43 4.922394e-04 0.753968839 0.84061317 6 6
+
+CIF spontaneous abortion
+ P time var lower upper n.risk n.event
+ 0.0000000 4 0.0000000000 0.0000000 0.0000000 18 0
+ 0.1504675 13 0.0004551293 0.1135970 0.1979013 645 1
+ 0.1570366 23 0.0004553237 0.1199469 0.2041947 819 0
+ 0.1599039 33 0.0004549788 0.1227389 0.2069247 885 0
+ 0.1607814 39 0.0004548031 0.1235965 0.2077571 716 0
+ 0.1607814 43 0.0004548031 0.1235965 0.2077571 6 0
+
+
+ group=1
+
+CIF ETOP
+ P time var lower upper n.risk n.event
+ 0.0000000 4 0.000000000 0.0000000 0.0000000 8 0
+ 0.2604775 12 0.001785362 0.1879526 0.3542503 94 5
+ 0.2811533 21 0.001802770 0.2074197 0.3742279 93 1
+ 0.2851118 32 0.001805662 0.2111650 0.3780568 90 0
+ 0.2851118 38 0.001805662 0.2111650 0.3780568 71 0
+ 0.2851118 42 0.001805662 0.2111650 0.3780568 6 0
+
+CIF life birth
+ P time var lower upper n.risk n.event
+ 0.00000000 4 0.000000e+00 0.000000000 0.00000000 8 0
+ 0.00000000 12 0.000000e+00 0.000000000 0.00000000 94 0
+ 0.00000000 21 0.000000e+00 0.000000000 0.00000000 93 0
+ 0.01541036 32 6.016217e-05 0.005730041 0.04110307 90 1
+ 0.13034947 38 5.576254e-04 0.090999609 0.18489993 71 12
+ 0.35256510 42 1.775693e-03 0.276882073 0.44177471 6 6
+
+CIF spontaneous abortion
+ P time var lower upper n.risk n.event
+ 0.0000000 4 0.000000000 0.0000000 0.0000000 8 0
+ 0.3143493 12 0.002571501 0.2266494 0.4254211 94 1
+ 0.3507019 21 0.002482739 0.2627692 0.4576195 93 0
+ 0.3584918 32 0.002459261 0.2706266 0.4644770 90 0
+ 0.3584918 38 0.002459261 0.2706266 0.4644770 71 0
+ 0.3623231 42 0.002447617 0.2744987 0.4678544 6 0
+
+>
+> ### test with group as a character vector
+> abortion$ttt <- with(abortion, ifelse(group == 0, "control", "exposed"))
+> abortion$ttt <- factor(abortion$ttt)
+>
+> netm.ttt <- etmCIF(Surv(entry, exit, status != "cens") ~ ttt, abortion,
++ etype = status, failcode = "spontaneous abortion")
+>
+> all.equal(trprob(cif.control, "0 3"), netm.ttt[[1]]$est["0", "spontaneous abortion", ])
+[1] TRUE
+> all.equal(trprob(cif.control, "0 2"), netm.ttt[[1]]$est["0", "life birth", ])
+[1] TRUE
+>
+> netm.ttt
+Call: etmCIF(formula = Surv(entry, exit, status != "cens") ~ ttt, data = abortion,
+ etype = status, failcode = "spontaneous abortion")
+
+Covariate: ttt
+ levels: control exposed
+
+
+ ttt = control
+ time P se(P) n.event
+CIF ETOP 43 0.04015931 0.009257784 20
+CIF life birth 43 0.79905931 0.022186468 924
+CIF spontaneous abortion 43 0.16078139 0.021326113 69
+
+ ttt = exposed
+ time P se(P) n.event
+CIF ETOP 42 0.2851118 0.04249308 38
+CIF life birth 42 0.3525651 0.04213898 92
+CIF spontaneous abortion 42 0.3623231 0.04947340 43
+>
+> summary(netm.ttt)
+
+ ttt=control
+
+CIF ETOP
+ P time var lower upper n.risk n.event
+ 0.00000000 4 0.000000e+00 0.00000000 0.00000000 18 0
+ 0.03895488 13 8.444048e-05 0.02448808 0.06169378 645 1
+ 0.04015931 23 8.570657e-05 0.02551262 0.06293875 819 0
+ 0.04015931 33 8.570657e-05 0.02551262 0.06293875 885 0
+ 0.04015931 39 8.570657e-05 0.02551262 0.06293875 716 0
+ 0.04015931 43 8.570657e-05 0.02551262 0.06293875 6 0
+
+CIF life birth
+ P time var lower upper n.risk n.event
+ 0.00000000 4 0.000000e+00 0.000000000 0.00000000 18 0
+ 0.00000000 13 0.000000e+00 0.000000000 0.00000000 645 0
+ 0.00000000 23 0.000000e+00 0.000000000 0.00000000 819 0
+ 0.01354288 33 1.216141e-05 0.008169604 0.02241009 885 6
+ 0.32201590 39 2.469805e-04 0.292313907 0.35391574 716 165
+ 0.79905931 43 4.922394e-04 0.753968839 0.84061317 6 6
+
+CIF spontaneous abortion
+ P time var lower upper n.risk n.event
+ 0.0000000 4 0.0000000000 0.0000000 0.0000000 18 0
+ 0.1504675 13 0.0004551293 0.1135970 0.1979013 645 1
+ 0.1570366 23 0.0004553237 0.1199469 0.2041947 819 0
+ 0.1599039 33 0.0004549788 0.1227389 0.2069247 885 0
+ 0.1607814 39 0.0004548031 0.1235965 0.2077571 716 0
+ 0.1607814 43 0.0004548031 0.1235965 0.2077571 6 0
+
+
+ ttt=exposed
+
+CIF ETOP
+ P time var lower upper n.risk n.event
+ 0.0000000 4 0.000000000 0.0000000 0.0000000 8 0
+ 0.2604775 12 0.001785362 0.1879526 0.3542503 94 5
+ 0.2811533 21 0.001802770 0.2074197 0.3742279 93 1
+ 0.2851118 32 0.001805662 0.2111650 0.3780568 90 0
+ 0.2851118 38 0.001805662 0.2111650 0.3780568 71 0
+ 0.2851118 42 0.001805662 0.2111650 0.3780568 6 0
+
+CIF life birth
+ P time var lower upper n.risk n.event
+ 0.00000000 4 0.000000e+00 0.000000000 0.00000000 8 0
+ 0.00000000 12 0.000000e+00 0.000000000 0.00000000 94 0
+ 0.00000000 21 0.000000e+00 0.000000000 0.00000000 93 0
+ 0.01541036 32 6.016217e-05 0.005730041 0.04110307 90 1
+ 0.13034947 38 5.576254e-04 0.090999609 0.18489993 71 12
+ 0.35256510 42 1.775693e-03 0.276882073 0.44177471 6 6
+
+CIF spontaneous abortion
+ P time var lower upper n.risk n.event
+ 0.0000000 4 0.000000000 0.0000000 0.0000000 8 0
+ 0.3143493 12 0.002571501 0.2266494 0.4254211 94 1
+ 0.3507019 21 0.002482739 0.2627692 0.4576195 93 0
+ 0.3584918 32 0.002459261 0.2706266 0.4644770 90 0
+ 0.3584918 38 0.002459261 0.2706266 0.4644770 71 0
+ 0.3623231 42 0.002447617 0.2744987 0.4678544 6 0
+
+>
+>
+> ### A couple of comparisons with simulated data
+> set.seed(1313)
+> time <- rexp(100)
+> to <- rbinom(100, 2, prob = c(1/3, 1/3, 1/3))
+> from <- rep(11, 100)
+> id <- 1:100
+> cov <- rbinom(100, 1, 0.5)
+>
+> dat.s <- data.frame(id, time, from, to, cov)
+>
+> traa <- matrix(FALSE, 3, 3)
+> traa[1, 2:3] <- TRUE
+>
+> aa0 <- etm(dat.s[dat.s$cov == 0, ], c("11", "1", "2"), traa, "0", 0)
+> aa1 <- etm(dat.s[dat.s$cov == 1, ], c("11", "1", "2"), traa, "0", 0)
+> aa <- etm(dat.s, c("11", "1", "2"), traa, "0", 0)
+>
+> test <- etmCIF(Surv(time, to != 0) ~ 1, dat.s, etype = to)
+>
+> test.c <- etmCIF(Surv(time, to != 0) ~ cov, dat.s, etype = to)
+>
+> all.equal(trprob(aa, "11 1"), test[[1]]$est["0", "1", ])
+[1] TRUE
+> all.equal(trprob(aa, "11 2"), test[[1]]$est["0", "2", ])
+[1] TRUE
+>
+> all.equal(trprob(aa0, "11 1"), test.c[[1]]$est["0", "1", ])
+[1] TRUE
+> all.equal(trprob(aa0, "11 2"), test.c[[1]]$est["0", "2", ])
+[1] TRUE
+>
+> all.equal(trprob(aa1, "11 1"), test.c[[2]]$est["0", "1", ])
+[1] TRUE
+> all.equal(trprob(aa1, "11 2"), test.c[[2]]$est["0", "2", ])
+[1] TRUE
+>
+> test
+Call: etmCIF(formula = Surv(time, to != 0) ~ 1, data = dat.s, etype = to)
+
+ time P se(P) n.event
+CIF 1 4.929943 0.80910809 0.07968014 45
+CIF 2 4.929943 0.09661788 0.03290520 8
+>
+> test.c
+Call: etmCIF(formula = Surv(time, to != 0) ~ cov, data = dat.s, etype = to)
+
+Covariate: cov
+ levels: 0 1
+
+
+ cov = 0
+ time P se(P) n.event
+CIF 1 2.920944 0.7024648 0.10579670 19
+CIF 2 2.920944 0.1114404 0.05338408 4
+
+ cov = 1
+ time P se(P) n.event
+CIF 1 4.929943 0.80787111 0.09405073 26
+CIF 2 4.929943 0.08436022 0.04076920 4
+>
+> summary(test)
+
+
+
+CIF 1
+ P time var lower upper n.risk n.event
+ 0.0100000 0.009209855 0.000099000 0.001414712 0.0688628 100 1
+ 0.1142996 0.360023778 0.001054230 0.064945430 0.1969931 76 0
+ 0.2479372 0.784047742 0.002149357 0.170109947 0.3530034 51 0
+ 0.4405912 1.555114392 0.003517175 0.333817035 0.5642480 26 1
+ 0.5734230 2.268295292 0.004274160 0.450541377 0.7024323 11 0
+ 0.8091081 4.929943217 0.006348924 0.635954424 0.9337329 1 0
+
+CIF 2
+ P time var lower upper n.risk n.event
+ 0.00000000 0.009209855 0.0000000000 0.00000000 0.0000000 100 0
+ 0.04246723 0.360023778 0.0004318927 0.01615074 0.1092171 76 0
+ 0.06702937 0.784047742 0.0007036620 0.03059797 0.1435033 51 0
+ 0.09661788 1.555114392 0.0010827519 0.04908158 0.1854738 26 0
+ 0.09661788 2.268295292 0.0010827519 0.04908158 0.1854738 11 0
+ 0.09661788 4.929943217 0.0010827519 0.04908158 0.1854738 1 0
+
+> summary(test.c)
+
+ cov=0
+
+CIF 1
+ P time var lower upper n.risk n.event
+ 0.02222222 0.009209855 0.0004828532 0.00316047 0.1474667 45 1
+ 0.09222222 0.406113230 0.0019360322 0.03559707 0.2276215 34 0
+ 0.22668442 0.784047742 0.0045095420 0.12417599 0.3925031 23 0
+ 0.42066416 1.478827203 0.0082446289 0.26725155 0.6164448 12 1
+ 0.60941744 1.939093010 0.0095747480 0.42743893 0.7950394 6 1
+ 0.70246483 2.920943647 0.0111929419 0.49448899 0.8839905 1 0
+
+CIF 2
+ P time var lower upper n.risk n.event
+ 0.00000000 0.009209855 0.000000000 0.00000000 0.0000000 45 0
+ 0.04844136 0.406113230 0.001116811 0.01233703 0.1801316 34 0
+ 0.07641078 0.784047742 0.001810437 0.02520184 0.2192780 23 0
+ 0.11144039 1.478827203 0.002849860 0.04267633 0.2739153 12 0
+ 0.11144039 1.939093010 0.002849860 0.04267633 0.2739153 6 0
+ 0.11144039 2.920943647 0.002849860 0.04267633 0.2739153 1 0
+
+
+ cov=1
+
+CIF 1
+ P time var lower upper n.risk n.event
+ 0.01818182 0.06669232 0.000324568 0.002581315 0.1221376 55 1
+ 0.13171422 0.36002378 0.002156700 0.065024199 0.2567179 42 0
+ 0.26514875 0.80139542 0.004072829 0.162479119 0.4145201 28 0
+ 0.46217162 1.55511439 0.006255707 0.322729736 0.6273534 15 1
+ 0.59233377 2.48978047 0.007759845 0.428622952 0.7627259 7 0
+ 0.80787111 4.92994322 0.008845539 0.602318537 0.9477134 1 0
+
+CIF 2
+ P time var lower upper n.risk n.event
+ 0.00000000 0.06669232 0.0000000000 0.000000000 0.0000000 55 0
+ 0.03743357 0.36002378 0.0006745784 0.009493953 0.1415172 42 0
+ 0.05934134 0.80139542 0.0011129497 0.019446521 0.1735097 28 0
+ 0.08436022 1.55511439 0.0016621276 0.032211300 0.2111908 15 0
+ 0.08436022 2.48978047 0.0016621276 0.032211300 0.2111908 7 0
+ 0.08436022 4.92994322 0.0016621276 0.032211300 0.2111908 1 0
+
+>
diff --git a/tests/tests.etm.R b/tests/tests.etm.R
new file mode 100644
index 0000000..b5aacb2
--- /dev/null
+++ b/tests/tests.etm.R
@@ -0,0 +1,220 @@
+require(etm)
+
+### Simple test
+
+time <- id <- 1:10
+from <- rep(0, 10)
+to <- rep(1, 10)
+
+data1 <- data.frame(id, from, to, time)
+tra1 <- matrix(FALSE, 2, 2)
+tra1[1, 2] <- TRUE
+
+etm1 <- etm(data1, c("0", "1"), tra1, NULL, 0)
+
+all.equal(as.vector(trprob(etm1, "0 0")), cumprod((10:1 - 1) / (10:1)))
+
+etm1$cov["0 0", "0 0", ]
+
+all.equal(etm1$cov["0 0", "0 0",], trcov(etm1, "0 0"))
+
+
+### a bit more complicated
+
+time <- id <- 1:10
+from <- rep(0, 10)
+to <- rep(c(1, 2), 5)
+data2 <- data.frame(id, from, to, time)
+
+tra2 <- matrix(FALSE, 3, 3)
+tra2[1, 2:3] <- TRUE
+
+etm2 <- etm(data2, c("0", "1", "2"), tra2, NULL, 0)
+
+aa <- table(time, to)
+
+cif1 <- cumsum(aa[, 1] / 10)
+cif2 <- cumsum(aa[, 2] / 10)
+surv <- cumprod((10:1 - 1) / (10:1))
+
+all.equal(trprob(etm2, "0 1"), cif1)
+all.equal(trprob(etm2, "0 2"), cif2)
+all.equal(as.vector(trprob(etm2, "0 0")), surv)
+
+## a test on id
+data2$id <- letters[1:10]
+
+etm3 <- etm(data2, c("0", "1", "2"), tra2, NULL, 0)
+
+all.equal(trprob(etm2, "0 1"), trprob(etm3, "0 1"))
+all.equal(trprob(etm2, "0 2"), trprob(etm3, "0 2"))
+all.equal(trprob(etm2, "0 0"), trprob(etm3, "0 0"))
+
+
+### Test on sir.cont
+
+data(sir.cont)
+
+## Modification for patients entering and leaving a state
+## at the same date
+## Change on ventilation status is considered
+## to happen before end of hospital stay
+sir.cont <- sir.cont[order(sir.cont$id, sir.cont$time), ]
+for (i in 2:nrow(sir.cont)) {
+ if (sir.cont$id[i]==sir.cont$id[i-1]) {
+ if (sir.cont$time[i]==sir.cont$time[i-1]) {
+ sir.cont$time[i-1] <- sir.cont$time[i-1] - 0.5
+ }
+ }
+}
+
+### Computation of the transition probabilities
+## Possible transitions.
+tra <- matrix(ncol=3,nrow=3,FALSE)
+tra[1, 2:3] <- TRUE
+tra[2, c(1, 3)] <- TRUE
+
+## etm
+prob.sir <- etm(sir.cont, c("0", "1", "2"), tra, "cens", 1)
+
+prob.sir
+
+summ.sir <- summary(prob.sir)
+all.equal(summ.sir[[1]]$P, as.vector(trprob(prob.sir, "0 1")))
+summ.sir[[2]]
+
+## gonna play a bit with the state names
+dd <- sir.cont
+dd$from <- ifelse(dd$from == 0, "initial state", "ventilation")
+dd$to <- as.character(dd$to)
+for (i in seq_len(nrow(dd))) {
+ dd$to[i] <- switch(dd$to[i],
+ "0" = "initial state",
+ "1" = "ventilation",
+ "2" = "end of story",
+ "cens" = "cens"
+ )
+}
+
+test <- etm(dd, c("initial state", "ventilation", "end of story"), tra, "cens", 1)
+
+all.equal(test$est["initial state", "initial state", ],
+ prob.sir$est["0", "0", ])
+all.equal(trprob(test, "initial state initial state"), trprob(prob.sir, "0 0"))
+all.equal(trprob(test, "initial state ventilation"), trprob(prob.sir, "0 1"))
+all.equal(trprob(test, "initial state end of story"), trprob(prob.sir, "0 2"))
+
+all.equal(trcov(test, "initial state end of story"), trcov(prob.sir, "0 2"))
+
+aa <- summary(test)
+all.equal(summ.sir[[6]], aa[[6]])
+all.equal(summ.sir[[4]], aa[[4]])
+
+### Test on abortion data
+
+data(abortion)
+
+from <- rep(0, nrow(abortion))
+to <- abortion$cause
+entry <- abortion$entry
+exit <- abortion$exit
+id <- 1:nrow(abortion)
+data <- data.frame(id, from, to, entry, exit, group = abortion$group)
+
+## Computation of the CIFs
+tra <- matrix(FALSE, 4, 4)
+tra[1, 2:4] <- TRUE
+
+cif.control <- etm(data[data$group == 0, ], c("0", "1", "2", "3"),
+ tra, NULL, 0)
+cif.exposed <- etm(data[data$group == 1, ], c("0", "1", "2", "3"),
+ tra, NULL, 0)
+
+all.equal(trprob(cif.control, "0 1"), cif.control$est["0", "1", ])
+all.equal(trcov(cif.control, c("0 1", "0 2")), cif.control$cov["0 1", "0 2", ])
+
+trprob(cif.control, "0 1")
+trprob(cif.control, "0 2")
+trprob(cif.control, "0 0")
+
+trcov(cif.control, "0 1")
+trcov(cif.control, "0 2")
+trcov(cif.control, "0 0")
+
+aa <- summary(cif.control)
+aa$"0 1"
+all.equal(aa$"0 1"$P, as.vector(trprob(cif.control, "0 1")))
+
+### test on los data
+
+data(los.data) # in package changeLOS
+
+## putting los.data in the long format (see changeLOS)
+my.observ <- prepare.los.data(x=los.data)
+
+tra <- matrix(FALSE, 4, 4)
+tra[1, 2:4] <- TRUE
+tra[2, 3:4] <- TRUE
+
+tr.prob <- etm(my.observ, c("0","1","2","3"), tra, NULL, 0)
+
+tr.prob
+summary(tr.prob)
+
+cLOS <- etm::clos(tr.prob, aw = TRUE)
+
+cLOS
+
+
+### Tests on pseudo values
+t_pseudo <- closPseudo(my.observ, c("0","1","2","3"), tra, NULL,
+ formula = ~ 1, aw = TRUE)
+
+cLOS$e.phi == t_pseudo$theta[, "e.phi"]
+cLOS$e.phi.weights.1 == t_pseudo$theta[, "e.phi.weights.1"]
+cLOS$e.phi.weights.other == t_pseudo$theta[, "e.phi.weights.other"]
+
+mean(t_pseudo$pseudoData$ps.e.phi)
+
+### tests on etmprep
+
+### creation of fake data in the wild format, following an illness-death model
+## transition times
+tdisease <- c(3, 4, 3, 6, 8, 9)
+tdeath <- c(6, 9, 8, 6, 8, 9)
+
+## transition status
+stat.disease <- c(1, 1, 1, 0, 0, 0)
+stat.death <- c(1, 1, 1, 1, 1, 0)
+
+## a covariate that we want to keep in the new data
+set.seed(1313)
+cova <- rbinom(6, 1, 0.5)
+
+dat <- data.frame(tdisease, tdeath,
+ stat.disease, stat.death,
+ cova)
+
+## Possible transitions
+tra <- matrix(FALSE, 3, 3)
+tra[1, 2:3] <- TRUE
+tra[2, 3] <- TRUE
+
+## data preparation
+newdat <- etmprep(c(NA, "tdisease", "tdeath"),
+ c(NA, "stat.disease", "stat.death"),
+ data = dat, tra = tra,
+ cens.name = "cens", keep = "cova")
+
+newdat
+
+ref <- data.frame(id = c(1, 1, 2, 2, 3, 3, 4, 5, 6),
+ entry = c(0, 3, 0, 4, 0, 3, 0, 0, 0),
+ exit = c(3, 6, 4, 9, 3, 8, 6, 8, 9),
+ from = c(0, 1, 0, 1, 0, 1, 0, 0, 0),
+ to = c(rep(c(1, 2), 3), 2, 2, "cens"),
+ cova = c(1, 1, 0, 0, 1, 1, 0, 1, 1))
+ref$from <- factor(as.character(ref$from), levels = c("0", "1", "2", "cens"))
+ref$to <- factor(as.character(ref$to), levels = c("0", "1", "2", "cens"))
+
+all.equal(ref, newdat)
diff --git a/tests/tests.etm.Rout.save b/tests/tests.etm.Rout.save
new file mode 100644
index 0000000..de45c76
--- /dev/null
+++ b/tests/tests.etm.Rout.save
@@ -0,0 +1,659 @@
+
+R version 3.1.2 (2014-10-31) -- "Pumpkin Helmet"
+Copyright (C) 2014 The R Foundation for Statistical Computing
+Platform: x86_64-suse-linux-gnu (64-bit)
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+ Natural language support but running in an English locale
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> require(etm)
+Loading required package: etm
+Loading required package: survival
+Loading required package: splines
+>
+> ### Simple test
+>
+> time <- id <- 1:10
+> from <- rep(0, 10)
+> to <- rep(1, 10)
+>
+> data1 <- data.frame(id, from, to, time)
+> tra1 <- matrix(FALSE, 2, 2)
+> tra1[1, 2] <- TRUE
+>
+> etm1 <- etm(data1, c("0", "1"), tra1, NULL, 0)
+>
+> all.equal(as.vector(trprob(etm1, "0 0")), cumprod((10:1 - 1) / (10:1)))
+[1] TRUE
+>
+> etm1$cov["0 0", "0 0", ]
+ 1 2 3 4 5 6 7 8 9 10
+0.009 0.016 0.021 0.024 0.025 0.024 0.021 0.016 0.009 0.000
+>
+> all.equal(etm1$cov["0 0", "0 0",], trcov(etm1, "0 0"))
+[1] TRUE
+>
+>
+> ### a bit more complicated
+>
+> time <- id <- 1:10
+> from <- rep(0, 10)
+> to <- rep(c(1, 2), 5)
+> data2 <- data.frame(id, from, to, time)
+>
+> tra2 <- matrix(FALSE, 3, 3)
+> tra2[1, 2:3] <- TRUE
+>
+> etm2 <- etm(data2, c("0", "1", "2"), tra2, NULL, 0)
+>
+> aa <- table(time, to)
+>
+> cif1 <- cumsum(aa[, 1] / 10)
+> cif2 <- cumsum(aa[, 2] / 10)
+> surv <- cumprod((10:1 - 1) / (10:1))
+>
+> all.equal(trprob(etm2, "0 1"), cif1)
+[1] TRUE
+> all.equal(trprob(etm2, "0 2"), cif2)
+[1] TRUE
+> all.equal(as.vector(trprob(etm2, "0 0")), surv)
+[1] TRUE
+>
+> ## a test on id
+> data2$id <- letters[1:10]
+>
+> etm3 <- etm(data2, c("0", "1", "2"), tra2, NULL, 0)
+>
+> all.equal(trprob(etm2, "0 1"), trprob(etm3, "0 1"))
+[1] TRUE
+> all.equal(trprob(etm2, "0 2"), trprob(etm3, "0 2"))
+[1] TRUE
+> all.equal(trprob(etm2, "0 0"), trprob(etm3, "0 0"))
+[1] TRUE
+>
+>
+> ### Test on sir.cont
+>
+> data(sir.cont)
+>
+> ## Modification for patients entering and leaving a state
+> ## at the same date
+> ## Change on ventilation status is considered
+> ## to happen before end of hospital stay
+> sir.cont <- sir.cont[order(sir.cont$id, sir.cont$time), ]
+> for (i in 2:nrow(sir.cont)) {
++ if (sir.cont$id[i]==sir.cont$id[i-1]) {
++ if (sir.cont$time[i]==sir.cont$time[i-1]) {
++ sir.cont$time[i-1] <- sir.cont$time[i-1] - 0.5
++ }
++ }
++ }
+>
+> ### Computation of the transition probabilities
+> ## Possible transitions.
+> tra <- matrix(ncol=3,nrow=3,FALSE)
+> tra[1, 2:3] <- TRUE
+> tra[2, c(1, 3)] <- TRUE
+>
+> ## etm
+> prob.sir <- etm(sir.cont, c("0", "1", "2"), tra, "cens", 1)
+>
+> prob.sir
+Multistate model with 2 transient state(s)
+ and 1 absorbing state(s)
+
+Possible transitions:
+ from to
+ 0 1
+ 0 2
+ 1 0
+ 1 2
+
+Estimate of P(1, 183)
+ 0 1 2
+0 0 0 1
+1 0 0 1
+2 0 0 1
+
+Estimate of cov(P(1, 183))
+ 0 0 1 0 2 0 0 1 1 1 2 1 0 2 1 2 2 2
+0 0 0 0 0 0 0 0 0.000000e+00 0.000000e+00 0
+1 0 0 0 0 0 0 0 0.000000e+00 0.000000e+00 0
+2 0 0 0 0 0 0 0 0.000000e+00 0.000000e+00 0
+0 1 0 0 0 0 0 0 0.000000e+00 0.000000e+00 0
+1 1 0 0 0 0 0 0 0.000000e+00 0.000000e+00 0
+2 1 0 0 0 0 0 0 0.000000e+00 0.000000e+00 0
+0 2 0 0 0 0 0 0 -2.864030e-20 -1.126554e-19 0
+1 2 0 0 0 0 0 0 -4.785736e-20 2.710505e-19 0
+2 2 0 0 0 0 0 0 0.000000e+00 0.000000e+00 0
+>
+> summ.sir <- summary(prob.sir)
+Warning messages:
+1: In sqrt(var) : NaNs produced
+2: In sqrt(var) : NaNs produced
+> all.equal(summ.sir[[1]]$P, as.vector(trprob(prob.sir, "0 1")))
+[1] TRUE
+> summ.sir[[2]]
+ P time var lower upper n.risk n.event
+1.5 0.0000000 1.5 0.000000e+00 0.00000000 0.0000000 394 0
+2 0.1186869 2.0 2.641422e-04 0.08683265 0.1505411 396 47
+2.5 0.1186869 2.5 2.641422e-04 0.08683265 0.1505411 364 0
+3 0.2453993 3.0 4.465256e-04 0.20398301 0.2868156 365 54
+3.5 0.2453993 3.5 4.465256e-04 0.20398301 0.2868156 328 0
+4 0.3806244 4.0 5.416492e-04 0.33500942 0.4262393 331 62
+4.5 0.3806244 4.5 5.416492e-04 0.33500942 0.4262393 280 0
+5 0.4792121 5.0 5.480328e-04 0.43332915 0.5250951 283 48
+5.5 0.4792121 5.5 5.480328e-04 0.43332915 0.5250951 248 0
+6 0.5692649 6.0 5.141238e-04 0.52482414 0.6137058 249 47
+7 0.6349924 7.0 4.665144e-04 0.59265929 0.6773256 212 36
+8 0.6794916 8.0 4.202391e-04 0.63931284 0.7196703 195 27
+8.5 0.6794916 8.5 4.202391e-04 0.63931284 0.7196703 172 0
+9 0.7324895 9.0 3.579860e-04 0.69540594 0.7695730 173 34
+10 0.7646506 10.0 3.140867e-04 0.72991512 0.7993860 148 21
+10.5 0.7646506 10.5 3.140867e-04 0.72991512 0.7993860 135 0
+11 0.7894789 11.0 2.789769e-04 0.75674237 0.8222154 136 18
+12 0.8137852 12.0 2.419720e-04 0.78329710 0.8442733 129 18
+12.5 0.8137852 12.5 2.419720e-04 0.78329710 0.8442733 117 0
+13 0.8293991 13.0 2.181963e-04 0.80044760 0.8583507 118 13
+14 0.8451773 14.0 1.938437e-04 0.81788913 0.8724654 115 14
+15 0.8624687 15.0 1.670243e-04 0.83713851 0.8877988 106 15
+16 0.8722513 16.0 1.522153e-04 0.84807011 0.8964324 93 9
+17 0.8851601 17.0 1.329865e-04 0.86255784 0.9077624 86 12
+17.5 0.8851601 17.5 1.329865e-04 0.86255784 0.9077624 77 0
+18 0.8960254 18.0 1.167891e-04 0.87484428 0.9172066 76 9
+19 0.9028854 19.0 1.069942e-04 0.88261196 0.9231589 71 7
+20 0.9125267 20.0 9.367135e-05 0.89355740 0.9314960 64 10
+21 0.9161439 21.0 8.878103e-05 0.89767636 0.9346114 57 4
+22 0.9225643 22.0 7.995614e-05 0.90503865 0.9400899 55 6
+23 0.9260521 23.0 7.536948e-05 0.90903660 0.9430677 51 4
+23.5 0.9260521 23.5 7.536948e-05 0.90903660 0.9430677 49 0
+24 0.9353639 24.0 6.292082e-05 0.91981690 0.9509108 50 9
+25 0.9385430 25.0 5.877878e-05 0.92351645 0.9535695 42 3
+26 0.9429383 26.0 5.325890e-05 0.92863472 0.9572418 39 5
+27 0.9476771 27.0 4.748795e-05 0.93417068 0.9611835 35 6
+27.5 0.9476771 27.5 4.748795e-05 0.93417068 0.9611835 29 0
+28 0.9531288 28.0 4.092631e-05 0.94059022 0.9656674 30 5
+29 0.9567220 29.0 3.667615e-05 0.94485230 0.9685917 31 4
+30 0.9591876 30.0 3.383912e-05 0.94778617 0.9705889 28 3
+30.5 0.9591876 30.5 3.383912e-05 0.94778617 0.9705889 29 0
+31 0.9642349 31.0 2.820676e-05 0.95382549 0.9746442 30 6
+32 0.9648667 32.0 2.752066e-05 0.95458472 0.9751487 25 1
+33 0.9669455 33.0 2.533123e-05 0.95708094 0.9768100 24 2
+34 0.9685356 34.0 2.367984e-05 0.95899806 0.9780732 26 2
+35 0.9696628 35.0 2.251767e-05 0.96036219 0.9789633 28 2
+36 0.9702263 36.0 2.194423e-05 0.96104495 0.9794077 26 1
+37 0.9717546 37.0 2.043249e-05 0.96289513 0.9806141 26 2
+38 0.9739393 38.0 1.831026e-05 0.96555250 0.9823261 25 4
+38.5 0.9739393 38.5 1.831026e-05 0.96555250 0.9823261 21 0
+39 0.9759610 39.0 1.643312e-05 0.96801570 0.9839062 23 3
+40 0.9769163 40.0 1.557773e-05 0.96918064 0.9846521 19 1
+41 0.9774305 41.0 1.511599e-05 0.96981026 0.9850507 22 1
+42 0.9778509 42.0 1.475784e-05 0.97032155 0.9853803 22 0
+43 0.9798010 43.0 1.307925e-05 0.97271272 0.9868892 22 3
+44 0.9803023 44.0 1.265491e-05 0.97333000 0.9872746 21 1
+45 0.9816513 45.0 1.156647e-05 0.97498560 0.9883171 19 1
+46 0.9821527 46.0 1.115820e-05 0.97560565 0.9886997 17 1
+47 0.9831389 47.0 1.037038e-05 0.97682722 0.9894506 18 2
+48 0.9836281 48.0 9.986572e-06 0.97743435 0.9898219 17 1
+49 0.9840553 49.0 9.669176e-06 0.97796078 0.9901499 17 0
+50 0.9845409 50.0 9.296786e-06 0.97856487 0.9905170 17 1
+50.5 0.9845409 50.5 9.296786e-06 0.97856487 0.9905170 16 0
+51 0.9859918 51.0 8.213748e-06 0.98037462 0.9916090 17 3
+52 0.9869591 52.0 7.512700e-06 0.98158694 0.9923312 14 2
+53 0.9878950 53.0 6.874544e-06 0.98275613 0.9930339 12 1
+54 0.9888571 54.0 6.213830e-06 0.98397136 0.9937428 12 2
+55 0.9903001 55.0 5.253896e-06 0.98580762 0.9947926 10 3
+56 0.9912678 56.0 4.666932e-06 0.98703372 0.9955020 6 1
+57 0.9917489 57.0 4.363513e-06 0.98765469 0.9958430 5 1
+58 0.9922299 58.0 4.064246e-06 0.98827860 0.9961812 4 1
+59 0.9927109 59.0 3.769130e-06 0.98890578 0.9965160 3 1
+60 0.9931938 60.0 3.488235e-06 0.98953323 0.9968544 3 1
+62 0.9936805 62.0 3.229764e-06 0.99015816 0.9972029 2 0
+63 0.9941634 63.0 2.955869e-06 0.99079373 0.9975331 2 1
+68 0.9941634 68.0 2.955869e-06 0.99079373 0.9975331 1 0
+70 0.9946482 70.0 2.693997e-06 0.99143126 0.9978652 2 1
+78 0.9951349 78.0 2.442281e-06 0.99207193 0.9981979 1 0
+80 0.9951349 80.0 2.442281e-06 0.99207193 0.9981979 1 0
+85 0.9965950 85.0 1.695084e-06 0.99404323 0.9991468 2 0
+89 0.9965950 89.0 1.695084e-06 0.99404323 0.9991468 2 0
+90 0.9965950 90.0 1.695084e-06 0.99404323 0.9991468 1 0
+95 0.9970816 95.0 1.448382e-06 0.99472276 0.9994403 2 0
+100 0.9975681 100.0 1.203159e-06 0.99541824 0.9997180 3 0
+101 0.9980544 101.0 9.591818e-07 0.99613482 0.9999739 3 1
+108 0.9985406 108.0 7.169274e-07 0.99688111 1.0000000 2 1
+113 0.9990272 113.0 4.763877e-07 0.99767440 1.0000000 1 0
+116 0.9990272 116.0 4.763877e-07 0.99767440 1.0000000 1 0
+124 0.9990272 124.0 4.763877e-07 0.99767440 1.0000000 2 0
+130 0.9990272 130.0 4.763877e-07 0.99767440 1.0000000 1 0
+164 0.9990272 164.0 4.763877e-07 0.99767440 1.0000000 0 0
+183 1.0000000 183.0 -2.864030e-20 NaN NaN 1 1
+>
+> ## gonna play a bit with the state names
+> dd <- sir.cont
+> dd$from <- ifelse(dd$from == 0, "initial state", "ventilation")
+> dd$to <- as.character(dd$to)
+> for (i in seq_len(nrow(dd))) {
++ dd$to[i] <- switch(dd$to[i],
++ "0" = "initial state",
++ "1" = "ventilation",
++ "2" = "end of story",
++ "cens" = "cens"
++ )
++ }
+>
+> test <- etm(dd, c("initial state", "ventilation", "end of story"), tra, "cens", 1)
+>
+> all.equal(test$est["initial state", "initial state", ],
++ prob.sir$est["0", "0", ])
+[1] TRUE
+> all.equal(trprob(test, "initial state initial state"), trprob(prob.sir, "0 0"))
+[1] TRUE
+> all.equal(trprob(test, "initial state ventilation"), trprob(prob.sir, "0 1"))
+[1] TRUE
+> all.equal(trprob(test, "initial state end of story"), trprob(prob.sir, "0 2"))
+[1] TRUE
+>
+> all.equal(trcov(test, "initial state end of story"), trcov(prob.sir, "0 2"))
+[1] TRUE
+>
+> aa <- summary(test)
+Warning messages:
+1: In sqrt(var) : NaNs produced
+2: In sqrt(var) : NaNs produced
+> all.equal(summ.sir[[6]], aa[[6]])
+[1] TRUE
+> all.equal(summ.sir[[4]], aa[[4]])
+[1] TRUE
+>
+> ### Test on abortion data
+>
+> data(abortion)
+>
+> from <- rep(0, nrow(abortion))
+> to <- abortion$cause
+> entry <- abortion$entry
+> exit <- abortion$exit
+> id <- 1:nrow(abortion)
+> data <- data.frame(id, from, to, entry, exit, group = abortion$group)
+>
+> ## Computation of the CIFs
+> tra <- matrix(FALSE, 4, 4)
+> tra[1, 2:4] <- TRUE
+>
+> cif.control <- etm(data[data$group == 0, ], c("0", "1", "2", "3"),
++ tra, NULL, 0)
+> cif.exposed <- etm(data[data$group == 1, ], c("0", "1", "2", "3"),
++ tra, NULL, 0)
+>
+> all.equal(trprob(cif.control, "0 1"), cif.control$est["0", "1", ])
+[1] TRUE
+> all.equal(trcov(cif.control, c("0 1", "0 2")), cif.control$cov["0 1", "0 2", ])
+[1] TRUE
+>
+> trprob(cif.control, "0 1")
+ 4 5 6 7 8 9
+0.000000000 0.000000000 0.000000000 0.007400858 0.014880870 0.026509184
+ 10 11 12 13 14 15
+0.033207696 0.037694266 0.037694266 0.038954884 0.040159308 0.040159308
+ 16 17 18 19 20 21
+0.040159308 0.040159308 0.040159308 0.040159308 0.040159308 0.040159308
+ 22 23 24 25 26 27
+0.040159308 0.040159308 0.040159308 0.040159308 0.040159308 0.040159308
+ 28 29 30 31 32 33
+0.040159308 0.040159308 0.040159308 0.040159308 0.040159308 0.040159308
+ 34 35 36 37 38 39
+0.040159308 0.040159308 0.040159308 0.040159308 0.040159308 0.040159308
+ 40 41 42 43
+0.040159308 0.040159308 0.040159308 0.040159308
+> trprob(cif.control, "0 2")
+ 4 5 6 7 8 9
+0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
+ 10 11 12 13 14 15
+0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
+ 16 17 18 19 20 21
+0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
+ 22 23 24 25 26 27
+0.000000000 0.000000000 0.000000000 0.000000000 0.000000000 0.000000000
+ 28 29 30 31 32 33
+0.000000000 0.000000000 0.003656854 0.006371445 0.008175002 0.013542879
+ 34 35 36 37 38 39
+0.023317266 0.031259966 0.053197090 0.084528525 0.179162614 0.322015902
+ 40 41 42 43
+0.563120872 0.742227421 0.793892771 0.799059306
+> trprob(cif.control, "0 0")
+ 4 5 6 7 8 9
+1.000000000 1.000000000 0.965811966 0.932508105 0.887628036 0.862433353
+ 10 11 12 13 14 15
+0.838988563 0.822537807 0.813098849 0.810577612 0.806964339 0.806964339
+ 16 17 18 19 20 21
+0.806964339 0.805873846 0.805873846 0.803810149 0.803810149 0.802804129
+ 22 23 24 25 26 27
+0.802804129 0.802804129 0.801836895 0.800883462 0.799936791 0.799936791
+ 28 29 30 31 32 33
+0.799936791 0.799936791 0.796279938 0.793565347 0.791761789 0.786393913
+ 34 35 36 37 38 39
+0.776619525 0.768676825 0.745862216 0.714530781 0.619896693 0.477043404
+ 40 41 42 43
+0.235938435 0.056831886 0.005166535 0.000000000
+>
+> trcov(cif.control, "0 1")
+ 4 5 6 7 8 9
+0.000000e+00 0.000000e+00 0.000000e+00 2.719306e-05 4.532753e-05 6.665019e-05
+ 10 11 12 13 14 15
+7.698480e-05 8.304209e-05 8.304209e-05 8.444048e-05 8.570657e-05 8.570657e-05
+ 16 17 18 19 20 21
+8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05
+ 22 23 24 25 26 27
+8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05
+ 28 29 30 31 32 33
+8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05
+ 34 35 36 37 38 39
+8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05
+ 40 41 42 43
+8.570657e-05 8.570657e-05 8.570657e-05 8.570657e-05
+> trcov(cif.control, "0 2")
+ 4 5 6 7 8 9
+0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
+ 10 11 12 13 14 15
+0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
+ 16 17 18 19 20 21
+0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
+ 22 23 24 25 26 27
+0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
+ 28 29 30 31 32 33
+0.000000e+00 0.000000e+00 3.338155e-06 5.784419e-06 7.401205e-06 1.216141e-05
+ 34 35 36 37 38 39
+2.071916e-05 2.757764e-05 4.619460e-05 7.202415e-05 1.460900e-04 2.469805e-04
+ 40 41 42 43
+3.880102e-04 4.701879e-04 4.903148e-04 4.922394e-04
+> trcov(cif.control, "0 0")
+ 4 5 6 7 8 9
+0.000000e+00 0.000000e+00 2.822155e-04 3.820769e-04 4.527000e-04 4.748082e-04
+ 10 11 12 13 14 15
+4.875383e-04 4.927267e-04 4.940647e-04 4.941740e-04 4.941106e-04 4.941106e-04
+ 16 17 18 19 20 21
+4.941106e-04 4.939636e-04 4.939636e-04 4.935609e-04 4.935609e-04 4.933371e-04
+ 22 23 24 25 26 27
+4.933371e-04 4.933371e-04 4.930834e-04 4.928195e-04 4.925502e-04 4.925502e-04
+ 28 29 30 31 32 33
+4.925502e-04 4.925502e-04 4.913851e-04 4.904884e-04 4.898842e-04 4.880340e-04
+ 34 35 36 37 38 39
+4.845548e-04 4.816321e-04 4.728916e-04 4.601194e-04 4.175917e-04 3.424805e-04
+ 40 41 42 43
+1.864578e-04 4.796800e-05 4.440837e-06 0.000000e+00
+>
+> aa <- summary(cif.control)
+> aa$"0 1"
+ P time var lower upper n.risk n.event
+4 0.000000000 4 0.000000e+00 0.00000000 0.00000000 18 0
+5 0.000000000 5 0.000000e+00 0.00000000 0.00000000 18 0
+6 0.000000000 6 0.000000e+00 0.00000000 0.00000000 117 0
+7 0.007400858 7 2.719306e-05 0.00000000 0.01762148 261 2
+8 0.014880870 8 4.532753e-05 0.00168527 0.02807647 374 3
+9 0.026509184 9 6.665019e-05 0.01050812 0.04251025 458 6
+10 0.033207696 10 7.698480e-05 0.01601078 0.05040461 515 4
+11 0.037694266 11 8.304209e-05 0.01983362 0.05555491 561 3
+12 0.037694266 12 8.304209e-05 0.01983362 0.05555491 610 0
+13 0.038954884 13 8.444048e-05 0.02094448 0.05696529 645 1
+14 0.040159308 14 8.570657e-05 0.02201438 0.05830423 673 1
+15 0.040159308 15 8.570657e-05 0.02201438 0.05830423 696 0
+16 0.040159308 16 8.570657e-05 0.02201438 0.05830423 714 0
+17 0.040159308 17 8.570657e-05 0.02201438 0.05830423 740 0
+18 0.040159308 18 8.570657e-05 0.02201438 0.05830423 759 0
+19 0.040159308 19 8.570657e-05 0.02201438 0.05830423 781 0
+20 0.040159308 20 8.570657e-05 0.02201438 0.05830423 786 0
+21 0.040159308 21 8.570657e-05 0.02201438 0.05830423 799 0
+22 0.040159308 22 8.570657e-05 0.02201438 0.05830423 810 0
+23 0.040159308 23 8.570657e-05 0.02201438 0.05830423 819 0
+24 0.040159308 24 8.570657e-05 0.02201438 0.05830423 830 0
+25 0.040159308 25 8.570657e-05 0.02201438 0.05830423 841 0
+26 0.040159308 26 8.570657e-05 0.02201438 0.05830423 846 0
+27 0.040159308 27 8.570657e-05 0.02201438 0.05830423 853 0
+28 0.040159308 28 8.570657e-05 0.02201438 0.05830423 860 0
+29 0.040159308 29 8.570657e-05 0.02201438 0.05830423 870 0
+30 0.040159308 30 8.570657e-05 0.02201438 0.05830423 875 0
+31 0.040159308 31 8.570657e-05 0.02201438 0.05830423 880 0
+32 0.040159308 32 8.570657e-05 0.02201438 0.05830423 880 0
+33 0.040159308 33 8.570657e-05 0.02201438 0.05830423 885 0
+34 0.040159308 34 8.570657e-05 0.02201438 0.05830423 885 0
+35 0.040159308 35 8.570657e-05 0.02201438 0.05830423 880 0
+36 0.040159308 36 8.570657e-05 0.02201438 0.05830423 876 0
+37 0.040159308 37 8.570657e-05 0.02201438 0.05830423 857 0
+38 0.040159308 38 8.570657e-05 0.02201438 0.05830423 823 0
+39 0.040159308 39 8.570657e-05 0.02201438 0.05830423 716 0
+40 0.040159308 40 8.570657e-05 0.02201438 0.05830423 554 0
+41 0.040159308 41 8.570657e-05 0.02201438 0.05830423 274 0
+42 0.040159308 42 8.570657e-05 0.02201438 0.05830423 66 0
+43 0.040159308 43 8.570657e-05 0.02201438 0.05830423 6 0
+> all.equal(aa$"0 1"$P, as.vector(trprob(cif.control, "0 1")))
+[1] TRUE
+>
+> ### test on los data
+>
+> data(los.data) # in package changeLOS
+>
+> ## putting los.data in the long format (see changeLOS)
+> my.observ <- prepare.los.data(x=los.data)
+>
+> tra <- matrix(FALSE, 4, 4)
+> tra[1, 2:4] <- TRUE
+> tra[2, 3:4] <- TRUE
+>
+> tr.prob <- etm(my.observ, c("0","1","2","3"), tra, NULL, 0)
+>
+> tr.prob
+Multistate model with 2 transient state(s)
+ and 2 absorbing state(s)
+
+Possible transitions:
+ from to
+ 0 1
+ 0 2
+ 0 3
+ 1 2
+ 1 3
+
+Estimate of P(0, 82)
+ 0 1 2 3
+0 0 0 0.7473545 0.2526455
+1 0 0 0.7072985 0.2927015
+2 0 0 1.0000000 0.0000000
+3 0 0 0.0000000 1.0000000
+
+Estimate of cov(P(0, 82))
+ 0 0 1 0 2 0 3 0 0 1 1 1 2 1 3 1 0 2 1 2 2 2 3 2
+0 0 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0
+1 0 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0
+2 0 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0
+3 0 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0
+0 1 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0
+1 1 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0
+2 1 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0
+3 1 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0
+0 2 0 0 0 0 0 0 0 0 0.0002497563 0.0002738457 0 0
+1 2 0 0 0 0 0 0 0 0 0.0002738457 0.0019836077 0 0
+2 2 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0
+3 2 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0
+0 3 0 0 0 0 0 0 0 0 -0.0002497563 -0.0002738457 0 0
+1 3 0 0 0 0 0 0 0 0 -0.0002738457 -0.0019836077 0 0
+2 3 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0
+3 3 0 0 0 0 0 0 0 0 0.0000000000 0.0000000000 0 0
+ 0 3 1 3 2 3 3 3
+0 0 0.0000000000 0.0000000000 0 0
+1 0 0.0000000000 0.0000000000 0 0
+2 0 0.0000000000 0.0000000000 0 0
+3 0 0.0000000000 0.0000000000 0 0
+0 1 0.0000000000 0.0000000000 0 0
+1 1 0.0000000000 0.0000000000 0 0
+2 1 0.0000000000 0.0000000000 0 0
+3 1 0.0000000000 0.0000000000 0 0
+0 2 -0.0002497563 -0.0002738457 0 0
+1 2 -0.0002738457 -0.0019836077 0 0
+2 2 0.0000000000 0.0000000000 0 0
+3 2 0.0000000000 0.0000000000 0 0
+0 3 0.0002497563 0.0002738457 0 0
+1 3 0.0002738457 0.0019836077 0 0
+2 3 0.0000000000 0.0000000000 0 0
+3 3 0.0000000000 0.0000000000 0 0
+> summary(tr.prob)
+Transition 0 1
+ P time var lower upper n.risk n.event
+ 0.017195767 3 2.235459e-05 0.0079289311 0.02646260 756 13
+ 0.063492063 15 7.865188e-05 0.0461099474 0.08087418 90 0
+ 0.030423280 27 3.901813e-05 0.0181804650 0.04266610 26 1
+ 0.015873016 41 2.066278e-05 0.0069637383 0.02478229 5 0
+ 0.005291005 61 6.961654e-06 0.0001196507 0.01046236 3 0
+ 0.000000000 82 0.000000e+00 0.0000000000 0.00000000 1 0
+
+Transition 0 2
+ P time var lower upper n.risk n.event
+ 0.08465608 3 0.0001024992 0.06481303 0.1044991 756 64
+ 0.62301587 15 0.0003106708 0.58846983 0.6575619 90 4
+ 0.69841270 27 0.0002786143 0.66569748 0.7311279 26 1
+ 0.72751323 41 0.0002622192 0.69577517 0.7592513 5 0
+ 0.74074074 61 0.0002540263 0.70950244 0.7719790 3 1
+ 0.74735450 82 0.0002497563 0.71637985 0.7783291 1 1
+
+Transition 0 3
+ P time var lower upper n.risk n.event
+ 0.01587302 3 2.066278e-05 0.006963738 0.02478229 756 12
+ 0.20105820 15 2.124786e-04 0.172488502 0.22962790 90 1
+ 0.23941799 27 2.408691e-04 0.208999432 0.26983655 26 0
+ 0.25000000 41 2.480159e-04 0.219133469 0.28086653 5 0
+ 0.25132275 61 2.488884e-04 0.220401973 0.28224353 3 0
+ 0.25264550 82 2.497563e-04 0.221670860 0.28362015 1 0
+
+Transition 1 2
+ P time var lower upper n.risk n.event
+ 0.0000000 3 0.000000000 0.0000000 0.0000000 0 0
+ 0.4106972 15 0.002589866 0.3109532 0.5104412 51 2
+ 0.6081627 27 0.002253890 0.5151131 0.7012123 23 1
+ 0.6651925 41 0.002064292 0.5761426 0.7542425 14 2
+ 0.6919872 61 0.002000374 0.6043268 0.7796477 4 0
+ 0.7072985 82 0.001983608 0.6200062 0.7945908 0 0
+
+Transition 1 3
+ P time var lower upper n.risk n.event
+ 0.0000000 3 0.000000000 0.0000000 0.0000000 0 0
+ 0.2026916 15 0.001784251 0.1199019 0.2854812 51 1
+ 0.2706490 27 0.001967639 0.1837087 0.3575892 23 0
+ 0.2888737 41 0.001981661 0.2016242 0.3761232 14 0
+ 0.2927015 61 0.001983608 0.2054092 0.3799938 4 0
+ 0.2927015 82 0.001983608 0.2054092 0.3799938 0 0
+
+Transition 0 0
+ P time var lower upper n.risk n.event
+ 0.882275132 3 1.373885e-04 0.859301836 0.905248429 756 0
+ 0.112433862 15 1.320006e-04 0.089915535 0.134952189 90 0
+ 0.031746032 27 4.065902e-05 0.019248434 0.044243630 26 0
+ 0.006613757 41 8.690496e-06 0.000835852 0.012391661 5 0
+ 0.002645503 61 3.490085e-06 0.000000000 0.006307062 3 0
+ 0.000000000 82 0.000000e+00 0.000000000 0.000000000 1 0
+
+Transition 1 1
+ P time var lower upper n.risk n.event
+ 1.00000000 3 0.000000e+00 1.00000000 1.00000000 0 0
+ 0.38661119 15 2.358121e-03 0.29143438 0.48178801 51 0
+ 0.12118830 27 7.841875e-04 0.06630275 0.17607386 23 0
+ 0.04593378 41 2.404897e-04 0.01553918 0.07632837 14 0
+ 0.01531126 61 6.579352e-05 0.00000000 0.03120916 4 0
+ 0.00000000 82 0.000000e+00 0.00000000 0.00000000 0 0
+
+>
+> cLOS <- etm::clos(tr.prob, aw = TRUE)
+>
+> cLOS
+The expected change in length of stay is:
+1.975
+
+Alternative weighting:
+
+Expected change in LOS with weight.1: 2.097
+Expected change in LOS with weight.other: 1.951
+>
+>
+> ### Tests on pseudo values
+> t_pseudo <- closPseudo(my.observ, c("0","1","2","3"), tra, NULL,
++ formula = ~ 1, aw = TRUE)
+>
+> cLOS$e.phi == t_pseudo$theta[, "e.phi"]
+ [,1]
+[1,] TRUE
+> cLOS$e.phi.weights.1 == t_pseudo$theta[, "e.phi.weights.1"]
+ [,1]
+[1,] TRUE
+> cLOS$e.phi.weights.other == t_pseudo$theta[, "e.phi.weights.other"]
+ [,1]
+[1,] TRUE
+>
+> mean(t_pseudo$pseudoData$ps.e.phi)
+[1] 1.968323
+>
+> ### tests on etmprep
+>
+> ### creation of fake data in the wild format, following an illness-death model
+> ## transition times
+> tdisease <- c(3, 4, 3, 6, 8, 9)
+> tdeath <- c(6, 9, 8, 6, 8, 9)
+>
+> ## transition status
+> stat.disease <- c(1, 1, 1, 0, 0, 0)
+> stat.death <- c(1, 1, 1, 1, 1, 0)
+>
+> ## a covariate that we want to keep in the new data
+> set.seed(1313)
+> cova <- rbinom(6, 1, 0.5)
+>
+> dat <- data.frame(tdisease, tdeath,
++ stat.disease, stat.death,
++ cova)
+>
+> ## Possible transitions
+> tra <- matrix(FALSE, 3, 3)
+> tra[1, 2:3] <- TRUE
+> tra[2, 3] <- TRUE
+>
+> ## data preparation
+> newdat <- etmprep(c(NA, "tdisease", "tdeath"),
++ c(NA, "stat.disease", "stat.death"),
++ data = dat, tra = tra,
++ cens.name = "cens", keep = "cova")
+>
+> newdat
+ id entry exit from to cova
+1 1 0 3 0 1 1
+2 1 3 6 1 2 1
+3 2 0 4 0 1 0
+4 2 4 9 1 2 0
+5 3 0 3 0 1 1
+6 3 3 8 1 2 1
+7 4 0 6 0 2 0
+8 5 0 8 0 2 1
+9 6 0 9 0 cens 1
+>
+> ref <- data.frame(id = c(1, 1, 2, 2, 3, 3, 4, 5, 6),
++ entry = c(0, 3, 0, 4, 0, 3, 0, 0, 0),
++ exit = c(3, 6, 4, 9, 3, 8, 6, 8, 9),
++ from = c(0, 1, 0, 1, 0, 1, 0, 0, 0),
++ to = c(rep(c(1, 2), 3), 2, 2, "cens"),
++ cova = c(1, 1, 0, 0, 1, 1, 0, 1, 1))
+> ref$from <- factor(as.character(ref$from), levels = c("0", "1", "2", "cens"))
+> ref$to <- factor(as.character(ref$to), levels = c("0", "1", "2", "cens"))
+>
+> all.equal(ref, newdat)
+[1] TRUE
+>
+> proc.time()
+ user system elapsed
+ 9.036 0.031 9.055
diff --git a/vignettes/etmCIF_tutorial.Rnw b/vignettes/etmCIF_tutorial.Rnw
new file mode 100644
index 0000000..d75ccd1
--- /dev/null
+++ b/vignettes/etmCIF_tutorial.Rnw
@@ -0,0 +1,302 @@
+%\VignetteIndexEntry{Computing Cumulative Incidence Functions with the etmCIF Function}
+
+\documentclass{article}
+
+\usepackage{amsmath, amssymb}
+\usepackage{graphicx}
+\usepackage{url}
+\usepackage[pdftex]{color}
+\usepackage[round]{natbib}
+
+\SweaveOpts{keep.source=TRUE,eps=FALSE}
+
+\title{Computing Cumulative Incidence Functions with the {\tt etmCIF}
+ Function, with a view Towards Pregnancy Applications}
+
+\author{Arthur Allignol}
+
+\date{}
+
+\begin{document}
+
+\maketitle
+
+\section{Introduction}
+
+This paper documents the use of the {\tt etmCIF} function to compute
+the cumulative incidence function (CIF) in pregnancy data.
+
+\section{Data Example}
+
+The data set {\tt abortion}, included in the {\bf etm} package will be
+used to illustrate the computation of the CIFs. We first load the {\bf
+ etm} package and the data set.
+<<>>=
+require(etm)
+data(abortion)
+@
+
+Briefly, the data set contains information on \Sexpr{nrow(abortion)}
+pregnant women collected prospectively by the Teratology Information
+Service of Berlin, Germany \citep{meister}. Among these pregnant women,
+\Sexpr{with(abortion, table(group)[2])} were exposed therapeutically
+to coumarin derivatives, a class of orally active anticoagulant, and
+\Sexpr{with(abortion, table(group)[1])} women served as
+controls. Coumarin derivatives are suspected to increase the number of
+spontaneous abortions. Competing events are elective abortion (ETOP) and
+life birth.
+
+Below is an excerpt of the data set
+<<>>=
+head(abortion)
+@
+
+{\tt id} is the individual number, {\tt entry} is the gestational age
+at which the women entered the study, {\tt exit} is the gestational
+age at the end of pregnancy, {\tt group} is the group membership (0
+for controls and 1 for the women exposed to coumarin derivatives) and
+{\tt cause} is the cause of end of pregnancy (1 for induced abortion, 2 for
+life birth and 3 for spontaneous abortion.)
+
+\section{Computing and plotting the CIFs}
+
+\subsection{The {\tt etmCIF} function}
+
+The CIFs are computed using the {\tt etmCIF} function. It is a
+wrapper around the {\tt etm} function, meant
+to facilitate the computation of the CIFs. {\tt etmCIF} takes as arguments
+\begin{itemize}
+\item {\tt formula}: A formula consisting of a {\tt Surv} object on
+ the left of a {\tt ~} operator, and the group covariate on the
+ right. A {\tt Surv} object is for example created this way: {\tt
+ Surv(entry, exit, cause != 0)}. We need to specify the entry
+ time ({\tt entry}), the gestational age at end of pregnancy ({\tt
+ exit}), and an event indicator ({\tt cause != 0}). The latter
+ means that any value different from 0 in {\tt cause} will be
+ considered as an event -- which is the case in our example, as we
+ don't have censoring.
+
+\item {\tt data}: A data set in which to interpret the terms of the
+ formula. In our case, it will be {\tt abortion}.
+
+\item {\tt etype}: Competing risks event indicator. When the status
+ indicator is 1 (or TRUE) in the formula, {\tt etype} describes the
+ type of event, otherwise, for censored observation, the value of
+ {\tt etype} is ignored.
+
+\item {\tt failcode}: Indicates the failure type of interest. Default
+ is one. This option is only interesting for some features of the
+ plot function.
+\end{itemize}
+
+\subsection{Estimation and display of the CIFs}
+
+We know compute the CIFs
+<<>>=
+cif.abortion <- etmCIF(Surv(entry, exit, cause != 0) ~ group,
+ abortion, etype = cause, failcode = 3)
+cif.abortion
+@
+
+Above is the display provided by the {\tt print} function. It gives,
+at the last event time, the probabilities ({\tt P}) standard errors
+({\tt se(P)}), and the total number of events ({\tt n.event}) for the
+three possible pregnancy outcomes and for both groups.
+
+More information is provided by the {\tt summary} function.
+<<>>=
+s.cif.ab <- summary(cif.abortion)
+@
+
+The function returns a list of data.frames that contain probabilities,
+variances, pointwise confidence intervals, number at risk and number
+of events for each event times. the {\tt print} function displays this
+information for some selected event times.
+<<>>=
+s.cif.ab
+@
+
+\subsection{Plotting the CIFs}
+
+Interest lies in the CIFs of spontaneous abortion. We display them
+using the {\tt plot} function, which by default, plots only the the
+CIFs for the event of interest, i.e., the one specified in {\tt
+ failcode}.
+\setkeys{Gin}{width=0.9\textwidth}
+\begin{figure}[!htb]
+\begin{center}
+<<fig = TRUE, width = 10, height = 10>>=
+plot(cif.abortion)
+@
+\caption{CIFs of spontaneous abortion for the controls (solid line)
+ and the exposed (dashed line), using the default settings of the
+ {\tt plot} function.}
+\end{center}
+\end{figure}
+
+\clearpage
+
+We now add confidence intervals taken at week 27, plus a
+bit of customisation.
+\setkeys{Gin}{width=0.9\textwidth}
+\begin{figure}[!htb]
+\begin{center}
+<<fig = TRUE, width = 10, height = 10>>=
+plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6),
+ ci.type = "bars", pos.ci = 27, col = c(1, 2), ci.lwd = 6,
+ lwd = 2, lty = 1, cex = 1.3)
+@
+\caption{CIFs of spontaneous abortion for the controls (black) and the
+ exposed (red), along with pointwise confidence intervals taken at
+ week 27.}
+\end{center}
+\end{figure}
+
+\clearpage
+
+When the figure is to be in black and white, or when the confidence
+intervals are not as separated as in this example, it might be a good
+idea to shift slightly one of the bar representing the confidence
+interval, so that the two bars don't overlap. This might be done
+manipulating the {\tt pos.ci} argument:
+
+\setkeys{Gin}{width=0.9\textwidth}
+\begin{figure}[!htb]
+\begin{center}
+<<fig = TRUE, width = 10, height = 10>>=
+plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6),
+ ci.type = "bars", pos.ci = c(27, 28), col = c(1, 1), ci.lwd = 6,
+ lwd = 2, lty = c(2, 1), cex = 1.3)
+@
+\caption{CIFs of spontaneous abortion for the controls (dashed line) and the
+ exposed (solid line), along with pointwise confidence intervals.}\label{decalage}
+\end{center}
+\end{figure}
+
+\clearpage
+
+Pointwise confidence intervals can also be plotted for the whole
+follow-up period.
+\begin{figure}[!htb]
+\begin{center}
+<<fig = TRUE, width = 10, height = 10>>=
+plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.5),
+ ci.type = "pointwise", col = c(1, 2), lwd = 2, lty = 1, cex = 1.3)
+@
+\caption{Same as the last pictures, except for the confidence
+ intervals, that are displayed for the whole follow-up period.}
+\end{center}
+\end{figure}
+
+\clearpage
+
+CIFs for other pregnancy outcomes can also be plotted using the {\tt
+ which.cif} arguments. For instance, for plotting the CIFs of ETOP
+and life birth on the same graph, we specify {\tt which.cif = c(1, 2)}
+in the call to {\tt plot}.
+\begin{figure}[!htb]
+\begin{center}
+<<fig = TRUE, width = 10, height = 10>>=
+plot(cif.abortion, which.cif = c(1, 2), ylim = c(0, 0.8), lwd = 2,
+ col = c(1, 1, 2, 2), lty = c(1, 2, 1, 2), legend = FALSE)
+legend(0, 0.8, c("Control", "Exposed"), col = c(1, 2), lty = 1,
+ bty = "n", lwd = 2)
+legend(0, 0.7, c("ETOP", "Life Birth"), col = 1, lty = c(1, 2),
+ bty = "n", lwd = 2)
+@
+\end{center}
+\caption{CIFs of ETOP (solid lines) and life birth (dashed lines) for
+ the exposed, in red, and the controls, in black.}
+\end{figure}
+
+\clearpage
+
+\subsection{Some More Features}
+
+\paragraph{Competing event names}
+
+For those who don't like using plain numbers for naming the competing
+events or the group allocation, it is of course possible to give more
+informative names, either as factors or character vectors. For
+instance, we define a new group variable that takes value {\tt 'control'}
+or {\tt 'exposed'}, and we give more informative names for the pregnancy
+outcomes.
+
+<<>>=
+abortion$status <- with(abortion, ifelse(cause == 2, "life birth",
+ ifelse(cause == 1, "ETOP", "spontaneous abortion")))
+abortion$status <- factor(abortion$status)
+
+abortion$treat <- with(abortion, ifelse(group == 0, "control", "exposed"))
+abortion$treat <- factor(abortion$treat)
+@
+
+We can compute the CIFs as before, taking care of changing the {\tt failcode} argument.
+
+<<>>=
+new.cif <- etmCIF(Surv(entry, exit, status != 0) ~ treat, abortion,
+ etype = status, failcode = "spontaneous abortion")
+new.cif
+@
+
+The {\tt summary} and {\tt plot} functions will work as before, except
+for a more informative outcome from scratch.
+
+\paragraph{Taking advantage of the miscellaneous functions defined for
+ {\tt etm} objects}
+
+The {\tt etmCIF} function uses the more general {\tt etm} machinery
+for computing the CIFs. Thus the returned {\tt etmCIF} object is for
+part a list of {\tt etm} objects (one for each covariate level). It is
+therefore relatively easy to use the methods defined for {\tt etm} on
+{\tt etmCIF} objects.
+
+An example would be to use the {\tt trprob} function to extract the
+CIF of spontaneous abortion for the controls. This function takes as
+arguments an {\tt etm} object, the transition we are interested in, in
+the form ``from to'' (the state a patient comes from is automatically
+defined as being 0 in {\tt etmCIF}), and possibly some time points.
+Using {\tt new.cif} from the example above:
+<<>>=
+trprob(new.cif[[1]], "0 spontaneous abortion", c(1, 10, 27))
+@
+We applied the {\tt trprob} function to the {\tt etm} object for the
+controls (which is in the first item of the output, for the exposed in
+the second). The transition of interest is from {\tt 0} to {\tt
+ spontaneous abortion}, and we want the CIF at weeks 1, 10 and 27
+(just put nothing if you want the CIF for all time points).
+
+Another example would be to use the {\tt lines} function to add a CIF
+to an existing plot. The following code snippet adds the CIF of ETOP
+for the exposed to Figure \ref{decalage}. That's the {\tt tr.choice}
+arguments that defines which CIF to pick. It works in the same way as
+in the {\tt trprob} function.
+
+<<eval = FALSE>>=
+lines(cif.abortion[[2]], tr.choice = "0 1", col = 2, lwd = 2)
+@
+\setkeys{Gin}{width=0.9\textwidth}
+\begin{figure}[!htb]
+\begin{center}
+<<echo = FALSE, fig = TRUE, width = 10, height = 10>>=
+plot(cif.abortion, curvlab = c("Control", "Exposed"), ylim = c(0, 0.6),
+ ci.type = "bars", pos.ci = c(27, 28), col = c(1, 1), ci.lwd = 6,
+ lwd = 2, lty = c(2, 1), cex = 1.3)
+lines(cif.abortion[[2]], tr.choice = "0 1", col = 2, lwd = 2)
+@
+\caption{Figure \ref{decalage} along with the CIF of ETOP for the exposed in red.}
+\end{center}
+\end{figure}
+
+\clearpage
+
+\begin{thebibliography}{1}
+\bibitem[Meister and Schaefer, 2008]{meister}
+ Meister, R. and Schaefer, C. (2008).
+ \newblock Statistical methods for estimating the probability of spontaneous
+ abortion in observational studies--analyzing pregnancies exposed to coumarin
+ derivatives.
+ \newblock {\em Reproductive Toxicology}, 26(1):31--35.
+\end{thebibliography}
+
+\end{document}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-etm.git
More information about the debian-med-commit
mailing list