# NOT RUN {
##
data(Ohio)
## Design matrix that forms the basis for model and
## phase I strata specification
##
XM <- cbind(Int=1, Ohio[,1:3]) ## main effects only
XI <- cbind(XM, SbyR=XM[,3]*XM[,4]) ## interaction between sex and race
## 'True' values for the underlying logistic model
##
fitM <- glm(cbind(Death, N-Death) ~ factor(Age) + Sex + Race, data=Ohio,
family=binomial)
fitI <- glm(cbind(Death, N-Death) ~ factor(Age) + Sex * Race, data=Ohio,
family=binomial)
##
betaNamesM <- c("Int", "Age1", "Age2", "Sex", "Race")
betaNamesI <- c("Int", "Age1", "Age2", "Sex", "Race", "SexRace")
## Two-phase design stratified by age
## * sample 50 from each of 6 phase I strata
## * show primary output (% bias, 95% CP, relative uncertainty)
##
# }
# NOT RUN {
ocAge <- tpsSim(B=1000, betaTruth=fitM$coef, X=XM, N=Ohio$N, strata=2,
nII0=c(50,50,50), nII1=c(50,50,50), betaNames=betaNamesM,
monitor=100)
ocAge
# }
# NOT RUN {
## All possible balanced two-phase designs
## * 250 controls and 250 cases
## * only show the relative uncertainty output
##
# }
# NOT RUN {
ocAll <- tpsSim(B=1000, betaTruth=fitM$coef, X=XM, N=Ohio$N, strata=0,
nII=c(250, 250), betaNames=betaNamesM,
monitor=100)
ocAll
# }
# NOT RUN {
## Two-phase design stratified by race
## * balanced solely on outcome
## * only show the relative uncertainty output
##
# }
# NOT RUN {
ocRace <- tpsSim(B=1000, betaTruth=fitI$coef, X=XI, N=Ohio$N, strata=4,
nII0=c(200, 50), nII1=c(200, 50), betaNames=betaNamesI,
monitor=100)
ocRace
# }
# NOT RUN {
## Comparison of two case-control designs
## * 240 controls and 260 cases
## * 240 controls and 260 cases
## * only show the relative uncertainty output
##
# }
# NOT RUN {
ocCC <- tpsSim(B=1000, betaTruth=fitM$coef, X=XM, N=Ohio$N, strata=1,
nII0=240, nII1= 260, nCC=c(200,300),
betaNames=betaNamesM,
monitor=100)
ocCC
# }
# NOT RUN {
## Illustration of setting where one of the covariates is continuous
## * restrict to black and white children born in 2003
## * dichotomize smoking, mothers age, weight gain during pregnancy and weight weight
## * note the use of 'etaTerms' to restrict to specific variables (the majority of which
## are created)
## * note the use of 'strata=list(11,12)' to simultaneously investigate stratification by
## - 11th column in XM: derived 'smoker' variable
## - 12th column in XM: derived 'teen' variable
##
## Warning: takes a long time!
##
# }
# NOT RUN {
data(infants)
##
infants <- infants[infants$year == 2003,]
##
infants$race[!is.element(infants$race, c(1,2))] <- NA ## White/Black = 0/1
infants$race <- infants$race - 1
infants <- na.omit(infants)
##
infants$smoker <- as.numeric(infants$cignum > 0)
infants$teen <- as.numeric(infants$mage < 20)
infants$lowgain <- as.numeric(infants$gained < 20)
infants$lbw <- as.numeric(infants$weight < 2500)
infants$weeks <- (infants$weeks - 36) / 4 ## estimate a 4-week contrast
##
fitM <- glm(death ~ smoker + teen + race + male+ lowgain + lbw + weeks,
data=infants,
family=binomial)
betaM <- fitM$coef
XM <- cbind(Int=1, infants)
etaM <- c("Int", "smoker", "teen", "race", "male", "lowgain", "lbw", "weeks")
##
tpsSim(B=1000, betaTruth=fitM$coef, X=XM, N=rep(1, nrow(XM)), strata=list(11,12),
expand="none", etaTerms=etaM, nII=c(1000,1000),
threshold=c(-20,20),
monitor=100)
# }
Run the code above in your browser using DataLab