Как моделировать данные из двух разных параметрических семейств с цензурой в JAGS
Я нашел хороший пост, чтобы сделать это без цензуры. Как смоделировать смесь конечных компонентов из разных параметрических семейств с помощью JAGS? но я работаю над моделью с цензурой. Этот код генерирует смесь Вейбулла и "точечной массы" в 50.
N <- 12
alpha <- 0.4
mu <- 16.3
max <- 50
# Which component to choose from?
latent_class <- rbinom(N, 1, alpha)
Y <- ifelse(latent_class, 50, rweibull(N, scale=mu, shape=5))
dat <- data.frame(Y=Y)
ggplot(dat, aes(x=Y)) + geom_histogram(binwidth=1)
#censoring
(miss <- sample(1:12, 4))
(t.cen <- Y[-miss] * runif(length(Y)-length(miss)))
(Y[miss] <- NA)
Y
Следующий код генерирует аналогичные данные без цензуры и довольно неплохо сочетается с уловкой, основанной на ссылке выше.
library(tidyverse)
set.seed(8361299)
# calculate parameters, shape = 5, mean = 15
# scale = 15 / gamma(1 + 1/5) = 16.3
# lambda = (1/16.3)^5 = 8.690844e-07
N <- 12
alpha <- 0.4
mu <- 16.3
max <- 50
# Which component to choose from?
latent_class <- rbinom(N, 1, alpha)
Y <- ifelse(latent_class, 50, rweibull(N, scale=mu, shape=5))
dat <- data.frame(Y=Y)
ggplot(dat, aes(x=Y)) + geom_histogram(binwidth=1)
# The model:
model <- "model{
for(i in 1:N){
# Log density for the weibull part:
ld_comp[i, 1] <- logdensity.weib(Y[i], mu, tau)
# Log density for the uniform part:
ld_comp[i, 2] <- logdensity.unif(Y[i], 49.9, 50.1)
# Select one of these two densities and normalise with a Constant:
density[i] <- exp(ld_comp[i, component_chosen[i]] - Constant)
# Generate a likelihood for the MCMC sampler:
Ones[i] ~ dbern(density[i])
# The latent class part using dcat:
component_chosen[i] ~ dcat(probs)
}
# Priors for 2 parameters using a dirichlet distribution:
probs ~ ddirch(c(1,1))
#lower ~ duni(0, 10^6)
#upper ~ duni(0, 10^6)
mu ~ dunif(0, 10^6)
tau ~ dunif(0.0, 10^6)
# Specify monitors, data and initial values using runjags:
#monitor# probs, mu, tau
#data# N, Y, Ones, Constant
#inits# mu, tau
}"
library('runjags')
# Initial values to get the chains started:
mu <- 1
tau <- 1
Ones <- rep(1,N)
# The constant needs to be big enough to avoid any densities >1 but
# also small enough to calculate probabilities for observations of 1:
Constant <- 10
results <- run.jags(model, sample=10000, thin=1)
results
Вот код, который соответствует данным Вейбулла с цензурой, но не смесью двух моделей.
library(R2jags)
N <- 25
k <- .5
lambda <- 3
d <- data.frame(waiting.time = rweibull(N, shape = k, scale = lambda))
mean(d$waiting.time)
d$waiting.time
# create censored data, putting a cut in all censored places
cut <- 20
d$miss <- d$waiting.time > cut
d$y <- ifelse(d$miss, cut, d$waiting.time)
#hyperparameters
# a <- b <- 1 #diffuse proper prior
# data
# number of subjects, N set above
t <- ifelse(d$miss, NA, d$waiting.time)
t.cen <- d$y
is.censored <- as.numeric(d$miss)
jags.params <- c("r","beta0","waiting.time")
jags.inits <- function(){
list("r"=runif(1),"beta0"=runif(1))
}
wei_model <- function() {
for(i in 1:N) {
is.censored[i] ~ dinterval( t[i] , t.cen[i] )
t[i] ~ dweib(r,beta0); # if subject i fails
}
waiting.time = (1/beta0)^(1/r) * exp(loggam(1 + 1/r))
beta0 ~ dgamma(1.0,.0001);
r ~ dgamma(1.0,.0001);
}
# Fit the model
jagsfit <- jags(data = c("t", "t.cen", "N", "is.censored"), inits =
jags.inits, jags.params, n.iter = 10000, model.file = wei_model)
jagsfit
Я просто не вижу, как соединить эти идеи.
Спасибо!