library(monoreg)
expit <- function(x) {1/(1+exp(-x))}
logit <- function(p) {log(p)-log(1-p)}
set.seed(1)
# nobs <- 500
nobs <- 200
x <- sort(runif(nobs))
ngrid <- 100
xgrid <- seq(1/ngrid, (ngrid-1)/ngrid, by=1/ngrid)
ngrid <- length(xgrid)
ncat <- 4
beta <- 0.75
disc <- c(Inf, Inf, 0.75, 0.5)
gamma <- c(0,0,0.25,0.5)
surv <- matrix(NA, nobs, ncat)
cdf <- matrix(NA, nobs, ncat)
cols <- c('black','red','blue','green')
for (i in 1:ncat) {
surv[,i] <- expit(logit((ncat-(i-1))/ncat) + beta * x +
gamma[i] * (x > disc[i]) - gamma[i] * (x < disc[i]))
if (i==1)
plot(x, surv[,i], type='l', col=cols[i], ylim=c(0,1), lwd=2, ylab='S')
else
lines(x, surv[,i], col=cols[i], lwd=2)
}
head(surv)
for (i in 1:ncat) {
if (i grid[i] - xwindow) & (x < grid[i] + xwindow)
for (j in 1:ncat)
mw[i,j] <- sum(y[idx] >= j)/sum(idx)
}
for (j in 1:ncat) {
lines(grid, mw[,j], lty='dashed', col=cols[j])
}
# results <- ordmonoreg(niter=15000, burnin=5000, adapt=5000, refresh=10, thin=5,
results <- ordmonoreg(niter=3000, burnin=1000, adapt=1000, refresh=10, thin=4,
birthdeath=1, logit=FALSE, gam=FALSE, seed=1, rhoa=0.1, rhob=0.1,
deltai=0.2, dlower=0, dupper=1, invprob=1.0, dc=0.0,
predict=c(rep(0,nobs),rep(1,ngrid)),
include=c(rep(1,nobs),rep(0,ngrid)),
outcome=c(y, rep(1,ngrid)),
axes=c(x, xgrid), covariates=NULL, cluster=NULL, ncluster=NULL,
settozero=getcmat(1))
s <- results$lambda
dim(s)
lines(xgrid, colMeans(subset(s, s[,1]==0)[,2:(ngrid+1)]))
lines(xgrid, colMeans(subset(s, s[,1]==1)[,2:(ngrid+1)]), col='red')
lines(xgrid, colMeans(subset(s, s[,1]==2)[,2:(ngrid+1)]), col='blue')
lines(xgrid, colMeans(subset(s, s[,1]==3)[,2:(ngrid+1)]), col='green')
legend('bottomright', legend=c(expression(P(Y>=1)), expression(P(Y>=2)),
expression(P(Y>=3)), expression(P(Y>=4))),
lwd=2, col=cols)
Run the code above in your browser using DataLab