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'")
}
is_stratified <- !is.null(x$strata)
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)) {
if (is_stratified) {
tr.choice <- pos[1]
} else {
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")
if (is_stratified) {
lstrat <- length(x$strata)
temp <- lapply(seq_len(lstrat), function(i) {
tmp <- ci.transfo(x[[i]], tr.choice, level, ci.fun)
tmp2 <- lapply(tmp, cbind, strata = x$strata[[i]])
tmp2
})
temp <- do.call(c, temp)
} else {
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()
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.