#-----------------------------------------------------------------------
# Time transforming function g(t)
#-----------------------------------------------------------------------
# Transformation g
g <- function(x,delta){
atanh((x-delta/2)/(delta/2))
}
# Derivative of g
dg <- function(x,delta){
(1/2)*delta/(x*(delta-x))
}
#-----------------------------------------------------------------------
# Data preparing function
#-----------------------------------------------------------------------
data.prep <- function(data, time, status, ID, w, cova=NULL){
#-----------------------------------------------------------------------
# Causes of failure
#-----------------------------------------------------------------------
causes <- cbind(data[, paste(status, 1, sep="")], data[, paste(status, 2, sep="")])
#-----------------------------------------------------------------------
# Xs
#-----------------------------------------------------------------------
n <- nrow(data)
if (!is.null(cova)){
x1 <- paste(cova, "1", sep="")
x2 <- paste(cova, "2", sep="")
}
if (is.null(cova)){
x1 <- cova
x2 <- cova
}
x.1 <- as.matrix(cbind(rep(1,n),data[,x1]))
x.2 <- as.matrix(cbind(rep(1,n),data[,x2]))
#-----------------------------------------------------------------------
# Transformation g(t)
#-----------------------------------------------------------------------
# Time points
t1 <- data[, paste(time, 1, sep="")]
t2 <- data[, paste(time, 2, sep="")]
# Max. time
delta <- max(t1,t2)
# Transformed timepoints
gt1 <- g(t1,delta)
gt2 <- g(t2,delta)
#-----------------------------------------------------------------------
# Derivative of g(t)
#-----------------------------------------------------------------------
dgt1 <- dg(t1,delta)
dgt2 <- dg(t2,delta)
#-----------------------------------------------------------------------
# EB0
#-----------------------------------------------------------------------
eb0 <- matrix(0, nrow=nrow(causes), ncol=2)
#-----------------------------------------------------------------------
# Return
#-----------------------------------------------------------------------
res <- list("causes"=causes, "x.1"=x.1, "x.2"=x.2, "gt1"=gt1, "dgt1"=dgt1, "gt2"=gt2, "dgt2"=dgt2, "delta"=delta, "eb0"=eb0)
return(res)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.