library(DoseFinding) library(MASS) set.seed(12357) ### dosing design dose<-c(0,0.025,0.125,0.250,0.5,1.0) nd<-length(dose) ndose<-rep(1,nd) ndose[1]<-2 ndose[nd]<-2 ndose<-40*ndose w<-diag(ndose) e0<-0 ### placebo efficacy throughout ### population model resSD<-1 popED50<-exp(-2.02881) popEmax<-1 effsize<-popEmax/(popED50+1) #### compute re-scaled regression projection matrix (second row) compContr<-function(drx,w){ nd<-length(drx) xmat<-cbind(rep(1,nd),drx) xdes<- solve(t(xmat)%*%w%*%xmat)%*%t(xmat)%*%w return(xdes[2,]/sqrt(sum(xdes[2,]^2))) } ###################################################################### ### contrasts (based on design, no response data needed here) ###################################################################### #### linear model linMod<-Mods(linear=NULL,doses=dose,placEff=e0,maxEff=1) linMat<-optContr(linMod,w=ndose) plot(linMod) print(linMat,digits=6) drx<-dose print(compContr(drx,w),digits=6) ###################################################################### #### emax model ed50<-c(0.1,0.2,0.3) ### contrast by DoseFinding package emaxMods<-Mods(emax=ed50,doses=dose,placEff=e0,maxEff=1) emaxMat<-optContr(emaxMods,w=ndose) plot(emaxMods) print(emaxMat,digits=6) #### manually compute contrasts ind<-3 drx<-dose/(dose+ed50[ind]) print(compContr(drx,w),digits=6) ################################################ ##### quadratic model theta<- -1/(2*c(0.6,0.70)) ### max occur at 4, 8, theta is b2/b1 in quad model quadMods<-Mods(quadratic=theta,doses=dose,placEff=e0,maxEff=1) plot(quadMods) quadMat<-optContr(quadMods,w=ndose) plot(quadMat) print(quadMat,digits=6) #### manually compute contrasts ind<-1 drx<- dose+theta[ind]*dose^2 compContr(drx,w) ################################################# #### combination models combMods<-Mods(linear=NULL,emax=ed50,quadratic=theta,doses=dose,placEff=e0,maxEff=1) pdf('modPlot.pdf') plot(combMods,modNams=c('Lin','Emax1','Emax2','Emax3','Quad1','Quad2')) dev.off() combMat<-optContr(combMods,w=ndose) plot(combMat) print(combMat,digits=6) xcontrasts<-round(combMat$contMat,6) colnames(xcontrasts)<-c('Lin','Emax1','Emax2','Emax3','Quad1','Quad2') #### manually compute contrasts ind<-2 drx<- dose+theta[ind]*dose^2 compContr(drx,w) ################################################ #### power for mcp mods altmod<-Mods(emax=popED50,doses=dose,placEff=e0,maxEff=effsize) plot(altmod) powMCT(emaxMat,alpha=0.05,altModels=altmod,n=ndose,sigma=resSD, alternative='one.sided',critV=TRUE) powMCT(combMat,alpha=0.05,altModels=altmod,n=ndose,sigma=1, alternative='one.sided',critV=TRUE) ################################################################################### ############################################################### ### numerical example aligning t-statistics: weighted version set.seed(12357) mlev<-e0+popEmax*dose/(dose+popED50) doserep<-rep(dose,ndose) mdose<-rep(mlev,ndose) y<-rnorm(length(mdose),mdose,sd=resSD) ym<-tapply(y,mdose,mean) ### compute contrasts (these are not stored by MCTtest, but are easily computed) ycontrasts<-t(combMat$contMat)%*%ym ycontrasts ## use grouped data outtest<-MCTtest(dose, ym, contMat = combMat, type='general', S=diag(1/ndose)*lmsatsd^2,df=sum(ndose)-nd) print(outtest,digits=6) ### saturated model sd from ungrouped data lmsatsd<-summary(lm(y~factor(doserep)))$sigma ############### ### linear using linear regression lmsum<-summary(lm(ym~dose,weight=ndose)) lmsd<-lmsum$sigma ### correct t-stat lmsum$coef[2,3]*(lmsd/lmsatsd) ### reproduce contrast with re-scaling drx<-dose xres<-drx-weighted.mean(drx,w=ndose) xnorm<-sqrt(sum((ndose*xres)^2))/sum(ndose*xres^2) drxn<-drx*xnorm summary(lm(ym~drxn,weight=ndose)) ############### ### quadratic using linear regression ind<-1 drx<- dose+theta[ind]*dose^2 lmsum<-summary(lm(ym~drx,weight=ndose)) lmsd<-lmsum$sigma ### correct t-stat lmsum$coef[2,3]*(lmsd/lmsatsd) ### reproduce contrast with re-scaling xres<-drx-weighted.mean(drx,w=ndose) xnorm<-sqrt(sum((ndose*xres)^2))/sum(ndose*xres^2) drxn<-drx*xnorm summary(lm(ym~drxn,weight=ndose)) ############### ### emax using linear regression ind<-1 drx<-dose/(dose+ed50[ind]) lmsum<-summary(lm(ym~drx,weight=ndose)) lmsd<-lmsum$sigma ### correct t-stat lmsum$coef[2,3]*(lmsd/lmsatsd) ### reproduce contrast with re-scaling xres<-drx-weighted.mean(drx,w=ndose) xnorm<-sqrt(sum((ndose*xres)^2))/sum(ndose*xres^2) drxn<-drx*xnorm summary(lm(ym~drxn,weight=ndose)) ############################################################## ### the same simulated example using subject-level data set.seed(12357) mlev<-e0+popEmax*dose/(dose+popED50) doserep<-rep(dose,ndose) mdose<-rep(mlev,ndose) y<-rnorm(length(mdose),mdose,sd=resSD) ym<-tapply(y,mdose,mean) ### compute contrasts ycontrasts<-t(combMat$contMat)%*%ym outtest<-MCTtest(doserep, y, contMat = combMat) print(outtest,digits=6) Tm<-round(as.vector(outtest$tStat),6) ### saturated model sd lmsat<-lm(y~factor(doserep)) lmsatsd<-summary(lmsat)$sigma ####################### ### linear using linear regression lmsum<-lm(y~doserep) lmsd<-summary(lmsum)$sigma ### correct t-stat summary(lmsum)$coef[2,3]*(lmsd/lmsatsd) ### F stat anova(lmsum,lmsat) ### reproduce contrast with re-scaling drx<-doserep xres<-unique(drx)-mean(drx) xnorm<-sqrt(sum((ndose*xres)^2))/sum(ndose*xres^2) drxn<-drx*xnorm summary(lm(y~drxn)) ####################### ### quadratic using linear regression ind<-1 drx<- doserep+theta[ind]*doserep^2 lmsum<-lm(y~drx) lmsd<-summary(lmsum)$sigma ### correct t-stat summary(lmsum)$coef[2,3]*(lmsd/lmsatsd) ### F stat anova(lmsum,lmsat) ### reproduce contrast with re-scaling xres<-unique(drx)-mean(drx) xnorm<-sqrt(sum((ndose*xres)^2))/sum(ndose*xres^2) drxn<-drx*xnorm summary(lm(y~drxn)) ####################### ### emax using linear regression ind<-1 drx<-doserep/(doserep+ed50[ind]) lmsum<-lm(y~drx) lmsd<-summary(lmsum)$sigma ### correct t-stat summary(lmsum)$coef[2,3]*(lmsd/lmsatsd) ### F stat anova(lmsum,lmsat) ### reproduce contrast with re-scaling xres<-unique(drx)-mean(drx) xnorm<-sqrt(sum((ndose*xres)^2))/sum(ndose*xres^2) drxn<-drx*xnorm summary(lm(y~drxn)) ############################################################### ### numerical example applied to placebo adj inputs set.seed(12357) mlev<-e0+popEmax*dose/(dose+popED50) doserep<-rep(dose,ndose) mdose<-rep(mlev,ndose) y<-rnorm(length(mdose),mdose,sd=resSD) ### saturated model sd ## use ungrouped data lmsatsd<-summary(lm(y~factor(doserep)))$sigma ### form placebo-adjusted inputs ym<-tapply(y,mdose,mean) ymsub<-ym[2:nd]-ym[1] dosesub<-dose[2:nd]-dose[1] svar<-matrix(rep(1/ndose[1],(nd-1)^2),ncol=nd-1) diag(svar)<-1/ndose[2:nd]+1/ndose[1] ssub<-svar*lmsatsd^2 wsub<-solve(ssub) ### contrast approach combMatsub<-optContr(combMods,doses=dosesub,S=ssub,placAdj=T) plot(combMatsub) print(combMatsub,digits=6) outtest<-MCTtest(dosesub, ymsub, contMat = combMatsub, type='general', S=ssub,df=sum(ndose)-nd,placAdj=TRUE) print(outtest,digits=6) ############### ### linear using linear regression innerx<-t(dosesub)%*%wsub%*%dosesub linslope<-coef(lm.gls(ymsub~-1+dosesub,W=wsub)) se<-sqrt(1/innerx) lintstat<-linslope/se print(lintstat,digits=7) ############### ### quadratic using linear regression ind<-1 drx<- dose+theta[ind]*dose^2 drxsub<-drx[2:nd]-drx[1] innerx<-t(drxsub)%*%wsub%*%drxsub quadslope<-coef(lm.gls(ymsub~-1+drxsub,W=wsub)) se<-sqrt(1/innerx) quadtstat<-quadslope/se print(quadtstat,digits=7) ############### ### emax using linear regression ind<-1 drx<-dose/(dose+ed50[ind]) drxsub<-drx[2:nd]-drx[1] innerx<-t(drxsub)%*%wsub%*%drxsub emaxslope<-coef(lm.gls(ymsub~-1+drxsub,W=wsub)) se<-sqrt(1/innerx) emaxtstat<-emaxslope/se print(emaxtstat,digits=7) save.image('examp.RData')