# NOT RUN {
burnin <- 500
nmc <- 1000
thin <- 1
y.sd <- 1 # standard deviation of the response
p <- 100 # number of predictors
ntrain <- 100 # training size
ntest <- 50 # test size
n <- ntest + ntrain # sample size
q <- 10 # number of true predictos
beta.t <- c(sample(x = c(1, -1), size = q, replace = TRUE), rep(0, p - q))
x <- mvtnorm::rmvnorm(n, mean = rep(0, p), sigma = diag(p))
tmean <- x %*% beta.t
y <- rnorm(n, mean = tmean, sd = y.sd)
X <- scale(as.matrix(x)) # standarization
T <- exp(y) # AFT model
C <- rgamma(n, shape = 1.75, scale = 3) # 42% censoring time
time <- pmin(T, C) # observed time is min of censored and true
status = time == T # set to 1 if event is observed
ct <- as.matrix(cbind(time = time, status = status)) # censored time
# Training set
cttrain <- ct[1:ntrain, ]
Xtrain <- X[1:ntrain, ]
# Test set
cttest <- ct[(ntrain + 1):n, ]
Xtest <- X[(ntrain + 1):n, ]
posterior.fit <- afths(ct = cttrain, X = Xtrain, method.tau = "halfCauchy",
method.sigma = "Jeffreys", burn = burnin, nmc = nmc, thin = 1,
Xtest = Xtest)
posterior.fit$BetaHat
# Posterior processing to recover the true predictors
cluster <- kmeans(abs(posterior.fit$BetaHat), centers = 2)$cluster
cluster1 <- which(cluster == 1)
cluster2 <- which(cluster == 2)
min.cluster <- ifelse(length(cluster1) < length(cluster2), 1, 2)
which(cluster == min.cluster) # this matches with the true variables
# }
Run the code above in your browser using DataLab