DoseFinding/0000755000176200001440000000000014764054522012454 5ustar liggesusersDoseFinding/tests/0000755000176200001440000000000014654153534013617 5ustar liggesusersDoseFinding/tests/testsFitting.R0000644000176200001440000003370714654153534016443 0ustar liggesusersrequire("DoseFinding") ## effect curve estimate for linear type models!! ######################################################################## #### Testing function to generate doses and sample size allocs. genDFdats <- function(model, argsMod, doses, n, sigma, mu = NULL){ nD <- length(doses) dose <- sort(doses) if (length(n) == 1) n <- rep(n, nD) dose <- rep(dose, n) args <- c(list(dose), argsMod) mu <- do.call(model, args) data.frame(dose = dose, resp = mu + rnorm(sum(n), sd = sigma)) } getDosSampSiz <- function(){ # generate dose levels mD <- runif(1, 0, 1500) nD <- max(rpois(1, 5), 4) p <- rgamma(nD, 3) p <- cumsum(p/sum(p)) doses <- signif(c(0, mD*p), 3) # sample size allocations totSS <- rpois(1, rexp(1, 1/250)) totSS <- max(totSS, 50) p <- rgamma(nD+1, 3);p <- p/sum(p) n <- round(p*totSS) n[n==0] <- rpois(sum(n==0), 1)+1 list(doses=doses, n=n) } getDFdataSet <- function(doses, n){ if(missing(doses) & missing(n)){ ll <- getDosSampSiz() } else { ll <- list(doses = doses, n=n) } e0 <- rnorm(1, 0, 10) eMax <- rgamma(1, abs(e0)*0.5, 0.5) sig <- eMax/runif(1, 0.5, 5) if(runif(1)<0.3){ aa <- genDFdats("betaMod", c(e0 = e0, eMax = eMax, delta1=runif(1, 0.5, 4), delta2=runif(1, 0.5, 4), scal=1.2*max(ll$doses)), ll$doses, ll$n, sig) } else { aa <- genDFdats("sigEmax", c(e0 = e0, eMax = eMax, ed50=runif(1, 0.05*max(ll$doses), 1.5*max(ll$doses)), h=runif(1, 0.5, 4)), ll$doses, ll$n, sig) } N <- sum(ll$n) center <- c("blue", "green", "red", "yellow", "silver") aa <- data.frame(x= aa$dose, y=aa$resp, center=as.factor(sample(center, N, replace = T)), age=runif(N, 1, 100)) aa[sample(1:nrow(aa)),] } ######################################################################## ######################################################################## #### Generate data sets and compare results of fitDRModel #### to the result of nls and lm for AIC function (if these are consistent #### parameter estimates, residual sum of square and degrees of freedom are #### consistent) and the vcov function (if these are consistent parameter #### estimates, RSS, df and gradient are consistent) ######################################################################## ######################################################################## #### beta Model set.seed(2000) ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) # without covariates bnds <- matrix(c(0.05, 0.05, 6, 6), nrow=2) fit0 <- fitMod(x, y, datset, model = "betaMod", addCovars = ~1, addArgs=list(scal=1.2*max(datset$x)), bnds=bnds, start=c(0.6, 0.6)) fitnls <- nls(y~betaMod(x, e0, emax, delta1, delta2, 1.2*max(datset$x)), start=c(e0=15, emax=14, delta1=0.8, delta2=0.5), data=datset) AIC(fit0) AIC(fitnls) summary(fit0) summary(fitnls) vcov(fit0) vcov(fitnls) predict(fit0, predType="effect-curve", se.fit=TRUE) predict(fit0, predType="full-model", se.fit=TRUE) TD(fit0, Delta = 1) # with covariates fit0 <- fitMod(x, y, datset, model="betaMod", addCovars = ~age+center, addArgs=list(scal=1.2*max(datset$x)), bnds=bnds) XX <- model.matrix(~center+age, data=datset) scl <- 1.2*max(datset$x) fitnls <- nls(y~cbind(XX, betaMod(x, 0, 1, delta1, delta2, scl)), data=datset, start=c(delta1=1, delta2=0.2), algorithm = "plinear") AIC(fit0) AIC(fitnls) summary(fit0) summary(fitnls) vcov(fit0 ) vcov(fitnls) predict(fit0, predType="effect-curve", doseSeq = c(0, 100), se.fit=T) predict(fit0, predType="full-model", se.fit=T, newdata = data.frame(x = c(0,100), center = as.factor("yellow"), age = 50)) TD(fit0, Delta = 1) ######################################################################## #### emax Model set.seed(15) ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) # without covariates bnds <- c(1e-5, max(datset$x)) fit0 <- fitMod(x,y, datset, model="emax", addCovars = ~1, bnds=bnds) fitnls <- nls(y~emax(x, e0, emax, ed50), start=c(e0=-1, emax=1.3, ed50=0.1), data=datset) AIC(fit0) AIC(fitnls) summary(fit0) summary(fitnls) vcov(fit0 ) vcov(fitnls) predict(fit0, predType="effect-curve", se.fit=T) predict(fit0, predType="full-model", se.fit=T) TD(fit0, Delta = 0.005) # with covariates fit0 <- fitMod(x,y, datset, model="emax", addCovars = ~age+center, bnds=bnds) XX <- model.matrix(~center+age, data=datset) fitnls <- nls(y~cbind(XX, emax(x, 0, 1, ed50)), data=datset, start=list(ed50=1), algorithm = "plinear") AIC(fit0) AIC(fitnls) summary(fit0) summary(fitnls) vcov(fit0 ) vcov(fitnls) predict(fit0, predType="effect-curve", doseSeq = c(0, 100), se.fit=T) predict(fit0, predType="full-model", se.fit=T, newdata = data.frame(x = c(0,100), center = as.factor("silver"), age = 50)) TD(fit0, Delta = 0.005) ######################################################################## #### sigEmax Model ## set.seed(25) # example where nls and bndnls find different optimum set.seed(13) ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) # without covariates bnds <- matrix(c(1e-5, 1e-5, max(datset$x), 30), nrow=2) fit0 <- fitMod(x,y, datset, model = "sigEmax", addCovars = ~1, bnds=bnds) fitnls <- nls(y~sigEmax(x, e0, emax, ed50, h), start=c(e0=6, emax=17, ed50=240, h=2), data=datset) AIC(fit0) AIC(fitnls) summary(fit0) summary(fitnls) vcov(fit0 ) vcov(fitnls) predict(fit0, predType="effect-curve", se.fit=T) predict(fit0, predType="full-model", se.fit=T) TD(fit0, Delta = 1) # with covariates fit0 <- fitMod(x,y, datset, model="sigEmax", addCovars = ~age+center, bnds=bnds) XX <- model.matrix(~center+age, data=datset) fitnls <- nls(y~cbind(XX, sigEmax(x, 0, 1, ed50, h)), data=datset, start=list(ed50=368, h=2), algorithm = "plinear") AIC(fit0) AIC(fitnls) summary(fit0) summary(fitnls) vcov(fit0 ) vcov(fitnls) predict(fit0, predType="effect-curve", doseSeq = c(0, 100), se.fit=T) predict(fit0, predType="full-model", se.fit=T, newdata = data.frame(x = c(0,100), center = as.factor("silver"), age = 50)) TD(fit0, Delta = 1) ######################################################################## #### logistic Model set.seed(200) ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) # without covariates bnds <- matrix(c(1e-5, 1e-5, max(datset$x), max(datset$x)/2), nrow=2) fit0 <- fitMod(x,y, datset, model="logistic", addCovars = ~1, bnds=bnds) fitnls <- nls(y~logistic(x, e0, emax, ed50, delta), start=c(e0=0, emax=16, ed50=250, delta=90), data=datset) AIC(fit0) AIC(fitnls) summary(fit0) summary(fitnls) vcov(fit0 ) vcov(fitnls) predict(fit0, predType="effect-curve", se.fit=T) predict(fit0, predType="full-model", se.fit=T) TD(fit0, Delta = 0.5) # with covariates (example where nls and bndnls find different optima) fit0 <- fitMod(x,y, datset, model="logistic", addCovars = ~age+center, bnds=bnds) XX <- model.matrix(~center+age, data=datset) fitnls <- nls(y~cbind(XX, logistic(x, 0, 1, ed50, delta)), data=datset, start=list(ed50=220, delta=48), algorithm = "plinear") AIC(fit0) AIC(fitnls) summary(fit0) summary(fitnls) vcov(fit0 ) vcov(fitnls) predict(fit0, predType="effect-curve", doseSeq = c(0, 100), se.fit=T) predict(fit0, predType="full-model", se.fit=T, newdata = data.frame(x = c(0,100), center = as.factor("silver"), age = 5)) TD(fit0, Delta = 0.02) ######################################################################## #### exponential Model set.seed(4) ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) # without covariates bnds <- c(0.1, 2)*max(datset$x) fit0 <- fitMod(x,y, datset, model = "exponential", addCovars = ~1, bnds=bnds) fitnls <- nls(y~exponential(x, e0, e1, delta), start=coef(fit0), data=datset) AIC(fit0) AIC(fitnls) summary(fit0) summary(fitnls) vcov(fit0 ) vcov(fitnls) predict(fit0, predType="effect-curve", se.fit=T) predict(fit0, predType="full-model", se.fit=T) TD(fit0, Delta = 0.1) # with covariates bnds <- c(0.1, 2)*max(datset$x) fit0 <- fitMod(x,y, datset, model = "exponential", addCovars = ~age+center, bnds=bnds) XX <- model.matrix(~center+age, data=datset) fitnls <- nls(y~cbind(XX, exponential(x, 0, 1, delta)), data=datset, start=c(delta=450), algorithm = "plinear") AIC(fit0) AIC(fitnls) summary(fit0) summary(fitnls) vcov(fit0 ) vcov(fitnls) predict(fit0, predType="effect-curve", doseSeq = c(0, 100), se.fit=T) predict(fit0, predType="full-model", se.fit=T, newdata = data.frame(x = c(0,100), center = as.factor("blue"), age = 50)) TD(fit0, Delta = 0.1) ######################################################################## #### linear model ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) # without covariates fit0 <- fitMod(x,y, datset, model = "linear", addCovars = ~1) fitlm <- lm(y~x, data=datset) AIC(fit0) AIC(fitlm) summary(fit0) summary(fitlm) vcov(fit0 ) vcov(fitlm) predict(fit0, predType="effect-curve", se.fit=T) TD(fit0, Delta = 1) # with covariates fit0 <- fitMod(x,y, datset, model = "linear", addCovars = ~age+center) fitlm <- lm(y~x+age+center, data=datset) AIC(fit0) AIC(fitlm) summary(fit0) summary(fitlm) vcov(fit0 ) vcov(fitlm) predict(fit0, predType="effect-curve", se.fit=T) predict(fit0, predType = "f", se.fit = T, newdata = data.frame(x=c(0,1,2,100), age = 30, center = as.factor("blue"))) predict(fitlm, se.fit = T, newdata = data.frame(x=c(0,1,2,100), age = 30, center = as.factor("blue"))) TD(fit0, Delta = 1) ######################################################################## #### linlog model ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) off <- 0.05*max(datset$x) # without covariates fit0 <- fitMod(x,y, datset, model = "linlog", addCovars = ~1,addArgs=list(off=off)) fitlm <- lm(y~log(x+off), data=datset) AIC(fit0) AIC(fitlm) summary(fit0) summary(fitlm) vcov(fit0 ) vcov(fitlm) predict(fit0, predType="effect-curve", se.fit=T) ## bug ## TD(fit0, Delta = 1) # with covariates fit0 <- fitMod(x,y, datset, model = "linlog", addCovars = ~age+center, addArgs=list(off=off)) fitlm <- lm(y~log(x+off)+age+center, data=datset) AIC(fit0) AIC(fitlm) summary(fit0) summary(fitlm) vcov(fit0 ) vcov(fitlm) predict(fit0, predType = "f", se.fit = T, ## degrees of freedom wrong ## newdata = data.frame(x=c(0,1,2,100), age = 35, center = as.factor("blue"))) predict(fitlm, se.fit = T, newdata = data.frame(x=c(0,1,2,100), age = 35, center = as.factor("blue"))) TD(fit0, Delta = 1) ######################################################################## #### quadratic model ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) # without covariates fit0 <- fitMod(x,y, datset, model = "quadratic", addCovars = ~1) fitlm <- lm(y~x+I(x^2), data=datset) AIC(fit0) AIC(fitlm) summary(fit0) summary(fitlm) vcov(fit0 ) vcov(fitlm) predict(fit0, predType="effect-curve", se.fit=T) predict(fit0, predType="full-model", se.fit=T, newdata=data.frame(x=c(0, 10, 100))) predict(fitlm, se.fit=T, newdata=data.frame(x=c(0, 10, 100))) TD(fit0, Delta = 1) # with covariates fit0 <- fitMod(x,y, datset, model = "quadratic", addCovars = ~age+center) fitlm <- lm(y~x+I(x^2)+age+center, data=datset) AIC(fit0) AIC(fitlm) summary(fit0) summary(fitlm) vcov(fit0 ) vcov(fitlm) predict(fit0, predType = "f", se.fit = T, newdata=data.frame(x=c(0, 10, 100), age = 30, center = as.factor("blue"))) predict(fitlm, se.fit = T, newdata=data.frame(x=c(0, 10, 100), age = 30, center = as.factor("blue"))) TD(fit0, Delta = 0.1) ######################################################################## ## ensure that predict with no argument uses the original data not the ## sorted data that were used for fitting data(IBScovars) ff <- fitMod(dose, resp, data=IBScovars, model="quadratic", addCovars = ~gender) ## should be all zero predict(ff, predType = "ls-means")- predict(ff, predType = "ls-means", doseSeq = IBScovars[,3]) predict(ff, predType = "full-model")- predict(ff, predType = "full-model", newdata = IBScovars[,-2]) predict(ff, predType = "effect-curve")- predict(ff, predType = "effect-curve", doseSeq = IBScovars[,3]) ff2 <- fitMod(dose, resp, data=IBScovars, model="quadratic") ## should be all zero predict(ff2, predType = "ls-means")- predict(ff2, predType = "ls-means", doseSeq = IBScovars[,3]) predict(ff2, predType = "full-model")- predict(ff2, predType = "full-model", newdata = IBScovars[,-2]) predict(ff2, predType = "effect-curve")- predict(ff2, predType = "effect-curve", doseSeq = IBScovars[,3]) dose <- unique(IBScovars$dose) ord <- c(2,4,1,3,5) mns <- tapply(IBScovars$resp, IBScovars$dose, mean)[ord] ff3 <- fitMod(dose, mns, S=diag(5), model="quadratic", type = "general") predict(ff3, predType = "ls-means")- predict(ff3, predType = "ls-means", doseSeq = dose) predict(ff3, predType = "effect-curve")- predict(ff3, predType = "effect-curve", doseSeq = dose) ######################################################################## ## ensure that S is also sorted when the dose is not entered sorted dose <- sort(unique(IBScovars$dose)) mns <- tapply(IBScovars$resp, IBScovars$dose, mean) S <- c(1000,1,1,1,1)*diag(5) ff1 <- fitMod(dose, mns, S = S, model="linear", type="general") ## fit unsorted dose <- unique(IBScovars$dose) ord <- c(2,4,1,3,5) mns <- tapply(IBScovars$resp, IBScovars$dose, mean)[ord] ff2 <- fitMod(dose, mns, S = S, model="linear", type="general") ff3 <- fitMod(dose, mns, S = S[ord,ord], model="linear", type="general") ## coef(ff1) & coef(ff3) should be equal coef(ff1) coef(ff3) DoseFinding/tests/testsplotDRMod.R0000644000176200001440000000763714654153534016706 0ustar liggesusers## require("DoseFinding") ## ## commented out for time reasons ## resp <- c(1.23, 1.31, 1.32, 1.36, 1.38) ## dose <- c(0, 1.25, 2.5, 5, 10) ## sdev <- c(0.015, 0.014, 0.015, 0.016, 0.015) ## V <- diag(sdev^2) ## mods <- Mods(emax=c(2.65, 12.5), linear=NULL, linInt = c(1, 1, 1, 1), ## logistic=c(29, 9.55), quadratic = -0.0075, ## doses=dose) ## mmfit <- MCPMod(dose, resp, S=V, type="general", models=mods, Delta=0.12) ## efit <- mmfit$mods$emax ## plot(efit, plotData = "meansCI", CI=TRUE) ## plot(efit, plotData = "meansCI", CI=FALSE) ## ## plot(efit, plotData = "raw") # should throw an error ## plot(efit, plotData = "means", CI = TRUE) ## plot(efit, plotData = "means", CI = FALSE) ## plot(efit, plotData = "none", CI =TRUE) ## plot(efit, plotData = "none", CI =FALSE) ## plot(mmfit, plotData = "meansCI", CI=TRUE) ## plot(mmfit, plotData = "meansCI", CI=FALSE) ## ## plot(mmfit, plotData = "raw") # should throw an error ## plot(mmfit, plotData = "means", CI = TRUE) ## plot(mmfit, plotData = "means", CI = FALSE) ## plot(mmfit, plotData = "none", CI =TRUE) ## plot(mmfit, plotData = "none", CI =FALSE) ## data(IBScovars) ## models <- Mods(emax = c(0.5, 1), betaMod=c(1,1), linear = NULL, doses=c(0,4)) ## mmfit <- MCPMod(dose, resp, data=IBScovars, models=models, Delta=0.12) ## efit <- mmfit$mods$emax ## plot(efit, plotData = "meansCI", CI=TRUE) ## plot(efit, plotData = "meansCI", CI=FALSE) ## plot(efit, plotData = "raw", CI=FALSE) ## plot(efit, plotData = "raw", CI=TRUE) ## plot(efit, plotData = "means", CI = TRUE) ## plot(efit, plotData = "means", CI = FALSE) ## plot(efit, plotData = "none", CI =TRUE) ## plot(efit, plotData = "none", CI =FALSE) ## plot(mmfit, plotData = "meansCI", CI=TRUE) ## plot(mmfit, plotData = "meansCI", CI=FALSE) ## plot(mmfit, plotData = "raw", CI=TRUE) ## plot(mmfit, plotData = "raw", CI=FALSE) ## plot(mmfit, plotData = "means", CI = TRUE) ## plot(mmfit, plotData = "means", CI = FALSE) ## plot(mmfit, plotData = "none", CI =TRUE) ## plot(mmfit, plotData = "none", CI =FALSE) ## data(IBScovars) ## models <- Mods(emax = c(0.5, 1), betaMod=c(1,1), linInt = c(1, 1, 1, 1), ## linear = NULL, doses=0:4) ## anovaMod <- lm(resp~factor(dose)+gender, data=IBScovars) ## drFit <- coef(anovaMod)[2:5] # placebo adjusted estimates at doses ## vCov <- vcov(anovaMod)[2:5,2:5] ## dose <- sort(unique(IBScovars$dose))[-1] ## mmfit <- MCPMod(dose, drFit, S=vCov, type = "general", models=models, Delta=0.12, placAdj=TRUE) ## efit <- mmfit$mods$emax ## plot(efit, plotData = "meansCI", CI=TRUE) ## plot(efit, plotData = "meansCI", CI=FALSE) ## ## plot(efit, plotData = "raw", CI=FALSE) # should throw an error ## ## plot(efit, plotData = "raw", CI=TRUE) # should throw an error ## plot(efit, plotData = "means", CI = TRUE) ## plot(efit, plotData = "means", CI = FALSE) ## plot(efit, plotData = "none", CI =TRUE) ## plot(efit, plotData = "none", CI =FALSE) ## plot(mmfit, plotData = "meansCI", CI=TRUE) ## plot(mmfit, plotData = "meansCI", CI=FALSE) ## ## plot(mmfit, plotData = "raw", CI=TRUE) # should throw an error ## ## plot(mmfit, plotData = "raw", CI=FALSE) # should throw an error ## plot(mmfit, plotData = "means", CI = TRUE) ## plot(mmfit, plotData = "means", CI = FALSE) ## plot(mmfit, plotData = "none", CI =TRUE) ## plot(mmfit, plotData = "none", CI =FALSE) ## ## neurodeg example (in 0.9-6 not all means were visible) ## doses <- c(0,1,3,10,30) ## muH <- c(-5.099, -4.581, -3.22, -2.879, -3.52) # estimated slope ## covH <- structure(c(0.149, 0.009, 0.009, 0.009, 0.009, 0.009, 0.149, ## 0.009, 0.009, 0.009, 0.009, 0.009, 0.149, 0.009, ## 0.009, 0.009, 0.009, 0.009, 0.149, 0.009, 0.009, ## 0.009, 0.009, 0.009, 0.149), .Dim = c(5L, 5L)) ## fit <- fitMod(doses, muH, S=covH, model="emax", type = "general") ## plot(fit, plotData="meansCI", CI=TRUE) DoseFinding/tests/testsMCT.R0000644000176200001440000002555414654153534015463 0ustar liggesusersrequire("DoseFinding") if(!require("multcomp")) stop("need multcomp package to run this test") ######################################################################## #### multContTest # functions to sample random DF data getDosSampSiz <- function(){ # generate dose levels mD <- runif(1, 0, 1500) nD <- max(rpois(1, 5), 4) p <- rgamma(nD, 3) p <- cumsum(p/sum(p)) doses <- signif(c(0, mD*p), 3) # sample size allocations totSS <- rpois(1, rexp(1, 1/250)) totSS <- max(totSS, 50) p <- rgamma(nD+1, 3);p <- p/sum(p) n <- round(p*totSS) n[n==0] <- rpois(sum(n==0), 1)+1 list(doses=doses, n=n) } getDFdataSet <- function(doses, n){ ll <- getDosSampSiz() e0 <- rnorm(1, 0, 10) eMax <- rgamma(1, abs(e0)*0.5, 0.5)*I(runif(1)<0.25) if(eMax > 0){ sig <- eMax/runif(1, 0.5, 5)} else { sig <- rgamma(1, abs(e0)*0.5, 0.5) } dosVec <- rep(ll$doses, ll$n) if(runif(1)<0.3){ mnVec <- betaMod(dosVec, e0=e0, eMax=eMax, delta1=runif(1, 0.5, 5), delta2=runif(1, 0.5, 5), scal=1.2*max(ll$doses)) } else { mnVec <- logistic(dosVec, e0 = e0, eMax = eMax, ed50=runif(1, 0.05*max(ll$doses), 1.5*max(ll$doses)), delta=runif(1, 0.5, max(ll$doses)/2)) } resp <- rnorm(sum(ll$n), mnVec, sig) N <- sum(ll$n) cov1 <- as.factor(rpois(N, 5)) cov2 <- runif(N, 1, 100) aa <- data.frame(x= dosVec, y=resp, cov1=cov1, cov2=cov2) aa[sample(1:nrow(aa)),] } #### simulate data and compare to output of glht of multcomp package and oldMCPMod function set.seed(10) dd <- getDFdataSet() bet <- guesst(0.9*max(dd$x), p=0.8, "betaMod", scal = 1.2*max(dd$x), dMax = 0.7*max(dd$x), Maxd = max(dd$x)) sE <- guesst(c(0.5*max(dd$x), 0.7*max(dd$x)) , p=c(0.5, 0.9), "sigEmax") models <- Mods(linear = NULL, betaMod = bet, sigEmax = sE, doses = sort(unique(dd$x)), addArgs=list(scal = 1.2*max(dd$x))) obj <- MCTtest(x,y, dd, models=models, addCovars = ~cov1+cov2, pVal = T) dd2 <- dd;dd2$x <- as.factor(dd$x) fit <- lm(y~x+cov1+cov2, data=dd2) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") summary(mcp) print(obj, digits = 3) obj <- MCTtest(x,y, dd, models=models, addCovars = ~1, pVal = T) dd2 <- dd;dd2$x <- as.factor(dd$x) fit <- lm(y~x, data=dd2) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") summary(mcp) print(obj, digits = 3) #### different model set set.seed(10) dd <- getDFdataSet() mD <- max(dd$x) lg1 <- guesst(c(0.3*mD, 0.4*mD), c(0.3, 0.9), "logistic") lg2 <- guesst(c(0.3*mD, 0.4*mD), c(0.3, 0.5), "logistic") expo <- guesst(c(0.9*mD), c(0.7), "exponential", Maxd=mD) quad <- guesst(c(0.6*mD), c(1), "quadratic") models <- Mods(linlog = NULL, logistic = rbind(lg1, lg2), exponential = expo, quadratic = quad, doses = sort(unique(dd$x)), addArgs=list(off = 0.2*max(dd$x))) obj <- MCTtest(x,y, dd, models=models, addCovars = ~cov1+cov2, pVal = T) dd2 <- dd;dd2$x <- as.factor(dd$x) fit <- lm(y~x+cov1+cov2, data=dd2) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") summary(mcp) print(obj, digits = 3) obj <- MCTtest(x,y, dd, models=models, addCovars = ~1, pVal = T) dd2 <- dd;dd2$x <- as.factor(dd$x) fit <- lm(y~x, data=dd2) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") summary(mcp) print(obj, digits = 3) #### contrast matrix handed over set.seed(23) dd <- getDFdataSet() mD <- max(dd$x) lg1 <- guesst(c(0.3*mD, 0.4*mD), c(0.3, 0.9), "logistic") lg2 <- guesst(c(0.3*mD, 0.4*mD), c(0.3, 0.5), "logistic") expo <- guesst(c(0.9*mD), c(0.7), "exponential", Maxd=mD) quad <- guesst(c(0.6*mD), c(1), "quadratic") models <- Mods(linlog = NULL, logistic = rbind(lg1, lg2), exponential = expo, quadratic = quad, doses = dd$x, addArgs=list(off = 0.2*max(dd$x))) obj <- MCTtest(x,y, dd, models=models, addCovars = ~cov1+cov2, pVal = T) contMat <- obj$contMat obj <- MCTtest(x,y, dd, models=models, addCovars = ~1, pVal = T, contMat = contMat) dd2 <- dd dd2$x <- as.factor(dd2$x) fit <- lm(y~x, data=dd2) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") summary(mcp) obj ######################################################################## #### some binary test cases getDFdataSet.bin <- function(doses, n){ ll <- getDosSampSiz() ll$n <- ll$n+10 e0 <- rnorm(1, 0, sqrt(3.28)) eMax <- rnorm(1, 0, 5) dosVec <- rep(ll$doses, ll$n) if(runif(1)<0.3){ mn <- betaMod(dosVec, e0 = e0, eMax = eMax, delta1=runif(1, 0.5, 5), delta2=runif(1, 0.5, 5), scal=1.2*max(ll$doses)) } else { mn <- logistic(dosVec, e0 = e0, eMax = eMax, ed50=runif(1, 0.05*max(ll$doses), 1.5*max(ll$doses)), delta=runif(1, 0.5, max(ll$doses)/2)) } resp <- rbinom(length(ll$n), ll$n, 1/(1+exp(-mn))) aa <- data.frame(dose = ll$doses, resp = resp) aa <- data.frame(x= aa$dose, y=aa$resp/ll$n, n=ll$n) aa[sample(1:nrow(aa)),] } set.seed(1909) dd <- getDFdataSet.bin() bet <- guesst(0.9*max(dd$x), p=0.8, "betaMod", scal = 1.2*max(dd$x), dMax = 0.7*max(dd$x), Maxd = max(dd$x)) sE <- guesst(c(0.5*max(dd$x), 0.7*max(dd$x)) , p=c(0.5, 0.9), "sigEmax") models <- Mods(linear = NULL, betaMod = bet, sigEmax = sE, doses = sort(unique(dd$x)), addArgs=list(scal = 1.2*max(dd$x))) logReg <- glm(y~as.factor(x)-1, family=binomial, data=dd, weights = n) dePar <- coef(logReg) vCov <- vcov(logReg) dose <- sort(unique(dd$x)) obj <- MCTtest(dose, dePar, S=vCov, models=models, type="general", df=Inf, pVal = T) dd2 <- dd;dd2$x <- as.factor(dd$x) fit <- glm(y~x-1, family = binomial, data=dd2, weights = n) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") summary(mcp) print(obj, digits = 3) set.seed(1997) dd <- getDFdataSet.bin() bet <- guesst(0.9*max(dd$x), p=0.8, "betaMod", scal = 1.2*max(dd$x), dMax = 0.7*max(dd$x), Maxd = max(dd$x)) sE <- guesst(c(0.5*max(dd$x), 0.7*max(dd$x)) , p=c(0.5, 0.9), "sigEmax") models <- Mods(linear = NULL, betaMod = bet, sigEmax = sE,direction = "decreasing", addArgs=list(scal = 1.2*max(dd$x)), doses = sort(unique(dd$x))) logReg <- glm(y~as.factor(x)-1, family=binomial, data=dd, weights = n) dePar <- coef(logReg) vCov <- vcov(logReg) dose <- sort(unique(dd$x)) obj <- MCTtest(dose, dePar, S=vCov, models=models, type = "general", pVal = TRUE, df=Inf) dd2 <- dd;dd2$x <- as.factor(dd$x) fit <- glm(y~x-1, family = binomial, data=dd2, weights = n) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") summary(mcp) print(obj, digits = 3) set.seed(1) dd <- getDFdataSet.bin() bet <- guesst(0.9*max(dd$x), p=0.8, "betaMod", scal = 1.2*max(dd$x), dMax = 0.7*max(dd$x), Maxd = max(dd$x)) sE <- guesst(c(0.5*max(dd$x), 0.7*max(dd$x)) , p=c(0.5, 0.9), "sigEmax") models <- Mods(linear = NULL, betaMod = bet, sigEmax = sE, doses = sort(unique(dd$x)), addArgs=list(scal = 1.2*max(dd$x))) logReg <- glm(y~as.factor(x)-1, family=binomial, data=dd, weights = n) dePar <- coef(logReg) vCov <- vcov(logReg) dose <- sort(unique(dd$x)) obj <- MCTtest(dose, dePar, S=vCov, models=models, type = "general", pVal = T, df=Inf) dd2 <- dd;dd2$x <- as.factor(dd$x) fit <- glm(y~x-1, family = binomial, data=dd2, weights = n) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") summary(mcp) print(obj, digits = 3) ## one-dimensional test set.seed(1) dd <- getDFdataSet.bin() model <- Mods(linear = NULL, doses=sort(unique(dd$x)), addArgs=list(scal = 1.2*max(dd$x))) logReg <- glm(y~as.factor(x)-1, family=binomial, data=dd, weights = n) dePar <- coef(logReg) vCov <- vcov(logReg) dose <- sort(unique(dd$x)) obj <- MCTtest(dose, dePar, S=vCov, models=model, type = "general", pVal = T, df=Inf) dd2 <- dd;dd2$x <- as.factor(dd$x) fit <- glm(y~x-1, family = binomial, data=dd2, weights = n) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") summary(mcp) print(obj, digits = 3) ######################################################################## ## unordered values in MCTtest ## placebo-adjusted scale ## two blocks below should give equal results data(IBScovars) modlist <- Mods(emax = 0.05, linear = NULL, logistic = c(0.5, 0.1), linInt = c(0, 1, 1, 1), doses = c(0, 1, 2, 3, 4)) ancMod <- lm(resp~factor(dose)+gender, data=IBScovars) drEst <- coef(ancMod)[2:5] vc <- vcov(ancMod)[2:5, 2:5] doses <- 1:4 fitMod(doses, drEst, S=vc, model = "sigEmax", placAdj=TRUE, type = "general") MCTtest(doses, drEst, S = vc, models = modlist, placAdj = TRUE, type = "general", df = Inf) ord <- c(3,4,1,2) drEst2 <- drEst[ord] vc2 <- vc[ord,ord] doses2 <- doses[ord] fitMod(doses2, drEst2, S=vc2, model = "sigEmax", placAdj=TRUE, type = "general") MCTtest(doses2, drEst2, S = vc2, models = modlist, placAdj = TRUE, type = "general", df = Inf) ## unadjusted scale ## two blocks below should give equal results ancMod <- lm(resp~factor(dose)-1, data=IBScovars) drEst <- coef(ancMod) vc <- vcov(ancMod) doses <- 0:4 fitMod(doses, drEst, S=vc, model = "sigEmax", type = "general") MCTtest(doses, drEst, S = vc, models = modlist, type = "general", df = Inf) ord <- c(3,4,1,2,5) drEst2 <- drEst[ord] vc2 <- vc[ord,ord] doses2 <- doses[ord] fitMod(doses2, drEst2, S=vc2, model = "sigEmax", type = "general") MCTtest(doses2, drEst2, S = vc2, models = modlist, type = "general", df = Inf) ######################################################################## ## catch cases where mvtnorm does not calculate result due to non-psd ## covariance matrix doses<-c(0,10,20,40) exm1<-0.15 exm2<-c(0.05,5) expo<-0.2 quad<--0.6 beta<-c(0.05,4) data.sim <- structure(list(X = structure(1:4, .Label = c("0", "10", "20", "40"), class = "factor"), dose = c(0L, 10L, 20L, 40L), Estimate = c(0.266942236, 3.792703657, 14.69084734, 17.71179102), Cov1 = c(3.685607913, 0.595285049, 0.651289991, 0.742901538), Cov2 = c(0.595285049, 3.31255546, 0.47843908, 0.545737127), Cov3 = c(0.651289991, 0.47843908, 3.398708786, 0.597080557), Cov4 = c(0.742901538, 0.545737127, 0.597080557, 3.556324648)), class = "data.frame", row.names = c(NA, -4L)) mu<-data.sim[,3] S<-data.matrix(data.sim[,4:7],rownames.force = NA) models2<-Mods(doses=doses, emax=exm1,sigEmax=exm2,linear=NULL,exponential=expo,quadratic=quad,betaMod=beta) tst <- MCTtest(dose=doses,resp=mu,models = models2,S=S,type="general") ## p-value of linear model should be NA is.na(attr(tst$tStat, "pVal")[3]) DoseFinding/tests/testssamplMod.R0000644000176200001440000001066714654153534016613 0ustar liggesusersrequire("DoseFinding") ######################################################################## ## test Bayesian fitting ## compare bFitMod on example data set with jags data(biom) ## (i) fit biom data ## data to fit model <- "sigEmax" anMod <- lm(resp~factor(dose)-1, data=biom) drFit <- coef(anMod);y <- drFit vCov <- vcov(anMod) Omega <- solve(vCov)#+diag(5)*1000 dose <- sort(unique(biom$dose)) nD <- length(dose) prior <- list(t = c(0, sqrt(2), 3), norm = c(0, sqrt(2)), beta=c(0,1,1,1), lnorm=c(0, sqrt(0.5))) res <- bFitMod(dose, drFit, vCov, model = "sigEmax", prior=prior, nSim = 100) ## ## jags code (commented out, only for "manual" testing) ## library(rjags) ## path <- "~/Projekte/DoseFindingPackage/" ## modelstr <- " ## model{ ## y[] ~ dmnorm(mu[], Omega[,]) ## for(i in 1:nD){ ## mu[i] <- E0 + (Emax*dose[i]^h)/(dose[i]^h+ED50^h) ## } ## E0 ~ dt(0, 0.5, 3) ## Emax ~ dnorm(0, 0.5) ## ED50 ~ dunif(0,1) ## h ~ dlnorm(0, 2) ## } ## " ## file <- paste(path, "mod.txt", sep="") ## cat(modelstr, file = file) ## ## data ## jags.data <- list(y=y, nD=nD, dose=dose, Omega=Omega) ## jags.inits <- list("E0"=0,"Emax"=0,"ED50"=0.5,"h"=1) ## mod <- jags.model(file, jags.data, jags.inits, n.chains = 3) ## samp <- jags.samples(mod, c("E0","Emax","ED50", "h"), 100000) ## quantile(samp$E0, c(0.05,0.25,0.5,0.75,0.95)) ## quantile(res$samples[,1], c(0.05,0.25,0.5,0.75,0.95)) ## quantile(samp$Emax, c(0.05,0.25,0.5,0.75,0.95)) ## quantile(res$samples[,2], c(0.05,0.25,0.5,0.75,0.95)) ## quantile(samp$ED50, c(0.05,0.25,0.5,0.75,0.95)) ## quantile(res$samples[,3], c(0.05,0.25,0.5,0.75,0.95)) ## quantile(samp$h, c(0.05,0.25,0.5,0.75,0.95)) ## quantile(res$samples[,4], c(0.05,0.25,0.5,0.75,0.95)) ## cor(cbind(as.numeric(samp$E0[,,]), ## as.numeric(samp$Emax[,,]), ## as.numeric(samp$ED50[,,]), ## as.numeric(samp$h[,,]))) ## cor(res$samples) ## (ii) now run with inflated variance (essentially sample prior) vCov <- vcov(anMod)*100000 Omega <- solve(vCov)#+diag(5)*1000 res <- bFitMod(dose, drFit, vCov, model = "sigEmax", prior=prior, nSim = 100) ## ## jags code (commented out, only for "manual" testing) ## jags.data <- list(y=y, nD=nD, dose=dose, Omega=Omega) ## mod <- jags.model(file, jags.data, jags.inits, n.chains = 3) ## samp <- jags.samples(mod, c("E0","Emax","ED50", "h"), 100000) ## quantile(samp$E0, c(0.05,0.25,0.5,0.75,0.95)) ## quantile(res$samples[,1], c(0.05,0.25,0.5,0.75,0.95)) ## quantile(samp$Emax, c(0.05,0.25,0.5,0.75,0.95)) ## quantile(res$samples[,2], c(0.05,0.25,0.5,0.75,0.95)) ## quantile(samp$ED50, c(0.05,0.25,0.5,0.75,0.95)) ## quantile(res$samples[,3], c(0.05,0.25,0.5,0.75,0.95)) ## quantile(samp$h, c(0.05,0.25,0.5,0.75,0.95)) ## quantile(res$samples[,4], c(0.05,0.25,0.5,0.75,0.95)) ## cor(cbind(as.numeric(samp$E0[,,]), ## as.numeric(samp$Emax[,,]), ## as.numeric(samp$ED50[,,]), ## as.numeric(samp$h[,,]))) ## cor(res$samples) ######################################################################## ## test bootstrap fitting vCov <- vcov(anMod) bnds <- matrix(c(0.001, 0.5, 1.5, 10), 2, 2) res <- bFitMod(dose, drFit, vCov, model = "sigEmax", nSim = 100, bnds=bnds, type = "bootstrap") dd <- dose[-1];resp <- drFit[2:5]-drFit[1] vc <- cbind(-1,diag(4))%*%vCov%*%t(cbind(-1,diag(4))) res <- bFitMod(dd, resp, vc, model = "linear", nSim = 100, bnds=bnds, placAdj = TRUE, type = "bootstrap") ######################################################################## ## test dose calculations, when model = "linInt" and placAdj=TRUE data(IBScovars) anovaMod <- lm(resp~factor(dose)+gender, data=IBScovars) drFit <- coef(anovaMod)[2:5] # placebo adjusted estimates at doses vCov <- vcov(anovaMod)[2:5,2:5] dose <- sort(unique(IBScovars$dose))[-1] fm <- fitMod(dose, drFit, S=vCov, model = "linInt", type = "general", placAdj=TRUE) ED(fm, 0.25) ED(fm, 0.5) ED(fm, 0.75) ED(fm, 0.95) TD(fm, 0.2) TD(fm, 0.3) TD(fm, 0.4) prior <- list(norm = c(0,1000), norm = c(0,1000), norm = c(0,1000), norm = c(0,1000)) gsample <- bFitMod(dose, drFit, vCov, model = "linInt", placAdj=TRUE, start = c(1, 1, 1, 1), nSim = 1000, prior = prior) td1 <- TD(gsample, 0.3) td2 <- TD(gsample, 0.3, TDtype="d", doses = seq(0,4,length=101)) ed1 <- ED(gsample, 0.8) ed2 <- ED(gsample, 0.8, EDtype="d", doses = seq(0,4,length=101)) DoseFinding/tests/testsoptContr.R0000644000176200001440000001157114654153534016642 0ustar liggesusers## commented out for time (and dependency reasons) require("DoseFinding") if(!(require("quadprog") & require("Rsolnp"))) stop("need packages quadprog and Rsolnp to run these tests") ## ## calculation of optimal contrast by enumerating all active sets ## allActiveSets <- function(S, mu, mult){ ## k <- length(mu) ## CC <- cbind(-1, diag(k - 1)) ## SPa <- CC %*% S %*% t(CC) ## muPa <- as.numeric(CC %*% mu) ## ## generate all possible active sets ## mat <- matrix(nrow = 2^(k-1), ncol = (k-1)) ## for(i in 1:(k-1)) ## mat[,i] <- rep(rep(c(FALSE,TRUE), each=2^(i-1)), 2^((k-1)-i)) ## val <- numeric(2^(k-1)) ## feasible <- logical(2^(k-1)) ## cont <- matrix(nrow = 2^(k-1), ncol = (k-1)) ## for(i in 1:(2^(k-1))){ ## nonzero <- mat[i,] ## if(sum(nonzero) > 0){ ## cont[i,!nonzero] <- 0 ## cont[i,nonzero] <- solve(SPa[nonzero, nonzero]) %*% muPa[nonzero] ## feasible[i] <- all(mult*cont[i,] >= 0) ## contrast <- c(-sum(cont[i,]), cont[i,]) ## val[i] <- as.numeric(t(contrast)%*%mu/sqrt(t(contrast)%*%S%*%contrast)) ## } ## } ## if(!any(feasible)) ## return(rep(NA, k)) ## mm <- max(val[which(feasible)]) ## c(-sum(cont[val == mm,]), cont[val == mm,]) ## } ## ## helper functions ## getStand <- function(x) ## x/sqrt(sum(x^2)) ## getNCP <- function(cont, mu, S) ## as.numeric(t(cont)%*%mu/sqrt(t(cont)%*%S%*%cont)) ## set.seed(1) ## ncp1 <- ncp2 <- ncp3 <- ncp4 <- ncp5 <- numeric(1000) ## for(i in 1:1000){ ## ## simulate mean and covariance matrix ## kk <- round(runif(1, 4, 10)) ## A <- matrix(runif(kk^2,-1,1),kk,kk) ## S <- crossprod(A)+diag(kk) ## mult <- sign(rnorm(1)) ## mu <- mult*sort(rnorm(kk, 1:kk, 1)) ## ## unconstrained solution ## ones <- rep(1,kk) ## unConst <- solve(S)%*%(mu - c(t(mu)%*%solve(S)%*%ones/(t(ones)%*%solve(S)%*%ones))) ## cont1 <- getStand(unConst) ## ## function from DoseFinding package ## cont2 <- DoseFinding:::constOptC(mu, solve(S), placAdj=FALSE, ## ifelse(mult == 1, "increasing", "decreasing")) ## ## alternative solution using quadratic programming ## D <- S ## d <- rep(0,kk) ## tA <- rbind(rep(1, kk), ## mu, ## mult*diag(kk)*c(-1,rep(1,kk-1))) ## A <- t(tA) ## bvec <- c(0,1,rep(0,kk)) ## rr <- solve.QP(D, d, A, bvec, meq=2) ## cont3 <- getStand(rr$solution) ## ## using solnp ## LB <- rep(0, kk-1) ## UB <- rep(20, kk-1) ## strt <- rep(1, kk-1) ## mgetNCP <- function(x, ...){ ## cont <- c(-sum(x), x) ## -getNCP(cont, ...) ## } ## res <- solnp(strt, mgetNCP, mu=mu, S=S, ## LB=LB, UB=UB, ## control = list(trace = 0)) ## out <- c(-sum(res$pars), res$pars) ## cont4 <- getStand(out) ## ## using ## cont5 <- allActiveSets(S=S, mu=mu, mult=mult) ## ## compare optimized non-centrality parameters ## ncp1[i] <- getNCP(cont1, mu, S) ## ncp2[i] <- getNCP(cont2, mu, S) ## ncp3[i] <- getNCP(cont3, mu, S) ## ncp4[i] <- getNCP(cont4, mu, S) ## ncp5[i] <- getNCP(cont5, mu, S) ## } ## sapply(list(ncp1, ncp2, ncp3, ncp4, ncp5), quantile) ## ## tests whether constant shapes (possible with linInt) are handled correctly ## data(biom) ## ## define shapes for which to calculate optimal contrasts ## modlist <- Mods(emax = 0.05, linear = NULL, logistic = c(0.5, 0.1), ## linInt = rbind(c(0, 0, 0, 1), c(0, 1, 1, 1)), ## doses = c(0, 0.05, 0.2, 0.6, 1), placEff = 1) ## optContr(modlist, w=1, doses=c(0.05), placAdj=TRUE, type = "u") ## optContr(modlist, w=1, doses=c(0.05), placAdj=TRUE, type = "c") ## optContr(modlist, w=1, doses=c(0.05,0.5), placAdj=TRUE, type = "u") ## optContr(modlist, w=1, doses=c(0.05,0.5), placAdj=TRUE, type = "c") ## optContr(modlist, w=1, doses=c(0,0.05), placAdj=FALSE, type = "u") ## optContr(modlist, w=1, doses=c(0,0.05), placAdj=FALSE, type = "c") ## optContr(modlist, w=1, doses=c(0,0.05,0.5), placAdj=FALSE, type = "u") ## optContr(modlist, w=1, doses=c(0,0.05,0.5), placAdj=FALSE, type = "c") ## modlist2 <- Mods(linInt = rbind(c(0, 1, 1, 1), c(0,0,0,1)), ## doses = c(0, 0.05, 0.2, 0.6, 1), placEff = 1) ## ## all of these should throw an error ## optContr(modlist2, w=1, doses=c(0.05), placAdj=TRUE, type = "u") ## optContr(modlist2, w=1, doses=c(0.05), placAdj=TRUE, type = "c") ## optContr(modlist2, w=1, doses=c(0,0.05), placAdj=FALSE, type = "u") ## optContr(modlist2, w=1, doses=c(0,0.05), placAdj=FALSE, type = "c") ## ## these should work ## optContr(modlist2, w=1, doses=c(0.05,0.5), placAdj=TRUE, type = "u") ## optContr(modlist2, w=1, doses=c(0.05,0.5), placAdj=TRUE, type = "c") ## optContr(modlist2, w=1, doses=c(0,0.05,0.5), placAdj=FALSE, type = "u") ## optContr(modlist2, w=1, doses=c(0,0.05,0.5), placAdj=FALSE, type = "c") DoseFinding/tests/testplanMod.R0000644000176200001440000001415114654153534016236 0ustar liggesusers## ## commented out for time-reasons ## ################################################################################ ## ## test 1: "validation" using fitMod and vcov.DRMod and predict.DRMod ## model <- "emax" ## sigma <- 1 ## n <- c(100,50,50,50,100) ## doses <- c(0,10,20,40,50) ## cf <- c(0,1,10) ## V <- DoseFinding:::aprCov(doses, model, cf, S=diag(1/n)) ## DoseFinding:::getPredVar(model, cf, V=V, pDose=50) ## ## now validation using the formulas in fitMod ## doseVec <- rep(doses, n) ## respVec <- rnorm(length(doseVec)) ## dd <- fitMod(doseVec, respVec, model="emax") ## ## now change to achieve desired values ## dd$coefs <- cf ## dd$df <- dd$RSS <- sum(n) ## vcov(dd) ## predict(dd, predType = "effect-curve", doseSeq=50, se.fit=TRUE)$se.fit^2 ## ################################################################################ ## ## test 2: "validation" using simulation ## model <- "emax" ## sigma <- 1 ## ## select very large sample size (to validate asymptotics) ## n <- c(100000, 50000, 50000, 50000, 100000) ## n <- c(100, 50, 50, 50, 100) ## doses <- c(0,10,20,40,50) ## cf <- c(0,0.4,10) ## Delta <- 0.2 ## V <- DoseFinding:::aprCov(doses, model, cf, S=diag(0.3^2/n)) ## tdvar <- DoseFinding:::getTDVar(model, cf, V=V, Delta=Delta, scale = "unrestricted") ## edvar <- DoseFinding:::getEDVar(model, cf, V=V, p=0.5, maxD=50, scale = "unrestricted") ## pavar <- DoseFinding:::getPredVar(model, cf, V=V, pDose=50) ## tdvart <- DoseFinding:::getTDVar(model, cf, V=V,scale = "log", Delta=Delta) ## edvart <- DoseFinding:::getEDVar(model, cf, V=V,scale = "logit", p=0.5, maxD=50) ## ## simulation ## mn <- emax(doses, cf[1], cf[2], cf[3]) ## doseVec <- rep(doses, n) ## mnVec <- rep(mn, n) ## td <- pl <- ed <- numeric(10000) ## for(i in 1:10000){ ## respVec <- mnVec + rnorm(length(mnVec),0,0.3) ## ff <- fitMod(doseVec, respVec, model="emax", bnds = c(0.05, 75)) ## ed[i] <- ED(ff, p=0.5) ## td[i] <- TD(ff, Delta = Delta) ## pl[i] <- predict(ff, doseSeq=50, predType = "effect-curve") ## pb <- txtProgressBar(min=1, max=1000, char="*", width = 20, style = 3) ## setTxtProgressBar(pb, i) ## } ## cat("\n") ## mm <- Mods(emax=cf[3], doses=doses, placEff=0, maxEff=emax(50,cf[1],cf[2],cf[3])) ## edt <- ED(mm, p=0.5) ## edt7 <- ED(mm, p=0.7) ## edt3 <- ED(mm, p=0.3) ## tdt <- TD(mm, Delta=Delta) ## hist(td[td < 100], freq=FALSE, breaks = 21) ## curve(dnorm(x, tdt, sqrt(tdvar)), add=TRUE) ## hist(ed, freq=FALSE, breaks = 101) ## curve(dnorm(x, edt, sqrt(edvar)), add=TRUE) ## hist(pl, freq=FALSE, breaks = 21) ## curve(dnorm(x, emax(50,cf[1],cf[2],cf[3]), sqrt(pavar)), add=TRUE) ## hist(td[td < 100], freq=FALSE, breaks = 101) ## curve(dlnorm(x, log(tdt), sqrt(tdvart)), add=TRUE) ## hist(ed, freq=FALSE, breaks = 101) ## ## plot against logit-normal distribution ## mean(ed < edt7 & ed > edt3) ## pnorm(edt7, edt, sqrt(edvar))-pnorm(edt3, edt, sqrt(edvar)) ## ################################################################################ ## ## test 3: study example ## nSim <- 100 ## doses <- c(0,1,3,10,30,50,75,150,300,450) ## n <- c(100,rep(38,8),100) ## sigma <- 380 ## mm <- Mods(sigEmax = rbind(c(100,6),c(170,4), c(80,3), c(290,5)), ## emax = c(5,20,50,120), linear=NULL, doses=doses, ## placEff=0, maxEff=150) ## model <- "sigEmax" ## pp <- planMod(model, mm, n, sigma, doses=doses, ## simulation = TRUE, cores = 4, ## alpha = 0.025, nSim = nSim, ## p = 0.5, pLB = 0.25, pUB = 0.75) ## print(pp) ## summary(pp, Delta = 130, p = 0.5) ## plot(pp) ## plot(pp, type="ED", 0.5) ## plot(pp, type="TD", Delta = 130, direction = "increasing") ## model <- "emax" ## pp <- planMod(model, mm, n, sigma, doses=doses, ## simulation = TRUE, cores = 4, ## alpha = 0.025, ## p = 0.5, pLB = 0.25, pUB = 0.75) ## model <- "linear" ## pp <- planMod(model, mm, n, sigma, doses=doses, ## simulation = TRUE, cores = 4, ## alpha = 0.025, nSim = nSim, ## p = 0.5, pLB = 0.25, pUB = 0.75) ## ## now model selection ## model <- c("sigEmax", "emax") ## pp1 <- planMod(model, mm, n, sigma, doses=doses, asyApprox = FALSE, ## simulation = TRUE, cores = 4, ## alpha = 0.025, nSim = nSim, ## p = 0.5, pLB = 0.25, pUB = 0.75) ## print(pp1) ## summary(pp1) ## plot(pp1) ## plot(pp1, type="ED", 0.5) ## plot(pp1, type="TD", Delta = 130, direction = "increasing") ## ## ################################################################################ ## ## ## test 4: study example ## doses <- c(0,10,25,50,100,150) ## fmodels <- Mods(linear = NULL, emax = 25, ## logistic = c(50, 10.88111), exponential= 85, ## betaMod=rbind(c(0.33,2.31),c(1.39,1.39)), ## doses = doses, addArgs=list(scal = 200), ## placEff = 0, maxEff = 0.4) ## sigma <- 1 ## n <- rep(62, 6)*2 ## ## use all models not used previously ## model <- c("linear", "quadratic", "exponential", "betaMod", "logistic", "linlog") ## altb <- defBnds(200) ## pp <- planMod(model, fmodels, n, sigma, doses=doses, ## asyApprox = FALSE, simulation = TRUE, cores = 4, ## alpha = 0.025, nSim = nSim, bnds=altb, ## p = 0.5, pLB = 0.25, pUB = 0.75) ## pp ## summary(pp, p = 0.5, Delta = 0.3) ## plot(pp) ## plot(pp, type = "TD", Delta=0.3, direction = "i") ## plot(pp, type = "ED", p = 0.5) ## ######################################################################## ## ## test 5: C's example ## models <- Mods(linear = NULL, linlog = NULL, emax = c(8, 10), ## sigEmax = c(10, 2), ## doses = c(0, 10,20, 50, 100), ## placEff=0, maxEff=-2) ## pObj <- planMod("sigEmax",models,n=100,sigma=1.2, ## simulation=TRUE,nSim=100, cores=4) ## summary(pObj,Delta=-1.1) ## this should fail ## summary(pObj,Delta=1.1) ## plot(pObj) ## plot(pObj, type = "TD", Delta=-1.1) ## this should fail ## plot(pObj, type = "TD", Delta=1.1) ## plot(pObj, type = "ED", p=0.5) DoseFinding/tests/testsMCPMod.R0000644000176200001440000001603214654153534016106 0ustar liggesusersrequire("DoseFinding") ######################################################################## #### multContTest # functions to sample random DF data getDosSampSiz <- function(){ # generate dose levels mD <- runif(1, 0, 1500) nD <- max(rpois(1, 5), 4) p <- rgamma(nD, 3) p <- cumsum(p/sum(p)) doses <- signif(c(0, mD*p), 3) # sample size allocations totSS <- rpois(1, rexp(1, 1/250)) totSS <- max(totSS, 50) p <- rgamma(nD+1, 3);p <- p/sum(p) n <- round(p*totSS) n[n==0] <- rpois(sum(n==0), 1)+1 list(doses=doses, n=n) } getDFdataSet <- function(doses, n){ ll <- getDosSampSiz() e0 <- rnorm(1, 0, 10) eMax <- rgamma(1, abs(e0)*0.5, 0.5)*I(runif(1)<0.25) if(eMax > 0){ sig <- eMax/runif(1, 0.5, 5)} else { sig <- rgamma(1, abs(e0)*0.5, 0.5) } dosVec <- rep(ll$doses, ll$n) if(runif(1)<0.3){ mnVec <- betaMod(dosVec, e0=e0, eMax=eMax, delta1=runif(1, 0.5, 5), delta2=runif(1, 0.5, 5), scal=1.2*max(ll$doses)) } else { mnVec <- logistic(dosVec, e0 = e0, eMax = eMax, ed50=runif(1, 0.05*max(ll$doses), 1.5*max(ll$doses)), delta=runif(1, 0.5, max(ll$doses)/2)) } resp <- rnorm(sum(ll$n), mnVec, sig) N <- sum(ll$n) cov1 <- as.factor(rpois(N, 5)) cov2 <- runif(N, 1, 100) aa <- data.frame(x= dosVec, y=resp, cov1=cov1, cov2=cov2) aa[sample(1:nrow(aa)),] } #### simulate data set.seed(10) dd <- getDFdataSet() bet <- guesst(0.9*max(dd$x), p=0.8, "betaMod", scal = 1.2*max(dd$x), dMax = 0.7*max(dd$x), Maxd = max(dd$x)) sE <- guesst(c(0.5*max(dd$x), 0.7*max(dd$x)) , p=c(0.5, 0.9), "sigEmax") models <- Mods(linear = NULL, betaMod = bet, sigEmax = sE, doses = sort(unique(dd$x)), addArgs=list(scal = 1.2*max(dd$x))) obj <- MCPMod(x,y, dd, models=models, addCovars = ~cov1+cov2, alpha=0.05, Delta=0.5) plot(obj, plotData="meansCI", CI=TRUE) obj <- MCPMod(dd$x,dd$y, models=models, alpha=0.05, Delta=0.5) plot(obj, plotData="meansCI", CI=TRUE) #### different model set set.seed(10) dd <- getDFdataSet() mD <- max(dd$x) lg1 <- guesst(c(0.3*mD, 0.4*mD), c(0.3, 0.9), "logistic") lg2 <- guesst(c(0.3*mD, 0.4*mD), c(0.3, 0.5), "logistic") expo <- guesst(c(0.9*mD), c(0.7), "exponential", Maxd=mD) quad <- guesst(c(0.6*mD), c(1), "quadratic") models <- Mods(linlog = NULL, logistic = rbind(lg1, lg2), exponential = expo, quadratic = quad, doses = sort(unique(dd$x)), addArgs=list(off = 0.2*max(dd$x))) obj <- MCPMod(x,y, dd, models=models, addCovars = ~cov1+cov2, alpha = 0.2, Delta=0.5) plot(obj, plotData="meansCI", CI=TRUE) obj <- MCPMod(dd$x,dd$y, models=models, addCovars = ~1, alpha = 0.2, Delta=0.5) plot(obj, plotData="meansCI", CI=TRUE) ######################################################################## #### some binary test cases getDFdataSet.bin <- function(doses, n){ ll <- getDosSampSiz() ll$n <- ll$n+10 e0 <- rnorm(1, 0, sqrt(3.28)) eMax <- rnorm(1, 0, 5) dosVec <- rep(ll$doses, ll$n) if(runif(1)<0.3){ mn <- betaMod(dosVec, e0 = e0, eMax = eMax, delta1=runif(1, 0.5, 5), delta2=runif(1, 0.5, 5), scal=1.2*max(ll$doses)) } else { mn <- logistic(dosVec, e0 = e0, eMax = eMax, ed50=runif(1, 0.05*max(ll$doses), 1.5*max(ll$doses)), delta=runif(1, 0.5, max(ll$doses)/2)) } resp <- rbinom(length(ll$n), ll$n, 1/(1+exp(-mn))) aa <- data.frame(dose = ll$doses, resp = resp) aa <- data.frame(x= aa$dose, y=aa$resp/ll$n, n=ll$n) aa[sample(1:nrow(aa)),] } set.seed(1909) dd <- getDFdataSet.bin() bet <- guesst(0.9*max(dd$x), p=0.8, "betaMod", scal = 1.2*max(dd$x), dMax = 0.7*max(dd$x), Maxd = max(dd$x)) sE <- guesst(c(0.5*max(dd$x), 0.7*max(dd$x)) , p=c(0.5, 0.9), "sigEmax") models <- Mods(linear = NULL, betaMod = bet, sigEmax = sE, doses = sort(unique(dd$x)), addArgs=list(scal = 1.2*max(dd$x))) logReg <- glm(y~as.factor(x)-1, family=binomial, data=dd, weights = n) dePar <- coef(logReg) vCov <- vcov(logReg) dose <- sort(unique(dd$x)) obj <- MCPMod(dose, dePar, S=vCov, models=models, type="general", df=Inf, alpha = 0.3, Delta = 0.5) plot(obj, plotData="meansCI", CI=TRUE) set.seed(1997) dd <- getDFdataSet.bin() bet <- guesst(0.9*max(dd$x), p=0.8, "betaMod", scal = 1.2*max(dd$x), dMax = 0.7*max(dd$x), Maxd = max(dd$x)) sE <- guesst(c(0.5*max(dd$x), 0.7*max(dd$x)) , p=c(0.5, 0.9), "sigEmax") models <- Mods(linear = NULL, betaMod = bet, sigEmax = sE,direction = "decreasing", addArgs=list(scal = 1.2*max(dd$x)), doses = sort(unique(dd$x))) logReg <- glm(y~as.factor(x)-1, family=binomial, data=dd, weights = n) dePar <- coef(logReg) vCov <- vcov(logReg) dose <- sort(unique(dd$x)) obj <- MCPMod(dose, dePar, S=vCov, models=models, type = "general", pVal = TRUE, df=Inf, alpha = 0.2, Delta = 0.5) plot(obj, plotData="meansCI", CI=TRUE) set.seed(1) dd <- getDFdataSet.bin() bet <- guesst(0.9*max(dd$x), p=0.8, "betaMod", scal = 1.2*max(dd$x), dMax = 0.7*max(dd$x), Maxd = max(dd$x)) sE <- guesst(c(0.5*max(dd$x), 0.7*max(dd$x)) , p=c(0.5, 0.9), "sigEmax") models <- Mods(linear = NULL, betaMod = bet, sigEmax = sE, doses = sort(unique(dd$x)), addArgs=list(scal = 1.2*max(dd$x))) logReg <- glm(y~as.factor(x)-1, family=binomial, data=dd, weights = n) dePar <- coef(logReg) vCov <- vcov(logReg) dose <- sort(unique(dd$x)) obj <- MCPMod(dose, dePar, S=vCov, models=models, type = "general", pVal = T, df=Inf, alpha = 0.4, Delta = 0.5) plot(obj, plotData="meansCI", CI=TRUE) ######################################################################## ## placebo-adjusted scale ## two blocks below should give equal results data(IBScovars) modlist <- Mods(emax = 0.05, linear = NULL, linInt = c(0, 1, 1, 1), doses = c(0, 1, 2, 3, 4)) ancMod <- lm(resp~factor(dose)+gender, data=IBScovars) drEst <- coef(ancMod)[2:5] vc <- vcov(ancMod)[2:5, 2:5] doses <- (1:4) obj <- MCPMod(doses, drEst, S = vc, models = modlist, placAdj = TRUE, type = "general", df = Inf, Delta=0.5) plot(obj, plotData="meansCI", CI=TRUE) ## now unordered ord <- c(3,4,1,2) drEst2 <- drEst[ord] vc2 <- vc[ord,ord] doses2 <- doses[ord] obj <- MCPMod(doses2, drEst2, S = vc2, models = modlist, placAdj = TRUE, type = "general", df = Inf, Delta = 0.5) plot(obj, plotData="meansCI", CI=TRUE) ## unadjusted scale ## two blocks below should give equal results ancMod <- lm(resp~factor(dose)-1, data=IBScovars) drEst <- coef(ancMod) vc <- vcov(ancMod) doses <- 0:4 obj <- MCPMod(doses, drEst, S = vc, models = modlist, type = "general", df = Inf, Delta = 0.5) plot(obj, plotData="meansCI", CI=TRUE) ord <- c(3,4,1,2,5) drEst2 <- drEst[ord] vc2 <- vc[ord,ord] doses2 <- doses[ord] obj <- MCPMod(doses2, drEst2, S = vc2, models = modlist, type = "general", df = Inf, Delta = 0.5) plot(obj, plotData="meansCI", CI=TRUE) DoseFinding/tests/testssampSize.R0000644000176200001440000001203514654153534016621 0ustar liggesusers## require("DoseFinding") ## S <- diag(rep(1,4))/c(5,6,7,8) ## contrastModels <- Mods(emax=c(0.25,0.01),exponential=c(1.5), ## doses=seq(0,1,length=5)) ## contMat <- optContr(contrastModels,c(0.25,0.5,0.75,1),S=S,placAdj=TRUE)$contMat ## ## power scenario 1 ## models <- Mods(linear=NULL,emax=c(0.25,0.01),doses=seq(0,1,length=5), ## placEff=c(0.5,0.6,0.7),maxEff=0.5) ## power1 <- powMCT(contMat, alpha = 0.025, altModels=models, S=S, placAdj = TRUE, ## alternative = c("one.sided"),df=Inf, critV = TRUE) ## ## power scenario 2: placebo Effect smaller for linear model. ## models <- Mods(linear=NULL,emax=c(0.25,0.01), ## doses=seq(0,1,length=5),placEff=c(0.1,0.6,0.7),maxEff=0.5) ## power2 <- powMCT(contMat, alpha = 0.025, altModels=models, S=S, placAdj = TRUE, ## alternative = c("one.sided"),df=Inf, critV = TRUE) ## ## resulting values: ## any(abs(power1-power2) > 0.05) ## ## everything commented out here, for time reasons ## ## first define the target function ## ## first calculate the power to detect all of the models in the candidate set ## fmodels <- Mods(linear = NULL, emax = c(25), ## logistic = c(50, 10.88111), exponential=c(85), ## betaMod=matrix(c(0.33,2.31,1.39,1.39), byrow=TRUE, nrow=2), ## doses = c(0,10,25,50,100,150), placEff=0, maxEff=0.4, ## addArgs = list(scal=200)) ## ## contrast matrix to use ## contMat <- optContr(fmodels, w=1) ## ## this function calculates the power under each model and then returns ## ## the average power under all models ## tFunc <- function(n){ ## powVals <- powMCT(contMat, altModels=fmodels, n=n, sigma = 1, ## alpha=0.05) ## mean(powVals) ## } ## ## assume we want to achieve 80\% average power over the selected shapes ## ## and want to use a balanced allocations ## sSize <- sampSize(upperN = 80, targFunc = tFunc, target=0.8, ## alRatio = rep(1,6), verbose = TRUE) ## ## Now the same using the convenience sampSizeMCT function ## sampSizeMCT(upperN=80, contMat = contMat, sigma = 1, altModels=fmodels, ## power = 0.8, alRatio = rep(1, 6), alpha = 0.05) ## ## Alternatively one can also specify an S matrix ## ## covariance matrix in one observation (6 total observation result in a ## ## variance of 1 in each group) ## S <- 6*diag(6) ## ## this uses df = Inf, hence a slightly smaller sample size results ## sampSizeMCT(upperN=500, contMat = contMat, S=S, altModels=fmodels, ## power = 0.8, alRatio = rep(1, 6), alpha = 0.05, Ntype = "total") ## ## targN examples ## ## first calculate the power to detect all of the models in the candidate set ## fmodels <- Mods(linear = NULL, emax = c(25), ## logistic = c(50, 10.88111), exponential=c(85), ## betaMod=matrix(c(0.33,2.31,1.39,1.39), byrow=TRUE, nrow=2), ## doses = c(0,10,25,50,100,150), placEff=0, maxEff=0.4, ## addArgs = list(scal=200)) ## ## corresponding contrast matrix ## contMat <- optContr(fmodels, w=1) ## ## define target function ## tFunc <- function(n){ ## powMCT(contMat, altModels=fmodels, n=n, sigma = 1, alpha=0.05) ## } ## powVsN <- targN(upperN = 100, lowerN = 10, step = 10, tFunc, ## alRatio = rep(1, 6)) ## plot(powVsN) ## ## the same can be achieved using the convenience powN function ## ## without the need to specify a target function ## res <- powN(upperN = 100, lowerN=10, step = 10, contMat = contMat, ## sigma = 1, altModels = fmodels, alpha = 0.05, alRatio = rep(1, 6)) ## ## the same but with S (but using df=Inf) ## S <- 6*diag(6) ## res1 <- powN(upperN=80*6, lowerN=60, step=60, contMat = contMat, ## S=S, altModels = fmodels, alRatio = rep(1, 6), ## alpha = 0.05, sumFct = "mean", Ntype = "total") ## ## different allocation ratio ## res2 <- powN(upperN=80, lowerN=10, step=10, contMat = contMat, ## sigma = 1, altModels=fmodels, alRatio = c(1, rep(0.5,4), 1), ## alpha = 0.05, sumFct = "mean") ## ## powMCT(contMat, n = c(100,rep(50,4),100), sigma = 1, altModels = fmodels, ## ## alpha = 0.05) ## ## iterating the total sample size ## res3 <- powN(upperN=600, lowerN=100, step=25, contMat = contMat, ## sigma = 1, altModels=fmodels, alRatio = rep(1, 6), ## alpha = 0.05, sumFct = "mean", Ntype = "total") ## ## powMCT(contMat, n = c(50,rep(50,4),50), sigma = 1, altModels = fmodels, ## ## alpha = 0.05) ## ## iterating the total sample size, with unbalanced allocations ## res4 <- powN(upperN=600, lowerN=100, step=25, contMat = contMat, ## sigma = 1, altModels=fmodels, alRatio = c(1, rep(0.5,4), 1), ## alpha = 0.05, sumFct = "mean", Ntype = "total") ## ## powMCT(contMat, n = c(100,rep(50,4),100), sigma = 1, altModels = fmodels, ## ## alpha = 0.05) DoseFinding/tests/testthat/0000755000176200001440000000000014764054522015456 5ustar liggesusersDoseFinding/tests/testthat/test-planMod.R0000644000176200001440000001430314762603270020147 0ustar liggesuserscontext("planning models") # TODO # * what do we want to do with tests #3-5 (mostly plots) # * test #4 crashes in planMod # test 1: "validation" using fitMod and vcov.DRMod and predict.DRMod test_that("getPredVar gives the same results as predict.DRMod", { n <- c(100,50,50,50,100) doses <- c(0,10,20,40,50) cf <- c(0,1,10) V <- DoseFinding:::aprCov(doses, "emax", cf, S=diag(1/n)) pv1 <- DoseFinding:::getPredVar("emax", cf, V=V, pDose=50) # now validation using the formulas in fitMod doseVec <- rep(doses, n) respVec <- rnorm(length(doseVec)) dd <- fitMod(doseVec, respVec, model="emax") # now change to achieve desired values dd$coefs <- cf dd$df <- dd$RSS <- sum(n) pv2 <- predict(dd, predType = "effect-curve", doseSeq=50, se.fit=TRUE)$se.fit^2 expect_equal(pv1, pv2) }) # test 2: "validation" using simulation test_that("get_{TD,ED,Pred}Var gives the same result as a simulation", { skip_on_cran() # select very large sample size (to validate asymptotics) n <- c(100000, 50000, 50000, 50000, 100000) ##n <- c(100, 50, 50, 50, 100) doses <- c(0,10,20,40,50) cf <- c(0,0.4,10) Delta <- 0.2 mm <- Mods(emax=cf[3], doses=doses, placEff=0, maxEff=emax(50,cf[1],cf[2],cf[3])) true_values <- unname(c(ED(mm, p=0.5), TD(mm, Delta=Delta), emax(50, cf[1], cf[2], cf[3]))) V <- DoseFinding:::aprCov(doses, "emax", cf, S=diag(0.3^2/n)) true_variances <- unname(c( DoseFinding:::getEDVar("emax", cf, V=V, p=0.5, maxD=50, scale = "unrestricted"), DoseFinding:::getTDVar("emax", cf, V=V, Delta=Delta, scale = "unrestricted"), DoseFinding:::getPredVar("emax", cf, V=V, pDose=50))) # simulation mn <- emax(doses, cf[1], cf[2], cf[3]) doseVec <- rep(doses, n) mnVec <- rep(mn, n) one_sim <- function() { respVec <- mnVec + rnorm(length(mnVec),0,0.3) ff <- fitMod(doseVec, respVec, model="emax", bnds = c(0.05, 75)) return(c(ed = ED(ff, p=0.5), td = TD(ff, Delta = Delta), pl = predict(ff, doseSeq=50, predType = "effect-curve"))) } sim <- replicate(100, one_sim()) # for a real check use 10000 expect_equal(unname(rowMeans(sim)), true_values, tolerance = 0.01) expect_equal(unname(apply(sim, 1, var)), true_variances, tolerance = 0.01) edt7 <- ED(mm, p=0.7) edt3 <- ED(mm, p=0.3) expect_equal(mean(sim[1,] < edt7 & sim[1,] > edt3), unname(pnorm(edt7, true_values[1], sqrt(true_variances[1])) - pnorm(edt3, true_values[1], true_variances[1])), tolerance = 0.01) }) # test 5: C's example test_that("negative values for Delta lead to an error", { models <- Mods(linear = NULL, linlog = NULL, emax = c(8, 10), sigEmax = c(10, 2), doses = c(0, 10,20, 50, 100), placEff=0, maxEff=-2) pObj <- planMod("sigEmax",models,n=100,sigma=1.2, simulation=TRUE,nSim=100) expect_error(summary(pObj,Delta=-1.1), "\"Delta\" needs to be > 0") }) ## error testing doses <- c(0, 10, 25, 50, 100, 150) fmodels <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), exponential = 85, betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), doses = doses) sigma <- 1 n <- rep(62, 6) * 2 test_that("planMod errors when wrong or incomplete arguments supplied", { expect_error(planMod("linInt", fmodels, n, sigma, doses = doses), "planMod works for all built-in models but not linInt") expect_error(planMod(c("linear", "quadratic"), fmodels, n, sigma, doses = doses, asyApprox = TRUE, simulation = FALSE), "\"asyApprox\" needs to be FALSE for multiple models") expect_error(planMod("linear", fmodels, doses = doses, asyApprox = TRUE, simulation = FALSE), "either S or n and sigma need to be specified") expect_error(planMod("linear", fmodels, c(62, 62), sigma, doses = doses, asyApprox = TRUE, simulation = FALSE), "\"n\" and \"doses\" need to be of same length") expect_error(planMod("linear", fmodels, n, sigma, doses = doses, asyApprox = FALSE, simulation = FALSE), "Need to select either \"asyApprox = TRUE\" or \"simulation = TRUE\"") }) ## test print and plot methods # Mock some inputs for the planMod function to use in the tests doses <- c(0, 10, 25, 50, 100, 150) fmodels <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), exponential = 85, betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), doses = doses) sigma <- 1 n <- rep(62, 6) * 2 # Generate a planMod object to use in tests pObj <- planMod("linear", fmodels, n, sigma, doses = doses, asyApprox = TRUE, simulation = TRUE, nSim = 10) # Test cases test_that("print.planMod works without errors", { expect_output(print(pObj), "Fitted Model: linear", fixed = TRUE) }) test_that("plot.planMod dose-response plot works without errors", { expect_silent(plot(pObj, type = "dose-response")) }) test_that("plot.planMod ED plot works without errors", { expect_silent(plot(pObj, type = "ED", p = 0.5)) }) test_that("plot.planMod TD plot works without errors", { expect_silent(plot(pObj, type = "TD", Delta = 0.3)) }) test_that("print.planMod for multiple models works without errors", { pObj_multi <- planMod(c("linear", "quadratic"), fmodels, n, sigma, doses = doses, asyApprox = FALSE, simulation = TRUE, nSim = 10) expect_output(print(pObj_multi), "Fitted Models: linear quadratic", fixed = TRUE) }) test_that("plot.planMod for multiple models dose-response plot works without errors", { pObj_multi <- planMod(c("linear", "quadratic"), fmodels, n, sigma, doses = doses, asyApprox = FALSE, simulation = TRUE, nSim = 10) expect_silent(plot(pObj_multi, type = "dose-response")) }) test_that("plot.planMod for multiple models ED plot works without errors", { pObj_multi <- planMod(c("linear", "quadratic"), fmodels, n, sigma, doses = doses, asyApprox = FALSE, simulation = TRUE, nSim = 10) expect_silent(plot(pObj_multi, type = "ED", p = 0.5)) }) test_that("plot.planMod for multiple models TD plot works without errors", { pObj_multi <- planMod(c("linear", "quadratic"), fmodels, n, sigma, doses = doses, asyApprox = FALSE, simulation = TRUE, nSim = 10) expect_silent(plot(pObj_multi, type = "TD", Delta = 0.3)) }) DoseFinding/tests/testthat/test-sampSize.R0000644000176200001440000002206414762603270020353 0ustar liggesusers# create contrast matrix doses <- c(0, 10, 25, 50, 100, 150) fmodels <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), exponential = 85, betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), doses = doses, addArgs = list(scal = 200), placEff = 0, maxEff = 0.4) contMat <- optContr(fmodels, w = 1) tFunc <- function(n) { powVals <- powMCT(contMat, altModels = fmodels, n = n, sigma = 1) mean(powVals) } ######################################################### ## General tests: does sampSize work as expected ######################################################### test_that("sampSize and sampSizeMCT work correctly", { result1 <- sampSize(upperN = 80, targFunc = tFunc, target = 0.8, alRatio = rep(1, 6)) result2 <- sampSizeMCT(upperN = 80, power = 0.8, alRatio = rep(1, 6), contMat = contMat, altModels = fmodels, sigma = 1) expect_true(is.list(result1)) expect_true(all(result1$samp.size > 0)) expect_true(result1$target > 0) expect_true(is.list(result2)) expect_true(all(result2$samp.size > 0)) expect_true(result2$target > 0) expect_equal(result1$samp.size, result2$samp.size, tolerance = 1) }) test_that("sampSize and sampSizeMCT work correctly with Ntype = total", { result1 <- sampSize(upperN = 80, targFunc = tFunc, target = 0.8, alRatio = rep(1, 6), Ntype = "total") result2 <- sampSizeMCT(upperN = 80, power = 0.8, alRatio = rep(1, 6), contMat = contMat, altModels = fmodels, sigma = 1, Ntype = "total") expect_true(is.list(result1)) expect_true(all(result1$samp.size > 0)) expect_true(result1$target > 0) expect_true(is.list(result2)) expect_true(all(result2$samp.size > 0)) expect_true(result2$target > 0) expect_equal(result1$samp.size, result2$samp.size, tolerance = 6) }) test_that("sampSize and sampSizeMCT work correctly with sumFct = min", { result1 <- sampSize(upperN = 80, targFunc = tFunc, target = 0.8, alRatio = rep(1, 6), Ntype = "total") result2 <- sampSizeMCT(upperN = 80, power = 0.8, alRatio = rep(1, 6), contMat = contMat, altModels = fmodels, sigma = 1, Ntype = "total", sumFct = min) expect_true(is.list(result1)) expect_true(all(result1$samp.size > 0)) expect_true(result1$target > 0) expect_true(is.list(result2)) expect_true(all(result2$samp.size > 0)) expect_true(result2$target > 0) expect_equal(result1$samp.size, result2$samp.size, tolerance = 6) }) test_that("sampSizeMCT handles S matrix correctly", { S <- 6 * diag(6) result <- sampSizeMCT(upperN = 500, contMat = contMat, S = S, altModels = fmodels, power = 0.8, alRatio = rep(1, 6), Ntype = "total") expect_true(is.list(result)) expect_true(all(result$samp.size > 0)) expect_true(result$target > 0) }) test_that("print.sampSize prints correct output", { sSize_obj <- sampSize(upperN = 80, targFunc = tFunc, target = 0.8, alRatio = rep(1, 6), Ntype = "total") expect_output(print(sSize_obj), "Sample size calculation\n\n", fixed = TRUE) expect_output(print(sSize_obj), "alRatio: ", fixed = TRUE) expect_output(print(sSize_obj), paste("Total sample size:", sum(sSize_obj$samp.size)), fixed = TRUE) expect_output(print(sSize_obj), paste("Sample size per arm:", paste(sSize_obj$samp.size, collapse = " ")), fixed = TRUE) expect_output(print(sSize_obj), paste("targFunc:", sSize_obj$target), fixed = TRUE) }) ######################################################## ## Error testing ######################################################## test_that("sampSize errors with invalid inputs", { expect_error(sampSize(upperN = 80, targFunc = NULL, target = 0.8, alRatio = rep(1, 6)), "targFunc") expect_error(sampSize(upperN = 80, targFunc = function(n) { n }, target = 0.8), "allocation ratios need to be specified") expect_error(sampSize(upperN = 80, targFunc = function(n) { n }, target = 0.8, alRatio = c(1, -1, 1)), "all entries of alRatio need to be positive") }) test_that("sampSizeMCT errors with invalid inputs", { expect_error(sampSizeMCT(upperN = 80, contMat = contMat, altModels = fmodels, power = 0.8, alRatio = rep(1, 6), alpha = 0.025, placAdj = TRUE), "placAdj needs to be FALSE") expect_error(sampSizeMCT(upperN = 80, contMat = contMat, altModels = fmodels, power = 0.8, alRatio = rep(1, 6), sigma = 1, n = 50), "n is not allowed to be specified") expect_error(sampSizeMCT(upperN = 80, contMat = contMat, altModels = fmodels, power = 0.8, alRatio = rep(1, 6)), "need sigma if S is not specified") }) ######################################################## ## Compare results to powMCT ######################################################## # Tests for sampSizeMCT function test_that("sampSizeMCT results are consistent with powMCT", { result <- sampSizeMCT(upperN = 80, contMat = contMat, sigma = 1, altModels = fmodels, power = 0.8, alRatio = rep(1, 6), alpha = 0.025) power <- powMCT(contMat, altModels = fmodels, sigma = 1, n = result$samp.size[1]) expect_equal(result$target, mean(power), tolerance = 0.01) }) ######################################################## ## Testing targN and powN ######################################################## tFunc <- function(n) { powVals <- powMCT(contMat, altModels = fmodels, n = n, sigma = 1) powVals } test_that("targN calculates target function values correctly", { # Perform targN calculations result <- targN(upperN = 100, lowerN = 10, step = 10, targFunc = tFunc, alRatio = rep(1, 6)) power <- powMCT(contMat, altModels = fmodels, n = 50, sigma = 1) power <- c(power, min(power), mean(power), max(power)) expect_true(is.matrix(result)) expect_true(nrow(result) > 0) expect_true(ncol(result) > 0) expect_true(all(result > 0 & result <= 1)) expect_true(all(c("min", "mean", "max") %in% colnames(result))) expect_equal(as.numeric(power), as.numeric(result[5, ]), tolerance = 0.01) }) test_that("powN calculates power correctly", { # Perform targN calculations result <- powN(upperN = 100, lowerN = 10, step = 10, alRatio = rep(1, 6), contMat = contMat, sigma = 1, altModels = fmodels) power <- powMCT(contMat, altModels = fmodels, n = 50, sigma = 1) power <- c(power, min(power), mean(power), max(power)) expect_true(is.matrix(result)) expect_true(nrow(result) > 0) expect_true(ncol(result) > 0) expect_true(all(result > 0 & result <= 1)) expect_true(all(c("min", "mean", "max") %in% colnames(result))) expect_equal(as.numeric(power), as.numeric(result[5, ]), tolerance = 0.01) }) test_that("targN errors with invalid inputs", { expect_error(targN(upperN = 100, lowerN = 10, step = 10, targFunc = tFunc), "allocation ratios need to be specified") expect_error(targN(upperN = 100, lowerN = 10, step = 10, targFunc = tFunc, alRatio = c(1, 0, 1)), "all entries of alRatio need to be positive") expect_error(targN(upperN = 100, lowerN = 10, step = 10, targFunc = tFunc, alRatio = rep(1, 6), sumFct = mean), "sumFct needs to be a character vector") }) test_that("powN errors with invalid inputs", { expect_error(powN(upperN = 100, lowerN = 10, step = 10, alRatio = rep(1, 6), contMat = contMat, sigma = 1, altModels = fmodels, placAdj = TRUE), "placAdj needs to be FALSE for powN") expect_error(powN(upperN = 100, lowerN = 10, step = 10, alRatio = rep(1, 6), contMat = contMat, sigma = 1, n = 50, altModels = fmodels), "n is not allowed to be specified for sample size calculation") expect_error(powN(upperN = 100, lowerN = 10, step = 10, alRatio = rep(1, 6), contMat = contMat, altModels = fmodels), "need sigma if S is not specified") }) test_that("powN handles S matrix correctly", { S <- 6 * diag(6) result <- powN(upperN = 100, lowerN = 10, step = 10, contMat = contMat, S = S, altModels = fmodels, alRatio = rep(1, 6), Ntype = "total") expect_true(is.matrix(result)) expect_true(nrow(result) > 0) expect_true(ncol(result) > 0) expect_true(all(result > 0 & result <= 1)) expect_true(all(c("min", "mean", "max") %in% colnames(result))) }) # Tests for plot.targN function tn <- targN(upperN = 100, lowerN = 10, step = 10, targFunc = tFunc, alRatio = rep(1, 6)) test_that("plot.targN works as expected", { expect_error(plot(tn), NA) # Test with superpose = TRUE expect_error(plot(tn, superpose = TRUE), NA) # Test with superpose = FALSE expect_error(plot(tn, superpose = FALSE), NA) # Test with line.at specified expect_error(plot(tn, line.at = 0.8), NA) # Test with line.at as NULL expect_error(plot(tn, line.at = NULL), NA) # Test with custom xlab and ylab expect_error(plot(tn, xlab = "Sample Size", ylab = "Power"), NA) # Test with default xlab and ylab expect_error(plot(tn, xlab = NULL, ylab = NULL), NA) }) DoseFinding/tests/testthat/test-guesst.R0000644000176200001440000000714114762603270020071 0ustar liggesuserscontext("guesstimates") test_that("emax", { emx1 <- guesst(d=0.3, p=0.8, model="emax") expect_equal(unname(emax(0.3,0,1,emx1)), 0.8, tolerance = 0.001) }) test_that("emax local", { emx2 <- guesst(d=0.3, p=0.8, model="emax", local = TRUE, Maxd = 1) expect_equal(unname(emax(0.3,0,1,emx2)/emax(1,0,1,emx2)), 0.8, tolerance = 0.001) }) test_that("betaMod", { bta <- guesst(d=0.4, p=0.8, model="betaMod", dMax=0.8, scal=1.2, Maxd=1) expect_equal(betaMod(c(0.4,0.8), 0, 1, bta[1], bta[2], scal=1.2), c(0.8, 1.0), tolerance = 0.001) }) test_that("exponential", { expo <- guesst(d = 0.8, p = 0.5, "exponential", Maxd=1) expect_equal(unname(exponential(0.8,0,1,expo)/exponential(1,0,1,expo)), 0.5, tolerance = 0.001) }) test_that("quadratic", { quad <- guesst(d = 0.7, p = 1, "quadratic") mm <- Mods(quadratic=quad, doses=c(0,0.7,1)) expect_equal(getResp(mm)[2], 1, tolerance = 0.001) }) test_that("logistic", { lgc1 <- guesst(d = c(0.2, 0.6), p = c(0.2, 0.95), "logistic") expect_equal(logistic(c(0.2,0.6), 0, 1, lgc1[1], lgc1[2]), c(0.2, 0.95), tolerance = 0.001) }) test_that("logistic local", { lgc2 <- guesst(d = c(0.2, 0.6), p = c(0.2, 0.95), "logistic", local = TRUE, Maxd = 1) r0 <- logistic(0, 0, 1, lgc2[1], lgc2[2]) r1 <- logistic(1, 0, 1, lgc2[1], lgc2[2]) expect_equal((logistic(c(0.2,0.6), 0, 1, lgc2[1], lgc2[2])-r0)/(r1-r0), c(0.2, 0.95), tolerance = 0.001) }) test_that("sigEmax", { sgE1 <- guesst(d = c(0.2, 0.6), p = c(0.2, 0.95), "sigEmax") expect_equal(sigEmax(c(0.2,0.6), 0, 1, sgE1[1], sgE1[2]), c(0.2, 0.95), tolerance = 0.001) }) test_that("sigEmax local", { sgE2 <- guesst(d = c(0.2, 0.6), p = c(0.2, 0.95), "sigEmax", local = TRUE, Maxd = 1) r1 <- sigEmax(1, 0, 1, sgE2[1], sgE2[2]) expect_equal(sigEmax(c(0.2,0.6), 0, 1, sgE2[1], sgE2[2])/r1, c(0.2,0.95), tolerance = 0.001) }) ## test error conditions test_that("Error conditions for guesst function", { # Test for invalid percentage values (negative or greater than 1) expect_error(guesst(d = 0.5, p = -0.2, model = "emax"), "must have 0 < p <= 1") expect_error(guesst(d = 0.5, p = 1.2, model = "emax"), "must have 0 < p <= 1") # Test for logistic model needing at least two pairs expect_error(guesst(d = 0.2, p = 0.5, model = "logistic"), "logistic model needs at least two pairs") # Test for local version of emax with p <= d/Maxd expect_error(guesst(d = 0.3, p = 0.2, model = "emax", local = TRUE, Maxd = 1), "must have p > d/Maxd, for local version") # Test for exponential model needing p < d/Maxd expect_error(guesst(d = 0.8, p = 0.9, model = "exponential", Maxd = 1), "must have p < d/Maxd") # Test for betaMod model needing scal > dMax expect_error(guesst(d = 0.4, p = 0.8, model = "betaMod", dMax = 0.8, scal = 0.8, Maxd = 1), "scal needs to be larger than dMax to calculate guesstimate") # Test for betaMod model needing dMax <= Maxd expect_error(guesst(d = 0.4, p = 0.8, model = "betaMod", dMax = 1.2, scal = 1.5, Maxd = 1), "dose with maximum effect \\(dMax\\) needs to be smaller than maximum dose \\(Maxd\\)") # Test for sigmoid Emax model needing at least two pairs expect_error(guesst(d = 0.2, p = 0.5, model = "sigEmax"), "sigmoid Emax model needs at least two pairs") }) DoseFinding/tests/testthat/test-MCPMod.R0000644000176200001440000000304614762603270017636 0ustar liggesusers # Generating test data data(biom) models <- Mods(linear = NULL, emax=c(0.05,0.2), linInt=c(1, 1, 1, 1), doses=c(0,0.05,0.2,0.6,1)) MM <- MCPMod(dose, resp, biom, models, Delta=0.5) test_that("MCPMod object can be printed", { expect_output(print(MM), "MCPMod\\n") expect_output(print(MM), "Multiple Contrast Test:\\n") expect_output(print(MM), "Estimated Dose Response Models:") }) test_that("summary.MCPMod summarizes and prints an MCPMod object", { expect_output( summary(MM), "MCP part \\n") expect_output( summary(MM), "Mod part \\n") expect_output( summary(MM), "Model selection criteria \\(AIC\\):") expect_output( summary(MM), "Estimated TD\\, Delta=0\\.5\\n") }) test_that("plot.MCPMod plots the fitted dose-response model", { expect_silent(plot(MM, plotData = "meansCI")) expect_silent(plot(MM, plotData = "means")) expect_silent(plot(MM, plotData = "raw")) expect_silent(plot(MM, plotData = "none")) }) test_that("predict.MCPMod provides predictions from the fitted dose-response model", { pred <- predict(MM, se.fit = TRUE, doseSeq = c(0,0.2,0.4, 0.9, 1), predType="ls-means") expect_true(is.list(pred)) expect_true(is.list(pred[[1]])) # Ensure each model provides a list }) test_that("plot.MCPMod stops with appropriate error when no models significant", { # Create a scenario where no models are significant models_no_sig <- Mods(linear = NULL, doses=c(0,0.05,0.2,0.6,1)) MM_no_sig <- MCPMod(dose, resp, biom, models_no_sig, Delta=0.5, critV = 9999) expect_error(plot(MM_no_sig)) })DoseFinding/tests/testthat/test-bMCTtest.R0000644000176200001440000002625214654153534020253 0ustar liggesuserscontext("Bayesian multiple contrast test") # TODO: # * maybe define common candidate models outside of test_that() calls? # * how do we check for equal p-values (calculated with MC algorighm)? # * pull shared code out of test_that() calls source("generate_test_datasets.R") require_rbest <- function() { if (!require("RBesT")) { skip("RBesT package not available") } } # helper functions to increase readability of expect_equal() calls tstat <- function(obj) { UseMethod("tstat") } tstat.MCTtest <- function(obj) { # drop the pVal attribute of obj$tStat as.numeric(obj$tStat) } tstat.bMCTtest <- function(obj) { # drop the pVal attribute of obj$tStat as.numeric(obj$tStat) } tstat.glht <- function(obj) { unname(summary(obj)$test$tstat) } critVal2 <- function(obj) { UseMethod("critVal") } critVal.MCTtest <- function(obj) { as.numeric(obj$critVal) } critVal.bMCTtest <- function(obj) { as.numeric(obj$critVal) } pVal.bMCTtest <- function(obj) { as.numeric(attr(obj$tStat, "pVal")) } twoarm_rbest <- function(dat, prior1, prior2){ mod <- lm(y ~ as.factor(x) - 1, data = dat) mu1 <- coef(mod)[1] mu2 <- coef(mod)[2] S <- vcov(mod) post1 <- postmix(prior1, m = mu1, se = sqrt(S[1,1])) post2 <- postmix(prior2, m = mu2, se = sqrt(S[2,2])) pmixdiff(post1, post2, 0) } test_that("bMCTtest with uninformative prior produces same results as frequentist MCP-Mod", { require_rbest() set.seed(23) dd <- getDFdataSet_testsMCT() mD <- max(dd$x) nD <- length(unique(dd$x)) lg1 <- guesst(c(0.3*mD, 0.4*mD), c(0.3, 0.9), "logistic") lg2 <- guesst(c(0.3*mD, 0.4*mD), c(0.3, 0.5), "logistic") expo <- guesst(c(0.9*mD), c(0.7), "exponential", Maxd=mD) quad <- guesst(c(0.6*mD), c(1), "quadratic") noninf_prior <- mixnorm(c(1, 0, 10000)) prior <- vector("list", nD) for(i in 1:nD) prior[[i]] <- noninf_prior models <- Mods(linlog = NULL, logistic = rbind(lg1, lg2), exponential = expo, quadratic = quad, doses = dd$x, addArgs=list(off = 0.2*max(dd$x))) mcp_freq <- MCTtest(x,y , dd, models = models, df = Inf, critV = TRUE) mcp_bayes <- bMCTtest(x,y, dd, models=models, prior = prior) expect_equal(tstat(mcp_freq), tstat(mcp_bayes), tolerance = 0.001) expect_equal(1-pnorm(critVal2(mcp_freq)), critVal2(mcp_bayes), tolerance = 0.001) }) test_that("bMCTtest works with contrast matrix handed over and produces same results", { require_rbest() set.seed(23) dd <- getDFdataSet_testsMCT() mD <- max(dd$x) nD <- length(unique(dd$x)) lg1 <- guesst(c(0.3*mD, 0.4*mD), c(0.3, 0.9), "logistic") lg2 <- guesst(c(0.3*mD, 0.4*mD), c(0.3, 0.5), "logistic") expo <- guesst(c(0.9*mD), c(0.7), "exponential", Maxd=mD) quad <- guesst(c(0.6*mD), c(1), "quadratic") prior <- vector("list", nD) for(i in 1:nD) prior[[i]] <- mixnorm(c(1, 0, 10000)) models <- Mods(linlog = NULL, logistic = rbind(lg1, lg2), exponential = expo, quadratic = quad, doses = dd$x, addArgs=list(off = 0.2*max(dd$x))) mcp_freq <- MCTtest(x,y , dd, models = models, df = Inf, critV = TRUE) mcp_bayes <- bMCTtest(x,y, dd, models=models, prior = prior, contMat = mcp_freq$contMat) expect_equal(tstat(mcp_freq), tstat(mcp_bayes), tolerance = 0.001) expect_equal(1-pnorm(critVal2(mcp_freq)), critVal2(mcp_bayes), tolerance = 0.001) }) test_that("bMCTtest works with binary data (1)", { require_rbest() set.seed(1909) dd <- getDFdataSet.bin() bet <- guesst(0.9*max(dd$x), p=0.8, "betaMod", scal = 1.2*max(dd$x), dMax = 0.7*max(dd$x), Maxd = max(dd$x)) sE <- guesst(c(0.5*max(dd$x), 0.7*max(dd$x)) , p=c(0.5, 0.9), "sigEmax") models <- Mods(linear = NULL, betaMod = bet, sigEmax = sE, doses = sort(unique(dd$x)), addArgs=list(scal = 1.2*max(dd$x))) logReg <- glm(y~as.factor(x)-1, family=binomial, data=dd, weights = n) dePar <- coef(logReg) vCov <- vcov(logReg) dose <- sort(unique(dd$x)) prior <- vector("list", length(dose)) for(i in 1:length(unique(dd$x))) prior[[i]] <- mixnorm(c(1, 0, 10000)) mcp_freq <- MCTtest(dose, dePar, S=vCov, models=models, type = "general", df = Inf, critV = TRUE) mcp_bayes <- bMCTtest(dose, dePar, S=vCov, models=models, prior = prior, type = "general") expect_equal(tstat(mcp_freq), tstat(mcp_bayes), tolerance = 0.001) expect_equal(1-pnorm(critVal2(mcp_freq)), critVal2(mcp_bayes), tolerance = 0.001) }) test_that("MCTtest works with binary data (2)", { require_rbest() set.seed(1997) dd <- getDFdataSet.bin() bet <- guesst(0.9*max(dd$x), p=0.8, "betaMod", scal = 1.2*max(dd$x), dMax = 0.7*max(dd$x), Maxd = max(dd$x)) sE <- guesst(c(0.5*max(dd$x), 0.7*max(dd$x)) , p=c(0.5, 0.9), "sigEmax") models <- Mods(linear = NULL, betaMod = bet, sigEmax = sE,direction = "decreasing", addArgs=list(scal = 1.2*max(dd$x)), doses = sort(unique(dd$x))) logReg <- glm(y~as.factor(x)-1, family=binomial, data=dd, weights = n) dePar <- coef(logReg) vCov <- vcov(logReg) dose <- sort(unique(dd$x)) prior <- vector("list", length(dose)) for(i in 1:length(dose)) prior[[i]] <- mixnorm(c(1, 0, 10000)) mcp_freq <- MCTtest(dose, dePar, S=vCov, models=models, type = "general", df = Inf, critV = TRUE) mcp_bayes <- bMCTtest(dose, dePar, S=vCov, models=models, prior = prior, type = "general") expect_equal(tstat(mcp_freq), tstat(mcp_bayes), tolerance = 0.001) expect_equal(1-pnorm(critVal2(mcp_freq)), critVal2(mcp_bayes), tolerance = 0.001) }) test_that("MCTtest works with binary data (3)", { require_rbest() set.seed(1) dd <- getDFdataSet.bin() bet <- guesst(0.9*max(dd$x), p=0.8, "betaMod", scal = 1.2*max(dd$x), dMax = 0.7*max(dd$x), Maxd = max(dd$x)) sE <- guesst(c(0.5*max(dd$x), 0.7*max(dd$x)) , p=c(0.5, 0.9), "sigEmax") models <- Mods(linear = NULL, betaMod = bet, sigEmax = sE, doses = sort(unique(dd$x)), addArgs=list(scal = 1.2*max(dd$x))) logReg <- glm(y~as.factor(x)-1, family=binomial, data=dd, weights = n) dePar <- coef(logReg) vCov <- vcov(logReg) dose <- sort(unique(dd$x)) prior <- vector("list", length(dose)) for(i in 1:length(dose)) prior[[i]] <- mixnorm(c(1, 0, 10000)) mcp_freq <- MCTtest(dose, dePar, S=vCov, models=models, type = "general", df = Inf, critV = TRUE) mcp_bayes <- bMCTtest(dose, dePar, S=vCov, models=models, prior = prior, type = "general") expect_equal(tstat(mcp_freq), tstat(mcp_bayes), tolerance = 0.001) expect_equal(1-pnorm(critVal2(mcp_freq)), critVal2(mcp_bayes), tolerance = 0.001) }) test_that("a one-dimensional test works", { require_rbest() set.seed(1) dd <- getDFdataSet.bin() model <- Mods(linear = NULL, doses=sort(unique(dd$x)), addArgs=list(scal = 1.2*max(dd$x))) logReg <- glm(y~as.factor(x)-1, family=binomial, data=dd, weights = n) dePar <- coef(logReg) vCov <- vcov(logReg) dose <- sort(unique(dd$x)) prior <- vector("list", length(dose)) for(i in 1:length(dose)) prior[[i]] <- mixnorm(c(1, 0, 10000)) mcp_freq <- expect_warning(MCTtest(dose, dePar, S=vCov, models=model, type = "general", critV = TRUE, df=Inf), "univariate: using pnorm") mcp_bayes <- bMCTtest(dose, dePar, S=vCov, models=model, type = "general", prior = prior) expect_equal(tstat(mcp_freq), tstat(mcp_bayes), tolerance = 0.001) expect_equal(1-pnorm(critVal2(mcp_freq)), critVal2(mcp_bayes), tolerance = 0.001) }) test_that("unordered values in MCTtest work (unadjusted scale)", { require_rbest() data(IBScovars) modlist <- Mods(emax = 0.05, linear = NULL, logistic = c(0.5, 0.1), linInt = c(0, 1, 1, 1), doses = c(0, 1, 2, 3, 4)) ancMod <- lm(resp~factor(dose)-1, data=IBScovars) drEst <- coef(ancMod) vc <- vcov(ancMod) doses <- 0:4 noninf_prior <- mixnorm(c(1, 0, 10000)) prior <- vector("list", length(doses)) for(i in 1:length(doses)) prior[[i]] <- mixnorm(c(1, 0, 10000)) bnds <- defBnds(max(doses))$sigEmax test_orig <- bMCTtest(doses, drEst, S = vc, models = modlist, type = "general", prior = prior) ord <- c(3,4,1,2,5) drEst2 <- drEst[ord] vc2 <- vc[ord,ord] doses2 <- doses[ord] test_perm <- bMCTtest(doses2, drEst2, S = vc2, models = modlist, type = "general", prior = prior) expect_equal(tstat(test_orig), tstat(test_perm)) expect_equal(critVal2(test_orig), critVal2(test_perm), tolerance = 0.001) }) test_that("bMCTtest gives same results as RBesT two-sample analysis with non-informative prior", { require_rbest() set.seed(23) dd <- getDFdataSet_testsMCT() ## only keep the highest and lowest dose dd <- dd[dd$x %in% range(dd$x), ] mD <- max(dd$x) model <- Mods(linear = NULL, doses=sort(unique(dd$x))) prior <- list(mixnorm(c(1, 0, 1000)), mixnorm(c(1, 0, 1000))) twoarm <- twoarm_rbest(dd, prior[[1]], prior[[2]]) mcp_bayes <- bMCTtest(x,y, dd, models=model, prior = prior) expect_equal(twoarm, pVal.bMCTtest(mcp_bayes)) }) test_that("bMCTtest gives same results as RBesT two-sample analysis with informative prior for control", { require_rbest() set.seed(23) dd <- getDFdataSet_testsMCT() ## only keep the highest and lowest dose dd <- dd[dd$x %in% range(dd$x), ] mD <- max(dd$x) model <- Mods(linear = NULL, doses=sort(unique(dd$x))) noninf_prior <- mixnorm(c(1, 0, 1000)) inf_prior <- mixnorm(c(1, 0, 1)) prior <- list(inf_prior, noninf_prior) twoarm <- twoarm_rbest(dd, prior[[1]], prior[[2]]) mcp_bayes <- bMCTtest(x,y, dd, models=model, prior = prior) expect_equal(twoarm, pVal.bMCTtest(mcp_bayes)) }) test_that("bMCTtest gives same results as RBesT two-sample analysis with informative prior for both arms", { require_rbest() set.seed(24) dd <- getDFdataSet_testsMCT() ## only keep the highest and lowest dose dd <- dd[dd$x %in% range(dd$x), ] mD <- max(dd$x) model <- Mods(linear = NULL, doses=sort(unique(dd$x))) inf_prior_cont <- mixnorm(c(0.8, 0, 1), c(0.1, 1, 2), c(0.1, -1, 2)) inf_prior_trt <- mixnorm(c(0.5, 1, 1), c(0.3, 0.8, 2), c(0.2, 1.5, 2)) prior <- list(inf_prior_cont, inf_prior_trt) twoarm <- twoarm_rbest(dd, prior[[1]], prior[[2]]) mcp_bayes <- bMCTtest(x,y, dd, models=model, prior = prior) expect_equal(twoarm, pVal.bMCTtest(mcp_bayes)) }) test_that("Error message for incorrect prior arguments", { data(biom) ## define shapes for which to calculate optimal contrasts doses <- c(0, 0.05, 0.2, 0.6, 1) modlist <- Mods(emax = 0.05, linear = NULL, logistic = c(0.5, 0.1), linInt = c(0, 1, 1, 1), doses = doses) ## specify an informative prior for placebo, weakly informative for other arms plc_prior <- mixnorm(inf = c(0.8, 0.4, 0.1), rob = c(0.2, 0.4, 10)) vague_prior <- mixnorm(c(1, 0, 10)) ## one component of the list corresponds to each dose prior1 <- list(plc_prior, vague_prior) prior2 <- list(plc_prior, "foo", "foo", "foo", "foo") expect_error(bMCTtest(dose, resp, biom, models=modlist, prior = prior1), "Dose and prior have non-conforming size") expect_error(bMCTtest(dose, resp, biom, models=modlist, prior = prior2), "priors need to be of class normMix") }) DoseFinding/tests/testthat/test-DesignMCPModApp.R0000644000176200001440000000012214762603270021421 0ustar liggesusers test_that("DesignMCPModApp works", { expect_no_error(DesignMCPModApp()) }) DoseFinding/tests/testthat/test-optDesign.R0000644000176200001440000003640514762603270020520 0ustar liggesuserscontext("optimal designs") # TODO # * mixed Paper p. 1233, l. 2 (note the off and probably also the scal # parameter were treated as unknown in this example in the paper, hence the # results need not be consistent with paper) # # * everything from the "some other examples" section # # * optimizer = "exact" and "solnp" (weights vary by up to ~4 percentage points) # # * Example from Padmanabhan and Dragalin, Biometrical Journal 52 (2010) p. 836-852 # # * optimal design logistic regression; compare this to Atkinson et al. (2007), p. 400 ## Recreate examples from this this article ## ## @Article{dette2008, ## author = {Dette, Holger and Bretz, Frank and Pepelyshev, Andrey and Pinheiro, José}, ## title = {Optimal Designs for Dose-Finding Studies}, ## journaltitle = {Journal of the American Statistical Association}, ## year = 2008, ## volume = 103, ## issue = 483, ## pages = {1225-1237}, ## doi = {10.1198/016214508000000427}} # Note: expect_equal(..., tolerance = 1e-3) in most instances, because the # published results have three or four decimal places test_that("the emax model (table 2, line 5) gives the same results", { fMod <- Mods(emax = 25, doses = c(0,150), placEff=0, maxEff=0.4) fMod$emax[2] <- 0.6666667 doses <- c(0, 18.75, 150) probs <- 1 deswgts1 <- optDesign(fMod, probs, doses, Delta=0.2, designCrit = "TD", optimizer="Nelder-Mead") deswgts2 <- optDesign(fMod, probs, doses, Delta=0.2, designCrit = "TD", optimizer="nlminb") expect_equal(deswgts1$design, deswgts2$design, tolerance = 1e-4) expect_equal(deswgts1$design, c(0.442, 0.5, 0.058), tolerance = 1e-3) ## efficiency compared to standard design (last column) crt <- calcCrit(rep(1/6, 6), fMod, probs, c(0, 10, 25, 50, 100, 150), Delta=0.2, designCrit = "TD") expect_equal(exp(deswgts1$crit - crt), 0.5099, tolerance = 1e-4) }) test_that("the emax model (table 2, line 2) gives the same results", { fMod <- Mods(emax = 25, doses = c(0,150), placEff=0, maxEff=0.4) doses <- c(0, 18.75, 150) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.2, designCrit = "TD") expect_equal(deswgts$design, c(0.5, 0.5, 0), tolerance = 1e-3) }) test_that("the exponential model (table 3, line 2) gives the same results", { fMod <- Mods(exponential=85, doses = c(0, 150), placEff=0, maxEff=0.4) doses <- c(0, 50, 104.52, 150) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.2, designCrit = "TD", optimizer="Nelder-Mead") expect_equal(deswgts$design, c(0.5, 0, 0.5, 0), tolerance = 1e-3) # efficiency compared to standard design (last column) crt <- calcCrit(rep(1/6, 6), fMod, probs, c(0, 10, 25, 50, 100, 150), Delta=0.2, designCrit = "TD") expect_equal(exp(deswgts$crit - crt), 0.4286, tolerance = 1e-4) }) test_that("the exponential model (table 3, line 1) gives the same results", { fMod <- Mods(exponential=65, doses=c(0, 150), placEff=0, maxEff=0.4) fMod$exponential[2] <- 0.08264711 doses <- c(0, 101.57, 150) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.2, designCrit = "TD") expect_equal(deswgts$design, c(0.440, 0.5, 0.060), tolerance = 1e-3) }) test_that("the logistic model (table 4, line 7) gives the same results", { fMod <- Mods(logistic=c(50, 10.881), doses = c(0, 150), placEff=0, maxEff=0.4) doses <- c(0, 37.29, 64.44, 150) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.05, designCrit = "TD") expect_equal(deswgts$design, c(0.401, 0.453, 0.099, 0.047), tolerance = 1e-3) ## efficiency compared to standard design (last column) crt <- calcCrit(rep(1/6, 6), fMod, probs, c(0, 10, 25, 50, 100, 150), Delta=0.05, designCrit = "TD") expect_equal(exp(deswgts$crit - crt), 0.1853, tolerance = 1e-4) }) test_that("the logistic model (table 4, line 1) gives the same results", { fMod <- Mods(logistic=c(50, 10.881), doses = c(0, 150), placEff=0, maxEff=0.4) doses <- c(0, 50.22) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.2, designCrit = "TD") expect_equal(deswgts$design, c(0.5, 0.5)) }) test_that("the beta model (table 5, line 5) gives the same results", { fMod <- Mods(betaMod = c(0.33, 2.31), doses = c(0,150), addArgs=list(scal=200), placEff=0, maxEff=0.4) doses <- c(0, 0.49, 25.2, 108.07, 150) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.1, control=list(maxit=1000), designCrit = "TD") expect_equal(deswgts$design, c(0.45, 0.48, 0.05, 0.02, 0), tolerance = 1e-2) ## efficiency compared to standard design (last column) crt <- calcCrit(rep(1/6, 6), fMod, probs, c(0, 10, 25, 50, 100, 150), Delta=0.1, designCrit = "TD") expect_equal(exp(deswgts$crit - crt), 0.130, tolerance = 1e-3) }) test_that("the beta model (table 5, line 10) gives the same results", { fMod <- Mods(betaMod = c(1.39, 1.39), doses=c(0, 150), addArgs=list(scal=200), placEff=0, maxEff=0.4) doses <- c(0, 27, 94.89, 150) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.1, designCrit = "TD") expect_equal(deswgts$design, c(0.45, 0.48, 0.05, 0.02), tolerance = 1e-2) ## efficiency compared to standard design (last column) crt <- calcCrit(rep(1/6, 6), fMod, probs, c(0, 10, 25, 50, 100, 150), Delta=0.1, designCrit = "TD") expect_equal(exp(deswgts$crit - crt), 0.501, tolerance = 1e-3) }) test_that("the beta model (table 5, line 1) gives the same results", { fMod <- Mods(betaMod = c(0.23, 2.31), doses=c(0,150), addArgs=list(scal=200), placEff=0, maxEff=0.4) doses <- c(0, 0.35, 150) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.2, designCrit = "TD") expect_equal(deswgts$design, c(0.5, 0.5, 0), tolerance = 1e-2) ## efficiency compared to standard design (last column) crt <- calcCrit(rep(1/6, 6), fMod, probs, c(0, 10, 25, 50, 100, 150), Delta=0.2, designCrit = "TD") expect_equal(exp(deswgts$crit - crt), 0.056, tolerance = 1e-3) }) test_that("standardized Dopt and Dopt&TD criteria work", { doses <- c(0, 62.5, 125, 250, 500) fMod1 <- Mods(sigEmax = rbind(c(25, 5), c(107.14, 2)), doses=doses, placEff=60, maxEff=280) fMod2 <- Mods(sigEmax = rbind(c(25, 5), c(107.14, 2)), linear = NULL, doses=doses, placEff=60, maxEff=280) w1 <- rep(0.5, 2) w2 <- rep(1/3, 3) ## des1 and des2 should be exactly the same des1 <- optDesign(fMod1, w1, doses, designCrit = "Dopt", standDopt = FALSE) des2 <- optDesign(fMod1, w1, doses, designCrit = "Dopt", standDopt = TRUE) expect_equal(des1$design, des2$design, tolerance =1e-6) ## des1 and des2 should be different (as linear and emax have different ## number of parameters) des1 <- optDesign(fMod2, w2, doses, designCrit = "Dopt", standDopt = FALSE, optimizer = "solnp") des2 <- optDesign(fMod2, w2, doses, designCrit = "Dopt", standDopt = TRUE, optimizer = "solnp") expect_false(all(des1$design == des2$design)) ## same with Dopt&TD criterion: des1 and des2 will differ (due to different ## scaling of Dopt and TD criteria) des1 <- optDesign(fMod1, w1, doses, designCrit = "Dopt&TD", Delta = 100, standDopt = FALSE, optimizer = "solnp") des2 <- optDesign(fMod1, w1, doses, designCrit = "Dopt&TD", Delta = 100, standDopt = TRUE, optimizer = "solnp") expect_false(all(des1$design == des2$design)) }) ## code using lower and upper bound (previous to version 0.9-6 this caused ## problems as the starting value for solnp rep(0.2, 5) was on the boundary, ## now a feasible starting values are used test_that("feasible starting values are used when on boundary", { doses <- seq(0, 1, length=5) nold <- rep(0, times=5) lowbnd <- c(0.2,0.0,0.0,0.0,0.2) uppbnd <- c(1.0,0.3,1.0,1.0,1.0) trueModels <- Mods(linear=NULL, doses=doses, placEff = 0, maxEff = 1) des <- optDesign(models=trueModels, probs=1, doses=doses, designCrit="Dopt", lowbnd=lowbnd,uppbnd=uppbnd) expect_equal(des$design, c(0.5, 0, 0, 0, 0.5)) }) test_that("there are no instabilities for numerical gradients", { mm <- Mods(betaMod=c(1.5,0.8), doses=seq(0,1,by=0.25), placEff=0, maxEff=1) des <- optDesign(mm, probs=1, designCrit="TD", Delta=0.5) expect_equal(des$design, c(0.4895, 0.3552, 0.1448, 0, 0.0105), tolerance = 1e-4) }) ## test error conditions # Create sample Mods object for testing doses <- c(0, 10, 25, 50, 100) models <- Mods(emax = 15, doses = doses, placEff = 0, maxEff = 1) # Define some allocation weights for testing design <- c(0.2, 0.2, 0.2, 0.2, 0.2) test_that("optDesign errors when wrong inputs are supplied", { expect_error(optDesign(models = list(dummy = 1), probs = 1), "\"models\" needs to be of class Mods") expect_error(optDesign(probs = 1, doses = c(0, 5, 20, 100)), "either \"models\" or \"userCrit\" need to be specified") expect_error(optDesign(models, probs = 1, optimizer = "exact"), "need to specify sample size via n argument") expect_error(optDesign(models, probs = 1, nold = c(1, 2, 3)), "need to specify sample size for next cohort via n argument") expect_error(optDesign(models, probs = 1, designCrit = "TD"), "need to specify target difference \"Delta\"") expect_error(optDesign(models, probs = 1, designCrit = "Dopt&TD"), "need to specify target difference \"Delta\"") expect_error(optDesign(models, probs = 1, designCrit = "TD", Delta = -0.5), "\"Delta\" needs to be > 0") expect_error(optDesign(models, probs = 1, weights = c(1, 1)), "weights and doses need to be of equal length") expect_error(optDesign(models, probs = 1, lowbnd = rep(0.3, length(doses))), "Infeasible lower bound specified") expect_error(optDesign(models, probs = 1, uppbnd = rep(0.1, length(doses))), "Infeasible upper bound specified") expect_error(optDesign(models, probs = 1, lowbnd = c(0.1, 0.2)), "lowbnd needs to be of same length as doses") expect_error(optDesign(models, probs = 1, uppbnd = c(0.8, 0.9)), "uppbnd needs to be of same length as doses") expect_error(optDesign(models, probs = 1, doses = c(0, 10), designCrit = "Dopt"), "need at least as many dose levels as there are parameters to calculate Dopt design.") }) # Combine all tests in one testthat call test_that("calcCrit function error handling", { expect_error(calcCrit(design = design, models = list(dummy = 1), probs = 1, doses = doses), "\"models\" needs to be of class Mods", info = "models argument needs to be of class Mods") expect_error(calcCrit(design = list(1, 2, 3), models = models, probs = 1, doses = doses), "design needs to be numeric", info = "design needs to be numeric") expect_error(calcCrit(design = c(0.5, 0.5), models = models, probs = 1, doses = doses), "design and doses should be of the same length", info = "design and doses should be of the same length") expect_error(calcCrit(design = c(0.5, 0.4, 0, 0, 0), models = models, probs = 1, doses = doses), "design needs to sum to 1", info = "design needs to sum to 1") expect_error(calcCrit(design = design, models = models, probs = 1, doses = doses, n = c(1, 2)), "n needs to be of length 1", info = "n needs to be of length 1") expect_error(calcCrit(design = design, models = models, probs = 1, doses = doses, weights = c(1, 2)), "weights and doses need to be of equal length", info = "weights and doses need to be of equal length") expect_error(calcCrit(design = design, models = models, probs = 1, doses = doses, designCrit = "TD"), "need to specify clinical relevance parameter", info = "Delta needs to be specified for TD designCrit values") expect_error(calcCrit(design = design, models = models, probs = 1, doses = doses, designCrit = "Dopt", standDopt = "string"), "standDopt needs to contain a logical value", info = "standDopt needs to be logical") models_with_invalid_probs <- Mods(emax = 15, doses = doses, placEff = 0, maxEff = 1) probs_invalid <- c(0.5, 0.5) # Probs length not matching models length expect_error(calcCrit(design = design, models = models_with_invalid_probs, probs = probs_invalid, doses = doses), "Probs of wrong length", info = "probs length should match models length") expect_error(calcCrit(design = c(0.5, 0.5), models = models, probs = 1, doses = doses[1:2]), "need more dose levels to calculate Dopt design.", info = "D-optimality requires enough doses") }) ## rndDesign testing design <- optDesign(models, probs = 1) design_vector <- design$design test_that("rndDesign function error handling and functionality", { # Error tests expect_error(rndDesign(design = design_vector), "total sample size \"n\" needs to be specified", info = "total sample size n needs to be specified") expect_error(rndDesign(design = list(1, 2, 3), n = 100), "design needs to be a numeric vector.", info = "design needs to be a numeric vector") # General functionality tests result <- rndDesign(design = design_vector, n = 100) expect_equal(sum(result), 100, info = "sum of rounded design should equal n") design_with_small_values <- c(0.1, 0.2, 0.00001, 0.1, 0.6) result_with_small_values <- rndDesign(design = design_with_small_values, n = 50) expect_equal(sum(result_with_small_values), 50, info = "sum of rounded design with small values should equal n") expect_equal(result_with_small_values[3], 0, info = "elements of design below eps should be regarded as 0") # Test with an actual DRdesign object result_from_DRdesign <- rndDesign(design = design, n = 100) expect_equal(sum(result_from_DRdesign), 100, info = "sum of rounded design from DRdesign object should equal n") # Test edge case where design elements sum to exactly 1 design_exact <- c(0.2, 0.3, 0.5) result_exact <- rndDesign(design = design_exact, n = 90) expect_equal(sum(result_exact), 90, info = "sum of rounded design with exact sum to 1 should equal n") }) ## plot testing test_that("plot.DRdesign function error handling and functionality", { # Error test expect_error(plot.DRdesign(x = design), info = "models argument needs to be specified") # General functionality tests expect_silent(plot(design, models = models)) # Custom line width and color expect_silent(plot(design, models = models, lwdDes = 5, colDes = "blue")) # Test with additional plot arguments expect_silent(plot(design, models = models, main = "Optimal Design Plot", xlab = "Dose", ylab = "Response")) # Verify that plot produces expected output # Note: This is a visual inspection step, automated checking of graphical output would typically involve visual inspection. # Ensure that calling plot function does not produce errors or warnings })DoseFinding/tests/testthat/test-fitMod.R0000644000176200001440000003317114654153534020006 0ustar liggesuserscontext("Model Fitting") source("generate_test_datasets.R") # Generate data sets and compare results of fitDRModel to the result of nls and # lm for AIC function (if these are consistent parameter estimates, residual # sum of square and degrees of freedom are consistent) and the vcov function # (if these are consistent parameter estimates, RSS, df and gradient are # consistent) # TODO: # * Against what do we compare the following things from testsFitting.R? # - predict(fit0, predType="effect-curve", se.fit=TRUE) # - predict(fit0, predType="full-model", se.fit=TRUE) # - TD(fit0, Delta = 1) # * Using `unname` to make all.equal shut up about unequal dimnames is a bit ugly # * exponential model with covariates # beta model ------------------------------------------------------------------- set.seed(2000) ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) bnds <- matrix(c(0.05, 0.05, 6, 6), nrow=2) test_that("the beta model can be fitted (without covariates)", { fit0 <- fitMod(x, y, datset, model = "betaMod", addCovars = ~1, addArgs=list(scal=1.2*max(datset$x)), bnds=bnds, start=c(0.6, 0.6)) fitnls <- nls(y~betaMod(x, e0, eMax, delta1, delta2, 1.2*max(datset$x)), start=c(e0=15, eMax=14, delta1=0.8, delta2=0.5), data=datset) expect_equal(AIC(fit0), AIC(fitnls), tolerance = 0.0001) expect_equal(fit0$df, summary(fitnls)$df[2], tolerance = 0.0001) expect_equal(coef(fit0), coef(fitnls), tolerance = 0.0001) expect_equal(vcov(fit0), vcov(fitnls), tolerance = 0.0001) }) test_that("the beta model can be fitted (with covariates)", { fit0 <- fitMod(x, y, datset, model="betaMod", addCovars = ~age+center, addArgs=list(scal=1.2*max(datset$x)), bnds=bnds) XX <- model.matrix(~center+age, data=datset) scl <- 1.2*max(datset$x) fitnls <- nls(y~cbind(XX, betaMod(x, 0, 1, delta1, delta2, scl)), data=datset, start=c(delta1=1, delta2=0.2), algorithm = "plinear") expect_equal(AIC(fit0), AIC(fitnls), tolerance = 0.0001) expect_equal(fit0$df, summary(fitnls)$df[2], tolerance = 0.0001) ord <- c(3, 9, 1, 2, 8, 4, 5, 6, 7) expect_equal(unname(coef(fit0)), unname(coef(fitnls))[ord], tolerance = 0.0001) expect_equal(unname(vcov(fit0)), unname(vcov(fitnls))[ord, ord], tolerance = 0.0001) }) # emax model ------------------------------------------------------------------- set.seed(1) ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) bnds <- c(1e-5, max(datset$x)) test_that("the emax model can be fitted (without covariates)", { fit0 <- fitMod(x,y, datset, model="emax", addCovars = ~1, bnds=bnds) fitnls <- nls(y~emax(x, e0, eMax, ed50), start=c(e0=-1, eMax=1.3, ed50=0.1), data=datset) expect_equal(AIC(fit0), AIC(fitnls), tolerance = 0.0001) expect_equal(fit0$df, summary(fitnls)$df[2], tolerance = 0.0001) expect_equal(coef(fit0), coef(fitnls), tolerance = 0.0001) expect_equal(vcov(fit0), vcov(fitnls), tolerance = 0.0001) }) test_that("the emax model can be fitted (with covariates)", { fit0 <- fitMod(x,y, datset, model="emax", addCovars = ~age+center, bnds=bnds) XX <- model.matrix(~center+age, data=datset) fitnls <- nls(y~cbind(XX, emax(x, 0, 1, ed50)), data=datset, start=list(ed50=1), algorithm = "plinear") expect_equal(AIC(fit0), AIC(fitnls), tolerance = 0.0001) expect_equal(fit0$df, summary(fitnls)$df[2], tolerance = 0.0001) ord <- c(2, 8, 1, 7, 3, 4, 5, 6) expect_equal(unname(coef(fit0)), unname(coef(fitnls))[ord], tolerance = 0.0001) expect_equal(unname(vcov(fit0)), unname(vcov(fitnls))[ord, ord], tolerance = 0.0001) }) # sigEmax model ---------------------------------------------------------------- set.seed(13) ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) bnds <- matrix(c(1e-5, 1e-5, max(datset$x), 30), nrow=2) test_that("the sigEmax model can be fitted (without covariates)", { fit0 <- fitMod(x,y, datset, model = "sigEmax", addCovars = ~1, bnds=bnds) fitnls <- nls(y~sigEmax(x, e0, eMax, ed50, h), start=c(e0=6, eMax=17, ed50=240, h=2), data=datset) expect_equal(AIC(fit0), AIC(fitnls), tolerance = 0.0001) expect_equal(fit0$df, summary(fitnls)$df[2], tolerance = 0.0001) expect_equal(coef(fit0), coef(fitnls), tolerance = 0.0001) expect_equal(vcov(fit0), vcov(fitnls), tolerance = 0.0001) }) test_that("the sigEmax model can be fitted (with covariates)", { fit0 <- fitMod(x,y, datset, model="sigEmax", addCovars = ~age+center, bnds=bnds) XX <- model.matrix(~center+age, data=datset) fitnls <- nls(y~cbind(XX, sigEmax(x, 0, 1, ed50, h)), data=datset, start=list(ed50=368, h=2), algorithm = "plinear") expect_equal(AIC(fit0), AIC(fitnls), tolerance = 0.0001) expect_equal(fit0$df, summary(fitnls)$df[2], tolerance = 0.0001) ord <- c(3, 9, 1, 2, 8, 4, 5, 6, 7) expect_equal(unname(coef(fit0)), unname(coef(fitnls))[ord], tolerance = 0.0001) expect_equal(unname(vcov(fit0)), unname(vcov(fitnls))[ord, ord], tolerance = 0.0001) }) # logistic model --------------------------------------------------------------- set.seed(200) ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) bnds <- matrix(c(1e-5, 1e-5, max(datset$x), max(datset$x)/2), nrow=2) test_that("the logistic model can be fitted (without covariates)", { fit0 <- fitMod(x,y, datset, model="logistic", addCovars = ~1, bnds=bnds) fitnls <- nls(y~logistic(x, e0, eMax, ed50, delta), start=c(e0=0, eMax=16, ed50=250, delta=90), data=datset) expect_equal(AIC(fit0), AIC(fitnls), tolerance = 0.0001) expect_equal(fit0$df, summary(fitnls)$df[2], tolerance = 0.0001) expect_equal(coef(fit0), coef(fitnls), tolerance = 0.0001) expect_equal(vcov(fit0), vcov(fitnls), tolerance = 0.0001) }) test_that("the logistic model can be fitted (with covariates)", { fit0 <- fitMod(x,y, datset, model="logistic", addCovars = ~age+center, bnds=bnds) XX <- model.matrix(~center+age, data=datset) fitnls <- nls(y~cbind(XX, logistic(x, 0, 1, ed50, delta)), data=datset, start=list(ed50=220, delta=48), algorithm = "plinear") expect_equal(AIC(fit0), AIC(fitnls), tolerance = 0.0001) expect_equal(fit0$df, summary(fitnls)$df[2], tolerance = 0.0001) ord <- c(3, 9, 1, 2, 8, 4, 5, 6, 7) expect_equal(unname(coef(fit0)), unname(coef(fitnls))[ord], tolerance = 0.0001) expect_equal(unname(vcov(fit0)), unname(vcov(fitnls))[ord, ord], tolerance = 0.0001) }) # exponential model ------------------------------------------------------------ set.seed(104) ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) bnds <- c(0.1, 2)*max(datset$x) test_that("the exponential model can be fitted (without covariates)", { fit0 <- fitMod(x,y, datset, model = "exponential", addCovars = ~1, bnds=bnds) fitnls <- nls(y~exponential(x, e0, e1, delta), start=coef(fit0), data=datset) expect_equal(AIC(fit0), AIC(fitnls), tolerance = 0.0001) expect_equal(fit0$df, summary(fitnls)$df[2], tolerance = 0.0001) expect_equal(coef(fit0), coef(fitnls), tolerance = 0.0001) expect_equal(vcov(fit0), vcov(fitnls), tolerance = 0.0001) }) test_that("the exponential model can be fitted (with covariates)", { fit0 <- fitMod(x,y, datset, model = "exponential", addCovars = ~age+center, bnds=bnds) XX <- model.matrix(~center+age, data=datset) fitnls <- nls(y~cbind(XX, exponential(x, 0, 1, delta)), data=datset, start=c(delta=450), algorithm = "plinear") expect_equal(AIC(fit0), AIC(fitnls), tolerance = 0.0001) expect_equal(fit0$df, summary(fitnls)$df[2], tolerance = 0.0001) ord <- c(2, 8, 1, 7, 3, 4, 5, 6) expect_equal(unname(coef(fit0)), unname(coef(fitnls))[ord], tolerance = 0.0001) expect_equal(unname(vcov(fit0)), unname(vcov(fitnls))[ord, ord], tolerance = 0.0001) }) # linear model ----------------------------------------------------------------- ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) test_that("the linear model can be fitted (without covariates)", { fit0 <- fitMod(x,y, datset, model = "linear", addCovars = ~1) fitlm <- lm(y~x, data=datset) expect_equal(AIC(fit0), AIC(fitlm)) expect_equal(fit0$df, summary(fitlm)$df[2]) expect_equal(unname(coef(fit0)), unname(coef(fitlm))) expect_equal(unname(vcov(fit0)), unname(vcov(fitlm))) }) test_that("the linear model can be fitted (with covariates)", { fit0 <- fitMod(x,y, datset, model = "linear", addCovars = ~age+center) fitlm <- lm(y~x+age+center, data=datset) expect_equal(AIC(fit0), AIC(fitlm)) expect_equal(fit0$df, summary(fitlm)$df[2]) expect_equal(unname(coef(fit0)), unname(coef(fitlm))) expect_equal(unname(vcov(fit0)), unname(vcov(fitlm))) }) # linlog model ----------------------------------------------------------------- ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) off <- 0.05*max(datset$x) test_that("the linlog model can be fitted (without covariates)", { fit0 <- fitMod(x,y, datset, model = "linlog", addCovars = ~1,addArgs=list(off=off)) fitlm <- lm(y~log(x+off), data=datset) expect_equal(AIC(fit0), AIC(fitlm)) expect_equal(fit0$df, summary(fitlm)$df[2]) expect_equal(unname(coef(fit0)), unname(coef(fitlm))) expect_equal(unname(vcov(fit0)), unname(vcov(fitlm))) }) test_that("the linlog model can be fitted (with covariates)", { fit0 <- fitMod(x,y, datset, model = "linlog", addCovars = ~age+center, addArgs=list(off=off)) fitlm <- lm(y~log(x+off)+age+center, data=datset) expect_equal(AIC(fit0), AIC(fitlm)) expect_equal(fit0$df, summary(fitlm)$df[2]) expect_equal(unname(coef(fit0)), unname(coef(fitlm))) expect_equal(unname(vcov(fit0)), unname(vcov(fitlm))) }) # quadratic model -------------------------------------------------------------- ll <- getDosSampSiz() datset <- getDFdataSet(ll$doses, ll$n) test_that("the quadratic model can be fitted (without covariates)", { fit0 <- fitMod(x,y, datset, model = "quadratic", addCovars = ~1) fitlm <- lm(y~x+I(x^2), data=datset) expect_equal(AIC(fit0), AIC(fitlm)) expect_equal(fit0$df, summary(fitlm)$df[2]) expect_equal(unname(coef(fit0)), unname(coef(fitlm))) expect_equal(unname(vcov(fit0)), unname(vcov(fitlm))) }) test_that("the quadratic model can be fitted (with covariates)", { fit0 <- fitMod(x,y, datset, model = "quadratic", addCovars = ~age+center) fitlm <- lm(y~x+I(x^2)+age+center, data=datset) expect_equal(AIC(fit0), AIC(fitlm)) expect_equal(fit0$df, summary(fitlm)$df[2]) expect_equal(unname(coef(fit0)), unname(coef(fitlm))) expect_equal(unname(vcov(fit0)), unname(vcov(fitlm))) }) # ------------------------------------------------------------------------------ # ensure that predict with no argument uses the original data not the sorted # data that were used for fitting test_that("predict with no argument uses the original data", { data(IBScovars) ff <- fitMod(dose, resp, data=IBScovars, model="quadratic", addCovars = ~gender) expect_equal(predict(ff, predType = "ls-means"), predict(ff, predType = "ls-means", doseSeq = IBScovars[,3])) expect_equal(predict(ff, predType = "full-model"), predict(ff, predType = "full-model", newdata = IBScovars[,-2])) expect_equal(predict(ff, predType = "effect-curve"), predict(ff, predType = "effect-curve", doseSeq = IBScovars[,3])) ff2 <- fitMod(dose, resp, data=IBScovars, model="quadratic") expect_equal(predict(ff2, predType = "ls-means"), predict(ff2, predType = "ls-means", doseSeq = IBScovars[,3])) expect_equal(predict(ff2, predType = "full-model"), predict(ff2, predType = "full-model", newdata = IBScovars[,-2])) expect_equal(predict(ff2, predType = "effect-curve"), predict(ff2, predType = "effect-curve", doseSeq = IBScovars[,3])) dose <- unique(IBScovars$dose) ord <- c(2,4,1,3,5) mns <- as.numeric(tapply(IBScovars$resp, IBScovars$dose, mean)[ord]) ff3 <- fitMod(dose, mns, S=diag(5), model="quadratic", type = "general") expect_equal(predict(ff3, predType = "ls-means"), predict(ff3, predType = "ls-means", doseSeq = dose)) expect_equal(predict(ff3, predType = "effect-curve"), predict(ff3, predType = "effect-curve", doseSeq = dose)) }) # ------------------------------------------------------------------------------ # ensure that S is also sorted when the dose is not entered sorted test_that("S is also sorted when the dose is not entered sorted", { data(IBScovars) dose <- sort(unique(IBScovars$dose)) mns <- as.numeric(tapply(IBScovars$resp, IBScovars$dose, mean)) S <- c(1000,1,1,1,1)*diag(5) ff1 <- fitMod(dose, mns, S = S, model="linear", type="general") dose <- unique(IBScovars$dose) ord <- c(2,4,1,3,5) mns <- as.numeric(tapply(IBScovars$resp, IBScovars$dose, mean)[ord]) ff2 <- fitMod(dose, mns, S = S, model="linear", type="general") ff3 <- fitMod(dose, mns, S = S[ord,ord], model="linear", type="general") expect_equal(coef(ff1), coef(ff3)) }) test_that("fitMod complains if `resp` is a row-vector", { doses <- seq(0, 100, length.out=5) resp_col <- emax(doses, 2, 8, 50) resp_row <- t(resp_col) cov_mat <- diag(0.5, 5) fit <- fitMod(doses, resp_col, model = "emax", S = cov_mat, type = "general", bnds = defBnds(max(doses))$emax) coefs <- unname(coef(fit)) expect_equal(coefs, c(2, 8, 50), tolerance = 1e-5) expect_warning(fitMod(doses, resp_row, model = "emax", S = cov_mat, type = "general", bnds = defBnds(max(doses))$emax), "resp_row is not a numeric but a matrix, converting with as.numeric()") }) DoseFinding/tests/testthat/test-powMCT.R0000644000176200001440000001172114762603270017727 0ustar liggesusers# create contrast matrix doses <- c(0, 10, 25, 50, 100, 150) fmodels <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), exponential = 85, betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), doses = doses, addArgs = list(scal = 200), placEff = 0, maxEff = 0.4) contMat <- optContr(fmodels, w = 1) ######################################################## ## General tests: does powMCT work in various scenarios ######################################################## test_that("powMCT computes with default values", { power <- powMCT(contMat, altModels = fmodels, n = 50, sigma = 1) expect_true(is.numeric(power)) expect_true(all(power > 0 & power <= 1)) }) test_that("powMCT works with specified covariance matrix S", { doses <- c(0, 10, 25, 50, 100, 150) S <- 1^2 / 50 * diag(length(doses)) power <- powMCT(contMat, altModels = fmodels, S = S, df = 50 * length(doses) - length(doses), alpha = 0.05) expect_true(is.numeric(power)) expect_true(all(power > 0 & power <= 1)) }) test_that("powMCT works with placebo adjusted estimates", { doses <- c(10, 25, 50, 100, 150) fmodels <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), exponential = 85, betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), doses = c(0, doses), addArgs = list(scal = 200), placEff = 0, maxEff = 0.4) contMat <- optContr(fmodels, doses = doses, w = 1, placAdj = TRUE) power <- powMCT(contMat, altModels = fmodels, n = 50, sigma = 1, placAdj = TRUE) expect_true(is.numeric(power)) expect_true(all(power > 0 & power <= 1)) }) test_that("powMCT works with two-sided alternative", { power <- powMCT(contMat, altModels = fmodels, n = 50, alpha = 0.05, sigma = 1, alternative = "two.sided") expect_true(is.numeric(power)) expect_true(all(power > 0 & power <= 1)) }) ######################################################## ## Error testing ######################################################## test_that("powMCT errors when required arguments are missing", { expect_error(powMCT(contMat, altModels = fmodels), "Either S or both n and sigma need to be specified") expect_error(powMCT(contMat, n = 50, sigma = 1), "altModels argument needs to be specified") }) test_that("powMCT detects invalid inputs", { expect_error(powMCT(list(contMat), altModels = fmodels, n = 50, sigma = 1), "contMat needs to be a matrix") expect_error(powMCT(contMat, altModels = fmodels, n = rep(50, 2), sigma = 1), "n needs to be of length nrow") expect_error(powMCT(contMat, altModels = fmodels, n = 1, sigma = 1), "cannot compute power: specified \"n\" and dose vector result in df = 0") S <- matrix(1, nrow = 6, ncol = 6) badS1 <- matrix(1, nrow = 3, ncol = 3) badS2 <- matrix(1, nrow = 5, ncol = 6) expect_error(powMCT(contMat, altModels = fmodels, S = S), "need to specify degrees of freedom in \"df\", when specifying \"S\"") expect_error(powMCT(contMat, altModels = fmodels, S = S, n = 50), "Need to specify either \"S\" or both \"n\" and \"sigma\"") expect_error(powMCT(contMat, altModels = fmodels, S = badS1, df = 45), "S needs to have as many rows&cols as there are doses") expect_error(powMCT(contMat, altModels = fmodels, S = badS2, df = 45), "S needs to be a square matrix") fmodels2 <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), exponential = 85, betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), doses = c(0, 10, 25, 50, 100), placEff = 0, maxEff = 0.4) expect_error(powMCT(contMat, altModels = fmodels2, n = 50, sigma = 1), "Incompatible contMat and muMat") }) ######################################################## ## Test power calculations ######################################################## test_that("powMCT gives same result as power.t.test", { doses <- c(0, 1) fmodels <- Mods(linear = NULL, doses = doses, placEff = 0, maxEff = 0.4) contMat <- optContr(fmodels, w = 1) power1 <- powMCT(contMat, altModels = fmodels, n = 50, sigma = 1) power2 <- powMCT(contMat, altModels = fmodels, n = 50, sigma = 1, alpha = 0.05, alternative = "two.sided") expect_equal(as.numeric(power1), power.t.test(n = 50, delta = 0.4, sd = 1, sig.level = 0.025, alternative = "one.sided")$power, tolerance = 0.001) expect_equal(as.numeric(power2), power.t.test(n = 50, delta = 0.4, sd = 1, sig.level = 0.05, alternative = "two.sided")$power, tolerance = 0.001) }) ## compare power to externally calculated power values test_that("powMCT calculates power correctly", { doses <- c(0, 25, 100, 300) fmodels <- Mods(emax = 45, sigEmax = c(100,3 ), logistic = c(45, 15), exponential = 60, quadratic = -0.0022, doses = doses, placEff = 0, maxEff = 1) contMat <- optContr(fmodels, w = 1) power <- powMCT(contMat, altModels = fmodels, n = 100, sigma = 3) expect_equal(as.numeric(power), c(0.672, 0.754, 0.817, 0.757, 0.635), tolerance = 0.01) }) DoseFinding/tests/testthat/test-bFitMod.R0000644000176200001440000001070714762603270020105 0ustar liggesusers# Setting up some test data doses <- c(0, 0.5, 1, 2, 4) drFit <- c(1, 2, 3, 4, 5) # Example response S <- diag(5) # Covariance matrix for simplicity test_that("bFitMod errors with invalid inputs", { expect_error(bFitMod(dose = doses, resp = drFit, model = "invalidModel", S = S), "invalid model selected") expect_error(bFitMod(dose = doses, resp = drFit[1:4], model = "linear", S = S), "dose and resp need to be of the same size") expect_error(bFitMod(dose = doses, resp = drFit, model = "linear", S = diag(4)), "S and dose have non-conforming size") }) test_that("bFitMod correctly fits a 'linear' model with Bayes", { prior <- list(norm = c(0, 10), norm = c(0, 100)) fit <- bFitMod(dose = doses, resp = drFit, model = "linear", S = S, type = "Bayes", nSim = 100, prior = prior) expect_s3_class(fit, "bFitMod") expect_equal(attr(fit, "model"), "linear") expect_equal(attr(fit, "type"), "Bayes") expect_true(!is.null(fit$samples)) }) test_that("bFitMod correctly fits a 'linear' model with bootstrap", { fit <- bFitMod(dose = doses, resp = drFit, model = "linear", S = S, type = "bootstrap", nSim = 100) expect_s3_class(fit, "bFitMod") expect_equal(attr(fit, "model"), "linear") expect_equal(attr(fit, "type"), "bootstrap") expect_true(!is.null(fit$samples)) }) test_that("print.bFitMod does not throw an error", { prior <- list(norm = c(0, 10), norm = c(0, 100)) fit <- bFitMod(dose = doses, resp = drFit, model = "linear", S = S, type = "Bayes", nSim = 100, prior = prior) expect_output(print(fit), regexp = "Dose Response Model") expect_output(print(fit), regexp = "Summary of posterior draws") }) test_that("bFitMod handles placebo adjustment appropriately", { prior <- list(norm = c(0, 10), norm = c(0, 100)) expect_error(bFitMod(dose = doses, resp = drFit, model = "linlog", S = S, placAdj = TRUE, type = "Bayes", nSim = 100, prior = prior), "logistic and linlog models can only be fitted with placAdj") }) test_that("bFitMod correctly handles 'linInt' model", { fit <- bFitMod(dose = doses, resp = drFit, model = "linInt", S = S, type = "bootstrap", nSim = 100) expect_s3_class(fit, "bFitMod") expect_equal(attr(fit, "model"), "linInt") expect_true(!is.null(attr(fit, "nodes"))) expect_true(!is.null(fit$samples)) }) test_that("bFitMod correctly handles additional arguments", { prior <- list(norm = c(0, 10), norm = c(0, 100), beta=c(0, 1.5, 0.45, 1.7), beta=c(0, 1.5, 0.45, 1.7)) fit <- bFitMod(dose = doses, resp = drFit, model = "betaMod", S = S, type = "Bayes", nSim = 100, prior = prior, addArgs = list(scal = 1.2*max(doses))) expect_s3_class(fit, "bFitMod") expect_equal(attr(fit, "model"), "betaMod") expect_equal(attr(fit, "scal"), 1.2 * max(doses)) expect_true(!is.null(fit$samples)) }) # Assuming the `biom` dataset is available in the environment for examples data(biom) anMod <- lm(resp ~ factor(dose) - 1, data = biom) drFit <- coef(anMod) S <- vcov(anMod) dose <- sort(unique(biom$dose)) # Assuming normal priors for test example prior <- list(norm = c(0, 10), norm = c(0, 100), beta = c(0, 1.5, 0.45, 1.7)) # Fit a model gsample <- bFitMod(dose, drFit, S, model = "emax", start = c(0, 1, 0.1), nSim = 1000, prior = prior) test_that("predict.bFitMod returns correct quantiles", { doseSeq <- c(0, 0.5, 1) pred <- predict(gsample, doseSeq = doseSeq) expect_true(is.matrix(pred)) expect_equal(nrow(pred), 5) # Expecting rows for different quantiles expect_equal(length(unique(doseSeq)), ncol(pred)) # One column per dose in doseSeq }) test_that("plot.bFitMod generates a plot", { expect_error(plot(gsample), NA) # Check for plotting is a little tricky, one way to check if some plot is generated expect_true(is.null(dev.list()) || length(dev.list()) > 0) }) test_that("coef.bFitMod returns model coefficients", { coefs <- coef(gsample) expect_true(is.numeric(coefs)) expect_equal(length(coefs), length(gsample$samples)) }) # To ensure the appropriate methods are defined, use methods(...) to list them: test_that("appropriate methods for bFitMod are defined", { expect_true("predict.bFitMod" %in% methods("predict")) expect_true("plot.bFitMod" %in% methods("plot")) expect_true("coef.bFitMod" %in% methods("coef")) })DoseFinding/tests/testthat/test-maFitMod.R0000644000176200001440000001746314762603270020267 0ustar liggesuserscontext("maFitMod") data(biom) anMod <- lm(resp~factor(dose)-1, data=biom) drFit <- coef(anMod) S <- vcov(anMod) doses <- c(0,0.05,0.2,0.6,1) test_that("Test input parameters of maFitMod", { ## models expect_error( maFitMod(doses, drFit, S), "Need to specify the models that should be fitted") expect_error( maFitMod(doses, drFit, S, models = c("linear", "emax", "XYZ")), "Invalid dose-response model specified: XYZ") expect_error( maFitMod(doses, drFit, S, models = c("ABC", "emax", "XYZ")), "Invalid dose-response model specified: ABC, XYZ") ## bnds bnds <- c(10,20) expect_error( maFitMod(doses, drFit, S, models = c("emax"), nSim = 10, bnds = bnds), "bnds needs to be a list") bnds <- defBnds(1) bnds$emax <- NULL expect_message( maFitMod(doses, drFit, S, models = c("emax"), nSim = 10, bnds = bnds)) bnds$emax <- c(10,20) tmp <- maFitMod(doses, drFit, S, models = c("emax"), nSim = 10, bnds = bnds) out <- sapply(tmp$fits, function(x) coef(x)[3]) # all should be in [10,20] eps <- 0.0001 for(i in 1:10){ expect_lt(out[i], 20+eps) expect_gt(out[i], 10-eps) } bnds$betaMod <- rbind(c(1,2), c(1,2)) tmp <- maFitMod(doses, drFit, S, models = c("betaMod"), nSim = 10, bnds = bnds) out <- sapply(tmp$fits, function(x) coef(x)[3:4]) # all should be in [1,2] eps <- 0.0001 for(i in 1:10){ expect_lt(out[1,i], 2+eps) expect_gt(out[1,i], 1-eps) expect_lt(out[2,i], 2+eps) expect_gt(out[2,i], 1-eps) } ## addArgs tmp <- maFitMod(doses, drFit, S, models = c("betaMod"), nSim = 10) out <- sapply(tmp$fits, function(x) attr(x, "scal")) # should be 1.2 for(i in 1:10){ expect_equal(out[i], 1.2) } tmp <- maFitMod(doses, drFit, S, models = c("betaMod"), nSim = 10, addArgs = list(scal = 200)) out <- sapply(tmp$fits, function(x) attr(x, "scal")) # should be 200 for(i in 1:10){ expect_equal(out[i], 200) } tmp <- maFitMod(doses, drFit, S, models = c("linlog"), nSim = 10, addArgs = list(off = 123)) out <- sapply(tmp$fits, function(x) attr(x, "off")) # should be 123 for(i in 1:10){ expect_equal(out[i], 123) } }) test_that("test model fitting", { set.seed(295) bnds <- defBnds(max(doses)) expect_silent(fits1 <- maFitMod(doses, drFit, S, models = c("linear"), nSim = 10)) expect_silent(fits2 <- maFitMod(doses, drFit, S, models = c("linInt"), nSim = 10)) expect_silent(fits3 <- maFitMod(doses, drFit, S, models = c("emax", "sigEmax"), nSim = 10, bnds = bnds)) expect_silent(fits4 <- maFitMod(doses, drFit, S, models = c("linear", "emax", "betaMod"), nSim = 10, bnds = bnds)) expect_silent(fits5 <- maFitMod(doses, drFit, S, models = c("linear", "emax", "betaMod"), nSim = 10, bnds = bnds)) builtin <- c("linlog", "linear", "quadratic", "linInt", "emax", "exponential", "logistic", "betaMod", "sigEmax") expect_silent(fits6 <- maFitMod(doses, drFit, S, models = builtin, nSim = 10, bnds = bnds)) expect_true(class(fits6) == "maFit") expect_equal(length(fits6$fits), 10) expect_equal(length(fits6$selModels), 10) expect_named(fits6, c("fits", "selModels", "args")) ## test print method (HOW TO TEST PRINT, WITHOUT PRINTING TO CONSOLE) ## expect_no_condition(print(fits1)) ## expect_no_condition(print(fits2, digits=10)) ## expect_no_condition(print(fits3)) ## expect_no_condition(print(fits4) ## expect_no_condition(print(fits5)) ## expect_no_condition(print(fits6)) ## test prediction expect_error( predict(fits1), "Need to provide doseSeq argument") dsq <- seq(0,1,length=101) expect_silent(p1 <- predict(fits1, doseSeq = dsq, summaryFct = NULL)) expect_silent(p2 <- predict(fits2, doseSeq = dsq, summaryFct = NULL)) expect_silent(p3 <- predict(fits3, doseSeq = dsq, summaryFct = NULL)) expect_silent(p4 <- predict(fits4, doseSeq = dsq, summaryFct = NULL)) expect_silent(p5 <- predict(fits5, doseSeq = dsq, summaryFct = NULL)) expect_silent(p6 <- predict(fits5, doseSeq = dsq, summaryFct = NULL)) expect_equal(dim(p6), c(10,101)) expect_silent(plot(fits1)) expect_silent(plot(fits2, xlab = "ABC")) expect_silent(plot(fits3, ylab = "XYZ")) expect_silent(plot(fits4, title = "123")) expect_silent(plot(fits5)) expect_silent(plot(fits6)) expect_silent(plot(fits1, plotData = "none")) expect_silent(plot(fits2, plotData = "none")) expect_silent(plot(fits3, plotData = "none")) expect_silent(plot(fits4, plotData = "none")) expect_silent(plot(fits5, plotData = "none")) expect_silent(plot(fits6, plotData = "none")) expect_silent(plot(fits1, plotData = "meansCI")) expect_silent(plot(fits2, plotData = "meansCI")) expect_silent(plot(fits3, plotData = "meansCI")) expect_silent(plot(fits4, plotData = "meansCI")) expect_silent(plot(fits5, plotData = "meansCI")) expect_silent(plot(fits6, plotData = "meansCI")) expect_error(plot(fits6, title = 23), "title needs to be a character") expect_error(plot(fits6, trafo = 23), "trafo needs to be a function") ## check target dose estimation ## ED expect_error( ED(fits5, p = 0.9)) # should fail (direction not specified) expect_silent(ED(fits5, p = 0.9, direction = "increasing")) expect_silent(ED(fits5, p = 0.5, direction = "increasing")) expect_error( ED(fits5, p = 0.9, direction = "increasing", EDtype = "discrete")) expect_silent(ED(fits5, p = 0.9, direction = "increasing", EDtype = "discrete", doses = doses)) expect_silent(ED(fits5, p = 0.5, direction = "increasing", EDtype = "discrete", doses = doses)) ## check decreasing direction drFit2 <- 1-drFit fits6 <- maFitMod(doses, drFit2, S, models = builtin, nSim = 10, bnds = bnds) expect_true( is.na(ED(fits6, p = 0.9, direction = "increasing"))) expect_silent(ED(fits6, p = 0.9, direction = "decreasing")) expect_silent(ED(fits6, p = 0.5, direction = "decreasing")) expect_silent(ED(fits6, p = 0.9, direction = "decreasing", EDtype = "discrete", doses = doses)) expect_silent(ED(fits6, p = 0.5, direction = "decreasing", EDtype = "discrete", doses = doses)) ## TD expect_silent(TD(fits5, Delta=0.5, direction = "increasing")) expect_error( TD(fits5, Delta=0.5, direction = "increasing", TDtype = "discrete")) expect_silent( TD(fits5, Delta=0.5, direction = "increasing", TDtype = "discrete", doses = doses)) expect_true( is.na(TD(fits5, Delta=0.5, direction = "decreasing"))) }) ## compare model fitting to bFitMod ## Helper function to create example data make_example_data <- function() { dose <- c(0, 5, 10, 20, 40) resp <- sort(rnorm(5,0,0.1)) S <- diag(5)*rexp(5,2) + crossprod(matrix(rexp(25,10),5,5)) list(ds = dose, means = resp, vc = S) } test_that("Compare fits of maFitMod to bFitMod", { bnds <- defBnds(40) set.seed(726) dat <- make_example_data() builtin <- c("linlog", "linear", "quadratic", "linInt", "emax", "exponential", "logistic", "betaMod", "sigEmax") for(i in 1:length(builtin)){ set.seed(376) res1 <- maFitMod(dat$ds, dat$means, S=dat$vc, models = builtin[i], nSim = 10, bnds = bnds) set.seed(376) res2 <- bFitMod(dat$ds, dat$means, S=dat$vc, model = builtin[i], type = "bootstrap", nSim = 10, bnds = bnds[[builtin[i]]]) ds <- seq(0,40,by=1) pred0 <- predict(res1, doseSeq = ds, summaryFct = NULL) pred1 <- apply(pred0, 2, function(x){ quantile(x, c(0.025, 0.25, 0.5, 0.75, 0.975)) }) pred2 <- predict(res2, doseSeq = ds) rownames(pred1) <- NULL expect_equal(pred1, pred2) } }) DoseFinding/tests/testthat/test-MCTtest.R0000644000176200001440000002452114654153534020106 0ustar liggesuserscontext("multiple contrast test") # TODO: # * maybe define common candidate models outside of test_that() calls? # * how do we check for equal p-values (calculated with MC algorighm)? # * pull shared code out of test_that() calls source("generate_test_datasets.R") require_multcomp <- function() { if (!require("multcomp")) { skip("multcomp package not available") } } # helper functions to increase readability of expect_equal() calls tstat <- function(obj) { UseMethod("tstat") } tstat.MCTtest <- function(obj) { # drop the pVal attribute of obj$tStat as.numeric(obj$tStat) } tstat.glht <- function(obj) { unname(summary(obj)$test$tstat) } pval <- function(obj) { UseMethod("pval") } pval.MCTtest <- function(obj) { attr(obj$tStat, "pVal") } pval.glht <- function(obj) { as.numeric(summary(obj)$test$pvalues) } test_that("MCTtest gives the same output as multcomp::glht (beta and sigEmax models)", { require_multcomp() set.seed(10) dd <- getDFdataSet_testsMCT() dd_x_factor <- dd dd_x_factor$x <- as.factor(dd$x) bet <- guesst(0.9*max(dd$x), p=0.8, "betaMod", scal = 1.2*max(dd$x), dMax = 0.7*max(dd$x), Maxd = max(dd$x)) sE <- guesst(c(0.5*max(dd$x), 0.7*max(dd$x)) , p=c(0.5, 0.9), "sigEmax") models <- Mods(linear = NULL, betaMod = bet, sigEmax = sE, doses = sort(unique(dd$x)), addArgs=list(scal = 1.2*max(dd$x))) # model with covariates obj <- MCTtest(x,y, dd, models=models, addCovars = ~cov1+cov2, pVal = TRUE) fit <- lm(y~x+cov1+cov2, data=dd_x_factor) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") expect_equal(tstat(obj), tstat(mcp)) expect_equal(pval(obj), pval(mcp), tolerance = 0.001) # model without covariates obj <- MCTtest(x,y, dd, models=models, addCovars = ~1, pVal = TRUE) fit <- lm(y~x, data=dd_x_factor) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") expect_equal(tstat(obj), tstat(mcp)) expect_equal(pval(obj), pval(mcp), tolerance = 0.001) }) test_that("MCTtest gives the same output as multcomp::glht (logistic, exponential, quadratic models)", { require_multcomp() set.seed(10) dd <- getDFdataSet_testsMCT() dd_x_factor <- dd dd_x_factor$x <- as.factor(dd$x) mD <- max(dd$x) lg1 <- guesst(c(0.3*mD, 0.4*mD), c(0.3, 0.9), "logistic") lg2 <- guesst(c(0.3*mD, 0.4*mD), c(0.3, 0.5), "logistic") expo <- guesst(c(0.9*mD), c(0.7), "exponential", Maxd=mD) quad <- guesst(c(0.6*mD), c(1), "quadratic") models <- Mods(linlog = NULL, logistic = rbind(lg1, lg2), exponential = expo, quadratic = quad, doses = sort(unique(dd$x)), addArgs=list(off = 0.2*max(dd$x))) # model with covariates obj <- MCTtest(x, y, dd, models=models, addCovars = ~cov1+cov2, pVal = TRUE) fit <- lm(y~x+cov1+cov2, data=dd_x_factor) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") expect_equal(tstat(obj), tstat(mcp)) expect_equal(pval(obj), pval(mcp), tolerance = 0.001) # model without covariates obj <- MCTtest(x,y, dd, models=models, addCovars = ~1, pVal = TRUE) fit <- lm(y~x, data=dd_x_factor) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") expect_equal(tstat(obj), tstat(mcp)) expect_equal(pval(obj), pval(mcp), tolerance = 0.001) }) test_that("MCTtest works with contrast matrix handed over", { require_multcomp() set.seed(23) dd <- getDFdataSet_testsMCT() mD <- max(dd$x) lg1 <- guesst(c(0.3*mD, 0.4*mD), c(0.3, 0.9), "logistic") lg2 <- guesst(c(0.3*mD, 0.4*mD), c(0.3, 0.5), "logistic") expo <- guesst(c(0.9*mD), c(0.7), "exponential", Maxd=mD) quad <- guesst(c(0.6*mD), c(1), "quadratic") models <- Mods(linlog = NULL, logistic = rbind(lg1, lg2), exponential = expo, quadratic = quad, doses = dd$x, addArgs=list(off = 0.2*max(dd$x))) contMat <- MCTtest(x,y, dd, models=models, addCovars = ~cov1+cov2, pVal = TRUE)$contMat obj <- MCTtest(x,y, dd, models=models, addCovars = ~1, pVal = TRUE, contMat = contMat) dd$x <- as.factor(dd$x) fit <- lm(y~x, data=dd) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") expect_equal(tstat(obj), tstat(mcp)) expect_equal(pval(obj), pval(mcp), tolerance = 0.001) }) test_that("MCTtest works with binary data (1)", { require_multcomp() set.seed(1909) dd <- getDFdataSet.bin() bet <- guesst(0.9*max(dd$x), p=0.8, "betaMod", scal = 1.2*max(dd$x), dMax = 0.7*max(dd$x), Maxd = max(dd$x)) sE <- guesst(c(0.5*max(dd$x), 0.7*max(dd$x)) , p=c(0.5, 0.9), "sigEmax") models <- Mods(linear = NULL, betaMod = bet, sigEmax = sE, doses = sort(unique(dd$x)), addArgs=list(scal = 1.2*max(dd$x))) logReg <- glm(y~as.factor(x)-1, family=binomial, data=dd, weights = n) dePar <- coef(logReg) vCov <- vcov(logReg) dose <- sort(unique(dd$x)) obj <- MCTtest(dose, dePar, S=vCov, models=models, type="general", df=Inf, pVal = TRUE) dd$x <- as.factor(dd$x) fit <- glm(y~x-1, family = binomial, data=dd, weights = n) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") expect_equal(tstat(obj), tstat(mcp)) expect_equal(pval(obj), pval(mcp), tolerance = 0.001) }) test_that("MCTtest works with binary data (2)", { require_multcomp() set.seed(1997) dd <- getDFdataSet.bin() bet <- guesst(0.9*max(dd$x), p=0.8, "betaMod", scal = 1.2*max(dd$x), dMax = 0.7*max(dd$x), Maxd = max(dd$x)) sE <- guesst(c(0.5*max(dd$x), 0.7*max(dd$x)) , p=c(0.5, 0.9), "sigEmax") models <- Mods(linear = NULL, betaMod = bet, sigEmax = sE,direction = "decreasing", addArgs=list(scal = 1.2*max(dd$x)), doses = sort(unique(dd$x))) logReg <- glm(y~as.factor(x)-1, family=binomial, data=dd, weights = n) dePar <- coef(logReg) vCov <- vcov(logReg) dose <- sort(unique(dd$x)) obj <- MCTtest(dose, dePar, S=vCov, models=models, type = "general", pVal = TRUE, df=Inf) dd$x <- as.factor(dd$x) fit <- glm(y~x-1, family = binomial, data=dd, weights = n) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") expect_equal(tstat(obj), tstat(mcp)) expect_equal(pval(obj), pval(mcp), tolerance = 0.001) }) test_that("MCTtest works with binary data (3)", { require_multcomp() set.seed(1) dd <- getDFdataSet.bin() bet <- guesst(0.9*max(dd$x), p=0.8, "betaMod", scal = 1.2*max(dd$x), dMax = 0.7*max(dd$x), Maxd = max(dd$x)) sE <- guesst(c(0.5*max(dd$x), 0.7*max(dd$x)) , p=c(0.5, 0.9), "sigEmax") models <- Mods(linear = NULL, betaMod = bet, sigEmax = sE, doses = sort(unique(dd$x)), addArgs=list(scal = 1.2*max(dd$x))) logReg <- glm(y~as.factor(x)-1, family=binomial, data=dd, weights = n) dePar <- coef(logReg) vCov <- vcov(logReg) dose <- sort(unique(dd$x)) obj <- MCTtest(dose, dePar, S=vCov, models=models, type = "general", pVal = TRUE, df=Inf) dd$x <- as.factor(dd$x) fit <- glm(y~x-1, family = binomial, data=dd, weights = n) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") expect_equal(tstat(obj), tstat(mcp)) expect_equal(pval(obj), pval(mcp), tolerance = 0.001) }) test_that("a one-dimensional test works", { require_multcomp() set.seed(1) dd <- getDFdataSet.bin() model <- Mods(linear = NULL, doses=sort(unique(dd$x)), addArgs=list(scal = 1.2*max(dd$x))) logReg <- glm(y~as.factor(x)-1, family=binomial, data=dd, weights = n) dePar <- coef(logReg) vCov <- vcov(logReg) dose <- sort(unique(dd$x)) expect_warning(obj <- MCTtest(dose, dePar, S=vCov, models=model, type = "general", pVal = TRUE, df=Inf), "univariate: using pnorm") dd$x <- as.factor(dd$x) fit <- glm(y~x-1, family = binomial, data=dd, weights = n) mcp <- glht(fit, linfct = mcp(x = t(obj$contMat)), alternative = "greater") expect_equal(tstat(obj), tstat(mcp)) expect_equal(pval(obj), pval(mcp)) }) test_that("unordered values in MCTtest work (placebo adjusted scale)", { require_multcomp() data(IBScovars) modlist <- Mods(emax = 0.05, linear = NULL, logistic = c(0.5, 0.1), linInt = c(0, 1, 1, 1), doses = c(0, 1, 2, 3, 4)) ancMod <- lm(resp~factor(dose)+gender, data=IBScovars) drEst <- coef(ancMod)[2:5] vc <- vcov(ancMod)[2:5, 2:5] doses <- 1:4 fit_orig <- fitMod(doses, drEst, S=vc, model = "sigEmax", placAdj=TRUE, type = "general") test_orig <- MCTtest(doses, drEst, S = vc, models = modlist, placAdj = TRUE, type = "general", df = Inf) ord <- c(3,4,1,2) drEst2 <- drEst[ord] vc2 <- vc[ord,ord] doses2 <- doses[ord] fit_perm <- fitMod(doses2, drEst2, S=vc2, model = "sigEmax", placAdj=TRUE, type = "general") test_perm <- MCTtest(doses2, drEst2, S = vc2, models = modlist, placAdj = TRUE, type = "general", df = Inf) # we don't compare stuff we want to be different attr(fit_orig, "data") <- attr(fit_perm, "data") <- NULL attr(fit_orig, "doseRespNam") <- attr(fit_perm, "doseRespNam") <- NULL expect_equal(fit_orig, fit_perm) expect_equal(tstat(test_orig), tstat(test_perm)) }) test_that("unordered values in MCTtest work (unadjusted scale)", { require_multcomp() data(IBScovars) modlist <- Mods(emax = 0.05, linear = NULL, logistic = c(0.5, 0.1), linInt = c(0, 1, 1, 1), doses = c(0, 1, 2, 3, 4)) ancMod <- lm(resp~factor(dose)-1, data=IBScovars) drEst <- coef(ancMod) vc <- vcov(ancMod) doses <- 0:4 bnds <- defBnds(max(doses))$sigEmax fit_orig <- fitMod(doses, drEst, S=vc, model = "sigEmax", type = "general", bnds=bnds) test_orig <- MCTtest(doses, drEst, S = vc, models = modlist, type = "general", df = Inf) ord <- c(3,4,1,2,5) drEst2 <- drEst[ord] vc2 <- vc[ord,ord] doses2 <- doses[ord] fit_perm <- fitMod(doses2, drEst2, S=vc2, model = "sigEmax", type = "general", bnds=bnds) test_perm <- MCTtest(doses2, drEst2, S = vc2, models = modlist, type = "general", df = Inf) # we don't compare stuff we want to be different attr(fit_orig, "data") <- attr(fit_perm, "data") <- NULL attr(fit_orig, "doseRespNam") <- attr(fit_perm, "doseRespNam") <- NULL expect_equal(fit_orig, fit_perm) expect_equal(tstat(test_orig), tstat(test_perm)) }) DoseFinding/tests/testthat/test-powMCTBinCount.R0000644000176200001440000001273714654153534021404 0ustar liggesuserscontext("power calculation binary and count data") ## general options mvt_control <- DoseFinding:::mvtnorm.control(maxpts=1e5, abseps = 0.0001) ## example (binary data) candModList <- list(emax = c(0.25, 1), sigEmax = rbind(c(1, 3), c(2.5, 4)), betaMod = c(1.1, 1.1)) powA <- DoseFinding:::powMCTBinCount(rep(20,5), doses = c(0, 0.5, 1.5, 2.5, 4), candModList=candModList, respModList=candModList, placEffu = 0.1, maxEffu = 0.25, type = "binary_logit", option = "A", alpha = 0.1, theta, control = mvt_control, addArgs = list(scal = 4.8)) ## externally calculated result in order Emax1, Emax2, sigEmax1, sigEmax2, betaMod extern_pow <- c(0.6792, 0.7365, 0.825, 0.8007, 0.7139) expect_equal(unname(powA), extern_pow, tolerance = 0.001) ## just test whether code fails (for testing option = "B" see further below) powB <- DoseFinding:::powMCTBinCount(rep(20,5),doses = c(0, 0.5, 1.5, 2.5, 4), candModList=candModList, respModList=candModList, placEffu = 0.1, maxEffu = 0.25, type = "binary_logit", option = "B", alpha = 0.1, theta, control = mvt_control, addArgs = list(scal = 4.8)) ## example (negative binomial data) candModList <- list(emax = c(0.1, 0.5, 1, 2), sigEmax = rbind(c(1, 3), c(3, 3)), betaMod = c(0.37, 0.74)) powA <- DoseFinding:::powMCTBinCount(c(100,50,50,100,100), doses = c(0, 0.5, 2, 4, 8), candModList=candModList, respModList=candModList, placEffu = 0.6, maxEffu = -0.3, type = "negative_binomial", option = "A", alpha = 0.025, theta = 1.25, control = mvt_control, addArgs = list(scal = 9.6)) ## externally calculated result in order Emax1, Emax2, Emax3, Emax4, sigEmax1, sigEmax2, betaMod extern_pow <- c(0.9035, 0.8816, 0.8691, 0.8518, 0.9264, 0.8518, 0.7913) expect_equal(unname(powA), extern_pow, tolerance = 0.001) ## just test whether code fails (for testing option = "B" see further below) powB <- DoseFinding:::powMCTBinCount(c(100,50,50,100,100), doses = c(0, 0.5, 2, 4, 8), candModList=candModList, respModList=candModList, placEffu = 0.6, maxEffu = -0.3, type = "negative_binomial", option = "B", alpha = 0.025, theta = 1.25, control = mvt_control, addArgs = list(scal = 9.6)) ## tests for option = "B" ## cannot validate against external results, so validate against manually calculated result cVal <- qnorm(1-0.05) n <- 50 ## binary case logit <- function(x) log(x/(1-x)) placEffu <- 0.4 maxEffu <- 0.3 p1 <- placEffu+maxEffu p0 <- placEffu nc_num <- logit(p1)-logit(p0) nc_den <- sqrt(1/(n*p0*(1-p0))+1/(n*p1*(1-p1))) delta <- nc_num/nc_den power_bin <- 1-pnorm(cVal, delta, 1) ## compare against powMCTBinCount candModList <- list(linear = NULL) powB <- DoseFinding:::powMCTBinCount(c(n,n), doses = c(0, 1), candModList=candModList, respModList=candModList, placEffu = placEffu, maxEffu = maxEffu, type = "binary_logit", option = "B", alpha = 0.05, control = mvt_control, addArgs = list(scal = 1)) expect_equal(unname(powB), power_bin, tolerance = 0.000001) ## negative binomial case placEffu <- 1 maxEffu <- -0.5 theta <- 2 r0 <- placEffu r1 <- placEffu + maxEffu nc_num <- -1*(log(r1)-log(r0)) # multiply with -1 (decreasing) v <- (theta+c(r0, r1))/(theta*c(r0, r1)) nc_den <- sqrt(sum(v/c(n,n))) delta <- nc_num/nc_den power_nb <- 1-pnorm(cVal, delta, 1) powB <- DoseFinding:::powMCTBinCount(c(n,n), doses = c(0, 1), candModList=candModList, respModList=candModList, placEffu = placEffu, maxEffu = maxEffu, type = "negative_binomial", option = "B", alpha = 0.05, theta = theta, control = mvt_control, addArgs = list(scal = 1)) expect_equal(unname(powB), power_nb, tolerance = 0.000001) ## tests for contrast matrix handed over (just test whether code fails) contMat <- rbind(rep(-1, 4), diag(4)) respModList <- list(emax = c(0.25, 1), sigEmax = rbind(c(1, 3), c(2.5, 4)), betaMod = c(1.1, 1.1)) powA <- DoseFinding:::powMCTBinCount(n=rep(20,5), doses = c(0, 0.5, 1.5, 2.5, 4), candModList=NULL, respModList=respModList, placEffu = 0.1, maxEffu = 0.25, type = "binary_logit", alpha = 0.1, theta, control = mvt_control, contMat = contMat, addArgs = list(scal = 4.8)) respModList <- list(emax = c(0.1, 0.5, 1, 2), sigEmax = rbind(c(1, 3), c(3, 3)), betaMod = c(0.37, 0.74)) contMat <- rbind(rep(1, 4), -diag(4)) powA <- DoseFinding:::powMCTBinCount(c(100,50,50,100,100), doses = c(0, 0.5, 2, 4, 8), respModList=respModList, placEffu = 0.6, maxEffu = -0.3, type = "negative_binomial", alpha = 0.025, theta = 1.25, control = mvt_control, contMat = contMat, addArgs = list(scal = 9.6)) DoseFinding/tests/testthat/generate_test_datasets.R0000644000176200001440000000667514654153534022341 0ustar liggesusers# Functions for generating the datasets used in testing # TODO: unify this mess # from testsFitting.R ---------------------------------------------------------- genDFdats <- function(model, argsMod, doses, n, sigma, mu = NULL){ nD <- length(doses) dose <- sort(doses) if (length(n) == 1) n <- rep(n, nD) dose <- rep(dose, n) args <- c(list(dose), argsMod) mu <- do.call(model, args) data.frame(dose = dose, resp = mu + rnorm(sum(n), sd = sigma)) } getDosSampSiz <- function(){ # generate dose levels mD <- runif(1, 0, 1500) nD <- max(rpois(1, 5), 4) p <- rgamma(nD, 3) p <- cumsum(p/sum(p)) doses <- signif(c(0, mD*p), 3) # sample size allocations totSS <- rpois(1, rexp(1, 1/250)) totSS <- max(totSS, 50) p <- rgamma(nD+1, 3);p <- p/sum(p) n <- round(p*totSS) n[n==0] <- rpois(sum(n==0), 1)+1 list(doses=doses, n=n) } getDFdataSet <- function(doses, n){ if(missing(doses) & missing(n)){ ll <- getDosSampSiz() } else { ll <- list(doses = doses, n=n) } e0 <- rnorm(1, 0, 10) eMax <- rgamma(1, abs(e0)*0.5, 0.5) sig <- eMax/runif(1, 0.5, 5) if(runif(1)<0.3){ aa <- genDFdats("betaMod", c(e0 = e0, eMax = eMax, delta1=runif(1, 0.5, 4), delta2=runif(1, 0.5, 4), scal=1.2*max(ll$doses)), ll$doses, ll$n, sig) } else { aa <- genDFdats("sigEmax", c(e0 = e0, eMax = eMax, ed50=runif(1, 0.05*max(ll$doses), 1.5*max(ll$doses)), h=runif(1, 0.5, 4)), ll$doses, ll$n, sig) } N <- sum(ll$n) center <- c("blue", "green", "red", "yellow", "silver") aa <- data.frame(x= aa$dose, y=aa$resp, center=as.factor(sample(center, N, replace = T)), age=runif(N, 1, 100)) aa[sample(1:nrow(aa)),] } # from testsMCT.R --------------------------------------------------------------- getDFdataSet_testsMCT <- function(doses, n){ ll <- getDosSampSiz() e0 <- rnorm(1, 0, 10) eMax <- rgamma(1, abs(e0)*0.5, 0.5)*I(runif(1)<0.25) if(eMax > 0){ sig <- eMax/runif(1, 0.5, 5)} else { sig <- rgamma(1, abs(e0)*0.5, 0.5) } dosVec <- rep(ll$doses, ll$n) if(runif(1)<0.3){ mnVec <- betaMod(dosVec, e0=e0, eMax=eMax, delta1=runif(1, 0.5, 5), delta2=runif(1, 0.5, 5), scal=1.2*max(ll$doses)) } else { mnVec <- logistic(dosVec, e0 = e0, eMax = eMax, ed50=runif(1, 0.05*max(ll$doses), 1.5*max(ll$doses)), delta=runif(1, 0.5, max(ll$doses)/2)) } resp <- rnorm(sum(ll$n), mnVec, sig) N <- sum(ll$n) cov1 <- as.factor(rpois(N, 5)) cov2 <- runif(N, 1, 100) aa <- data.frame(x= dosVec, y=resp, cov1=cov1, cov2=cov2) aa[sample(1:nrow(aa)),] } getDFdataSet.bin <- function(doses, n){ ll <- getDosSampSiz() ll$n <- ll$n+10 e0 <- rnorm(1, 0, sqrt(3.28)) eMax <- rnorm(1, 0, 5) dosVec <- rep(ll$doses, ll$n) if(runif(1)<0.3){ mn <- betaMod(dosVec, e0 = e0, eMax = eMax, delta1=runif(1, 0.5, 5), delta2=runif(1, 0.5, 5), scal=1.2*max(ll$doses)) } else { mn <- logistic(dosVec, e0 = e0, eMax = eMax, ed50=runif(1, 0.05*max(ll$doses), 1.5*max(ll$doses)), delta=runif(1, 0.5, max(ll$doses)/2)) } resp <- rbinom(length(ll$n), ll$n, 1/(1+exp(-mn))) aa <- data.frame(dose = ll$doses, resp = resp) aa <- data.frame(x= aa$dose, y=aa$resp/ll$n, n=ll$n) aa[sample(1:nrow(aa)),] } DoseFinding/tests/testthat/test-optContr.R0000644000176200001440000002421714762603270020372 0ustar liggesuserscontext("Optimal Contrasts") require_extra_packages <- function() { if (!(require("quadprog") && require("Rsolnp"))) { skip("packages quadprog and Rsolnp not available") } } # calculation of optimal contrast by enumerating all active sets allActiveSets <- function(S, mu, mult){ k <- length(mu) CC <- cbind(-1, diag(k - 1)) SPa <- CC %*% S %*% t(CC) muPa <- as.numeric(CC %*% mu) # generate all possible active sets mat <- matrix(nrow = 2^(k-1), ncol = (k-1)) for(i in 1:(k-1)) mat[,i] <- rep(rep(c(FALSE,TRUE), each=2^(i-1)), 2^((k-1)-i)) val <- numeric(2^(k-1)) feasible <- logical(2^(k-1)) cont <- matrix(nrow = 2^(k-1), ncol = (k-1)) for(i in 1:(2^(k-1))){ nonzero <- mat[i,] if(sum(nonzero) > 0){ cont[i,!nonzero] <- 0 cont[i,nonzero] <- solve(SPa[nonzero, nonzero]) %*% muPa[nonzero] feasible[i] <- all(mult*cont[i,] >= 0) contrast <- c(-sum(cont[i,]), cont[i,]) val[i] <- as.numeric(t(contrast)%*%mu/sqrt(t(contrast)%*%S%*%contrast)) } } if(!any(feasible)) return(rep(NA, k)) mm <- max(val[which(feasible)]) c(-sum(cont[val == mm,]), cont[val == mm,]) } # helper functions getStand <- function(x) x/sqrt(sum(x^2)) getNCP <- function(cont, mu, S) { as.numeric(t(cont)%*%mu/sqrt(t(cont)%*%S%*%cont)) } one_sim <- function() { cont <- vector("list", 5) # simulate mean and covariance matrix kk <- round(runif(1, 4, 10)) A <- matrix(runif(kk^2, -1, 1), kk, kk) S <- crossprod(A)+diag(kk) S_inv <- solve(S) mult <- sign(rnorm(1)) mu <- mult*sort(rnorm(kk, 1:kk, 1)) # unconstrained solution ones <- rep(1, kk) unConst <- S_inv%*%(mu - c(t(mu)%*%S_inv%*%ones/(t(ones)%*%S_inv%*%ones))) cont[[1]] <- getStand(unConst) # function from DoseFinding package cont[[2]] <- DoseFinding:::constOptC(mu, S_inv, placAdj=FALSE, ifelse(mult == 1, "increasing", "decreasing")) # alternative solution using quadratic programming A <- t(rbind(rep(1, kk), mu, mult * diag(kk) * c(-1, rep(1, kk - 1)))) bvec <- c(0, 1, rep(0, kk)) rr <- solve.QP(S, rep(0, kk), A, bvec, meq = 2) cont[[3]] <- getStand(rr$solution) # using solnp mgetNCP <- function(x, ...){ cont <- c(-sum(x), x) -getNCP(cont, ...) } res <- solnp(rep(1, kk-1), mgetNCP, mu=mu, S=S, LB=rep(0, kk-1), UB=rep(20, kk-1), control = list(trace = 0)) cont[[4]] <- getStand(c(-sum(res$pars), res$pars)) # using enumeration cont[[5]] <- allActiveSets(S=S, mu=mu, mult=mult) return(sapply(cont, getNCP, mu = mu, S = S)) } test_that("calculation of contrasts works", { skip_on_cran() set.seed(1) require_extra_packages() ncps <- replicate(1000, one_sim()) ## calculate best result among alternative methods (solnp sometimes fails) best_ncp <- apply(ncps[c(3,4,5),], 2, max) ## compare to DoseFinding::constOptC expect_equal(ncps[2,], best_ncp) }) test_that("constant shapes are handled correctly", { data(biom) # define shapes for which to calculate optimal contrasts modlist <- Mods(emax = 0.05, linear = NULL, logistic = c(0.5, 0.1), linInt = rbind(c(0, 0, 0, 1), c(0, 1, 1, 1)), doses = c(0, 0.05, 0.2, 0.6, 1), placEff = 1) cont_mat <- function(doses, placAdj, type) { optContr(modlist, w=1, doses=doses, placAdj=placAdj, type = type)$contMat } ## code should notice that linInt shapes are constant over specified dose rng (no contrast can be calculated) expect_message(cont_mat(0.05, TRUE, "u"), "The linInt1, linInt2 models have a constant shape, cannot calculate optimal contrasts for these shapes.") expect_message(cont_mat(0.05, TRUE, "c"), "The linInt1, linInt2 models have a constant shape, cannot calculate optimal contrasts for these shapes.") expect_message(cont_mat(c(0.05, 0.5), TRUE, "u"), "The linInt1 model has a constant shape, cannot calculate optimal contrasts for this shape.") expect_message(cont_mat(c(0.05, 0.5), TRUE, "c"), "The linInt1 model has a constant shape, cannot calculate optimal contrasts for this shape.") expect_message(cont_mat(c(0, 0.05), FALSE, "u"), "The linInt1, linInt2 models have a constant shape, cannot calculate optimal contrasts for these shapes.") expect_message(cont_mat(c(0, 0.05), FALSE, "c"), "The linInt1, linInt2 models have a constant shape, cannot calculate optimal contrasts for these shapes.") expect_message(cont_mat(c(0, 0.05, 0.5), FALSE, "u"), "The linInt1 model has a constant shape, cannot calculate optimal contrasts for this shape.") expect_message(cont_mat(c(0, 0.05, 0.5), FALSE, "c"), "The linInt1 model has a constant shape, cannot calculate optimal contrasts for this shape.") ## in case of all constant shapes stop with error modlist2 <- Mods(linInt = rbind(c(0, 1, 1, 1), c(0, 0, 0, 1)), doses = c(0, 0.05, 0.2, 0.6, 1), placEff = 1) expect_error(optContr(modlist2, w=1, doses=c(0.05), placAdj=TRUE, type = "u"), "All models correspond to a constant shape, no optimal contrasts calculated.") expect_error(optContr(modlist2, w=1, doses=c(0.05), placAdj=TRUE, type = "c"), "All models correspond to a constant shape, no optimal contrasts calculated.") expect_error(optContr(modlist2, w=1, doses=c(0, 0.05), placAdj=FALSE, type = "u"), "All models correspond to a constant shape, no optimal contrasts calculated.") expect_error(optContr(modlist2, w=1, doses=c(0, 0.05), placAdj=FALSE, type = "c"), "All models correspond to a constant shape, no optimal contrasts calculated.") ## mixed cases where some linInt models are non-constant expect_message(optContr(modlist2, w=1, doses=c(0.05, 0.5), placAdj=TRUE, type = "u"), "The linInt2 model has a constant shape, cannot calculate optimal contrasts for this shape.") expect_message(optContr(modlist2, w=1, doses=c(0.05, 0.5), placAdj=TRUE, type = "c"), "The linInt2 model has a constant shape, cannot calculate optimal contrasts for this shape.") expect_message(optContr(modlist2, w=1, doses=c(0, 0.05, 0.5), placAdj=FALSE, type = "u"), "The linInt2 model has a constant shape, cannot calculate optimal contrasts for this shape.") expect_message(optContr(modlist2, w=1, doses=c(0, 0.05, 0.5), placAdj=FALSE, type = "c"), "The linInt2 model has a constant shape, cannot calculate optimal contrasts for this shape.") }) test_that("optContr errors when invalid inputs are provided", { expect_error(optContr(models = list(), doses = c(0, 10), w = c(1, 1)), "models needs to be of class Mods") models <- Mods(linear = NULL, emax = 25, direction = c("increasing", "decreasing"), doses = c(0, 10)) models <- Mods(linear = NULL, doses = c(0, 10)) expect_error(optContr(models, doses = c(0, 10)), "Need to specify exactly one of \"w\" or \"S\"") expect_error(optContr(models, doses = c(0, 10), w = c(1, 1), S = diag(2)), "Need to specify exactly one of \"w\" or \"S\"") expect_error(optContr(models, doses = c(0, 10), w = c(1, 1), placAdj = TRUE), "If placAdj == TRUE there should be no placebo group in \"doses\"") expect_error(optContr(models, doses = c(0, 10), w = c(1, 1, 1)), "w needs to be of length 1 or of the same length as doses") expect_error(optContr(models, doses = c(0, 10), S = c(1, 1)), "S needs to be a matrix") }) models <- Mods(linear = NULL, doses = c(0, 10)) test_that("print.optContr prints contrast matrix", { contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) expect_output(print(contMat), "Optimal contrasts\n.*") }) test_that("summary.optContr summarizes and prints an optContr object", { contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) expect_output(summary(contMat), "Optimal contrasts\n.*") expect_output(summary(contMat), "Contrast Correlation Matrix:.*") }) test_that("plot.optContr plots contrast coefficients", { contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) expect_silent(plot(contMat, plotType = "contrasts")) expect_silent(plot(contMat, plotType = "means")) }) test_that("plotContr creates a ggplot object for the contrast coefficients", { contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) expect_s3_class(plotContr(contMat), "ggplot") }) test_that("plotContr creates a ggplot object with the correct data", { contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) plot <- plotContr(contMat) # Ensure all dose levels are present in the plot expect_true(all(levels(as.factor(plot$data$dose)) %in% c(0, 10))) # Ensure all models are present in the plot expect_true(all(levels(as.factor(plot$data$model)) %in% c("linear"))) # Check y-axis label expect_equal(plot$labels$y, "Contrast coefficients") # Check x-axis label expect_equal(plot$labels$x, "Dose") }) test_that("lattice plot for optContr with superpose options works correctly", { contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) expect_no_error(plot(contMat, plotType = "contrasts", superpose = TRUE)) }) test_that("lattice plot for optContr without superpose options works correctly", { contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) expect_no_error(plot(contMat, plotType = "contrasts", superpose = FALSE)) }) # Additional test to ensure plotContr produces the correct ggplot2 plot test_that("plotContr returns a ggplot2 plot with correct elements", { models <- Mods(linear = NULL, doses = c(0, 10, 25, 50, 100, 150)) contMat <- optContr(models, doses = c(0, 10, 25, 50, 100, 150), w = rep(50, 6)) p <- plotContr(contMat) expect_s3_class(p, "ggplot") expect_equal(p$theme$legend.position, "top") }) # Additional test to ensure plot.optContr correctly sets y-axis labels test_that("plot.optContr sets correct y-axis labels", { contMat <- optContr(models, doses = c(0, 10), w = c(1, 1)) p1 <- plot(contMat, plotType = "contrasts", ylab = "Contrast coefficients") expect_equal(p1$ylab, "Contrast coefficients") p2 <- plot(contMat, plotType = "means", ylab = "Normalized model means") expect_equal(p2$ylab, "Normalized model means") }) DoseFinding/tests/testthat/test-Mods.R0000644000176200001440000002333514762603270017464 0ustar liggesuserstest_that("Mods function requires dose levels", { expect_error(Mods(linear = NULL), "Need to specify dose levels") }) test_that("Mods function ensures dose levels include placebo and are non-negative", { expect_error(Mods(linear = NULL, doses = c(0.05, 0.2)), "Need to include placebo dose") expect_error(Mods(linear = NULL, doses = c(-0.05, 0, 0.2)), "Only dose-levels >= 0 allowed") }) test_that("Mods function checks addArgs parameters for validity", { expect_error(Mods(linear = NULL, doses = c(0, 0.05, 0.2), addArgs = list(scal = 0.1, off = 0.01)), "\"scal\" parameter needs to be ") expect_error(Mods(linear = NULL, doses = c(0, 0.05, 0.2), addArgs = list(scal = 1.2, off = -0.1)), "\"off\" parameter needs to be positive") }) test_that("Mods function generates an object of class Mods", { models <- Mods(linear = NULL, emax = 0.05, doses = c(0, 0.05, 0.2, 0.6, 1), addArgs = list(scal = 1.2, off = 0.1)) expect_s3_class(models, "Mods") expect_true(!is.null(attr(models, "placEff"))) expect_true(!is.null(attr(models, "maxEff"))) expect_true(!is.null(attr(models, "direction"))) expect_true(!is.null(attr(models, "doses"))) expect_true(!is.null(attr(models, "scal"))) expect_true(!is.null(attr(models, "off"))) }) test_that("Mods function calculates responses correctly", { doses <- c(0, 10, 25, 50, 100, 150) fmodels <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), exponential = 85, betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), linInt = rbind(c(0, 1, 1, 1, 1), c(0, 0, 1, 1, 0.8)), doses = doses, placEff = 0.5, maxEff = -0.4, addArgs = list(scal = 200)) responses <- getResp(fmodels, doses) expect_equal(nrow(responses), length(doses)) }) test_that("Mods function can specify all model parameters (fullMod = TRUE)", { fmods <- Mods(emax = c(0, 1, 0.1), linear = cbind(c(-0.4, 0), c(0.2, 0.1)), sigEmax = c(0, 1.1, 0.5, 3), doses = 0:4, fullMod = TRUE) responses <- getResp(fmods, doses = seq(0, 4, length = 11)) expect_equal(nrow(responses), 11) expect_equal(ncol(responses), length(attr(fmods, "maxEff"))) }) ## test plotting functions test_that("plotMods function basic functionality", { models <- Mods(linear = NULL, emax = 0.05, doses = c(0, 0.05, 0.2, 0.6, 1), addArgs = list(scal = 1.2, off = 0.1)) p <- plotMods(models) expect_s3_class(p, "ggplot") expect_true("GeomLine" %in% sapply(p$layers, function(layer) class(layer$geom)[1])) expect_true("GeomPoint" %in% sapply(p$layers, function(layer) class(layer$geom)[1])) p_superpose <- plotMods(models, superpose = TRUE) expect_s3_class(p_superpose, "ggplot") expect_true("GeomLine" %in% sapply(p_superpose$layers, function(layer) class(layer$geom)[1])) }) test_that("plot.Mods function basic functionality", { models <- Mods(linear = NULL, emax = 0.05, doses = c(0, 0.05, 0.2, 0.6, 1), addArgs = list(scal = 1.2, off = 0.1)) p <- plot(models) expect_s3_class(p, "trellis") }) test_that("plotMods handles customizations correctly", { models <- Mods(linear = NULL, emax = 0.05, doses = c(0, 0.05, 0.2, 0.6, 1), addArgs = list(scal = 1.2, off = 0.1)) p_custom <- plotMods(models, xlab = "Custom X Label", ylab = "Custom Y Label") expect_s3_class(p_custom, "ggplot") expect_equal(p_custom$labels$x, "Custom X Label") expect_equal(p_custom$labels$y, "Custom Y Label") }) test_that("plot.Mods handles customizations correctly", { models <- Mods(linear = NULL, emax = 0.05, doses = c(0, 0.05, 0.2, 0.6, 1), addArgs = list(scal = 1.2, off = 0.1)) p_custom <- plot(models, lwd = 3, pch = 3, cex = 1.2, col = "red") expect_s3_class(p_custom, "trellis") }) ######################### ## tests for ED and TD ######################### data(biom) modlist <- Mods(emax = 0.05, linear = NULL, logistic = c(0.5, 0.1), linInt = c(0, 0.5, 1, 1), doses = c(0, 0.05, 0.2, 0.6, 1)) ## produce first stage fit (using dose as factor) anMod <- lm(resp~factor(dose)-1, data=biom) drFit <- coef(anMod) S <- vcov(anMod) dose <- sort(unique(biom$dose)) mod_dr <- fitMod(dose, drFit, S = S, type = "general", model = "emax", bnds = c(0.01, 4)) prior <- list(norm = c(0, 10), norm = c(0,100), beta=c(0,1.5,0.45,1.7)) mod_bfit <- bFitMod(dose, drFit, S, model = "emax", start = c(0, 1, 0.1), nSim = 1000, prior = prior) mod_maFit <- maFitMod(dose, drFit, S, model = c("emax", "sigEmax"), nSim = 10) test_that("TD errors with type discrete if incorrect dose-range supplied", { expect_error(TD(modlist, Delta=0.3, TDtype = "discrete", doses=dose[-1]), "need placebo dose for TD calculation") expect_error(TD(mod_dr, Delta=0.3, TDtype = "discrete", doses=dose[-1]), "need placebo dose for TD calculation") expect_error(TD(mod_bfit, Delta=0.3, TDtype = "discrete", doses=dose[-1]), "need placebo dose for TD calculation") expect_error(TD(mod_maFit, Delta=0.3, TDtype = "discrete", doses=dose[-1]), "need placebo dose for TD calculation") expect_error(TD(modlist, Delta=0.3, TDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range") expect_error(TD(mod_dr, Delta=0.3, TDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range") expect_error(TD(mod_bfit, Delta=0.3, TDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range") expect_error(TD(mod_maFit, Delta=0.3, TDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range") }) test_that("TD gives consistent results for discrete and continuous type", { td1a <- TD(modlist, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose), 0.002)) td1b <- TD(modlist, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose) - 0.1, 0.002)) td2 <- TD(modlist, Delta=0.3, TDtype = "continuous") expect_equal(td1a, td2, tolerance = 0.01) expect_equal(td1b, td2, tolerance = 0.01) td1a <- TD(mod_dr, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose), 0.002)) td1b <- TD(mod_dr, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose) - 0.1, 0.002)) td2 <- TD(mod_dr, Delta=0.3, TDtype = "continuous") expect_equal(td1a, td2, tolerance = 0.01) expect_equal(td1b, td2, tolerance = 0.01) td1a <- median(TD(mod_bfit, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose), 0.002))) td1b <- median(TD(mod_bfit, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose) - 0.1, 0.002))) td2 <- median(TD(mod_bfit, Delta=0.3, TDtype = "continuous")) expect_equal(td1a, td2, tolerance = 0.01) expect_equal(td1b, td2, tolerance = 0.01) td1a <- TD(mod_maFit, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose), 0.002)) td1b <- TD(mod_maFit, Delta=0.3, TDtype = "discrete", doses=seq(0, max(dose) - 0.1, 0.002)) td2 <- TD(mod_maFit, Delta=0.3, TDtype = "continuous") expect_equal(td1a, td2, tolerance = 0.01) expect_equal(td1b, td2, tolerance = 0.01) }) test_that("ED errors with type discrete if incorrect dose-range supplied", { expect_error(ED(modlist, p=0.9, EDtype = "discrete", doses=dose[-1]), "need placebo dose for ED calculation") expect_error(ED(mod_dr, p=0.9, EDtype = "discrete", doses=dose[-1]), "need placebo dose for ED calculation") expect_error(ED(mod_bfit, p=0.9, EDtype = "discrete", doses=dose[-1]), "need placebo dose for ED calculation") expect_error(ED(mod_maFit, p=0.9, EDtype = "discrete", doses=dose[-1]), "need placebo dose for ED calculation") expect_error(ED(modlist, p=0.9, EDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range") expect_error(ED(mod_dr, p=0.9, EDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range") expect_error(ED(mod_bfit, p=0.9, EDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range") expect_error(ED(mod_maFit, p=0.9, EDtype = "discrete", doses=c(dose, 2)), "Doses provided may not exceed the observed dose range") }) test_that("ED gives consistent results for discrete and continuous type", { ed1a <- ED(modlist, p=0.9, EDtype = "discrete", doses=seq(0, max(dose), 0.002)) ed1b <- ED(modlist, p=0.9, EDtype = "discrete", doses=seq(0, max(dose) - 0.05, 0.002)) ed2 <- ED(modlist, p=0.9, EDtype = "continuous") expect_equal(ed1a, ed1b) expect_equal(ed1a, ed2, tolerance = 0.01) expect_equal(ed1b, ed2, tolerance = 0.01) ed1a <- ED(mod_dr, p=0.9, EDtype = "discrete", doses=seq(0, max(dose), 0.002)) ed1b <- ED(mod_dr, p=0.9, EDtype = "discrete", doses=seq(0, max(dose) - 0.05, 0.002)) ed2 <- ED(mod_dr, p=0.9, EDtype = "continuous") expect_equal(ed1a, ed1b) expect_equal(ed1a, ed2, tolerance = 0.01) expect_equal(ed1b, ed2, tolerance = 0.01) ed1a <- median(ED(mod_bfit, p=0.9, EDtype = "discrete", doses=seq(0, max(dose), 0.002))) ed1b <- median(ED(mod_bfit, p=0.9, EDtype = "discrete", doses=seq(0, max(dose) - 0.05, 0.002))) ed2 <- median(ED(mod_bfit, p=0.9, EDtype = "continuous")) expect_equal(ed1a, ed1b) expect_equal(ed1a, ed2, tolerance = 0.01) expect_equal(ed1b, ed2, tolerance = 0.01) ed1a <- ED(mod_maFit, p=0.9, EDtype = "discrete", doses=seq(0, max(dose), 0.002), direction = "increasing") ed1b <- ED(mod_maFit, p=0.9, EDtype = "discrete", doses=seq(0, max(dose) - 0.05, 0.002), direction = "increasing") ed2 <- ED(mod_maFit, p=0.9, EDtype = "continuous", direction = "increasing") expect_equal(ed1a, ed1b) expect_equal(ed1a, ed2, tolerance = 0.01) expect_equal(ed1b, ed2, tolerance = 0.01) })DoseFinding/tests/testthat/test-drmodels.R0000644000176200001440000000331014654153534020365 0ustar liggesuserscontext("dose response model functions") ud <- function(x) unname(drop(x)) test_that("betaMod does not produce NaN for large delta1, delta2", { expect_equal(betaMod(100, 1, 2, 10, 10, 200), 3) expect_equal(betaMod(100, 1, 2, 150, 150, 200), 3) expect_equal(betaMod(100, 1, 2, 100, 50, 200), 1.000409) expect_equal(betaMod(0, 1, 2, 50, 50, 200), 1) expect_equal(betaMod(0, 1, 2, 75, 75, 200), 1) expect_equal(ud(betaModGrad(100, 2, 50, 50, 200)), c(1, 1, 0, 0)) expect_equal(ud(betaModGrad(100, 2, 150, 150, 200)), c(1, 1, 0, 0)) expect_equal(ud(betaModGrad(0, 2, 50, 50, 200)), c(1, 0, 0, 0)) expect_equal(ud(betaModGrad(0, 2, 100, 100, 200)), c(1, 0, 0, 0)) }) test_that("sigEmax does not produce NaN for large dose and large h", { expect_equal(sigEmax(100, 1, 1, 50, 2), 1.8) expect_equal(sigEmax(100, 1, 1, 50, 150), 2) expect_equal(sigEmax(150, 1, 1, 50, 150), 2) expect_equal(sigEmax(0, 1, 1, 50, 10), 1) expect_equal(sigEmax(0, 1, 1, 50, 400), 1) expect_equal(sigEmax(c(50, 150), 1, 1, 50, 0), c(1.5, 1.5)) expect_equal(ud(sigEmaxGrad(100, 1, 50, 10)), c(1, 0.999024390243902, -0.000194931588340274, 0.000675581404300663)) expect_equal(ud(sigEmaxGrad(100, 1, 50, 150)), c(1, 1, 0, 0)) expect_equal(ud(sigEmaxGrad(150, 1, 50, 150)), c(1, 1, 0, 0)) expect_equal(ud(sigEmaxGrad(0, 1, 50, 0)), c(1, 0.5, 0, 0)) expect_equal(ud(sigEmaxGrad(0, 1, 50, 150)), c(1, 0, 0, 0)) # this is the only NaN we can't get rid off, as the function # (a,b,x) ↦ a^x/(a^x+b^x) # has a non-removable discontinuity at (0, 0, x) for all x > 0 # fortunately an ed50=0 does not make much sense from a modeling perspective expect_equal(sigEmax(0, 1, 1, 0, 5), NaN) }) DoseFinding/tests/testthat.R0000644000176200001440000000101414654153534015576 0ustar liggesusers## Note: Files in this directory are old test cases that accumulated ## historically over time, many of them commented out for time reasons ## (and unorganized due to lack of anything close to testthat at the ## time of creation). The testthat sub-directory now contains a ## selected subset of these tests (with some additions) that have been ## brought in the testthat format. library(testthat) library(DoseFinding) options(testthat.progress.max_fails = 100) Sys.unsetenv("R_TESTS") test_check("DoseFinding") DoseFinding/tests/testsDesign.R0000644000176200001440000003321014654153534016235 0ustar liggesusersrequire("DoseFinding") ## Some examples from the JASA paper (for validation) ######################################################################## # Emax model p.1228 l. 5 fMod <- Mods(emax = 25, doses = c(0,150), placEff=0, maxEff=0.4) fMod$emax[2] <- 0.6666667 doses <- c(0, 18.75, 150) probs <- 1 deswgts1 <- optDesign(fMod, probs, doses, Delta=0.2, designCrit = "TD", optimizer="Nelder-Mead") deswgts2 <- optDesign(fMod, probs, doses, Delta=0.2, designCrit = "TD", optimizer="nlminb") ## efficiency compared to standard design (last column) crt <- calcCrit(rep(1/6, 6), fMod, probs, c(0, 10, 25, 50, 100, 150), Delta=0.2, designCrit = "TD") exp(deswgts1$crit - crt) # Paper p. 1228 l. 2 fMod <- Mods(emax = 25, doses = c(0,150), placEff=0, maxEff=0.4) doses <- c(0, 18.75, 150) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.2, designCrit = "TD") deswgts ######################################################################## #### exponential # Paper p.1229 2nd line fMod <- Mods(exponential=85, doses = c(0, 150), placEff=0, maxEff=0.4) doses <- c(0, 50, 104.52, 150) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.2, designCrit = "TD", optimizer="Nelder-Mead") deswgts ## efficiency compared to standard design (last column) crt <- calcCrit(rep(1/6, 6), fMod, probs, c(0, 10, 25, 50, 100, 150), Delta=0.2, designCrit = "TD") exp(deswgts$crit - crt) # Paper p.1229 1st line fMod <- Mods(exponential=65, doses=c(0, 150), placEff=0, maxEff=0.4) fMod$exponential[2] <- 0.08264711 doses <- c(0, 101.57, 150) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.2, designCrit = "TD") deswgts ######################################################################## #### Logistic #### Paper: p.1230 7th line fMod <- Mods(logistic=c(50, 10.881), doses = c(0, 150), placEff=0, maxEff=0.4) doses <- c(0, 37.29, 64.44, 150) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.05, designCrit = "TD") deswgts ## efficiency compared to standard design (last column) crt <- calcCrit(rep(1/6, 6), fMod, probs, c(0, 10, 25, 50, 100, 150), Delta=0.05, designCrit = "TD") exp(deswgts$crit - crt) #### Paper p.1230 line 1 fMod <- Mods(logistic=c(50, 10.881), doses = c(0, 150), placEff=0, maxEff=0.4) doses <- c(0, 50.22) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.2, designCrit = "TD") deswgts ######################################################################## #### beta # Paper p.1230 line 5 fMod <- Mods(betaMod = c(0.33, 2.31), doses = c(0,150), addArgs=list(scal=200), placEff=0, maxEff=0.4) doses <- c(0, 0.49, 25.2, 108.07, 150) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.1, control=list(maxit=1000), designCrit = "TD") deswgts ## efficiency compared to standard design (last column) crt <- calcCrit(rep(1/6, 6), fMod, probs, c(0, 10, 25, 50, 100, 150), Delta=0.1, designCrit = "TD") exp(deswgts$crit - crt) # Paper p. 1230 line 10 fMod <- Mods(betaMod = c(1.39, 1.39), doses=c(0, 150), addArgs=list(scal=200), placEff=0, maxEff=0.4) #doses <- c(0, 10, 25, 50, 100, 150) doses <- c(0, 27, 94.89, 150) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.1, designCrit = "TD") deswgts ## efficiency compared to standard design (last column) crt <- calcCrit(rep(1/6, 6), fMod, probs, c(0, 10, 25, 50, 100, 150), Delta=0.1, designCrit = "TD") exp(deswgts$crit - crt) # Paper p. 1230 line 1 fMod <- Mods(betaMod = c(0.23, 2.31), doses=c(0,150), addArgs=list(scal=200), placEff=0, maxEff=0.4) doses <- c(0, 0.35, 150) probs <- 1 deswgts <- optDesign(fMod, probs, doses, Delta=0.2, designCrit = "TD") deswgts ## efficiency compared to standard design (last column) crt <- calcCrit(rep(1/6, 6), fMod, probs, c(0, 10, 25, 50, 100, 150), Delta=0.2, designCrit = "TD") exp(deswgts$crit - crt) ######################################################################## #### mixed Paper p. 1233, l. 2 (note the off and probably also the #### scal parameter were treated as unknown in this example in the paper, #### hence the results need not be consistent with paper) doses <- c(0, 9.9, 49.5, 115.4, 150) fMod <- Mods(linear = NULL, emax = 25, exponential = 85, linlog = NULL, logistic = c(50, 10.8811), doses=doses, addArgs=list(off=1), placEff=0, maxEff=0.4) probs <- rep(1/5, 5) deswgts <- optDesign(fMod, probs, doses, Delta=0.2, designCrit = "TD") deswgts2 <- optDesign(fMod, probs, doses, Delta=0.2, optimizer = "nlminb", designCrit = "TD") # Some other examples ######################################################################## doses <- c(0, 62.5, 125, 250, 500) fMod <- Mods(emax = c(25, 107.14), linear = NULL, logistic = c(150, 45.51), betaMod = c(1,1), doses = doses, addArgs=list(scal=1.2*500), placEff=60, maxEff=280) probs <- rep(0.2, length=5) deswgts <- optDesign(fMod, probs, Delta=200, designCrit = "TD") ######################################################################## #### using already allocated patients fMod <- Mods(betaMod = c(0.33, 2.31), doses = c(0,150), addArgs=list(scal=200), placEff=0, maxEff=0.4) doses <- c(0, 0.49, 25.2, 108.07, 150) probs <- 1 # no previously allocated patients deswgts <- optDesign(fMod, probs, doses=doses, Delta=0.1, control=list(maxit=1000), designCrit = "TD") # now use previously allocated patients nold <- c(45, 50, 0, 0, 0) deswgts2 <- optDesign(fMod, probs, doses=doses, Delta=0.1, n=30, control=list(maxit=1000), nold=nold, designCrit = "TD") # the overall design (30*deswgts2$design+nold)/(30+sum(nold)) deswgts$design ######################################################################## #### Dopt Examples doses <- c(0, 62.5, 125, 250, 500) fMod <- Mods(emax = c(25, 107.14), logistic = c(150, 45.51), linear = NULL, betaMod = c(1,1), doses=doses, addArgs=list(scal=500*1.2), placEff=60, maxEff=280) probs <- rep(0.2, 5) des1 <- optDesign(fMod, probs, doses, Delta = 200, scal = 500*1.2, designCrit = "TD") des2 <- optDesign(fMod, probs, doses, Delta = 200, scal = 500*1.2, designCrit = "Dopt") des3 <- optDesign(fMod, probs, doses, Delta = 200, scal = 500*1.2, designCrit = "Dopt&TD") ######################################################################## #### optimizer = "exact" and "solnp" doses <- c(0, 62.5, 125, 250, 500) fMod <- Mods(emax = c(25, 107.14), logistic = c(150, 45.51), linear = NULL, betaMod = c(1,1), doses=doses, addArgs=list(scal=500*1.2), placEff=60, maxEff=280) probs <- rep(0.2, 5) des41 <- optDesign(fMod, probs, doses=doses, Delta = 200, n = 10, optimizer = "exact", lowbnd = c(0.3,0,0,0,0), designCrit = "TD") des42 <- optDesign(fMod, probs, doses=doses, Delta = 200, optimizer = "solnp", designCrit = "TD", lowbnd = c(0.1,0,0,0,0)) des51 <- optDesign(fMod, probs, doses=doses, Delta = 200, n = 10, designCrit = "Dopt", optimizer = "exact", uppbnd = rep(0.5,5)) des52 <- optDesign(fMod, probs, doses=doses, Delta = 200, designCrit = "Dopt", optimizer = "solnp", uppbnd = rep(0.5,5)) des61 <- optDesign(fMod, probs, doses=doses, Delta = 200, n = 10, optimizer = "exact", designCrit = "Dopt&TD") des62 <- optDesign(fMod, probs, doses=doses, Delta = 200, optimizer = "solnp", designCrit = "Dopt&TD") ######################################################################## #### Example from Padmanabhan and Dragalin, Biometrical Journal 52 (2010) #### p. 836-852 fm <- Mods(sigEmax = c(4, 5), doses = 0:8, placEff=0, maxEff=-1.65) fm$sigEmax <- c(0, -1.70, 4, 5) ## compare to Figure 1, p. 841 desSED <- optDesign(fm, 1, designCrit="Dopt", optimizer = "solnp") desSEM <- optDesign(fm, 1, Delta = 1.3, designCrit = "TD", optimizer = "solnp") ## designs underlying Table 2, p. 843 (from an e-mail of Vlad) ## I cannot reproduce the displayed efficiencies exactly ## (most probably due to numerical round-off) ##LDoD ## [1,] 0.246 0.141 0.123 0.000 0.000 0.240 0 0 0.250 ## [2,] 0.248 0.233 0.061 0.210 0.000 0.000 0 0 0.248 ## [3,] 0.246 0.000 0.000 0.223 0.081 0.204 0 0 0.246 ## [4,] 0.250 0.247 0.045 0.210 0.000 0.000 0 0 0.248 ## [6,] 0.250 0.249 0.192 0.062 0.000 0.000 0 0 0.246 ## MEDoD ## [1,] 0.49 0.01 0.00 0.00 0.00 0.00 0.36 0.14 0 ## [2,] 0.49 0.02 0.00 0.15 0.35 0.00 0.00 0.00 0 ## [3,] 0.23 0.26 0.01 0.00 0.00 0.46 0.04 0.00 0 ## [4,] 0.50 0.00 0.49 0.01 0.00 0.00 0.00 0.00 0 ## [6,] 0.49 0.01 0.47 0.02 0.00 0.00 0.00 0.00 0 doses <- 0:8 fm <- list() fm[[1]] <- Mods(sigEmax = c(23.07, 1.18), doses=doses, placEff=0, maxEff=-1.65);fm[[1]]$sigEmax <- c(0, -7.29, 23.07, 1.18) fm[[2]] <- Mods(sigEmax = c(2, 2.22), doses=doses, placEff=0, maxEff=-1.65);fm[[2]]$sigEmax <- c(-0.08, -1.71, 2, 2.22) fm[[3]] <- Mods(sigEmax = c(4, 5), doses=doses, placEff=0, maxEff=-1.65);fm[[3]]$sigEmax <- c(0, -1.70, 4, 5) fm[[4]] <- Mods(sigEmax = c(0.79, 1), doses=doses, placEff=0, maxEff=-1.65);fm[[4]]$sigEmax <- c(0, -1.81, 0.79, 1.00) fm[[5]] <- Mods(sigEmax = c(0.74, 1.18), doses=doses, placEff=0, maxEff=-1.65);fm[[5]]$sigEmax <- c(-0.03, -1.72, 0.74, 1.18) desD <- desM <- matrix(ncol = 9, nrow = 5) for(i in 1:5){ cc1 <- optDesign(fm[[i]], 1, doses=doses, designCrit = "TD", optimizer = "solnp", Delta = 1.3) cc2 <- optDesign(fm[[i]], 1, doses=doses, designCrit="Dopt", optimizer = "solnp") desM[i,] <- cc1$design desD[i,] <- cc2$design } round(desD, 3) round(desM, 2) ## compare criterion for TD design under model 2 crDrag <- calcCrit(c(0.49,0.02,0,0.15,0.34,0,0,0,0), models=fm[[2]], probs=1, doses=doses, designCrit="TD", Delta=1.3) crDF <- optDesign(fm[[i]], 1, doses=doses, designCrit = "TD", optimizer = "solnp", Delta = 1.3)$crit exp(crDF-crDrag) ## design calculated by P and Dragalin only has 88% efficacy? ################################################################################ #### look at standardized Dopt and Dopt&TD criteria doses <- c(0, 62.5, 125, 250, 500) fMod1 <- Mods(sigEmax = rbind(c(25, 5), c(107.14, 2)), doses=doses, placEff=60, maxEff=280) fMod2 <- Mods(sigEmax = rbind(c(25, 5), c(107.14, 2)), linear = NULL, doses=doses, placEff=60, maxEff=280) w1 <- rep(0.5, 2) w2 <- rep(1/3, 3) ## des1 and des2 should be exactly the same des1 <- optDesign(fMod1, w1, doses, designCrit = "Dopt", standDopt = FALSE) des2 <- optDesign(fMod1, w1, doses, designCrit = "Dopt", standDopt = TRUE) ## des1 and des2 should be different (as linear and emax have ## different number of parameters) des1 <- optDesign(fMod2, w2, doses, designCrit = "Dopt", standDopt = FALSE, optimizer = "solnp") des2 <- optDesign(fMod2, w2, doses, designCrit = "Dopt", standDopt = TRUE, optimizer = "solnp") ## same with Dopt&TD criterion ## des1 and des2 will differ (due to different scaling ## of Dopt and TD criteria) des1 <- optDesign(fMod1, w1, doses, designCrit = "Dopt&TD", Delta = 100, standDopt = FALSE, optimizer = "solnp") des2 <- optDesign(fMod1, w1, doses, designCrit = "Dopt&TD", Delta = 100, standDopt = TRUE, optimizer = "solnp") ######################################################################## #### optimial design logistic regression ## compare this to Atkinson et al. (2007), p. 400 ## theoretically the D-opt design should have weights 0.5,0.5 at points where ## the probability is 0.176 and 1-0.176 (0.3456 and 0.6544 in this case) doses <- seq(0, 1, length = 21) fMod <- Mods(linear = NULL, doses=doses, placEff=-5, maxEff = 10) pp <- 1 # just one model ## by default calculates TD optimal design mu <- as.numeric(getResp(fMod, doses=doses)) mu <- 1/(1+exp(-mu)) weights <- mu*(1-mu) des1 <- optDesign(fMod, pp, doses, weights = weights, optimizer = "solnp") des2 <- optDesign(fMod, pp, doses, designCrit = "TD", Delta=0.2, optimizer = "solnp", weights = weights) des3 <- optDesign(fMod, pp, doses, Delta=0.2, designCrit = "Dopt&TD", optimizer = "solnp", weights = weights) ######################################################################## #### code using lower and upper bound (previous to version 0.9-6 this #### caused problems as the starting value for solnp rep(0.2, 5) was #### on the boundary, now a feasible starting values is used doses <- seq(0, 1, length=5) nold <- rep(0, times=5) lowbnd <- c(0.2,0.0,0.0,0.0,0.2) uppbnd <- c(1.0,0.3,1.0,1.0,1.0) trueModels <- Mods(linear=NULL, doses=doses, placEff = 0, maxEff = 1) optDesign(models=trueModels, probs=1, doses=doses, designCrit="Dopt", lowbnd=lowbnd,uppbnd=uppbnd) ######################################################################## ## TD optimal design for beta model (previously instabilities for ## numerical gradients) mm <- Mods(betaMod=c(1.5,0.8), doses=seq(0,1,by=0.25), placEff=0, maxEff=1) optDesign(mm, probs=1, designCrit="TD", Delta=0.5) ## Output from GUI ## placEff=0, maxEff=1 ## TD-optimalität mit Delta= 0.5 ## Model: BetaMod mit delta1=1.5, delta2=0.8 ## Dosen 0 0.25 0.5 0.75 1 ## Design 0.4895 0.3552 0.1448 0 0.0105 DoseFinding/tests/testgFit.R0000644000176200001440000001103614654153534015534 0ustar liggesusersrequire("DoseFinding") data(IBScovars) lmfit <- lm(resp~factor(dose)+gender, data=IBScovars) cf <- coef(lmfit)[-c(6)] vcv <- vcov(lmfit)[-c(6), -c(6)] lmfit2 <- lm(resp~as.factor(dose)-1+gender, data=IBScovars) cf2 <- coef(lmfit2)[-c(6)] vcv2 <- vcov(lmfit2)[-c(6), -c(6)] dose <- c(0:4) ## test fitting all available models fitMod(dose[-1], cf[-1], S=vcv[-1,-1], model="linear", placAdj=TRUE,type="general") fitMod(dose, cf2, S=vcv2, model="linear", placAdj=FALSE,type="general") fitMod(dose[-1], cf[-1], S=vcv[-1,-1], model="quadratic", placAdj=TRUE,type="general") fitMod(dose, cf2, S=vcv2, model="quadratic", placAdj=FALSE,type="general") fitMod(dose, cf2, S=vcv2, model="linlog", placAdj=FALSE, addArgs=list(off=0.01*max(dose)),type="general") fitMod(dose[-1], cf[-1], S=vcv[-1,-1], model="emax", placAdj=TRUE, bnds=defBnds(max(dose))$emax,type="general") fitMod(dose, cf2, S=vcv2, model="emax", placAdj=FALSE, bnds=defBnds(max(dose))$emax,type="general") fitMod(dose[-1], cf[-1], S=vcv[-1,-1], model="sigEmax", placAdj=TRUE, bnds=defBnds(max(dose))$sigEmax,type="general") fitMod(dose, cf2, S=vcv2, model="sigEmax", placAdj=FALSE, bnds=defBnds(max(dose))$sigEmax,type="general") fitMod(dose[-1], cf[-1], S=vcv[-1,-1], model="exponential", placAdj=TRUE, bnds=defBnds(max(dose))$exponential,type="general") fitMod(dose, cf2, S=vcv2, model="exponential", placAdj=FALSE, bnds=defBnds(max(dose))$exponential,type="general") fitMod(dose, cf2, S=vcv2, model="logistic", placAdj=FALSE, bnds=defBnds(max(dose))$logistic,type="general") fitMod(dose[-1], cf[-1], S=vcv[-1,-1], model="betaMod", placAdj=TRUE, bnds=defBnds(max(dose))$betaMod, addArgs=list(scal=1.2*4),type="general") fitMod(dose, cf2, S=vcv2, model="betaMod", placAdj=FALSE, bnds=defBnds(max(dose))$betaMod, addArgs=list(scal=1.2*4),type="general") fitMod(dose[-1], cf[-1], S=vcv[-1,-1], model="linInt", placAdj=TRUE, type="general") fitMod(dose, cf2, S=vcv2, model="linInt", placAdj=FALSE, type="general") ## test using starting value (instead of grid search) fitMod(dose[-1], cf[-1], S=vcv[-1,-1], model="emax", placAdj=TRUE, bnds=defBnds(max(dose))$emax, start = 0.5,type="general") fitMod(dose, cf2, S=vcv2, model="emax", placAdj=FALSE, bnds=defBnds(max(dose))$emax, start = 0.2,type="general") fitMod(dose[-1], cf[-1], S=vcv[-1,-1], model="betaMod", placAdj=TRUE, bnds=defBnds(max(dose))$betaMod, addArgs=list(scal=1.2*4),type="general") fitMod(dose, cf2, S=vcv2, model="betaMod", placAdj=FALSE, bnds=defBnds(max(dose))$betaMod, start = c(1, 1), addArgs=list(scal=1.2*4),type="general") ## test predict, vcov, coef, intervals, plot, summary ggI <- fitMod(dose, cf2, S=vcv2, model="betaMod", placAdj=FALSE, bnds=defBnds(max(dose))$betaMod, addArgs=list(scal=1.2*4),type="general") ggNI <- fitMod(dose[-1], cf[-1], S=vcv[-1,-1], model="betaMod", placAdj=TRUE, bnds=defBnds(max(dose))$betaMod, addArgs=list(scal=1.2*4),type="general") predict(ggI, se.fit=TRUE, predType = "e") predict(ggNI, se.fit=TRUE, predType = "e") vcov(ggI) vcov(ggNI) plot(ggI, CI=T, plotData = "meansCI") plot(ggNI, CI=T, plotData = "meansCI") ggI <- fitMod(dose, cf2, S=vcv2, model="linInt", placAdj=FALSE,type="general") ggNI <- fitMod(dose[-1], cf[-1], S=vcv[-1,-1], model="linInt", placAdj=TRUE,type="general") predict(ggI, se.fit=TRUE, predType = "full-model") predict(ggI, se.fit=TRUE, predType = "effect-curve") predict(ggNI, se.fit=TRUE, predType = "full-model") vcov(ggI) vcov(ggNI) plot(ggI, CI=T, plotData = "meansCI") plot(ggNI, CI=T, plotData = "meansCI") ## even more tests for the linInt model data(IBScovars) ## without covariates fit <- fitMod(dose, resp, data=IBScovars, model="linInt") plot(fit, CI=TRUE, plotData="meansCI") fit <- fitMod(dose, resp, data=IBScovars, model="linInt", addCovars=~gender) plot(fit, CI=TRUE, plotData="meansCI") vcov(fit) fit <- lm(resp~as.factor(dose)-1, data=IBScovars) cf <- coef(fit) vc <- vcov(fit) doseVec <- 0:4 fit <- fitMod(doseVec, cf, model="linInt", S=vc, type = "general") plot(fit, CI=TRUE, plotData="meansCI") vcov(fit) fit <- lm(resp~as.factor(dose)+gender, data=IBScovars) cf <- coef(fit)[2:5] vc <- vcov(fit)[2:5,2:5] doseVec <- 1:4 fit <- fitMod(doseVec, cf, model="linInt", S=vc, type = "general", placAdj=TRUE) vcov(fit) plot(fit, CI=TRUE, plotData="meansCI") predict(fit, predType = "effect-curve", se.fit=TRUE) DoseFinding/MD50000644000176200001440000001560214764054522012770 0ustar liggesusers56b88ad969a81691322783706251665d *DESCRIPTION 6dc45e1f3da19265a2148439c235bc97 *NAMESPACE df2c167adfc2e293a32a3260898b6ce3 *NEWS.md c8472dffa5b1aa3dd497c54c033ab67b *R/DesignMCPModApp.R 5746f7d447d90a988701538deff469ef *R/DoseFinding-package.R 7df61ade4aa18d3b7a491375d4643a9a *R/MCPMod.R 0b475443a1530489ebc5a6987c3d355c *R/MCTtest.R 31a17974c3d74ca5eef5c4e7de0001df *R/MCTtest_helpers.R 5ca015d8926c710f22d8ebac2b95d438 *R/Mods.R e487f58e3d37512b3d841692b6f66604 *R/Mods_helpers.R 7e61fc7d3501045fbdef1d7e3fdbd279 *R/bFitMod.R 633fa230b34445c95378793762ce8d49 *R/bFitMod_helpers.R 40c3f0ae9a220ea7c7b04496f8d85b87 *R/bMCTtest.R ef1285556d5156fc08bf7721ac019295 *R/bMCTtest_helpers.R 778cb11dc704a278d8ec2832f7e763df *R/drmodels.R 44d0f11ae73d256efe22369fb077c5d9 *R/fitMod.R f94c6a486473905fec6927832020afe9 *R/fitMod_helpers.R b2ab5b4c757f9253021e7eaa0c4027f1 *R/guesst.R 3cb5836f4b0f2cc26eff8e7f2644c710 *R/maFitMod.R adf306336e07ca6019a63a24c224da16 *R/optContr.R 9bd06f01fd30585e7a6234770ee846ba *R/optContr_helpers.R 0040170413c1a67a8bc5cb565411b809 *R/optDesign.R ebbe829e5d563942985cf6f04a9e5c35 *R/optDesign_helpers.R 8f371dae4628fd7bb8d3315825bc5d61 *R/planMod.R c43c090f2eaf95a61e6f37a056c104b8 *R/planMod_helpers.R ddc55dcce60bb596af05442dfa9813f7 *R/powMCT.R 55f46c0280e3df0a4035ee2b8e33ffc1 *R/powMCT_helpers.R bad9d9cd1639b37b4746ca0341eac768 *R/sampSize.R 58781a91abac3996a73b39b58d8845d8 *README.md 4e851bb32afed74d3368236db2011f92 *build/vignette.rds 4eececc090f50b4ec9018ee1c745f398 *data/IBScovars.rda 3cc70c1f72990c43612c447828d99095 *data/biom.rda a946f02e98832a2e7d4280c301d9f389 *data/glycobrom.rda 33017675ed1b1a520c4635da8b1e9747 *data/migraine.rda 67d721d20a92e2c79456e51cf1c47c09 *data/neurodeg.rda 4c6a330146ca1f42e35d58322d97577c *inst/doc/analysis_normal.R 04f3a7d6f2a01e7fa05c62a1e29e4fc7 *inst/doc/analysis_normal.Rmd 322e31548f5db260ec91ff695a564039 *inst/doc/analysis_normal.html 26514f24f9dc8811703cc7916bfc03a9 *inst/doc/binary_data.R e85ec5fb7a2e4437f5f232017fe303a4 *inst/doc/binary_data.Rmd 0917c18adcfdf6eac1b2902786cd5d42 *inst/doc/binary_data.html df38cf01b4dbdc1944e76d29b4f824bf *inst/doc/faq.R 43ca31cc8992eb71358c2dad78ed79f6 *inst/doc/faq.Rmd dca7c69e1f36c60224c60b177a4ae2ce *inst/doc/faq.html e04599fbeb8335b5a3a655a72d7f2fda *inst/doc/mult_regimen.R 9d1855830b5bdbadb145e7aa509c3ec3 *inst/doc/mult_regimen.Rmd 3d52f5882fd2b5bc1c4bb02b6c00b459 *inst/doc/mult_regimen.html 0f0685206f472d6ca1b27b46c80f39b8 *inst/doc/overview.R c5fec3129b26df45ab55795406d8e8fe *inst/doc/overview.Rmd 71e9818d9c04f43078f2111a5ad587aa *inst/doc/overview.html 083d434c626a22cd106d3b5121db3296 *inst/doc/sample_size.R 4aa482be5be5860169102349c3dc6a59 *inst/doc/sample_size.Rmd 49f64ffd35f79743ec0791c58a81bf19 *inst/doc/sample_size.html 4d8d0c54182c01d053bb4186875ee711 *man/DesignMCPModApp.Rd b86b2c2002c5cfdccb48695015a559fc *man/DoseFinding-package.Rd ee6966a5545206c2cd96bbf22a4df4e5 *man/IBScovars.Rd f8bfd206eb14faca41c8fe54deda5d7d *man/MCPMod.Rd 9bd01afdcc671771d069d998a64bb56d *man/MCTpval.Rd 56cd1fb26a9e76e3ceb26a955a12bcc3 *man/MCTtest.Rd 7c2687e219facd0b06ada8878f73cbbf *man/Mods.Rd afe925289407c3418e8f2b1c8dad8d44 *man/bFitMod.Rd 4ff23089ca5c113087b8f35933095c05 *man/bMCTtest.Rd 341c067219b395112d411772923dd05a *man/biom.Rd 27b3cd285623950c319dfb6b83583e28 *man/critVal.Rd dd971f7a7aadd2633e20db27594c449d *man/defBnds.Rd f361100a4e87693d75ed1245cf6f2577 *man/drmodels.Rd d7673b865e011d2b96e9c4d6eea78801 *man/figures/README-example-1.png c66a0ac76ce6e5f538591f867a83757e *man/figures/README-example-2.png d85aa87c7a8386b768539413fc0b9c99 *man/figures/README-example-3.png d7673b865e011d2b96e9c4d6eea78801 *man/figures/README-example1-1.png c66a0ac76ce6e5f538591f867a83757e *man/figures/README-example2-1.png d85aa87c7a8386b768539413fc0b9c99 *man/figures/README-example3-1.png 3eb2ba4842d647a3c99782ba5d1b2f43 *man/fitMod.Rd d198d7fa024e1b550a87bda87563e6b4 *man/glycobrom.Rd ca889798fabeffdbaafde45add0b074e *man/guesst.Rd 48c0e983a7d31f7fd683764c4239eb3e *man/maFitMod.Rd 078ed25d20d35ff159338b960341708a *man/migraine.Rd 0a45bd81378584c09ca0623ab013da00 *man/mvpostmix.Rd d83d9bcc5612cd47d4003bbcf2b90984 *man/mvtnorm-control.Rd 92b95114144f8fe26c83877dc085b9ef *man/neurodeg.Rd af89fb340a8fdcf62e5f0fb5e9d297c6 *man/optContr.Rd c7dd5e62447d443cdce664d3f98ccaec *man/optDesign.Rd 6171883febcda13f72f87c1ea715dc54 *man/planMod.Rd 46769518dc395bf6206e11bd042c37b1 *man/powMCT.Rd c8e6b7879bf92637b10332cb5b861f27 *man/sampSize.Rd 5f01235b1a2fc126e5a27c943d118371 *man/targdose.Rd 3cdba82c5ac72d3f217d77bc3ca335a2 *src/DoseFinding_init.c 2a6f9e9e044a78154d3cfda5936d6f48 *src/Makevars 5321b1f578a7238c0921f9fd8b3c9f8e *src/bFitMod.c 8b06211458ee51d73920b8bde61d7db6 *src/combinations.c adb28d4f2ed6ecb4bce2fc652564ba52 *src/optDes.c e87f474cc9274046531fca669abc0a22 *tests/testgFit.R 5fb0f8c4fd9c1efb33fb07a235be47c4 *tests/testplanMod.R 70df4f6ca90dcfa6c938039bad2e6c7f *tests/testsDesign.R 2aa01667b8b066ad252e4aeae05292a4 *tests/testsFitting.R f16b30b01499b767073ee196f8ee1ab5 *tests/testsMCPMod.R 4003a3a9776d39dbd94f315f876b9dc5 *tests/testsMCT.R 19bf39293d0b8fd259cf282f7ef8ed2a *tests/testsoptContr.R e3f638fde7a3e4b4cb682a819c26096f *tests/testsplotDRMod.R 89475c030b81173347c11fbb4b2077b3 *tests/testssampSize.R d5334d3de0224c3c33a763f42d18314b *tests/testssamplMod.R 062d6c13c9b9c528c9451c1bd226b4ce *tests/testthat.R becfdc741476b9230e200e704861e816 *tests/testthat/generate_test_datasets.R a29d8a15ba4f645523baca673602cc19 *tests/testthat/test-DesignMCPModApp.R c91a4c98a2d2974f5e5fad696fef65fc *tests/testthat/test-MCPMod.R 36abf96a5e5ea0a2362be2a297b5d3b9 *tests/testthat/test-MCTtest.R bb1ea9dd030b9e40bed74c015b8c0b47 *tests/testthat/test-Mods.R 1906f40f8622be507940ef06d015ba80 *tests/testthat/test-bFitMod.R b79b2aab1d2c5128aeff18fae846fe25 *tests/testthat/test-bMCTtest.R 90803d68279fc3c29aa9d944a4dee2af *tests/testthat/test-drmodels.R d01d869973bcb66dfd3ac26080b73751 *tests/testthat/test-fitMod.R 3df1d6589dd54d48a770408f03a52158 *tests/testthat/test-guesst.R 75430dfb46bf5103acc84862ccd16143 *tests/testthat/test-maFitMod.R f4e0419b54f88cb49d27219ff899934b *tests/testthat/test-optContr.R c30000fb79b06c762e10c43cc5d0e8a5 *tests/testthat/test-optDesign.R 032cd2fbad0edacd9fa3695227526d85 *tests/testthat/test-planMod.R 613b3357ea766aa34e711da4012bc9c5 *tests/testthat/test-powMCT.R 2a54731df83721b40ba59256127346bb *tests/testthat/test-powMCTBinCount.R bf47267694209fb9a27a0b08b7ef9202 *tests/testthat/test-sampSize.R 6d5383fd118f8df09ff13b7b352a0ede *vignettes/american-statistical-association.csl 04f3a7d6f2a01e7fa05c62a1e29e4fc7 *vignettes/analysis_normal.Rmd e85ec5fb7a2e4437f5f232017fe303a4 *vignettes/binary_data.Rmd 618d940653b296501bea2c26a618a273 *vignettes/children/settings.txt 43ca31cc8992eb71358c2dad78ed79f6 *vignettes/faq.Rmd 9d1855830b5bdbadb145e7aa509c3ec3 *vignettes/mult_regimen.Rmd c5fec3129b26df45ab55795406d8e8fe *vignettes/overview.Rmd e581ae8e418978723f961d2d7cc142a5 *vignettes/refs.bib 4aa482be5be5860169102349c3dc6a59 *vignettes/sample_size.Rmd DoseFinding/R/0000755000176200001440000000000014762603270012653 5ustar liggesusersDoseFinding/R/MCPMod.R0000644000176200001440000004007314734504243014060 0ustar liggesusers## wrapper function for MCTtest and fitMod calls #' MCPMod - Multiple Comparisons and Modeling #' #' Tests for a dose-response effect using a model-based multiple contrast test (see \code{\link{MCTtest}}), selects one #' (or several) model(s) from the significant shapes, fits them using \code{\link{fitMod}}. For details on the method #' see Bretz et al. (2005). #' #' #' @aliases MCPMod predict.MCPMod plot.MCPMod #' @inheritParams MCTtest #' @param selModel Optional character vector specifying the model selection #' criterion for dose estimation. Possible values are \itemize{ \item #' \code{AIC}: Selects model with smallest AIC (this is the default) \item #' \code{maxT}: Selects the model corresponding to the largest t-statistic. #' \item \code{aveAIC}: Uses a weighted average of the models corresponding to #' the significant contrasts. The model weights are chosen by the formula: #' \eqn{w_i = \exp(-0.5AIC_i)/\sum_i(\exp(-0.5AIC_i))}{w_i = #' exp(-0.5AIC_i)/sum(exp(-0.5AIC_i))} See Buckland et al. (1997) for details. #' } For \samp{type = "general"} the "gAIC" is used. #' @param df Specify the degrees of freedom to use in case \samp{type = "general"}, for the call to #' \code{\link{MCTtest}} and \code{\link{fitMod}}. Infinite degrees of (\samp{df=Inf}) correspond to the multivariate #' normal distribution. For type = "normal" the degrees of freedom deduced from the AN(C)OVA fit are used and this #' argument is ignored. #' @param doseType,Delta,p \samp{doseType} determines the dose to estimate, ED or TD (see also \code{\link{Mods}}), and #' \samp{Delta} and \samp{p} need to be specified depending on whether TD or ED is to be estimated. See #' \code{\link{TD}} and \code{\link{ED}} for details. #' @param bnds Bounds for non-linear parameters. This needs to be a list with list entries corresponding to the selected #' bounds. The names of the list entries need to correspond to the model names. The \code{\link{defBnds}} function #' provides the default selection. #' @param control Control list for the optimization.\cr A list with entries: "nlminbcontrol", "optimizetol" and #' "gridSize". #' #' The entry nlminbcontrol needs to be a list and is passed directly to control argument in the nlminb function, that #' is used internally for models with 2 nonlinear parameters (e.g. sigmoid Emax or beta model). #' #' The entry optimizetol is passed directly to the tol argument of the optimize function, which is used for models #' with 1 nonlinear parameters (e.g. Emax or exponential model). #' #' The entry gridSize needs to be a list with entries dim1 and dim2 giving the size of the grid for the gridsearch in #' 1d or 2d models. #' @return An object of class \samp{MCPMod}, which contains the fitted \samp{MCTtest} object as well as the \samp{DRMod} #' objects and additional information (model selection criteria, dose estimates, selected models). #' @author Bjoern Bornkamp #' @seealso \code{\link{MCTtest}}, \code{\link{fitMod}}, \code{\link{drmodels}} #' @references Bretz, F., Pinheiro, J. C., and Branson, M. (2005), Combining multiple comparisons and modeling #' techniques in dose-response studies, \emph{Biometrics}, \bold{61}, 738--748 #' #' Pinheiro, J. C., Bornkamp, B., and Bretz, F. (2006). Design and analysis of dose finding studies combining multiple #' comparisons and modeling procedures, \emph{Journal of Biopharmaceutical Statistics}, \bold{16}, 639--656 #' #' Pinheiro, J. C., Bretz, F., and Branson, M. (2006). Analysis of dose-response studies - modeling approaches, #' \emph{in} N. Ting (ed.). \emph{Dose Finding in Drug Development}, Springer, New York, pp. 146--171 #' #' Pinheiro, J. C., Bornkamp, B., Glimm, E. and Bretz, F. (2014) Model-based dose finding under model uncertainty #' using general parametric models, \emph{Statistics in Medicine}, \bold{33}, 1646--1661 #' #' Schorning, K., Bornkamp, B., Bretz, F., & Dette, H. (2016). Model selection #' versus model averaging in dose finding studies. \emph{Statistics in #' Medicine}, \bold{35}, 4021--4040 #' #' Xun, X. and Bretz, F. (2017) The MCP-Mod methodology: Practical Considerations and The DoseFinding R package, in #' O'Quigley, J., Iasonos, A. and Bornkamp, B. (eds) Handbook of methods for designing, monitoring, and analyzing #' dose-finding trials, CRC press #' #' Buckland, S. T., Burnham, K. P. and Augustin, N. H. (1997). Model selection an integral part of inference, #' \emph{Biometrics}, \bold{53}, 603--618 #' #' Seber, G.A.F. and Wild, C.J. (2003). Nonlinear Regression, Wiley. #' @examples #' #' data(biom) #' ## first define candidate model set (only need "standardized" models) #' models <- Mods(linear = NULL, emax=c(0.05,0.2), linInt=c(1, 1, 1, 1), #' doses=c(0,0.05,0.2,0.6,1)) #' plot(models) #' ## perform MCPMod procedure #' MM <- MCPMod(dose, resp, biom, models, Delta=0.5) #' ## a number of things can be done with an MCPMod object #' MM # print method provides basic information #' summary(MM) # more information #' ## predict all significant dose-response models #' predict(MM, se.fit=TRUE, doseSeq=c(0,0.2,0.4, 0.9, 1), #' predType="ls-means") #' ## display all model functions #' plot(MM, plotData="meansCI", CI=TRUE) #' #' ## now perform model-averaging #' MM2 <- MCPMod(dose, resp, biom, models, Delta=0.5, selModel = "aveAIC") #' sq <- seq(0,1,length=11) #' pred <- predict(MM, doseSeq=sq, predType="ls-means") #' modWeights <- MM2$selMod #' ## model averaged predictions #' pred <- do.call("cbind", pred)%*%modWeights #' ## model averaged dose-estimate #' TDEst <- MM2$doseEst%*%modWeights #' #' ## now an example using a general fit and fitting based on placebo #' ## adjusted first-stage estimates #' data(IBScovars) #' ## ANCOVA fit model including covariates #' anovaMod <- lm(resp~factor(dose)+gender, data=IBScovars) #' drFit <- coef(anovaMod)[2:5] # placebo adjusted estimates at doses #' vCov <- vcov(anovaMod)[2:5,2:5] #' dose <- sort(unique(IBScovars$dose))[-1] # no estimate for placebo #' ## candidate models #' models <- Mods(emax = c(0.5, 1), betaMod=c(1,1), doses=c(0,4)) #' plot(models) #' ## hand over placebo-adjusted estimates drFit to MCPMod #' MM3 <- MCPMod(dose, drFit, S=vCov, models = models, type = "general", #' placAdj = TRUE, Delta=0.2) #' plot(MM3, plotData="meansCI") #' #' ## The first example, but with critical value handed over #' ## this is useful, e.g. in simulation studies #' MM4 <- MCPMod(dose, resp, biom, models, Delta=0.5, critV = 2.31) #' @export MCPMod <- function(dose, resp, data = NULL, models = NULL, S=NULL, type = c("normal", "general"), addCovars = ~1, placAdj = FALSE, selModel = c("AIC", "maxT", "aveAIC"), alpha = 0.025, df = NULL, critV = NULL, doseType = c("TD", "ED"), Delta, p, pVal = TRUE, alternative = c("one.sided", "two.sided"), na.action = na.fail, mvtcontrol = mvtnorm.control(), bnds, control = NULL){ direction <- attr(models, "direction") ## first perform multiple contrast test if(!is.null(data)){ callMCT <- list(deparse(substitute(dose)), deparse(substitute(resp)), data, models, S, type, addCovars, placAdj, alpha, df, critV, pVal, alternative, na.action, mvtcontrol) test <- do.call(MCTtest, callMCT) } else { test <- MCTtest(dose, resp, data, models, S, type, addCovars, placAdj, alpha, df, critV, pVal, alternative, na.action, mvtcontrol) } ## now pre-select models based on contrasts tstat <- test$tStat pvals <- attr(tstat, "pVal") if(!is.null(pvals)){ tstat <- tstat[pvals < alpha] } else { tstat <- tstat[tstat > test$critVal] } if(length(tstat) == 0) ## stop if no model significant return(list(MCTtest = test, mods = NULL, modcrit = NULL, selMod = NULL, TD = NULL)) ## fit models and calculate model selection criteria addArgs <- list(off=attr(models, "off"), scal=attr(models, "scal")) selModel <- match.arg(selModel) builtIn <- c("linlog", "linear", "quadratic", "linInt", "emax", "exponential", "logistic", "betaMod", "sigEmax") nams <- gsub("[0-9]", "", names(tstat)) ## remove numbers from model-names namsU <- unique(nams) mods <- vector("list", length(namsU));z <- 1 if(missing(bnds)){ if(!is.null(data)){ cal <- as.character(match.call()) doseVec <- data[, cal[2]] } else { doseVec <- dose } bnds <- defBnds(max(doseVec)) } else { if(!is.list(bnds)) stop("bnds needs to be a list") } if(selModel %in% c("AIC", "aveAIC")){ if(type[1] == "normal"){ modcrit <- AIC } else { modcrit <- gAIC } } else { modcrit <- function(x) max(tstat[attr(x, "model") == nams]) } for(i in 1:length(namsU)){ if(!is.null(data)){ callMod <- list(deparse(substitute(dose)), deparse(substitute(resp)), data, namsU[i], S, type, addCovars, placAdj, bnds[[namsU[i]]], df, NULL, na.action, control, addArgs) mods[[i]] <- do.call(fitMod, callMod) } else { mods[[i]] <- fitMod(dose, resp, data, namsU[i], S, type, addCovars, placAdj, bnds[[namsU[i]]], df, NULL, na.action, control, addArgs) } } crit <- sapply(mods, modcrit) names(crit) <- names(mods) <- namsU attr(crit, "crit") <- selModel if(selModel %in% c("maxT", "AIC")){ if(selModel == "AIC"){ ind <- which.min(crit) } if(selModel == "maxT"){ nam <- names(tstat)[which.max(tstat)] ind <- which(gsub("[0-9]", "", nam) == names(mods)) } selMod <- namsU[ind] # name of selected model } else { aic <- crit-mean(crit) selMod <- exp(-0.5*aic)/sum(exp(-0.5*aic)) # model weights names(selMod) <- namsU } ## calculate target dose estimate tds <- NULL doseType <- match.arg(doseType) if(doseType == "TD"){ if(missing(Delta)) stop("\"Delta\" needs to be specified for TD estimation") tds <- sapply(mods, TD, Delta=Delta, direction = direction) attr(tds, "addPar") <- Delta } if(doseType == "ED"){ if(missing(p)) stop("\"p\" needs to be specified for TD estimation") tds <- sapply(mods, ED, p=p) attr(tds, "addPar") <- p } out <- list(MCTtest = test, mods = mods, modcrit=crit, selMod=selMod, doseEst=tds, doseType = doseType) class(out) <- "MCPMod" out } #' Predict from the fitted dose-response model #' #' @param object,x MCPMod object #' @param predType,newdata,doseSeq,se.fit,... predType determines whether predictions are returned for the full model #' (including potential covariates), the ls-means (SAS type) or the effect curve (difference to placebo). #' #' newdata gives the covariates to use in producing the predictions (for \samp{predType = "full-model"}), if missing #' the covariates used for fitting are used. #' #' doseSeq dose-sequence on where to produce predictions (for \samp{predType = #' "effect-curve"} and \samp{predType = "ls-means"}). If missing the doses used #' for fitting are used. #' #' se.fit: logical determining, whether the standard error should be calculated. #' #' \ldots: Additional arguments, for plot.MCPMod these are passed to plot.DRMod. #' #' @rdname MCPMod #' @method predict MCPMod #' @export predict.MCPMod <- function(object, predType = c("full-model", "ls-means", "effect-curve"), newdata = NULL, doseSeq = NULL, se.fit = FALSE, ...){ lapply(object$mods, function(x) predict(x, predType, newdata, doseSeq, se.fit)) } #' @export print.MCPMod <- function(x, digits=3, eps=1e-03, ...){ cat("MCPMod\n") xx <- x$MCTtest cat("\nMultiple Contrast Test:\n") ord <- rev(order(xx$tStat)) if (!any(is.null(attr(xx$tStat, "pVal")))) { pval <- format.pval(attr(xx$tStat, "pVal"), digits = digits, eps = eps) dfrm <- data.frame(round(xx$tStat, digits)[ord], pval[ord]) names(dfrm) <- c("t-Stat", "adj-p") } else { dfrm <- data.frame(round(xx$tStat, digits)[ord]) names(dfrm) <- c("t-Stat") } print(dfrm) if (!is.null(xx$critVal)) { twoSide <- xx$alternative == "two.sided" vec <- c(" one-sided)", " two-sided)") cat("\n", "Critical value: ", round(xx$critVal, digits), sep = "") if (attr(xx$critVal, "Calc")) { cat(" (alpha = ", xx$alpha, ",", vec[twoSide + 1], sep = "") } cat("\n") } cat("\n") cat("Estimated Dose Response Models:") for(i in 1:length(x$mods)){ cat("\n") cat(names(x$mods)[i], "model\n") cofList <- coef(x$mods[[i]], sep = TRUE) cof <- do.call("c", cofList) namcof <- c(names(cofList$DRpars), names(cofList$covarPars)) namcof <- gsub(" ", "", namcof) # remove white spaces for GUI names(cof) <- gsub("doseM", "dose", namcof) # use more obvious names print(round(cof, digits)) } if(attr(x$modcrit, "crit") != "aveAIC"){ cat("\nSelected model (",attr(x$modcrit, "crit"),"): ", x$selMod, "\n", sep="") } else { cat("\nModel weights (AIC):\n") attr(x$selMod, "crit") <- NULL print(round(x$selMod, 4)) } if(is.null(length(x$doseEst))) return() if(x$doseType == "TD") strn <- ", Delta=" if(x$doseType == "ED") strn <- ", p=" cat("\nEstimated ",x$doseType,strn,attr(x$doseEst, "addPar"),"\n", sep="") attr(x$doseEst, "addPar") <- NULL print(round(x$doseEst, 4)) } #' @export summary.MCPMod <- function(object, ...){ class(object) <- "summary.MCPMod" print(object, digits = 3) } #' @export print.summary.MCPMod <- function(x, ...){ cat("MCPMod\n\n") cat(rep("*", 39), "\n", sep="") cat("MCP part \n") cat(rep("*", 39), "\n", sep="") print(x$MCTtest) cat("\n") if(length(x$mods) == 0) return() cat(rep("*", 39), "\n", sep="") cat("Mod part \n") cat(rep("*", 39), "\n", sep="") for(i in 1:length(x$mods)){ if(i > 1) cat("\n") if(length(x$mods) > 1) cat("** Fitted model", i,"\n") summary(x$mods[[i]]) } cat("\n") cat(rep("*", 39), "\n", sep="") cat("Model selection criteria (",attr(x$modcrit, "crit"),"):\n", sep="") cat(rep("*", 39), "\n", sep="") crit <- attr(x$modcrit, "crit") attr(x$modcrit, "crit") <- NULL print(x$modcrit) if(crit != "aveAIC"){ cat("\nSelected model:", x$selMod, "\n") } else { cat("\nModel weights (AIC):\n") attr(x$selMod, "crit") <- NULL print(round(x$selMod, 4)) } if(is.null(length(x$doseEst))) return() cat("\n") cat(rep("*", 39), "\n", sep="") if(x$doseType == "TD") strn <- ", Delta=" if(x$doseType == "ED") strn <- ", p=" cat("Estimated ",x$doseType,strn,attr(x$doseEst, "addPar"),"\n", sep="") cat(rep("*", 39), "\n", sep="") attr(x$doseEst, "addPar") <- NULL print(round(x$doseEst, 4)) } #' Plot fitted dose-response model #' #' @inheritParams predict.MCPMod #' @param CI,level,plotData,plotGrid,colMn,colFit Arguments for plot method: \samp{CI} determines whether confidence #' intervals should be plotted. \samp{level} determines the level of the confidence intervals. \samp{plotData} #' determines how the data are plotted: Either as means or as means with CI, raw data or none. In case of \samp{type = #' "normal"} and covariates the ls-means are displayed, when \samp{type = "general"} the option "raw" is not #' available. \samp{colMn} and \samp{colFit} determine the colors of fitted model and the raw means. #' #' @rdname MCPMod #' @method plot MCPMod #' @export plot.MCPMod <- function(x, CI = FALSE, level = 0.95, plotData = c("means", "meansCI", "raw", "none"), plotGrid = TRUE, colMn = 1, colFit = 1, ...){ if(is.null(x$mods)) stop("No models significant, nothing to plot") plotFunc(x, CI, level, plotData, plotGrid, colMn, colFit, ...) } DoseFinding/R/fitMod_helpers.R0000644000176200001440000005125714654153534015757 0ustar liggesusers## functions related to fitting dose-response models using ML or generalized approach fit.control <- function(control){ ## get control parameters for nonlinear fitting ## default parameters res <- list(nlminbcontrol = list(), optimizetol = .Machine$double.eps^0.5, gridSize = list(dim1 = 30, dim2 = 144)) if(!is.null(control)){ ## check arguments first if(!is.null(control$nlminbcontrol)){ if(!is.list(control$nlminbcontrol)) stop("nlminbcontrol element of fitControl must be a list") } if(!is.null(control$gridSize)){ if(!is.list(control$gridSize)) stop("gridSize element of fitControl must be a list") nams <- names(control$gridSize) ind <- any(is.na(match(nams,c("dim1", "dim2")))) if(ind){ stop("gridSize list needs to have names dim1 and dim2") } else { if(!is.numeric(control$gridSize$dim1) | !is.numeric(control$gridSize$dim1)) stop("gridSize$dim1 and gridSize$dim2 need to be numeric") } } nams <- names(control) res[nams] <- control if(!all(nams %in% c("nlminbcontrol","optimizetol","gridSize"))) warning("control needs to have entries called \"nlminbcontrol\",\"optimizetol\",\"gridSize\"") res[nams] <- control } res } getGrid <- function(Ngrd, bnds, dim){ if(dim == 1){ grdnods <- (2*(1:Ngrd)-1)/(2*Ngrd) mat <- matrix(grdnods*(bnds[2]-bnds[1])+bnds[1], ncol = 1) } else { # use generalized lattice point set (glp) set (maximum size 75025) glp <- c(3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025) if(Ngrd > 75025) Ngrd <- 75025 if(Ngrd < 5) Ngrd <- 5 ind <- min((1:22)[glp >= Ngrd]) N <- glp[ind] k <- 1:N mat <- cbind((k-0.5)/N, ((glp[ind-1]*k-0.5)/N)%%1) mat[,1] <- mat[,1]*(bnds[1,2]-bnds[1,1])+bnds[1,1] mat[,2] <- mat[,2]*(bnds[2,2]-bnds[2,1])+bnds[2,1] } mat } fitMod.raw <- function(dose, resp, data, model, S, type, addCovars = ~1, placAdj = FALSE, bnds, df, start = NULL, na.action = na.fail, control, doseNam, respNam, off, scal, nodes, covarsUsed){ ## fit model but do not check for arguments (for use in MCPMod function)! ## differences to fitMod: ## - dose, resp need to be vectors containing the data ## - additional args: doseNam, respNam, off, scal builtIn <- c("linlog", "linear", "quadratic", "linInt", "emax", "exponential", "logistic", "betaMod", "sigEmax") modelNum <- match(model, builtIn) weights <- NULL;clinS <- NULL ## package data for model-fitting if(type == "general"){ # general approach dataFit <- data.frame(dose = dose, resp = resp) ## pre-calculate some necessary information clinS <- chol(solve(S)) } else { # normal data if(covarsUsed){ dataFit <- data ind1 <- which(names(dataFit) == doseNam) ind2 <- which(names(dataFit) == respNam) names(dataFit)[c(ind1, ind2)] <- c("dose", "resp") ord <- order(dataFit$dose) dataFit <- dataFit[ord,] ## sorting by increasing dose is needed for optGrid (specifically getZmat) } else { ## for efficiency fit on means in case of no covariates dataFit <- data.frame(dose = sort(unique(dose)), resp = as.numeric(tapply(resp, dose, mean))) ## calculate within group variance to recover full RSS later n <- as.vector(table(dose)) vars <- tapply(resp, dose, var) vars[n == 1] <- 0 S2 <- sum((n - 1) * vars) weights <- n } } ## call actual fitting algorithms if(is.element(modelNum, 1:4)){ # linear model fit <- fitModel.lin(dataFit, model, addCovars, off, type, weights, placAdj, clinS) } else { # non-linear model fit <- fitModel.bndnls(dataFit, model, addCovars, type, bnds, control, start, scal, weights, placAdj, clinS) } ## now need to post-process resid <- fit$resid if(type == "normal" & !covarsUsed) # fitted on means, need to recover full RSS resid <- fit$resid + S2 ## extract levels for factor covariates if(covarsUsed){ usedVars <- all.vars(addCovars) # variables used for fitting ind <- sapply(data, function(x) is.factor(x)) # determine factors in data ind <- is.element(names(data), usedVars) & ind # has the factor been used in fitting? xlev <- lapply(data[ind], levels) # extract levels } else { xlev <- NULL } df <- ifelse(is.null(fit$df), df, fit$df) res <- list(coefs = fit$coefs, resid, df=df, addCovars = addCovars) names(res)[2] <- ifelse(type == "normal", "RSS", "gRSS") attr(res, "model") <- model attr(res, "type") <- type attr(res, "placAdj") <- placAdj attr(res, "addCovars") <- addCovars attr(res, "xlev") <- xlev attr(res, "doseRespNam") <- c(doseNam, respNam) attr(res, "off") <- off attr(res, "scal") <- scal attr(res, "nodes") <- nodes class(res) <- "DRMod" res } fitModel.lin <- function(dataFit, model, addCovars, off, type, weights, placAdj, clinS){ dose <- dataFit$dose resp <- dataFit$resp ## build model matrices and fit model using QR decompositions X <- switch(model, linear = cbind(1, dose), linlog = cbind(1, log(dose + off)), quadratic = cbind(1, dose, dose^2), linInt = model.matrix(~as.factor(dose)-1, data=dataFit)) if(model == "quadratic"){ nam <- c("e0", "b1", "b2") } else { if(model == "linInt"){ nam <- paste("d", sort(unique(dose)), sep="") } else { nam <- c("e0", "delta") } } if(placAdj){ # no intercept if(model != "linInt"){ # only need to remove intercept for non-linInt mods X <- X[,-1, drop = FALSE] nam <- nam[-1] } } covarsUsed <- addCovars != ~1 if(type == "normal" & covarsUsed){ # normal with covariates form <- paste("resp ~", addCovars[2], sep="") m <- model.matrix(as.formula(form), data = dataFit) X <- cbind(X, m[,-1]) nam <- c(nam, colnames(m)[-1]) par <- as.numeric(qr.coef(qr(X),resp)) df <- nrow(X)-ncol(X) } else { # general or normal without covariates if(type == "normal"){ clinS <- diag(sqrt(weights)) df <- sum(weights) - length(nam) } else { df <- NULL } par <- as.numeric(qr.coef(qr(clinS%*%X),clinS%*%resp)) } pred <- as.numeric(X%*%par) names(par) <- nam if(covarsUsed){ out <- list(coefs=par, sum((resp-pred)^2), df = df) } else { out <- list(coefs=par, as.numeric(crossprod(clinS%*%(resp-pred))), df = df) } names(out)[2] <- "resid" out } fitModel.bndnls <- function(dataFit, model, addCovars, type, bnds, control, start, scal, weights, placAdj, clinS){ ctrl <- fit.control(control) if(model == "emax"|model == "exponential"){ dim <- 1 if(!is.matrix(bnds)) bnds <- matrix(bnds, nrow = 1) } else { dim <- 2 } dose <- dataFit$dose resp <- dataFit$resp ## preliminary calculations (need resXY, clinS and qrX) covarsUsed <- addCovars != ~1 covarNams <- NULL if(type == "general"){ # general approach if(placAdj){ # no intercept resXY <- as.numeric(clinS%*%resp) } else { X2 <- clinS%*%matrix(1, nrow = length(dose)) resp2 <- clinS%*%resp qrX <- qr(X2) resXY <- as.numeric(qr.resid(qrX, resp2)) } } else { # normal data form <- paste("resp ~", addCovars[2], sep="") m <- model.matrix(as.formula(form), dataFit) if(covarsUsed){ # covariates present covarNams <- colnames(m)[2:ncol(m)] qrX <- qr(m) resXY <- as.numeric(qr.resid(qrX, resp)) } else { # no covariates: fit on means clinS <- diag(sqrt(weights)) qrX <- qr(clinS%*%m) resXY <- as.numeric(qr.resid(qrX, sqrt(weights)*resp)) } } ## if no starting values provided use grid-search if(is.null(start)){ opt <- optGrid(model, dim, bnds, ctrl$gridSize, dose, type, qrX, resXY, clinS, placAdj, scal) strt <- opt$coefs;resid <- opt$resid if(dim == 1){ ## refine bounds N <- ctrl$gridSize$dim1 dif <- (bnds[2]-bnds[1])/N # distance between grid points bnds[1] <- max(c(strt-1.1*dif), bnds[1]) bnds[2] <- min(c(strt+1.1*dif), bnds[2]) } } else { strt <- start;resid <- Inf } ## start local optimizer at starting value opt2 <- optLoc(model, dim, bnds, dose, qrX, resXY, strt, scal, placAdj, type, ctrl$optimizetol, ctrl$nlminbcontrol, clinS) ## recover names nam1 <- switch(model, emax = c("eMax", "ed50"), sigEmax = c("eMax", "ed50", "h"), logistic = c("eMax", "ed50", "delta"), exponential = c("e1", "delta"), betaMod = c("eMax", "delta1", "delta2")) ## recover all parameters from nonlin parameter and return results f0 <- getStandDR(model, dose, opt2$coefs, scal) if(type == "general"){ # return "generalized" sum of squares if(placAdj){ # no intercept par0 <- sum((clinS %*% f0) * (clinS%*%resp))/sum((clinS %*% f0)^2) pred <- f0*par0 par <- c(par0, opt2$coefs) names(par) <- nam1 } else { # with intercept F <- cbind(1, f0) par0 <- qr.coef(qr(clinS %*% F), clinS %*% resp) pred <- F%*%par0 par <- c(par0, opt2$coefs) names(par) <- c("e0", nam1) } return(list(coefs=par, resid = opt2$resid)) } else { ## type == normal X <- cbind(1,f0,m[,-1]) if(covarsUsed){ par0 <- as.numeric(qr.coef(qr(X),resp)) pred <- as.numeric(X%*%par0) par <- c(par0[1:2], opt2$coefs, par0[3:length(par0)]) df <- nrow(X) - length(par) } else { # no covariates; was fitted on means par0 <- qr.coef(qr(clinS %*% X), clinS %*% resp) pred <- X%*%par0 par <- c(par0, opt2$coefs) df <- sum(weights) - length(par) } names(par) <- c("e0", nam1, covarNams) return(list(coefs=par, resid = opt2$resid, df = df)) } } optGrid <- function(model, dim, bnds, gridSize, dose, type, qrX, resXY, wMat, placAdj, scal){ ## grid optimizer for non-linear case N <- ifelse(dim==1, gridSize$dim1, gridSize$dim2) if(N < 1) stop("need N >= 1") nodes <- getGrid(N, bnds, dim) ## calculate residuals if(type == "normal" & is.null(wMat)){ # normal with covariates Zmat <- getZmat(dose, nodes, model, dim, scal) resZmat <- qr.resid(qrX, Zmat) } else { # normal without covariates or general Zmat <- getZmat.weighted(dose, nodes, model, dim, scal) Zmat <- wMat%*%Zmat if(placAdj & type == "general") # general without intercept resZmat <- Zmat else resZmat <- qr.resid(qrX, Zmat) } colsms1 <- colSums(resZmat * resXY) colsms2 <- colSums(resZmat * resZmat) RSSvec <- sum(resXY*resXY) - (colsms1*colsms1)/colsms2 indMin <- which.min(RSSvec) coefs <- nodes[indMin,] list(coefs=coefs, resid = RSSvec[indMin]) } getZmat <- function(x, nodes, model, dim, scal=NULL){ getPred <- function(vec, x, model, scal) getStandDR(model, x, vec, scal) xU <- sort(unique(x)) n <- as.numeric(table(x)) args <- nodes res0 <- apply(args, 1, getPred, x=xU, model=model, scal=scal) Zmat <- apply(res0, 2, function(x,n) rep(x,n), n=n) Zmat } getZmat.weighted <- function(x, nodes, model, dim, scal){ # does not exploit repeated observations getPred <- function(vec, x, model, scal) getStandDR(model, x, vec, scal) args <- nodes Zmat <- apply(args, 1, getPred, x=x, model=model, scal=scal) Zmat } getStandDR <- function(model, x, nl, scal){ ## calculate standardized response for nonlinear models switch(model, emax = emax(x, 0, 1, nl), sigEmax = sigEmax(x, 0, 1, nl[1], nl[2]), exponential = exponential(x, 0, 1, nl), logistic = logistic(x, 0, 1, nl[1], nl[2]), betaMod = betaMod(x, 0, 1, nl[1], nl[2], scal)) } optLoc <- function(model, dim, bnds, dose, qrX, resXY, start, scal, placAdj, type, tol, nlminbcontrol, clinS){ ## function to calculate ls residuals (to be optimized) optFunc <- function(nl, x, qrX, resXY, model, scal, clinS){ Z <- getStandDR(model, x, nl, scal) if(!is.null(clinS)){ Z <- clinS%*%Z } if(placAdj & type == "general"){ resXZ <- Z } else { resXZ <- try(qr.resid(qrX, Z)) # might be NaN if function is called on strange parameters if(inherits(resXZ, "try-error")) return(NA) } sumrsXYrsXZ <- sum(resXY*resXZ) sum(resXY*resXY) - sumrsXYrsXZ*sumrsXYrsXZ/sum(resXZ*resXZ) } if(dim == 1){ # one-dimensional models optobj <- optimize(optFunc, c(bnds[1], bnds[2]), x=dose, qrX=qrX, resXY=resXY, model = model, tol=tol, clinS=clinS, scal = scal) coefs <- optobj$minimum RSS <- optobj$objective } else { optobj <- try(nlminb(start, optFunc, x=dose, qrX=qrX, resXY=resXY, model = model, scal = scal, lower = bnds[,1], upper = bnds[,2], control = nlminbcontrol, clinS=clinS)) if(inherits(optobj, "try-error")){ coefs <- RSS <- NA } else { coefs <- optobj$par RSS <- optobj$objective } } list(coefs=coefs, resid=RSS) } sepCoef <- function(object){ model <- attr(object, "model") if(attr(object, "type") == "general") return(list(DRpars=object$coefs, covarPars = numeric(0))) if(attr(object, "type") == "normal" & object$addCovars == ~1) return(list(DRpars=object$coefs, covarPars = numeric(0))) ## determine the number of parameters (not counting e0 and eMax) if(model %in% c("linear","linlog")) dim <- 2 if(model %in% c("quadratic", "exponential", "emax")) dim <- 3 if(model %in% c("sigEmax", "logistic", "betaMod")) dim <- 4 if(model == "linInt") dim <- length(attr(object, "nodes")) cf <- object$coefs p <- length(cf) ## extract coefficients DRpars <- cf[1:dim] # coefs of DR model covarPars <- cf[(dim+1):p] return(list(DRpars=DRpars, covarPars=covarPars)) } gradCalc <- function(model, cf, dose, off, scal, nodes){ ## wrapper function to calculate gradient switch(model, linear = { linearGrad(dose) }, linlog = { linlogGrad(dose, off=off) }, quadratic = { quadraticGrad(dose) }, emax = { emaxGrad(dose, eMax = cf[2], ed50 = cf[3]) }, logistic = { logisticGrad(dose, eMax = cf[2], ed50 = cf[3], delta = cf[4]) }, sigEmax = { sigEmaxGrad(dose, eMax = cf[2], ed50 = cf[3], h = cf[4]) }, betaMod = { betaModGrad(dose, eMax = cf[2], delta1 = cf[3], delta2 = cf[4], scal = scal) }, exponential = { exponentialGrad(dose, e1 = cf[2], delta = cf[3]) }, linInt = { linIntGrad(dose, resp=cf, nodes=nodes) }) } plotFunc <- function(x, CI = FALSE, level = 0.95, plotData = c("means", "meansCI", "raw", "none"), plotGrid = TRUE, colMn = 1, colFit = 1, ...){ ## Extract relevant information from object if(inherits(x, "DRMod")) obj <- x if(inherits(x, "MCPMod")) obj <- x$mods[[1]] addCovars <- attr(obj, "addCovars") covarsUsed <- addCovars != ~1 xlev <- attr(obj, "xlev") doseNam <- attr(obj, "doseRespNam")[1] respNam <- attr(obj, "doseRespNam")[2] data <- attr(obj, "data") type <- attr(obj, "type") placAdj <- attr(obj, "placAdj") plotData <- match.arg(plotData) if(type == "general" & plotData == "raw") stop("plotData =\"raw\" only allowed if fitted DRmod object is of type = \"normal\"") ## save anova info in pList list pList <- as.list(data) if(type == "normal"){ if(plotData %in% c("means", "meansCI")){ ## produce estimates for ANOVA type model data$doseFac <- as.factor(data[[doseNam]]) form <- as.formula(paste(respNam, "~ doseFac +", addCovars[2])) fit <- lm(form, data=data) ## build design matrix for prediction dose <- sort(unique(data[[doseNam]])) preddat <- data.frame(doseFac=factor(dose)) m <- model.matrix(~doseFac, data=preddat) if(covarsUsed){ ## get sas type ls-means nams <- all.vars(addCovars) out <- list() z <- 1 for(covar in nams){ varb <- data[,covar] if(is.numeric(varb)){ out[[z]] <- mean(varb) } else if(is.factor(varb)){ k <- nlevels(varb) out[[z]] <- rep(1/k, k-1) } z <- z+1 } out <- do.call("c", out) m0 <- matrix(rep(out, length(dose)), byrow=TRUE, nrow = length(dose)) m <- cbind(m, m0) } pList$dos <- sort(unique(data[[doseNam]])) pList$mns <- as.numeric(m%*%coef(fit)) if(plotData == "meansCI"){ sdv <- sqrt(diag(m%*%vcov(fit)%*%t(m))) quant <- qt(1 - (1 - level)/2, df=fit$df) pList$lbndm <- pList$mns-quant*sdv pList$ubndm <- pList$mns+quant*sdv } } } if(type == "general"){ ## extract ANOVA estimates if(plotData %in% c("means", "meansCI")){ pList$dos <- data[[doseNam]] pList$mns <- data[[respNam]] sdv <- sqrt(diag(data$S)) if(plotData == "meansCI"){ quant <- qnorm(1 - (1 - level)/2) pList$lbndm <- pList$mns-quant*sdv pList$ubndm <- pList$mns+quant*sdv } } } doseSeq <- seq(0, max(data[[doseNam]]), length=201) ## create data frame for plotting dr-functions predtype <- ifelse(placAdj, "effect-curve", "ls-means") if(inherits(x, "MCPMod")){ nmods <- length(x$mods) lst <- vector(mode = "list", nmods) for(i in 1:nmods){ pred <- predict(x$mods[[i]], predType = predtype, doseSeq = doseSeq, se.fit = CI) lbnd <- ubnd <- rep(NA, length(doseSeq)) if(CI){ quant <- qt(1 - (1 - level)/2, df=x$mods[[i]]$df) lbnd <- pred$fit-quant*pred$se.fit ubnd <- pred$fit+quant*pred$se.fit pred <- pred$fit } lst[[i]] <- data.frame(rep(doseSeq, 3), c(pred, lbnd, ubnd), rep(c("pred", "LB", "UB"), each=length(doseSeq)), attr(x$mods[[i]], "model")) } plotdf <- do.call("rbind", lst) } if(inherits(x, "DRMod")){ pred <- predict(x, predType = predtype, doseSeq = doseSeq, se.fit = CI) lbnd <- ubnd <- rep(NA, length(doseSeq)) if(CI){ quant <- qt(1 - (1 - level)/2, df=x$df) lbnd <- pred$fit-quant*pred$se.fit ubnd <- pred$fit+quant*pred$se.fit pred <- pred$fit } plotdf <- data.frame(rep(doseSeq, 3), c(pred, lbnd, ubnd), rep(c("pred", "LB", "UB"), each=length(doseSeq)), attr(x, "model")) } names(plotdf) <- c(doseNam, respNam, "group", "model") ## calculate plotting range rng <- switch(plotData, raw = range(data[[respNam]]), none = range(plotdf[[respNam]], na.rm=TRUE), range(plotdf[[respNam]], pList$mns, pList$lbndm, pList$ubndm, na.rm=TRUE)) dff <- diff(rng) ylim <- c(rng[1] - 0.05 * dff, rng[2] + 0.05 * dff) ## produce plot form <- as.formula(paste(respNam, "~", doseNam, "|model", sep="")) print( lattice::xyplot(form, groups = plotdf$group, data = plotdf, pList=pList, ..., ylim = ylim, panel = function(x, y, ..., pList){ if(plotGrid) lattice::panel.grid(h = -1, v = -1, col = "lightgrey", lty = 2) if(plotData != "none"){ if(type == "normal" & plotData == "raw"){ lattice::lpoints(data[[doseNam]], data[[respNam]], col = "grey45", pch=19) } else { lattice::lpoints(pList$dos, pList$mns, pch=19, col = colMn) if(plotData == "meansCI"){ quant <- qnorm(1 - (1 - level)/2) for(i in 1:length(pList$dos)){ lattice::llines(rep(pList$dos[i], 2), c(pList$lbndm[i], pList$ubndm[i]), lty=2, col = colMn, ...) } } } } lattice::panel.xyplot(x, y, col=colFit, type="l", ...) })) } gAIC <- function (object, ..., k = 2) UseMethod("gAIC") DoseFinding/R/powMCT.R0000644000176200001440000002012714654153534014154 0ustar liggesusers## all design related functions for power calculations #' Control options for pmvt and qmvt functions #' #' Returns a list (an object of class "GenzBretz") with control parameters for the \samp{pmvt} and \samp{qmvt} functions #' from the \samp{mvtnorm} package. Note that the DoseFinding package always uses "GenzBretz" algorithm. See the mvtnorm #' documentation for more information. #' #' @name mvtnorm-control #' @param maxpts Maximum number of function values as integer. #' @param abseps Absolute error tolerance as double. #' @param releps Relative error tolerance as double. #' @param interval Interval to be searched, when the quantile is calculated. #' @export mvtnorm.control <- function(maxpts = 30000, abseps = 0.001, releps = 0, interval = NULL){ res <- list(maxpts = maxpts, abseps = abseps, releps = releps, interval = interval) class(res) <- "GenzBretz" res } #' Calculate power for multiple contrast test #' #' Calculate power for a multiple contrast test for a set of specified #' alternatives. #' #' #' @param contMat Contrast matrix to use. The individual contrasts should be #' saved in the columns of the matrix #' @param alpha Significance level to use #' @param altModels An object of class \samp{Mods}, defining the mean vectors #' under which the power should be calculated #' @param n,sigma,S Either a vector \samp{n} and \samp{sigma} or \samp{S} need #' to be specified. When \samp{n} and \samp{sigma} are specified it is assumed #' computations are made for a normal homoscedastic ANOVA model with group #' sample sizes given by \samp{n} and residual standard deviation \samp{sigma}, #' i.e. the covariance matrix used for the estimates is thus #' \code{sigma^2*diag(1/n)} and the degrees of freedom are calculated as #' \code{sum(n)-nrow(contMat)}. When a single number is specified for \samp{n} #' it is assumed this is the sample size per group and balanced allocations are #' used.\cr #' #' When \samp{S} is specified this will be used as covariance matrix for the #' estimates. #' @param placAdj Logical, if true, it is assumed that the standard deviation #' or variance matrix of the placebo-adjusted estimates are specified in #' \samp{sigma} or \samp{S}, respectively. The contrast matrix has to be #' produced on placebo-adjusted scale, see \code{\link{optContr}}, so that the #' coefficients are no longer contrasts (i.e. do not sum to 0). #' @param alternative Character determining the alternative for the multiple #' contrast trend test. #' @param df Degrees of freedom to assume in case \samp{S} (a general #' covariance matrix) is specified. When \samp{n} and \samp{sigma} are #' specified the ones from the corresponding ANOVA model are calculated. #' @param critV Critical value, if equal to \samp{TRUE} the critical value will #' be calculated. Otherwise one can directly specify the critical value here. #' @param control A list specifying additional control parameters for the #' \samp{qmvt} and \samp{pmvt} calls in the code, see also #' \samp{mvtnorm.control} for details. #' @return Numeric containing the calculated power values #' @author Bjoern Bornkamp #' @seealso \code{\link{powN}}, \code{\link{sampSizeMCT}}, #' \code{\link{MCTtest}}, \code{\link{optContr}}, \code{\link{Mods}} #' @references Pinheiro, J. C., Bornkamp, B., and Bretz, F. (2006). Design and #' analysis of dose finding studies combining multiple comparisons and modeling #' procedures, \emph{Journal of Biopharmaceutical Statistics}, \bold{16}, #' 639--656 #' @examples #' #' ## look at power under some dose-response alternatives #' ## first the candidate models used for the contrasts #' doses <- c(0,10,25,50,100,150) #' ## define models to use as alternative #' fmodels <- Mods(linear = NULL, emax = 25, #' logistic = c(50, 10.88111), exponential= 85, #' betaMod=rbind(c(0.33,2.31),c(1.39,1.39)), #' doses = doses, addArgs=list(scal = 200), #' placEff = 0, maxEff = 0.4) #' ## plot alternatives #' plot(fmodels) #' ## power for to detect a trend #' contMat <- optContr(fmodels, w = 1) #' powMCT(contMat, altModels = fmodels, n = 50, alpha = 0.05, sigma = 1) #' #' \dontrun{ #' ## power under the Dunnett test #' ## contrast matrix for Dunnett test with informative names #' contMatD <- rbind(-1, diag(5)) #' rownames(contMatD) <- doses #' colnames(contMatD) <- paste("D", doses[-1], sep="") #' powMCT(contMatD, altModels = fmodels, n = 50, alpha = 0.05, sigma = 1) #' #' ## now investigate power of the contrasts in contMat under "general" alternatives #' altFmods <- Mods(linInt = rbind(c(0, 1, 1, 1, 1), #' c(0.5, 1, 1, 1, 0.5)), #' doses=doses, placEff=0, maxEff=0.5) #' plot(altFmods) #' powMCT(contMat, altModels = altFmods, n = 50, alpha = 0.05, sigma = 1) #' #' ## now the first example but assume information only on the #' ## placebo-adjusted scale #' ## for balanced allocations and 50 patients with sigma = 1 one obtains #' ## the following covariance matrix #' S <- 1^2/50*diag(6) #' ## now calculate variance of placebo adjusted estimates #' CC <- cbind(-1,diag(5)) #' V <- (CC)%*%S%*%t(CC) #' linMat <- optContr(fmodels, doses = c(10,25,50,100,150), #' S = V, placAdj = TRUE) #' powMCT(linMat, altModels = fmodels, placAdj=TRUE, #' alpha = 0.05, S = V, df=6*50-6) # match df with the df above #' } #' @export powMCT <- function(contMat, alpha = 0.025, altModels, n, sigma, S, placAdj = FALSE, alternative = c("one.sided", "two.sided"), df, critV = TRUE, control = mvtnorm.control()){ alternative <- match.arg(alternative) if(inherits(contMat, "optContr")){ if(attr(contMat, "placAdj") != placAdj){ message("using \"placAdj\" specification from contMat object") placAdj <- attr(contMat, "placAdj") } contMat <- contMat$contMat } if(!is.matrix(contMat)) stop("contMat needs to be a matrix") nD <- nrow(contMat) # nr of doses nC <- ncol(contMat) # nr of contrasts ## extract covariance matrix if(missing(S)){ if(missing(n) | missing(sigma)) stop("Either S or both n and sigma need to be specified") if(length(n) == 1) n <- rep(n, nD) if(length(n) != nD) stop("n needs to be of length nrow(contMat)") S <- sigma^2*diag(1/n) df <- sum(n) - nD if(df == 0) stop("cannot compute power: specified \"n\" and dose vector result in df = 0") } else { if(!missing(n)|!missing(sigma)) stop("Need to specify either \"S\" or both \"n\" and \"sigma\"") if(nrow(S) != ncol(S)) stop("S needs to be a square matrix") if(nrow(S) != nD) stop("S needs to have as many rows&cols as there are doses") if(missing(df)) stop("need to specify degrees of freedom in \"df\", when specifying \"S\"") } ## extract means under the alternative if(missing(altModels)) stop("altModels argument needs to be specified") muMat <- getResp(altModels) if(placAdj){ muMat <- sweep(muMat, 2, muMat[1,], "-") # remove placebo column muMat <- muMat[-1, , drop=FALSE] } if(nrow(muMat) != nD) stop("Incompatible contMat and muMat") ## calculate non-centrality parameter deltaMat <- t(contMat) %*% muMat covMat <- t(contMat) %*% S %*% contMat den <- sqrt(diag(covMat)) deltaMat <- deltaMat/den if(alternative == "two.sided"){ deltaMat <- abs(deltaMat) } corMat <- cov2cor(covMat) if(!is.finite(df)) df <- 0 ## calculate critical value if(is.logical(critV) & critV == TRUE){ critV <- critVal(corMat, alpha, df, alternative, control) } # else assume critV already contains critical value res <- powCalc(alternative, critV, df, corMat, deltaMat, control) ## class(res) <- "powMCT" ## attr(res, "type") <- ifelse(missing(n), "S", "n&sigma") ## attr(res, "contMat") <- contMat ## attr(res, "muMat") <- muMat res } ## print.powMCT <- function(x, ...){ ## attributes(x)[2:5] <- NULL ## print(x) ## } DoseFinding/R/drmodels.R0000644000176200001440000001404114762603270014607 0ustar liggesusers ## model functions #' @rdname drmodels #' @param dose Dose variable #' @param e0 For most models placebo effect. For logistic model left-asymptote #' parameter, corresponding to a basal effect level (not the placebo effect) #' @param eMax Beta Model: Maximum effect within dose-range\cr Emax, sigmoid #' Emax, logistic Model: Asymptotic maximum effect #' @param ed50 Dose giving half of the asymptotic maximum effect #' @usage NULL #' @export emax <- function(dose, e0, eMax, ed50){ e0 + eMax*dose/(ed50 + dose) } #' @rdname drmodels #' @inheritParams emax #' @param ... Just included for convenience in the gradient functions, so that #' for example \code{quadratic(dose, e0=0, b1=1, b2=3)} will not throw an error #' (although the gradient of the quadratic model is independent of e0, b1 and #' b2). #' @usage NULL #' @export emaxGrad <- function(dose, eMax, ed50, ...){ cbind(e0=1, eMax=dose/(ed50 + dose), ed50=-eMax * dose/(dose + ed50)^2) } #' @rdname drmodels #' @inheritParams emax #' @param h Hill parameter, determining the steepness of the model at the ED50 #' @usage NULL #' @export sigEmax <- function(dose, e0, eMax, ed50, h){ e0 + eMax * 1 /(1 + (ed50/dose)^h) } #' @rdname drmodels #' @inheritParams sigEmax #' @usage NULL #' @export sigEmaxGrad <- function(dose, eMax, ed50, h, ...){ lg2 <- function(x) {l<-x; l[x==0] <- 0; l[x!=0] <- log(x[x!=0]); l} a <- 1 / (1 + (dose/ed50)^h) g1 <- 1 / (1 + (ed50/dose)^h) g2 <- -(h * eMax / ed50) * g1 * a g3 <- eMax * lg2(dose / ed50) * g1 * a cbind(e0=1, eMax=g1, ed50=g2, h=g3) } #' @rdname drmodels #' @inheritParams emax #' @param e1 Slope parameter for exponential model #' @param delta Exponential model: Parameter, controlling the convexity of the #' model.\cr Linear and linlog model: Slope parameter\cr Logistic model: #' Parameter controlling determining the steepness of the curve #' @usage NULL #' @export exponential <- function(dose, e0, e1, delta){ e0 + e1*(exp(dose/delta) - 1) } #' @rdname drmodels #' @inheritParams exponential #' @usage NULL #' @export exponentialGrad <- function(dose, e1, delta, ...){ cbind(e0=1, e1=exp(dose/delta)-1, delta=-exp(dose/delta) * dose * e1/delta^2) } #' @rdname drmodels #' @inheritParams emax #' @param b1 first parameter of quadratic model #' @param b2 second parameter of quadratic model (controls, whether model is #' convex or concave) #' @usage NULL #' @export quadratic <- function(dose, e0, b1, b2){ e0 + b1 * dose + b2 * dose^2 } #' @rdname drmodels #' @inheritParams quadratic #' @usage NULL #' @export quadraticGrad <- function(dose, ...){ cbind(e0=1, b1 = dose, b2 = dose^2) } #' @rdname drmodels #' @inheritParams emax #' @param delta1 delta1 parameter for beta model #' @param delta2 delta2 parameter for beta model #' @param scal Scale parameter (treated as a fixed value, not estimated) #' @usage NULL #' @export betaMod <- function(dose, e0, eMax, delta1, delta2, scal){ xlogx <- function(x) if(x == 0) 0 else x * log(x) # will not be called with vector x logMaxDens <- xlogx(delta1) + xlogx(delta2) - xlogx(delta1 + delta2) dose <- dose/scal e0 + eMax/exp(logMaxDens) * (dose^delta1) * (1 - dose)^delta2 } #' @rdname drmodels #' @inheritParams betaMod #' @usage NULL #' @export betaModGrad <- function(dose, eMax, delta1, delta2, scal, ...){ lg2 <- function(x) {l<-x; l[x==0] <- 0; l[x!=0] <- log(x[x!=0]); l} xlogx <- function(x) if(x == 0) 0 else x * log(x) # will not be called with vector x dose <- dose/scal if(any(dose > 1)) { stop("doses cannot be larger than scal in betaModel") } logMaxDens <- xlogx(delta1) + xlogx(delta2) - xlogx(delta1 + delta2) g1 <- ((dose^delta1) * (1 - dose)^delta2)/exp(logMaxDens) g2 <- g1 * eMax * (lg2(dose) + lg2(delta1 + delta2) - lg2(delta1)) g3 <- g1 * eMax * (lg2(1 - dose) + lg2(delta1 + delta2) - lg2(delta2)) cbind(e0=1, eMax=g1, delta1=g2, delta2=g3) } #' @rdname drmodels #' @inheritParams exponential #' @usage NULL #' @export linear <- function(dose, e0, delta){ e0 + delta * dose } #' @rdname drmodels #' @inheritParams linear #' @usage NULL #' @export linearGrad <- function(dose, ...){ cbind(e0=1, delta=dose) } #' @rdname drmodels #' @inheritParams exponential #' @param off Offset value to avoid problems with dose=0 (treated as a fixed #' value, not estimated) #' @usage NULL #' @export linlog <- function(dose, e0, delta, off = 1){ linear(log(dose + off), e0, delta) } #' @rdname drmodels #' @inheritParams linlog #' @usage NULL #' @export linlogGrad <- function(dose, off, ...){ cbind(e0=1, delta=log(dose+off)) } #' @rdname drmodels #' @inheritParams emax #' @param delta Exponential model: Parameter, controlling the convexity of the #' model.\cr Linear and linlog model: Slope parameter\cr Logistic model: #' Parameter controlling determining the steepness of the curve #' @usage NULL #' @export logistic <- function(dose, e0, eMax, ed50, delta){ e0 + eMax/(1 + exp((ed50 - dose)/delta)) } #' @rdname drmodels #' @inheritParams logistic #' @usage NULL #' @export logisticGrad <- function(dose, eMax, ed50, delta, ...){ den <- 1 + exp((ed50 - dose)/delta) g1 <- -eMax * (den - 1)/(delta * den^2) g2 <- eMax * (den - 1) * (ed50 - dose)/(delta^2 * den^2) cbind(e0=1, eMax=1/den, ed50=g1, delta=g2) } #' @rdname drmodels #' @inheritParams emax #' @param resp Response values at the nodes for the linInt model #' @param nodes Interpolation nodes for the linear interpolation for the linInt #' model (treated as a fixed value, not estimated) #' @usage NULL #' @export linInt <- function(dose, resp, nodes){ if(length(nodes) != length(resp)) stop("\"nodes\" and \"resp\" need to be of same length in \"linInt\"") approx(x=nodes, y=resp, xout = dose)$y } #' @rdname drmodels #' @inheritParams linInt #' @usage NULL #' @export linIntGrad <- function(dose, resp, nodes, ...){ knts <- c(nodes[1], nodes, nodes[length(nodes)]) splines::splineDesign(knots=knts, ord=2, x=dose) } DoseFinding/R/optContr_helpers.R0000644000176200001440000000573414654153534016344 0ustar liggesusers## helper functions for calculating optimal contrasts and critical value optC <- function(mu, Sinv = NULL, placAdj = FALSE){ ## calculate optimal contrast for given mu and Sinv (Sinv = proportional to inv covariance matrix) if(!placAdj){ aux <- rowSums(Sinv) # Sinv %*% 1 mn <- sum(mu * aux)/sum(aux) # formula is: S^(-1)(mu-mu*S^(-1)*1/(1*S^(-1)1)1) val <- Sinv %*% (mu - mn) ## now center so that sum is 0 ## and standardize to have norm 1 val <- val - sum(val) } else { # placAdj = TRUE val <- Sinv %*% mu } val/sqrt(sum(val^2)) } constOptC <- function(mu, Sinv = NULL, placAdj = FALSE, direction){ ## calculate optimal contrasts under the additional constraint that ## the control and the active treatment groups have a different sign ## in the contrast S <- solve(Sinv) # ugly fix, we should use S as argument if(!placAdj){ k <- length(mu) CC <- cbind(-1,diag(k-1)) SPa <- CC%*%S%*%t(CC) muPa <- as.numeric(CC%*%mu) } else { k <- length(mu)+1 SPa <- S muPa <- mu } ## determine direction of effect unContr <- solve(SPa)%*%muPa # unconstrained optimal contrast mult <- ifelse(direction == "increasing", 1, -1) # 1 increasing, -1 decreasing ## prepare call of quadprog::solve.QP D <- SPa d <- rep(0,k-1) tA <- rbind(muPa, mult*diag(k-1)) A <- t(tA) bvec <- c(1,rep(0,k-1)) contr <- quadprog::solve.QP(D, d, A, bvec, meq=1)$solution contr[abs(contr) < 1e-10] <- 0 if(!placAdj) contr <- c(-sum(contr), contr) contr/sqrt(sum(contr^2)) } modContr <- function(means, W = NULL, Sinv = NULL, placAdj = FALSE, type, direction){ ## call optC on matrix ## check whether constant shape was specified and remove (can happen for linInt model) if(!placAdj){ ind <- apply(means, 2, function(x){ length(unique(x)) > 1 }) } else { ## placAdj ind <- apply(means, 2, function(x){ any(x != 0) }) } if(all(!ind)) stop("All models correspond to a constant shape, no optimal contrasts calculated.") if(any(!ind)){ nam <- colnames(means)[!ind] namsC <- paste(nam, collapse = ", ") if(length(nam) == 1){ message("The ", namsC, " model has a constant shape, cannot calculate optimal contrasts for this shape.") } else { message("The ", namsC, " models have a constant shape, cannot calculate optimal contrasts for these shapes.") } means <- means[,ind, drop=FALSE] } if(is.null(Sinv)) Sinv <- solve(W) if(type == "unconstrained"){ out <- apply(means, 2, optC, Sinv = Sinv, placAdj = placAdj) } else { # type == "constrained" out <- apply(means, 2, constOptC, Sinv = Sinv, placAdj = placAdj, direction = direction) } if(!is.matrix(out)){ ## can happen for placAdj=T and only 1 act dose nam <- names(out) out <- matrix(out, nrow = 1) colnames(out) <- nam } out } DoseFinding/R/planMod.R0000644000176200001440000004567314654153534014412 0ustar liggesusers## various functions for assessing the operating characteristics of a design ## for model-based estimation of dose-response functions #' Evaluate performance metrics for fitting dose-response models #' #' This function evaluates, the performance metrics for fitting dose-response models (using asymptotic approximations or #' simulations). Note that some metrics are available via the print method and others only via the summary #' method applied to planMod objects. The implemented metrics are \itemize{ #' \item Root of the mean-squared error to estimate the placebo-adjusted #' dose-response averaged over the used dose-levels, i.e. a rather discrete set #' (\code{dRMSE}). Available via the print method of planMod objects. \item #' Root of the mean-squared error to estimate the placebo-adjusted #' dose-response (\code{cRMSE}) averaged over fine (almost continuous) grid at #' 101 equally spaced values between placebo and the maximum dose. NOTE: #' Available via the summary method applied to planMod objects. \item Ratio of #' the placebo-adjusted mean-squared error (at the observed doses) of #' model-based vs ANOVA approach (\code{Eff-vs-ANOVA}). This can be interpreted #' on the sample size scale. NOTE: Available via the summary method applied to #' planMod objects. \item Power that the (unadjusted) one-sided \samp{1-alpha} #' confidence interval comparing the dose with maximum effect vs placebo is #' larger than \samp{tau}. By default \samp{alpha = 0.025} and \samp{tau = 0} #' (\code{Pow(maxDose)}). Available via the print method of planMod objects. #' \item Probability that the EDp estimate is within the true [EDpLB, EDpUB] #' (by default \samp{p=0.5}, \samp{pLB=0.25} and \samp{pUB=0.75}). This metric #' gives an idea on the ability to characterize the increasing part of the #' dose-response curve (\code{P(EDp)}). Available via the print method of #' planMod objects. \item Length of the quantile range for a target dose (TD #' or EDp). This is calculated by taking the difference of the dUB and dLB #' quantile of the empirical distribution of the dose estimates. #' (\code{lengthTDCI} and \code{lengthEDpCI}). It is NOT calculated by #' calculating confidence interval lengths in each simulated data-set and #' taking the mean. NOTE: Available via the summary method of planMod objects. #' } #' #' A plot method exists to summarize dose-response and dose estimations graphically. #' #' #' @aliases planMod plot.planMod summary.planMod #' @param model Character vector determining the dose-response model(s) to be used for fitting the data. When more than #' one dose-response model is provided the best fitting model is chosen using the AIC. Built-in models are "linlog", #' "linear", "quadratic", "emax", "exponential", "sigEmax", "betaMod" and "logistic" (see \link{drmodels}). #' @param altModels An object of class \samp{Mods}, defining the true mean vectors under which operating characteristics #' should be calculated. #' @param n,sigma,S Either a vector \samp{n} and \samp{sigma} or \samp{S} need to be specified. When \samp{n} and #' \samp{sigma} are specified it is assumed computations are made for a normal homoscedastic ANOVA model with group #' sample sizes given by \samp{n} and residual standard deviation \samp{sigma}, i.e. the covariance matrix used for #' the estimates is thus \code{sigma^2*diag(1/n)} and the degrees of freedom are calculated as #' \code{sum(n)-nrow(contMat)}. When a single number is specified for \samp{n} it is assumed this is the sample size #' per group and balanced allocations are used.\cr #' #' When \samp{S} is specified this will be used as covariance matrix for the estimates. #' @param doses Doses to use #' @param asyApprox,simulation Logicals determining, whether asymptotic approximations or simulations should be #' calculated. If multiple models are specified in \samp{model} asymptotic approximations are not available. #' @param alpha,tau Significance level for the one-sided confidence interval for model-based contrast of best dose vs #' placebo. Tau is the threshold to compare the confidence interval limit to. CI(MaxDCont) gives the percentage that #' the bound of the confidence interval was larger than tau. #' @param p,pLB,pUB p determines the type of EDp to estimate. pLB and pUB define the bounds for the EDp estimate. The #' performance metric Pr(Id-ED) gives the percentage that the estimated EDp was within the true EDpLB and EDpUB. #' @param nSim Number of simulations #' @param cores Number of cores to use for simulations. By default 1 cores is used, note that cores > 1 will have no #' effect Windows, as the mclapply function is used internally. #' @param showSimProgress In case of simulations show the progress using a progress-bar. #' @param bnds Bounds for non-linear parameters. This needs to be a list with list entries corresponding to the selected #' bounds. The names of the list entries need to correspond to the model names. The \code{\link{defBnds}} function #' provides the default selection. #' @param addArgs See the corresponding argument in function \code{\link{fitMod}}. This argument is directly passed to #' fitMod. #' @author Bjoern Bornkamp #' @seealso \code{\link{fitMod}} #' @references TBD #' @examples #' #' \dontrun{ #' doses <- c(0,10,25,50,100,150) #' fmodels <- Mods(linear = NULL, emax = 25, #' logistic = c(50, 10.88111), exponential= 85, #' betaMod=rbind(c(0.33,2.31),c(1.39,1.39)), #' doses = doses, addArgs=list(scal = 200), #' placEff = 0, maxEff = 0.4) #' sigma <- 1 #' n <- rep(62, 6)*2 #' #' model <- "quadratic" #' pObj <- planMod(model, fmodels, n, sigma, doses=doses, #' simulation = TRUE, #' alpha = 0.025, nSim = 200, #' p = 0.5, pLB = 0.25, pUB = 0.75) #' print(pObj) #' ## to get additional metrics (e.g. Eff-vs-ANOVA, cRMSE, lengthTDCI, ...) #' summary(pObj, p = 0.5, Delta = 0.3) #' plot(pObj) #' plot(pObj, type = "TD", Delta=0.3) #' plot(pObj, type = "ED", p = 0.5) #' } #' @export planMod <- function(model, altModels, n, sigma, S, doses, asyApprox = TRUE, simulation = FALSE, alpha = 0.025, tau = 0, p = 0.5, pLB = 0.25, pUB = 0.75, nSim = 100, cores = 1, showSimProgress = TRUE, bnds, addArgs = NULL){ if(any(is.element(model, "linInt"))) stop("planMod works for all built-in models but not linInt") if(length(model) > 1 & asyApprox){ stop("\"asyApprox\" needs to be FALSE for multiple models") } ## off and scal off <- scal <- NULL if(any(is.element(model, c("linlog", "betaMod")))) { lst <- getAddArgs(addArgs, sort(unique(doses))) if ("betaMod" %in% model) scal <- lst$scal if ("linlog" %in% model) off <- lst$off } if(missing(doses)) doses <- attr(altModels, "doses") ## calculate mean response at doses muMat <- getResp(altModels, doses) nD <- length(doses) if(missing(S)){ if(missing(n) | missing(sigma)) stop("either S or n and sigma need to be specified") if (length(n) == 1) n <- rep(n, nD) if (length(n) != nD) stop("\"n\" and \"doses\" need to be of same length") S <- sigma^2 * diag(1/n) } ## calculate parameters, gradients and results for the asymptotic approximation if(missing(bnds)) { if(any(!is.element(model, c("linear", "linlog", "quadratic")))){ message("Message: Need bounds in \"bnds\" for nonlinear models, using default bounds from \"defBnds\".") bnds <- defBnds(max(doses)) } } nams <- colnames(muMat) covMat <- list() approx <- matrix(nrow = ncol(muMat), ncol = 3) maxdose <- apply(abs(muMat-muMat[1,]), 2, function(x) doses[which.max(x)]) EDs <- ED(altModels, p) EDsUB <- ED(altModels, pUB) EDsLB <- ED(altModels, pLB) if(!asyApprox & !simulation) stop("Need to select either \"asyApprox = TRUE\" or \"simulation = TRUE\"") if(asyApprox){ npar <- switch(model, linInt = length(doses), nPars(model)) bestPar <- matrix(nrow = ncol(muMat), ncol = npar) ## best fit by model to models in altModels for(i in 1:ncol(muMat)){ ## if other model-class approximate best fit nam <- gsub("[0-9]", "", nams[i]) # model name (number removed) if(nam == model){ pars <- attr(muMat, "parList")[[i]] if(is.element(model, c("betaMod", "linlog"))) bestPar[i,] <- pars[-length(pars)] else bestPar[i,] <- pars bias <- 0 } else { ## find the best fit fit <- fitMod(doses, muMat[,i], model=model, S=S, bnds = bnds[[model]], type="general") bias <- predict(fit, predType = "effect-curve" , doseSeq = doses[-1])-(muMat[-1,i]-muMat[1,i]) bestPar[i,] <- coef(fit) } ## now calculate approximate covariance matrix covMat[[i]] <- aprCov(doses, model, bestPar[i,], S, off, scal) if(!is.matrix(covMat[[i]])){ approx[i,] <- NA } else { ## root-mse paVar <- getPredVar(model, bestPar[i,], covMat[[i]], pDose=doses[-1], scal=scal, off=off) approx[i,1] <- sqrt(mean(paVar+bias^2)) ## Pr(eff_maxdose > 0) ind <- which(doses[-1] == maxdose[i]) paVar <- paVar[ind] call <- c(list(c(0,maxdose[i])), as.list(c(bestPar[i,], scal, off))) pa <- abs(diff(do.call(model, call))) LBmn <- qnorm(alpha, pa, sqrt(paVar)) approx[i,2] <- pnorm(tau, LBmn, sqrt(paVar), lower.tail = FALSE) ## Pr(eff_ED50) edvar <- getEDVar(model, bestPar[i,], covMat[[i]], "unrestricted", p, maxdose[i], off=off, scal=scal) ed <- calcED(model, bestPar[i,], p, maxdose[i], "continuous", off=off, scal=scal) edsd <- sqrt(edvar) approx[i,3] <- pnorm(EDsUB[i], ed, edsd) - pnorm(EDsLB[i], ed, edsd) } } colnames(approx) <- c("dRMSE", "Pow(maxDose)", "P(EDp)") rownames(approx) <- rownames(bestPar) <- nams colnames(bestPar) <- rownames(covMat[[1]]) attr(approx, "bestPar") <- bestPar attr(approx, "covMat") <- covMat } if(simulation){ cat("Running simulations\n") requireNamespace("parallel", quietly = TRUE) sim <- parallel::mclapply(1:ncol(muMat), function(i){ if(showSimProgress){ if(cores == 1){ cat(sprintf("Scenario %d/%d\n", i, ncol(muMat))) pb <- txtProgressBar(style=3, char="*") } else { cat(sprintf("Scenario %d/%d started\n", i, ncol(muMat))) } } dat <- mvtnorm::rmvnorm(nSim, mean = muMat[,i], sigma = S) sims <- numeric(3) mse <- LBmn <- edpred <- resp <- numeric(nSim) coefs <- vector("list", length = nSim) modelSel <- character(nSim) for(j in 1:nSim){ if(showSimProgress & cores == 1) setTxtProgressBar(pb, j/nSim) fit <- vector("list", length = length(model)) k <- 1 for(namMod in model){ fit[[k]] <- fitMod(dose=doses, dat[j,], model=namMod, S=S, type="general", bnds=bnds[[namMod]]) k <- k+1 ## ## this would be faster ## fit <- fitMod.raw(doses, dat[j,], model=model, ## off=off, scal=scal, nodes=NULL, ## S=S, type="general", bnds=bnds, ## covarsUsed = FALSE, df = Inf, ## control = NULL, ## doseNam = "dose", respNam = "resp") } aics <- sapply(fit, gAIC) fit <- fit[[which.min(aics)]] coefs[[j]] <- coef(fit) modelSel[j] <- attr(fit, "model") ## root-MSE of plac-adj dr at doses respDoses <- predict(fit, predType = "effect-curve", doseSeq = doses[-1]) call <- c(list(doses), as.list(c(coef(fit), scal, off))) trm <- muMat[-1,i] - muMat[1,i] mse[j] <- mean((respDoses-trm)^2) ## Pr(LB_maxdose > tau) > 1-alpha respMaxD <- predict(fit, predType = "effect-curve", doseSeq = maxdose[i], se.fit=TRUE) if(is.na(respMaxD$se.fit)){ LBmn[j] <- NA } else { LBmn[j] <- qnorm(alpha, abs(respMaxD$fit), respMaxD$se.fit) } resp[j] <- respMaxD$fit ## ED estimation edpred[j] <- ED(fit, p=p) } ind <- is.na(LBmn) NAind <- sum(ind) LBmn[ind] <- qnorm(alpha, abs(resp[ind]), sd(resp, na.rm=TRUE)) sims[1] <- sqrt(mean(mse)) sims[2] <- mean(LBmn > tau) sims[3] <- mean(edpred > EDsLB[i] & edpred < EDsUB[i]) attr(sims, "NAind") <- NAind attr(sims, "coefs") <- coefs attr(sims, "model") <- modelSel if(showSimProgress){ if(cores == 1){ close(pb) } else { cat(sprintf("Scenario %d/%d finished\n", i, ncol(muMat))) } } sims }, mc.cores=cores) NAind <- sapply(sim, function(x) attr(x, "NAind")) coefs <- lapply(sim, function(x) attr(x, "coefs")) modelSel <- sapply(sim, function(x) attr(x, "model")) names(NAind) <- colnames(modelSel) <- names(coefs) <- nams rownames(modelSel) <- 1:nSim sim <- do.call("rbind", sim) colnames(sim) <- c("dRMSE", "Pow(maxDose)", "P(EDp)") rownames(sim) <- nams attr(sim, "NAind") <- NAind attr(sim, "coefs") <- coefs attr(sim, "modelSel") <- modelSel } out <- list(approx = NULL, sim = NULL) if(asyApprox) out$approx <- approx if(simulation){ out$sim <- sim attr(out$sim, "nSim") <- nSim } attr(out, "model") <- model attr(out, "altModels") <- altModels attr(out, "doses") <- doses attr(out, "off") <- off attr(out, "scal") <- scal attr(out, "S") <- S class(out) <- "planMod" out } #' @export print.planMod <- function(x, digits = 3,...){ model <- attr(x, "model") multiMod <- length(model) > 1 str <- ifelse(multiMod, "s", "") cat(sprintf("Fitted Model%s: %s\n\n", str, paste(model, collapse=" "))) if(!is.null(x$approx)){ attr(x$approx, "bestPar") <- NULL attr(x$approx, "NAind") <- NULL attr(x$approx, "covMat") <- NULL cat("Asymptotic Approximations\n") print(signif(x$approx, digits)) cat("\n") } if(!is.null(x$sim)){ pltsim <- x$sim attr(pltsim, "NAind") <- NULL attr(pltsim, "coefs") <- NULL attr(pltsim, "modelSel") <- NULL attr(pltsim, "nSim") <- NULL cat(sprintf("Simulation Results (nSim = %i)\n", attr(x$sim, "nSim"))) print(signif(pltsim, digits)) if(multiMod){ cat("\nSelected models\n") res <- apply(attr(x$sim, "modelSel"), 2, tableMatch, match = model) print(signif(t(res)/colSums(res), digits)) } } } #' Summarize performance metrics for dose-response models #' #' @param object,digits object: A planMod object. digits: Digits in summary output #' @param len Number of equally spaced points to determine the mean-squared error on a grid (cRMSE). #' @param Delta Additional arguments determining what dose estimate to plot, when \samp{type = "ED"} or \samp{type = #' "TD"} #' @param dLB,dUB Which quantiles to use for calculation of \code{lengthTDCI} and \code{lengthEDpCI}. By default dLB = #' 0.05 and dUB = 0.95, so that this corresponds to a 90\% interval. #' @param ... Additional arguments (currently ignored) #' #' @rdname planMod #' @method summary planMod #' @export summary.planMod <- function(object, digits = 3, len = 101, Delta=NULL, p=NULL, dLB = 0.05, dUB = 0.95, ...){ class(object) <- "summary.planMod" print(object, digits, len, Delta, p, dLB, dUB, ...) } #' @export print.summary.planMod <- function(x, digits = 3, len = 101, Delta=NULL, p=NULL, dLB = 0.05, dUB = 0.95, ...){ ## provide more information than print method modelSel <- attr(x$sim, "modelSel") model <- attr(x, "model") coefs <- attr(x$sim, "coefs") altModels <- attr(x, "altModels") direction <- attr(altModels, "direction") doses <- attr(x, "doses") S <- attr(x, "S") off <- attr(x, "off") scal <- attr(x, "scal") ## calculate mean response at doses doseSeq <- seq(min(doses), max(doses), length=len) muMat <- getResp(altModels, doseSeq) if(is.null(x$sim)) stop("Additional metrics only available if simulations were performed") ## calculate average mse of placebo-adjusted dose-response for ANOVA CM <- cbind(-1, diag(length(doses)-1)) mseANOVA <- mean(diag(CM%*%S%*%t(CM))) ## calculate predictions predList <- getSimEst(x, "dose-response", doseSeq=doseSeq) out <- matrix(ncol = 5, nrow = ncol(muMat)) colnames(out) <- c("Eff-vs-ANOVA", "cRMSE", "lengthTDCI", "P(no TD)", "lengthEDCI") rownames(out) <- colnames(muMat) if(!is.null(Delta)){ tds <- getSimEst(x, "TD", Delta=Delta, direction=direction) } if(!is.null(p)){ eds <- getSimEst(x, "ED", p=p) } for(i in 1:ncol(muMat)){ out[i,1] <- mseANOVA/x$sim[i,1]^2 ## calculate mse of estimating the plac-adj dose-response at fine grid ## first calculate placebo-adjusted predictions pred <- predList[[i]] pred <- (pred-pred[,1])[,-1] ## placebo-adjusted response mn <- (muMat[-1,i]-muMat[1,i]) clmn <- colMeans(sweep(pred, 2, mn)^2) out[i,2] <- sqrt(mean(clmn)) ## calculate length of CI for TD if(!is.null(Delta)){ out[i,3] <- diff(quantile(tds[[i]], c(dLB, dUB), na.rm = TRUE)) out[i,4] <- mean(is.na(tds[[i]])) } else { out[i,3] <- out[i,4] <- NA } ## calculate length of CI for ED if(!is.null(p)){ out[i,5] <- diff(quantile(eds[[i]], c(dLB, dUB))) } else { out[i,5] <- NA } } cat(sprintf("Additional simulation metrics (nSim=%i)\n", attr(x$sim, "nSim"))) print(signif(out, digits=digits)) } #' Plot to summarize dose-response and dose estimations #' #' @inheritParams plot.planMod #' @param x An object of class planMod #' @param type Type of plot to produce #' @param placAdj When \samp{type = "dose-response"}, this determines whether dose-response estimates are shown on #' placebo-adjusted or original scale #' @param xlab,ylab Labels for the plot (ylab only applies for \samp{type = "dose-response"}) #' #' @rdname planMod #' @method plot planMod #' @export plot.planMod <- function(x, type = c("dose-response", "ED", "TD"), p, Delta, placAdj = FALSE, xlab = "Dose", ylab = "", ...){ type <- match.arg(type) if(type == "dose-response"){ plotDRSims(x, placAdj = placAdj, xlab=xlab, ylab = ylab) } else { plotDoseSims(x, type=type, p=p, Delta=Delta, xlab = xlab) } } DoseFinding/R/maFitMod.R0000644000176200001440000002200114762603270014471 0ustar liggesusers#' Fit dose-response models via bootstrap model #' averaging (bagging) #' #' This function fits dose-response models in a bootstrap model #' averaging approach motivated by the bagging procedure (Breiman #' 1996). Given summary estimates for the outcome at each dose, the #' function samples summary data from the multivariate normal #' distribution. For each sample dose-response models are fit to these #' summary estimates and the best model #' according to the gAIC is selected. #' #' @aliases predict.maFit plot.maFit print.maFit #' @param dose Numeric specifying the dose variable. #' @param resp Numeric specifying the response estimate corresponding #' to the doses in \code{dose} #' @param S Covariance matrix associated with the dose-response #' estimate specified via \code{resp} #' @param models dose-response models to fit #' @param nSim Number of bootstrap simulations #' @param control Same as the control argument in #' \code{\link{fitMod}}. #' @param bnds Bounds for non-linear parameters. This needs to be a #' list with list entries corresponding to the selected bounds. The #' names of the list entries need to correspond to the model #' names. The \code{\link{defBnds}} function provides the default #' selection. #' @param addArgs List containing two entries named "scal" and "off" #' for the "betaMod" and "linlog" model. When addArgs is NULL the #' following defaults are used \samp{list(scal = 1.2*max(doses), off #' = 0.01*max(doses))} #' @return An object of class \samp{maFit}, which contains the fitted #' dose-response models \samp{DRMod} objects, information on which model #' was selected in each bootstrap and basic input parameters. #' @author Bjoern Bornkamp #' @seealso \code{\link{fitMod}}, \code{\link{bFitMod}}, \code{\link{drmodels}} #' @references Breiman, L. (1996). Bagging predictors. Machine learning, 24, 123-140. #' @examples #' data(biom) #' ## produce first stage fit (using dose as factor) #' anMod <- lm(resp~factor(dose)-1, data=biom) #' drFit <- coef(anMod) #' S <- vcov(anMod) #' dose <- sort(unique(biom$dose)) #' ## fit an emax and sigEmax model (increase nSim for real use) #' mFit <- maFitMod(dose, drFit, S, model = c("emax", "sigEmax"), nSim = 10) #' mFit #' plot(mFit, plotData = "meansCI") #' ED(mFit, direction = "increasing", p = 0.9) #' @export maFitMod <- function(dose, resp, S, models, nSim = 1000, control, bnds, addArgs = NULL){ builtIn <- c("linlog", "linear", "quadratic", "linInt", "emax", "exponential", "logistic", "betaMod", "sigEmax") if(missing(models)) stop("Need to specify the models that should be fitted") modelNum <- match(models, builtIn) if(any(is.na(modelNum))){ stop_str <- sprintf("Invalid dose-response model specified: %s", paste(models[is.na(modelNum)], collapse = ", ")) stop(stop_str) } if(!missing(bnds)){ if(!is.list(bnds)) stop("bnds needs to be a list") } if(any(modelNum > 4)){ # non-linear model -> needs bounds if(missing(bnds)){ message("Message: Need bounds in \"bnds\" for nonlinear models, using default bounds from \"defBnds\".") bnds <- defBnds(max(dose)) } else{ nonlin_models <- builtIn[modelNum[modelNum > 4]] bnds <- sapply(nonlin_models, function(x) if(x %in% names(bnds)){bnds[[x]]} else{ message("Message: Need bounds in \"bnds\" for nonlinear models, using default bounds from \"defBnds\"."); defBnds(max(dose))[[x]]}, simplify = FALSE) } } ## parametric bootstrap sims <- mvtnorm::rmvnorm(nSim, resp, S) fits <- vector("list", nSim) selModel <- character(nSim) for(i in 1:nSim){ mod_fits <- lapply(models, function(mod){ fitMod(dose, sims[i,], model = mod, S = S, type = "general", bnds = bnds[[mod]], addArgs = addArgs) }) index <- which.min(sapply(mod_fits, gAIC)) fits[[i]] <- mod_fits[[index]] selModel[i] <- models[index] } out <- list(fits = fits, selModels = selModel, args = list(dose = dose, resp = resp, S=S, models = models)) class(out) <- "maFit" out } #' @param object Object of class maFit #' @param summaryFct If equal to NULL predictions are calculated for #' each sampled parameter value. Otherwise a summary function is #' applied to the dose-response predictions for each parameter #' value. The default is to calculate 0.025, 0.25, 0.5, 0.75, 0.975 #' quantiles of the predictions for each dose. #' @param doseSeq Where to calculate predictions. #' @param ... Further arguments (currently ignored) #' @rdname maFitMod #' @method predict maFit #' @export predict.maFit <- function(object, summaryFct = function(x) quantile(x, probs = c(0.025, 0.25, 0.5, 0.75, 0.975)), doseSeq = NULL, ...){ if(is.null(doseSeq)) stop("Need to provide doseSeq argument") nSim <- length(object$selModel) pred <- matrix(nrow = nSim, ncol = length(doseSeq)) colnames(pred) <- doseSeq rownames(pred) <- 1:nSim for(i in 1:nSim){ pred[i,] <- predict(object$fits[[i]], doseSeq = doseSeq, predType = "ls-means") } if(!is.null(summaryFct)){ out0 <- apply(pred, 2, summaryFct) out <- matrix(out0, ncol = length(doseSeq)) } else { out <- pred } colnames(out) <- doseSeq out } #' @export print.maFit <- function(x, digits = 3, ...){ cat("Bootstrap model averaging fits\n") cat("\nSpecified summary data:\n") dose_str <- paste(x$args$dose, collapse = ", ") cat(sprintf("doses: %s\n", dose_str)) mn_str <- paste(round(x$args$resp, digits), collapse = ", ") cat(sprintf("mean: %s\n", mn_str)) cat("Covariance Matrix:\n") S2 <- x$args$S rownames(S2) <- colnames(S2) <- x$args$dose print(round(S2, digits)) cat(sprintf("\nModels fitted: %s\n", paste(x$args$models, collapse = ", "))) nSim <- length(x$selModels) cat(sprintf("\nModels selected by gAIC on bootstrap samples (nSim = %s)\n", nSim)) tab0 <- table(x$selModels) out <- as.numeric(tab0) names(out) <- names(tab0) print(out) } #' @param x object of class maFit #' @param plotData Determines how the original data are plotted: #' Either as means or as means with CI or not at all. The level of the CI #' is determined by the argument \samp{level}. #' @param xlab x-axis label #' @param ylab y-axis label #' @param title plot title #' @param level Level for CI, when plotData is equal to #' \samp{meansCI}. #' @param trafo Plot the fitted models on a transformed scale #' (e.g. probability scale if models have been fitted on log-odds #' scale). The default for \samp{trafo} is the identity function. #' @param lenDose Number of grid values to use for display. #' @param ... Additional parametes (unused) #' @rdname maFitMod #' @method plot maFit #' @export plot.maFit <- function(x, plotData = c("means", "meansCI", "none"), xlab = "Dose", ylab = "Response", title = NULL, level = 0.95, trafo = function(x) x, lenDose = 201, ...){ if(!inherits(trafo, "function")) stop("trafo needs to be a function") plotData <- match.arg(plotData) dsq <- seq(0, max(x$args$dose), length = lenDose) preds <- predict(x, doseSeq = dsq, summaryFct = NULL) tail_prob <- (1-level)/2 pdat <- data.frame( dose = dsq, median = trafo(apply(preds, 2, function(x) quantile(x, 0.5))), UB = trafo(apply(preds, 2, function(x) quantile(x, 1-tail_prob))), LB = trafo(apply(preds, 2, function(x) quantile(x, tail_prob))) ) if (plotData %in% c("meansCI", "means")) { pmdat <- data.frame(dose = x$args$dose, median = trafo(x$args$resp)) sdev <- sqrt(diag(x$args$S)) crit <- qnorm(1 - tail_prob) LBm <- UBm <- numeric(length(x$args$dose)) for (i in 1:length(x$args$dose)) { LBm[i] <- trafo(x$args$resp[i] - crit * sdev[i]) UBm[i] <- trafo(x$args$resp[i] + crit * sdev[i]) } pmdat$LBm <- LBm pmdat$UBm <- UBm } pp <- ggplot2::ggplot(pdat, ggplot2::aes(x=.data$dose, y=.data$median)) + ggplot2::geom_ribbon(ggplot2::aes(ymin = .data$LB, ymax = .data$UB), alpha=0.2)+ ggplot2::geom_line()+ ggplot2::xlab(xlab)+ ggplot2::ylab(ylab)+ ggplot2::theme_bw()+ ggplot2::scale_x_continuous(breaks=x$args$dose)+ ggplot2::scale_y_continuous(breaks=pretty(c(pdat$UB, pdat$LB), 8)) if(plotData %in% c("means", "meansCI")){ pp <- pp + ggplot2::geom_point(ggplot2::aes(x=.data$dose, y=.data$median), data=pmdat) if(plotData == "meansCI") pp <- pp + ggplot2::geom_errorbar(ggplot2::aes(ymin=.data$LBm, ymax=.data$UBm), data=pmdat, width = 0) } if(!is.null(title)){ if(!is.character(title)) stop("title needs to be a character") pp <- pp + ggplot2::ggtitle(title) } pp } DoseFinding/R/bFitMod.R0000644000176200001440000004035214654153534014331 0ustar liggesusers #' Fit a dose-response model using Bayesian or bootstrap methods. #' #' For \samp{type = "Bayes"}, MCMC sampling from the posterior distribution of the dose-response model is done. The #' function assumes a multivariate normal distribution for \code{resp} with covariance matrix \code{S}, and this is #' taken as likelihood function and combined with the prior distributions specified in prior to form the posterior #' distribution. #' #' For \samp{type = "bootstrap"}, a multivariate normal distribution for \code{resp} with covariance matrix \code{S} is #' assumed, and a large number of samples is drawn from this distribution. For each draw the fitMod function with #' \samp{type = "general"} is used to fit the draws from the multivariate normal distribution. #' #' Componentwise univariate slice samplers are implemented (see Neal, 2003) to sample from the posterior distribution. #' #' @aliases bFitMod coef.bFitMod predict.bFitMod plot.bFitMod #' @param dose Numeric specifying the dose variable. #' @param resp Numeric specifying the response estimate corresponding to the doses in \code{dose} #' @param S Covariance matrix associated with the dose-response estimate specified via \code{resp} #' @param model Dose-response model to fit, possible models are "linlog", "linear", "quadratic", "emax", "exponential", #' "sigEmax", "betaMod" and "logistic", see \code{\link{drmodels}}. #' @param placAdj Whether or not estimates in "placAdj" are placebo-adjusted (note that the linear in log and the #' logistic model cannot be fitted for placebo-adjusted data) #' @param type Character with allowed values "Bayes" and "bootstrap", Determining whether samples are drawn from the #' posterior, or the bootstrap distribution. #' @param start Optional starting values for the dose-response parameters in the MCMC algorithm. #' @param prior List containing the information regarding the prior distributions for \samp{type = "Bayes"}. The list #' needs to have as many entries as there are model parameters. The ordering of the list entries should be the same as #' in the arguments list of the model see (see \code{\link{drmodels}}). For example for the Emax model the first #' entry determines the prior for e0, the second to eMax and the third to ed50. #' #' For each list entry the user has the choice to choose from 4 possible #' distributions: \itemize{ \item \code{norm}: Vector of length 2 giving mean #' and standard deviation. \item \code{t}: Vector of length 3 giving median, #' scale and degrees of freedom of the t-distribution. \item \code{lnorm}: #' Vector of length 2 giving mean and standard deviation on log scale. \item #' \code{beta}: Vector of length 4 giving lower and upper bound of the beta #' prior as well as the alpha and beta parameters of the beta distribution } #' @param nSim Desired number of samples to produce with the algorithm #' @param MCMCcontrol List of control parameters for the MCMC algorithm #' \itemize{ \item \code{thin} Thinning rate. Must be a positive integer. #' \item \code{w} Numeric of same length as number of parameters in the model, #' specifies the width parameters of the slice sampler. \item \code{adapt} #' Logical whether to adapt the \code{w} (width) parameter of the slice sampler #' in a short trial run. The widths are chosen as IQR/1.3 of the trial run. } #' @param control Same as the control argument in \code{\link{fitMod}}. #' @param bnds Bounds for non-linear parameters, in case \samp{type = "bootstrap"}. If missing the the default bounds #' from \code{\link{defBnds}} is used. #' @param addArgs List containing two entries named "scal" and "off" for the "betaMod" and "linlog" model. When addArgs #' is NULL the following defaults are used \samp{list(scal = 1.2*max(doses), off = 0.01*max(doses))} #' @param x,object A bFitMod object #' @param ... Additional arguments are ignored. #' @return An object of class bFitMod, which is a list containing the matrix of posterior simulations plus some #' additional information on the fitted model. #' @author Bjoern Bornkamp #' @seealso \code{\link{fitMod}} #' @references Neal, R. M. (2003), Slice sampling, Annals of Statistics, 31, 705-767 #' @examples #' data(biom) # ## produce first stage fit (using dose as factor) #' anMod <- lm(resp~factor(dose)-1, data=biom) #' drFit <- coef(anMod) #' S <- vcov(anMod) #' dose <- sort(unique(biom$dose)) #' ## define prior list #' ## normal prior for E0 (mean=0 and sdev=10) #' ## normal prior for Emax (mean=0 and sdev=100) #' ## beta prior for ED50: bounds: [0,1.5] parameters shape1=0.45, shape2=1.7 #' prior <- list(norm = c(0, 10), norm = c(0,100), beta=c(0,1.5,0.45,1.7)) #' ## now fit an emax model #' gsample <- bFitMod(dose, drFit, S, model = "emax", #' start = c(0, 1, 0.1), nSim = 1000, prior = prior) #' ## summary information #' gsample #' ## samples are stored in #' head(gsample$samples) #' ## predict 0.025, 0.25, 0.5, 0.75, 0.975 Quantile at 0, 0.5 and 1 #' predict(gsample, doseSeq = c(0, 0.5, 1)) #' ## simple plot function #' plot(gsample) #' #' ## now look at bootstrap distribution #' gsample <- bFitMod(dose, drFit, S, model = "emax", type = "bootstrap", #' nSim = 100, bnds = defBnds(1)$emax) #' plot(gsample) #' #' ## now fit linear interpolation #' prior <- list(norm = c(0,1000), norm = c(0,1000), #' norm = c(0,1000), norm = c(0,1000), norm = c(0,100)) #' gsample <- bFitMod(dose, drFit, S, model = "linInt", #' start = rep(1,5), nSim = 1000, prior = prior) #' gsample <- bFitMod(dose, drFit, S, model = "linInt", type = "bootstrap", #' nSim = 100) #' #' ## data fitted on placebo adjusted scale #' data(IBScovars) #' anovaMod <- lm(resp~factor(dose)+gender, data=IBScovars) #' drFit <- coef(anovaMod)[2:5] # placebo adjusted estimates at doses #' vCov <- vcov(anovaMod)[2:5,2:5] #' dose <- sort(unique(IBScovars$dose))[-1] #' prior <- list(norm = c(0,100), beta=c(0,6,0.45,1.7)) #' ## Bayes fit #' gsample <- bFitMod(dose, drFit, vCov, model = "emax", placAdj=TRUE, #' start = c(1, 0.1), nSim = 1000, prior = prior) #' ## bootstrap fit #' gsample <- bFitMod(dose, drFit, vCov, model = "emax", placAdj=TRUE, #' type = "bootstrap", start = c(1, 0.1), #' nSim = 100, prior = prior, bnds = c(0.01,6)) #' ## calculate target dose estimate #' TD(gsample, Delta = 0.2) #' ## now fit linear interpolation #' prior <- list(norm = c(0,1000), norm = c(0,1000), norm = c(0,1000), norm = c(0,100)) #' gsample <- bFitMod(dose, drFit, vCov, model = "linInt", placAdj=TRUE, #' start = rep(1,4), nSim = 1000, prior = prior) #' gsample <- bFitMod(dose, drFit, vCov, model = "linInt", type = "bootstrap", #' placAdj = TRUE, nSim = 100) #' @export bFitMod <- function(dose, resp, model, S, placAdj = FALSE, type = c("Bayes", "bootstrap"), start = NULL, prior = NULL, nSim = 1000, MCMCcontrol = list(), control = NULL, bnds, addArgs = NULL){ if(placAdj & model %in% c("linlog", "logistic")) stop("logistic and linlog models can only be fitted with placAdj") nD <- length(dose) if (length(resp) != nD) stop("dose and resp need to be of the same size") dose <- as.numeric(dose) if (any(dose < -.Machine$double.eps)) stop("dose values need to be non-negative") if (!is.numeric(dose)) stop("dose variable needs to be numeric") resp <- as.numeric(resp) ## order dose and resp increasingly ord <- order(dose) dose <- dose[ord] resp <- resp[ord] if (nrow(S) != nD | ncol(S) != nD) stop("S and dose have non-conforming size") if (missing(model)) stop("need to specify the model that should be fitted") scal <- off <- nodes <- NULL if(model %in% c("linlog", "betaMod")){ lst <- getAddArgs(addArgs, dose) if(model == "betaMod") scal <- lst$scal if(model == "linlog") off <- lst$off } if(model == "linInt") nodes <- dose ## model number builtIn <- c("linear", "linlog", "quadratic", "linInt", "emax", "logistic", "exponential", "sigEmax", "betaMod") modNr <- match(model, builtIn) if(is.na(modNr)) stop("invalid model selected") ## number of parameters nPar <- as.integer(c(2, 2, 3, length(dose), 3, 4, 3, 4, 4)[modNr]) type <- match.arg(type) if(type == "Bayes"){ res <- bFitMod.Bayes(dose, resp, S, model, placAdj, start, prior, nSim, MCMCcontrol, off, scal, nPar, modNr) res <- matrix(res, nrow = nSim, ncol = nPar) if(placAdj & model != "linInt") res <- res[,-1, drop = FALSE] } else { ## bootstrap res <- bFitMod.bootstrap(dose, resp, S, model, placAdj, nSim, control, bnds, off, scal, nodes) } out <- list(samples = res) if(model != "linInt"){ nams <- names(formals(model))[-1] } else { nams <- paste("d", dose, sep="") } if(modNr %in% c(2,9)) nams <- nams[-length(nams)] if(placAdj & model != "linInt") nams <- nams[-1] colnames(out$samples) <- nams attr(out, "model") <- model lst <- list(dose, resp, S) doseNam <- as.list(match.call())$dose respNam <- as.list(match.call())$resp attr(out, "doseRespNam") <- as.character(c(doseNam, respNam)) names(lst) <- c(doseNam, respNam, "S") attr(out, "data") <- lst attr(out, "type") <- type attr(out, "call") <- match.call() attr(out, "placAdj") <- placAdj attr(out, "prior") <- prior attr(out, "scal") <- scal attr(out, "off") <- off attr(out, "nodes") <- nodes class(out) <- "bFitMod" out } #' @export print.bFitMod <- function(x, digits = 3, ...){ ## print brief summary of MCMC samples doseNam <- attr(x, "doseRespNam")[1] respNam <- attr(x, "doseRespNam")[2] resp <- attr(x, "data")[[respNam]] names(resp) <- attr(x, "data")[[doseNam]] cat("Dose Response Model\n\n") cat(paste("Model:", attr(x, "model")), "\n\n") if(attr(x, "type") == "Bayes"){ cat("Summary of posterior draws\n") func <- function(x){ c(mean=mean(x), sdev=sd(x), quantile(x, c(0.025, 0.25, 0.5, 0.75, 0.975)), n.eff=ess.mcmc(x)) } print(t(apply(x$samples, 2, func)), digits=digits) } else { cat("Summary of bootstrap draws\n") func <- function(x){ c(mean=mean(x), sdev=sd(x), quantile(x, c(0.025, 0.25, 0.5, 0.75, 0.975))) } print(t(apply(x$samples, 2, func)), digits=digits) } cat("\nFitted to:\n") print(signif(resp, digits+2)) } #' Make predictions from fitted dose-response model #' #' @inheritParams coef.bFitMod #' @param predType,summaryFct,doseSeq,lenSeq Arguments for the predict method. #' #' \samp{predType}: predType determines whether predictions are returned for the dose-response curve or the effect #' curve (difference to placebo). #' #' \samp{summaryFct}: If equal to NULL predictions are calculated for each sampled parameter value. Otherwise a #' summary function is applied to the dose-response predictions for each parameter value. The default is to calculate #' 0.025, 0.25, 0.5, 0.75, 0.975 quantiles of the predictions for each dose. #' #' \samp{doseSeq}: Where to calculate predictions. If not specified predictions are calculated on a grid of length #' \samp{lenSeq} between minimum and maximum dose. #' #' \samp{lenSeq}: Length of the default grid where to calculate predictions. #' #' @rdname bFitMod #' @method predict bFitMod #' @export predict.bFitMod <- function(object, predType = c("full-model", "effect-curve"), summaryFct = function(x) quantile(x, probs = c(0.025, 0.25, 0.5, 0.75, 0.975)), doseSeq = NULL, lenSeq = 101, ...){ predType <- match.arg(predType) doseNam <- attr(object, "doseRespNam")[1] if (is.null(doseSeq)) { doseSeq <- seq(0, max(attr(object, "data")[[doseNam]]), length = lenSeq) } model <- attr(object, "model") scal <- attr(object, "scal") off <- attr(object, "off") placAdj <- attr(object, "placAdj") if(placAdj){ nodes <- c(0,attr(object, "data")[[doseNam]]) } else { nodes <- attr(object, "data")[[doseNam]] } out <- predSamples(samples = object$samples, doseSeq = doseSeq, placAdj = placAdj, model = model, scal = scal, off = off, nodes = nodes) if(predType == "effect-curve"){ out <- out - out[,1] } if(!is.null(summaryFct)){ out0 <- apply(out, 2, summaryFct) out <- matrix(out0, ncol = ncol(out)) } colnames(out) <- doseSeq out } #' Plot fitted dose-response model #' #' @inheritParams coef.bFitMod #' @param plotType,quant,plotData,level,lenDose Arguments for plot method. #' #' \samp{plotType}: Determining whether the dose-response curve or the effect curve should be plotted. #' #' \samp{quant}: Vector of quantiles to display in plot #' #' \samp{plotData}: Determines how the original data are plotted: Either as means or as means with CI or not. The #' level of the CI is determined by the argument \samp{level}. #' #' \samp{level}: Level for CI, when plotData is equal to \samp{meansCI}. #' #' \samp{lenDose}: Number of grid values to use for display. #' #' @rdname bFitMod #' @method plot bFitMod #' @export plot.bFitMod <- function (x, plotType = c("dr-curve", "effect-curve"), quant = c(0.025, 0.5, 0.975), plotData = c("means", "meansCI", "none"), level = 0.95, lenDose = 201, ...){ addArgs <- list(...) plotType <- match.arg(plotType) doseNam <- attr(x, "doseRespNam")[1] respNam <- attr(x, "doseRespNam")[2] dose <- attr(x, "data")[[doseNam]] resp <- attr(x, "data")[[respNam]] doseSeq <- seq(0, max(dose), length = lenDose) plotData <- match.arg(plotData) placAdj <- attr(x, "placAdj") sumFct <- function(x){ quantile(x, probs = quant) } if (placAdj) plotType <- "effect-curve" if (plotType == "effect-curve") { pred <- predict(x, predType = plotType, summaryFct = sumFct, doseSeq = doseSeq) main <- "Effect Curve" if (placAdj) { if (plotData == "meansCI") { sdev <- sqrt(diag(attr(x, "data")$S)) q <- qnorm(1 - (1 - level)/2) LBm <- UBm <- numeric(length(dose)) for (i in 1:length(dose)) { LBm[i] <- resp[i] - q * sdev[i] UBm[i] <- resp[i] + q * sdev[i] } } else { LBm <- UBm <- NULL } } else { LBm <- UBm <- NULL } } if (plotType == "dr-curve") { pred <- predict(x, predType = "full-model", summaryFct = sumFct, doseSeq = doseSeq) main <- "Dose-Response Curve\n" if (plotData == "meansCI") { sdev <- sqrt(diag(attr(x, "data")$S)) q <- qnorm(1 - (1 - level)/2) LBm <- UBm <- numeric(length(dose)) for (i in 1:length(dose)) { LBm[i] <- resp[i] - q * sdev[i] UBm[i] <- resp[i] + q * sdev[i] } } else { LBm <- UBm <- NULL } } rng <- range(c(pred, resp, LBm, UBm)) dff <- diff(rng) ylim <- c(rng[1] - 0.02 * dff, rng[2] + 0.02 * dff) callList <- list(doseSeq, t(pred), type = "l", xlab = doseNam, ylim = ylim, ylab = respNam, main = main, lty=1, col=1) callList[names(addArgs)] <- addArgs do.call("matplot", callList) if (plotType == "dr-curve" | placAdj) { if (plotData == "means") points(dose, resp, pch = 19, cex = 0.75) if (plotData == "meansCI") { points(dose, resp, pch = 19, cex = 0.75) for (i in 1:length(dose)) { lines(c(dose[i], dose[i]), c(LBm[i], UBm[i]), lty = 2) } } } res <- list(doseSeq = doseSeq) attr(res, "level") <- level attr(res, "ylim") <- ylim res$mean <- pred invisible(res) } #' Extract dose-response model coefficients #' #' @param x,object A bFitMod object #' @param ... Additional arguments are ignored. #' #' @rdname bFitMod #' @method coef bFitMod #' @export coef.bFitMod <- function (object, ...){ object$samples } DoseFinding/R/guesst.R0000644000176200001440000002137614654153534014324 0ustar liggesusers #' Calculate guesstimates based on prior knowledge #' #' Calculates guesstimates for standardized model parameter(s) using the general approach described in Pinheiro et al. #' (2006). #' #' Calculates guesstimates for the parameters \eqn{\theta_2}{theta2} of the standardized model function based on the #' prior expected percentage of the maximum effect at certain dose levels. Note that this function should be used #' together with the \code{\link{plot.Mods}} function to ensure that the guesstimates are reflecting the prior beliefs. #' #' For the logistic and sigmoid emax models at least two pairs (d,p) need to be specified. #' #' For the beta model the dose at which the maximum effect occurs (dMax) has to be specified in addition to the (d,p) #' pair. #' #' For the exponential model the maximum dose administered (Maxd) needs to be specified in addition to the (d,p) pair. #' #' For the quadratic model one (d,p) pair is needed. It is advisable to specify the location of the maximum within the #' dose range with this pair. #' #' For the emax, sigmoid Emax and logistic model one can choose between a local and an asymptotic version. In the local #' version one explicitly forces the standardized model function to pass through the specified points (d,p). For the #' asymptotic version it assumed that the standardized model function is equal to 1 at the largest dose (this is the #' approach described in Pinheiro et al. (2006)). If the local version is used, convergence problems with the underlying #' nonlinear optimization can occur. #' #' @param d Vector containing dose value(s). #' @param p Vector of expected percentages of the maximum effect achieved at d. #' @param model Character string. Should be one of "emax", "exponential", "quadratic", "betaMod", "sigEmax", "logistic". #' @param less Logical, only needed in case of quadratic model. Determines if d is smaller (\samp{less=TRUE}) or larger #' (\samp{less=FALSE}) than dopt (see Pinheiro et al. (2006) for details). #' @param local Logical indicating whether local or asymptotic version of guesstimate should be derived (defaults to #' \samp{FALSE}). Only needed for emax, logistic and sigEmax model. When \samp{local=TRUE} the maximum dose must be #' provided via \samp{Maxd}. #' @param dMax Dose at which maximum effect occurs, only needed for the beta model #' @param Maxd Maximum dose to be administered in the trial #' @param scal Scale parameter, only needed for the beta model #' @return Returns a numeric vector containing the guesstimates. #' @seealso \code{\link{emax}}, \code{\link{logistic}}, \code{\link{betaMod}}, \code{\link{sigEmax}}, #' \code{\link{quadratic}}, \code{\link{exponential}}, \code{\link{plot.Mods}} #' @references Bornkamp B., Pinheiro J. C., and Bretz, F. (2009). MCPMod: An R #' Package for the Design and Analysis of Dose-Finding Studies, \emph{Journal #' of Statistical Software}, \bold{29}(7), 1--23 #' #' Pinheiro, J. C., Bretz, F., and Branson, M. (2006). Analysis of dose-response studies - modeling approaches, #' \emph{in} N. Ting (ed.), \emph{Dose Finding in Drug Development}, Springer, New York, pp. 146--171 #' @examples #' #' ## Emax model #' ## Expected percentage of maximum effect: 0.8 is associated with #' ## dose 0.3 (d,p)=(0.3, 0.8), dose range [0,1] #' emx1 <- guesst(d=0.3, p=0.8, model="emax") #' emax(0.3,0,1,emx1) #' ## local approach #' emx2 <- guesst(d=0.3, p=0.8, model="emax", local = TRUE, Maxd = 1) #' emax(0.3,0,1,emx2)/emax(1,0,1,emx2) #' ## plot models #' models <- Mods(emax=c(emx1, emx2), doses=c(0,1)) #' plot(models) #' #' ## Logistic model #' ## Select two (d,p) pairs (0.2, 0.6) and (0.2, 0.95) #' lgc1 <- guesst(d = c(0.2, 0.6), p = c(0.2, 0.95), "logistic") #' logistic(c(0.2,0.6), 0, 1, lgc1[1], lgc1[2]) #' ## local approach #' lgc2 <- guesst(d = c(0.2, 0.6), p = c(0.2, 0.95), "logistic", #' local = TRUE, Maxd = 1) #' r0 <- logistic(0, 0, 1, lgc2[1], lgc2[2]) #' r1 <- logistic(1, 0, 1, lgc2[1], lgc2[2]) #' (logistic(c(0.2,0.6), 0, 1, lgc2[1], lgc2[2])-r0)/(r1-r0) #' ## plot models #' models <- Mods(logistic = rbind(lgc1, lgc2), doses=c(0,1)) #' plot(models) #' #' ## Beta Model #' ## Select one pair (d,p): (0.4,0.8) #' ## dose, where maximum occurs: 0.8 #' bta <- guesst(d=0.4, p=0.8, model="betaMod", dMax=0.8, scal=1.2, Maxd=1) #' ## plot #' models <- Mods(betaMod = bta, doses=c(0,1), addArgs = list(scal = 1.2)) #' plot(models) #' #' ## Sigmoid Emax model #' ## Select two (d,p) pairs (0.2, 0.6) and (0.2, 0.95) #' sgE1 <- guesst(d = c(0.2, 0.6), p = c(0.2, 0.95), "sigEmax") #' sigEmax(c(0.2,0.6), 0, 1, sgE1[1], sgE1[2]) #' ## local approach #' sgE2 <- guesst(d = c(0.2, 0.6), p = c(0.2, 0.95), "sigEmax", #' local = TRUE, Maxd = 1) #' sigEmax(c(0.2,0.6), 0, 1, sgE2[1], sgE2[2])/sigEmax(1, 0, 1, sgE2[1], sgE2[2]) #' models <- Mods(sigEmax = rbind(sgE1, sgE2), doses=c(0,1)) #' plot(models) #' #' ## Quadratic model #' ## For the quadratic model it is assumed that the maximum effect occurs at #' ## dose 0.7 #' quad <- guesst(d = 0.7, p = 1, "quadratic") #' models <- Mods(quadratic = quad, doses=c(0,1)) #' plot(models) #' #' ## exponential model #' ## (d,p) = (0.8,0.5) #' expo <- guesst(d = 0.8, p = 0.5, "exponential", Maxd=1) #' models <- Mods(exponential = expo, doses=c(0,1)) #' plot(models) #' @export guesst <- function(d, p, model = c("emax", "exponential", "logistic", "quadratic", "betaMod", "sigEmax"), less = TRUE, local = FALSE, dMax, Maxd, scal){ model <- match.arg(model) if(any(p <= 0) | any(p > 1)) stop("must have 0 < p <= 1") if(model == "emax"){ if(!local){ return(c(ed50 = mean(d * (1 - p)/p))) } else { if (any(p <= d/Maxd)) stop("must have p > d/Maxd, for local version") val <- (d/p-d)/(1-d/(Maxd*p)) return(c(ed50=mean(val))) } } if(model == "exponential"){ if(any(p >= d/Maxd)) stop("must have p < d/Maxd") init <- d/log(1 + p) fooexp <- function(delta, d, p, Maxd){ sum((exponential(d, 0, 1, delta)/ exponential(Maxd, 0, 1, delta) - p)^2) } val <- optimize(fooexp, c(0, 2*Maxd), d=d, p=p, Maxd=Maxd)$minimum return(c(delta = mean(val))) } if(model == "logistic"){ if(length(d) == 1) { stop("logistic model needs at least two pairs (d,p)") } logit <- function(p) log(p/(1-p)) if(length(d) == 2) { ed50 <- diff(rev(d)*logit(p))/diff(logit(p)) delta <- diff(d)/diff(logit(p)) res <- c(ed50 = ed50, delta = delta) } else { m <- lm(logit(p)~d) par <- coef(m) names(par) <- NULL res <- c(ed50 = -par[1]/par[2], delta = 1/par[2]) } if(local){ foolog <- function(par, d, p, Maxd) { e0 <- logistic(0,0,1,par[1],par[2]) sum(((logistic(d,0,1,par[1],par[2]) - e0)/ (logistic(Maxd,0,1,par[1],par[2])-e0)-p)^2) } res <- try(optim(par=res, fn=foolog, d=d, p=p, Maxd=Maxd)) if(res$convergence > 0) stop("cannot find guesstimates for specified values") else res <- res$par } if(res[1] < 0) message("Message: specified values lead to negative ed50, which should be positive") return(res) } if(model == "quadratic"){ aux <- sqrt(1 - p) if (less){ return(c(delta = mean(-(1 - aux)/(2 * d)))) } else { return(c(delta = mean(-(1 + aux)/(2 * d)))) } } if(model == "betaMod"){ if(scal <= dMax) stop("scal needs to be larger than dMax to calculate guesstimate") if(dMax > Maxd) stop("dose with maximum effect (dMax) needs to be smaller than maximum dose (Maxd)") k <- dMax/(scal-dMax) val <- d^k*(scal-d)/(dMax^k*(scal-dMax)) beta <- log(p)/(log(val)) return(c(delta1 = mean(k*beta), delta2 = mean(beta))) } if(model == "sigEmax"){ if(length(d) == 1) { stop("sigmoid Emax model needs at least two pairs (d,p)") } if(length(d) == 2){ num <- log((p[1]*(1-p[2]))/(p[2]*(1-p[1]))) h <- num/log(d[1]/d[2]) ed50 <- ((1-p[1])/p[1])^(1/h)*d[1] res <- c(ed50=ed50, h=h) } else { y <- log((1-p)/p) x <- log(d) par <- coef(lm(y~x)) names(par) <- NULL res <- c(ed50 = exp(par[1]/-par[2]), delta = -par[2]) } if(local) { fooSE <- function(par, d, p, Maxd) { sum((sigEmax(d,0,1,par[1],par[2])/ sigEmax(Maxd,0,1,par[1],par[2])-p)^2) } res <- try(optim(par=res, fn=fooSE, d=d, p=p, Maxd=Maxd)) if(res$convergence > 0) stop("cannot find guesstimates for specified values") else res <- res$par } if(res[1] < 0) message("Message: specified values lead to negative ed50, which should be positive") return(res) } } DoseFinding/R/bFitMod_helpers.R0000644000176200001440000002145314654153534016054 0ustar liggesusers## Bayesian and bootstrap fitting of dose-response models checkPrior <- function(prior){ z <- 1 for(z in 1:length(prior)){ prvec <- prior[[z]] nam <- names(prior)[z] if(!all(is.numeric(prvec))) stop("non-numeric entry in prior") if(nam %in% c("norm", "t", "lnorm")){ if(nam == "t"){ if(length(prvec) != 3) stop("need vector of length 3 for ", nam, " prior") if(prvec[2] <= 0|prvec[3] <= 0) stop("2nd and 3rd entry needs to be positive for ", nam, " prior") } else { if(length(prvec) != 2) stop("need vector of length 2 for ", nam, " prior") if(prvec[2] <= 0) stop("2nd entry needs to be positive for ", nam, " prior") } } else { if(length(prvec) != 4) stop("need vector of length 4 for beta prior") if(min(prvec[3:4]) <= 0) stop("entry 3 and 4 need to be positive for beta prior") if(prvec[1] >= prvec[2]) stop("entry 1 needs to be smaller than entry 2 for beta prior") } } } getPrBnds <- function(prior){ prbnds <- matrix(ncol = 2, nrow = length(prior)) for(z in 1:length(prior)){ prvec <- prior[[z]] nam <- names(prior)[z] if(nam %in% c("norm", "t")) prbnds[z,] <- c(-Inf, Inf) if(nam == "lnorm") prbnds[z,] <- c(0, Inf) if(nam == "beta") prbnds[z,] <- c(prvec[1], prvec[2]) } prbnds } projPrBnds <- function(par, lbnd, ubnd){ ## project start parameter into bounds if(par > lbnd & par < ubnd){ return(par) } else { rng <- ubnd-lbnd if(!is.finite(rng)) rng <- 5 if(par <= lbnd) return(lbnd+0.05*rng) if(par >= ubnd) return(ubnd-0.05*rng) } } bFitMod.Bayes <- function(dose, resp, S, model, placAdj, start, prior, nSim, MCMCcontrol, off, scal, nPar, modNr){ ## get defaults for MCMCcontrol ctrl <- list(thin = 1, w = NULL, adapt=TRUE) if (!is.null(MCMCcontrol)) { MCMCcontrol <- as.list(MCMCcontrol) ctrl[names(MCMCcontrol)] <- MCMCcontrol } ## check prior distribution if(is.null(prior)) stop("need specification of prior in prior argument") prnr <- match(names(prior), c("norm", "t", "lnorm", "beta")) if(any(is.na(prnr))) stop("invalid prior selected") np <- nPar if(placAdj){ if(model != "linInt"){ np <- nPar - 1 } else { placAdj <- FALSE ## can proceed as if placAdj = FALSE } } if(length(prnr) != np) stop(length(prnr), " priors specified, need ", np," for selected model") checkPrior(prior) prBnds <- getPrBnds(prior) ## add some checks here (scale > 0, a > b, alpha,beta>0) prior <- as.double(do.call("c", prior)) ## calculate starting value using fitMod if needed ## and width parameter for slice sampler if(is.null(start)|is.null(ctrl$w)){ mD <- max(dose) ll <- list(emax = c(0.1, 1.5) * mD, exponential = c(0.5, 1.5) * mD, logistic = matrix(c(0.1, 0.05, 1.5, 1/2) * mD, 2), sigEmax = matrix(c(0.1 * mD, 0.5, 1.5 * mD, 5), 2), betaMod = matrix(c(0.2, 0.2, 4, 4), 2)) gfit <- fitMod(dose, resp, S=S, model=model, type = "general", bnds = ll[[model]], placAdj = placAdj, addArgs=list(off = off, scal = scal)) if(is.null(start)){ start <- coef(gfit) for(i in 1:length(start)){ start[i] <- projPrBnds(start[i], prBnds[i,1], prBnds[i,2]) } } else { for(i in 1:length(start)){ if((start[i] < prBnds[i,1]) | (start[i] > prBnds[i,2])) stop("specified start value not consistent with bounds on prior distribution") } } if(is.null(ctrl$w)) ctrl$w <- rep(1.0, nPar)#sqrt(diag(vcov(gfit))) } if(np != length(start)) stop("start of wrong length") if(placAdj){ # append 0 if(model != "linInt") start <- c(0.0, start) } if(length(ctrl$w) != length(start)) stop("w and start need to be of same size") ## add information for beta and linlog model if(model == "betaMod"){ if(is.null(scal)) stop("need scal parameter for betaMod") start <- c(start, as.double(scal)) } if(model == "linlog"){ if(is.null(off)) stop("need off parameter for betaMod") start <- c(start, as.double(off)) } ## preliminary formatting to send information to C start <- as.double(start) inS <- solve(S) if(inherits(inS, "try-error")) stop("specified S is not invertible") clinS <- as.double(chol(inS)) ## ensure that parameters are of right class nSimTot <- as.integer(nSim*ctrl$thin);thin <- as.integer(ctrl$thin) out <- double(floor(nSimTot/thin)*nPar) resp <- as.double(resp);dose <- as.double(dose) modNr <- as.integer(modNr);clinS <- as.double(clinS) nD <- as.integer(length(dose));w <- as.double(ctrl$w) noint <- as.integer(placAdj) ## call c code if(ctrl$adapt){ res <- .C("sample", as.integer(500), as.integer(1), out=double(500*nPar), start, noint, w, dose, modNr, nPar, double(length(dose)), resp, clinS, nD, prior, prnr, double(nPar), double(nPar)) res <- matrix(res$out, nrow = 500, ncol = nPar) w <- apply(res, 2, function(x) IQR(x)/1.3) } res <- .C("sample", nSimTot, thin, out=out, start, noint, w, dose, modNr, nPar, double(length(dose)), resp, clinS, nD, prior, prnr, double(nPar), double(nPar)) res$out } bFitMod.bootstrap <- function(dose, resp, S, model, placAdj, nSim, control, bnds, off, scal, nodes){ if(model %in% c("emax", "exponential", "betaMod", "logistic", "sigEmax")){ if(missing(bnds)){ message("Message: Need bounds in \"bnds\" for nonlinear models, using default bounds from \"defBnds\".") bnds <- defBnds(max(dose))[[model]] } } ## same arguments as in gFitDRModel function sims <- mvtnorm::rmvnorm(nSim, resp, S) func <- function(x){ fit <- fitMod.raw(dose, x, S=S, model=model, type="general", placAdj=placAdj, bnds=bnds, control=control, off=off, scal=scal, nodes=nodes, covarsUsed = FALSE, df = Inf, doseNam = "dose", respNam = "resp") coef(fit) } out <- apply(sims, 1, func) if(is.matrix(out)){ return(t(out)) } else { return(matrix(out, nrow = nSim, ncol = 1)) } } ## to do write print, predict and summary method ess.mcmc <- function(series, lag.max = NULL){ ## initial monotone sequence estimate of effective sample size ## Geyer, 1992, Statistical Science, idea: ## sum of even and un-even autocorrelations (gamma) ## needs to be positive and monotone decreasing N <- length(series) if (length(unique(series)) == 1) return(NA) if (is.null(lag.max)) lag.max <- 10 * log10(N) ac <- acf(series, plot = FALSE, lag.max = lag.max)$acf[2:(lag.max + 1), , 1] gam <- ac[-length(ac)]+ac[-1] dgam <- -diff(gam) if (gam[1] < 0) return(N) m1 <- m2 <- lag.max ind1 <- gam < 0 if (any(ind1)) m1 <- min(which(ind1)) ind2 <- dgam < 0 if (any(ind2)) m2 <- min(which(ind2)) ind <- min(2 * min(m1, m2) + 1, lag.max) N/(1 + 2 * sum(ac[1:ind])) } predSamples <- function(samples, placAdjfullPars = FALSE, doseSeq, placAdj, model, scal, off, nodes){ ## placAdjfullPars argument only of interest if placAdj = TRUE ## it determines whether the e0 parameter is included as a row in the ## samples argument or not if(model != "betaMod") scal <- NULL if(model != "linlog") off <- NULL if(placAdj){ if(placAdjfullPars){ if(model != "linInt"){ func <- function(x){ pred <- do.call(model, c(list(doseSeq), as.list(c(x, scal, off)))) pred0 <- do.call(model, c(list(0), as.list(c(x, scal, off)))) pred-pred0 } } else { func <- function(x){ pred <- do.call(model, c(list(doseSeq), as.list(list(x, nodes)))) pred0 <- do.call(model, c(list(0), as.list(list(x, nodes)))) pred-pred0 } } } else { if(model != "linInt"){ func <- function(x) do.call(model, c(list(doseSeq), as.list(c(c(0,x), scal, off)))) } else { func <- function(x) do.call(model, c(list(doseSeq), as.list(list(c(0,x), nodes)))) } } } else { if(model != "linInt"){ func <- function(x) do.call(model, c(list(doseSeq), as.list(c(x, scal, off)))) } else { func <- function(x) do.call(model, c(list(doseSeq), as.list(list(x, nodes)))) } } out <- t(apply(samples, 1, func)) } DoseFinding/R/optDesign_helpers.R0000644000176200001440000001313414654153534016461 0ustar liggesusers## optimal designs for model-fitting ## calculate gradient of model and gradient of TD calcGrads <- function(fmodels, doses, weights, Delta, off, scal, direction, designCrit){ modgrad <- TDgrad <- nPar <- vector("list", modCount(fmodels, fullMod=TRUE)) z <- 1 for(nam in names(fmodels)){ pars <- fmodels[[nam]] if(is.matrix(pars)){ for(i in 1:nrow(pars)){ modgrad[[z]] <- t(gradCalc(nam, pars[i,], doses, off=off, scal=scal)*sqrt(weights)) if(designCrit != "Dopt") TDgrad[[z]] <- calcTDgrad(nam, pars[i,], Delta, direction, off, scal) nPar[[z]] <- nPars(nam) z <- z+1 } } else { modgrad[[z]] <- t(gradCalc(nam, pars, doses, off=off, scal=scal)*sqrt(weights)) if(designCrit != "Dopt") TDgrad[[z]] <- calcTDgrad(nam, pars, Delta, direction, off, scal) nPar[[z]] <- nPars(nam) z <- z+1 } } modgrads <- do.call("c", modgrad) TDgrad <- do.call("c", TDgrad) nPar <- do.call("c", nPar) list(modgrads=modgrads, TDgrad=TDgrad, nPar=nPar) } ## returns the number of parameters (needed for C call) nPars <- function(mods){ builtIn <- c("linlog", "linear", "quadratic", "emax", "exponential", "logistic", "betaMod", "sigEmax") ind <- match(mods, builtIn) if(any(is.na(ind))){ stop(mods[which(is.na(ind))], " model not allowed in optDesign") } c(2,2,3,3,3,4,4,4)[ind] } ## function which calls different optimizers callOptim <- function(func, method, nD, control, lowbnd, uppbnd){ ## actual optimizer if(method == "nlminb"){ # nlminb and optim run on transformed values res <- nlminb(getStart(nD), objective=func, control = control, lower=rep(0, nD), upper=rep(pi, nD)) } else if(method == "Nelder-Mead"){ res <- optim(getStart(nD), fn=func, control = control) } else if(method == "solnp"){ # no need for transformed values for solnp avail <- requireNamespace("Rsolnp", quietly = TRUE) if(!avail) stop("Need suggested package Rsolnp for this calculation to use solnp optimizer") ## get starting value (need feasible starting value for solnp) ## try whether equal allocation is feasible eq <- rep(1/nD, nD) if(all(eq > lowbnd+0.001) & all(eq < uppbnd-0.001)){ strt <- eq } else { slb <- sum(lowbnd) sub <- sum(uppbnd) gam <- (1-slb)/(sub-slb) strt <- lowbnd+gam*(uppbnd-lowbnd) } eqfun <- function(x, ...){ sum(x) } con <- list(trace = 0) con[(namc <- names(control))] <- control res <- Rsolnp::solnp(strt, fun=func, eqfun=eqfun, eqB=1, control = con, LB = lowbnd, UB = uppbnd) } res } ## transforms from unconstrained values R^k into constrained ## values in S^k = {w|sum_i w_i=1 and w_i >= 0} transTrig <- function(y, k){ a <- numeric(k) if(k == 2){ a[1] <- sin(y[1])^2 } else { a[1:(k-1)] <- sin(y)^2 a[2:(k-1)] <- a[2:(k-1)]*cumprod(cos(y[1:(k-2)])^2) } a[k] <- prod(cos(y[1:(k-1)])^2) a } ## identity function idtrans <- function(y, k){ y } ## calculate uniform design but on R^k scale ## (inverse of transTrig at uniform design) getStart <- function(k){ y <- numeric(k-1) eq <- 1/k y[1] <- asin(sqrt(eq)) for(j in 2:(k-1)){ y[j] <- asin(sqrt(eq/prod(cos(y[(1:j)-1])^2))) } y } ## function called in the optimization (design criterion is ## implemented in C and called "critfunc") optFunc <- function(x, xvec, pvec, nD, probs, M, n, nold, bvec, designCrit, trans, standInt){ xtrans <- do.call("trans", list(x, nD)) res <- .C("critfunc", xvec, pvec, nD, probs, M, xtrans, n, nold, double(16), as.double(1e-15), bvec, designCrit, standInt, double(1), PACKAGE = "DoseFinding") res[[14]] } ## auxiliary function for efficient rounding which.is.max <- function (x){ y <- seq_along(x)[x == max(x)] if (length(y) > 1L) sample(y, 1L) else y } getCompositions <- function(N, M){ nC <- choose(N+M-1, M-1) lst <- .C("getcomp", comp=integer(nC*M), integer(M-1), as.integer(N), as.integer(M-1), as.integer(nC), PACKAGE = "DoseFinding") matrix(lst$comp, byrow = TRUE, nrow = nC) } ## calculate all possible compositions of n patients to nDoses groups ## (assuming a certain block-size) upper and lower bounds on the ## allocations can also be specified getDesMat <- function(n, nDoses, lowbnd = rep(0, nDoses), uppbnd = rep(1, nDoses), groupSize, maxvls1, maxvls2){ if(n %% groupSize) stop("n needs to be divisible by groupSize") nG <- n/groupSize combn <- choose(nG+nDoses-1,nDoses-1) if(combn > maxvls1) stop(combn, " (unrestricted) combinations, increase maxvls1 in control argument if this calculation should be performed") desmat <- getCompositions(nG, nDoses)/nG if(any(lowbnd > 0) | any(uppbnd < 1)){ comp <- matrix(lowbnd, byrow = TRUE, ncol = nDoses, nrow=nrow(desmat)) LindMat <- desmat >= comp comp <- matrix(uppbnd, byrow=TRUE, ncol = nDoses, nrow=nrow(desmat)) UindMat <- desmat <= comp ind <- rowSums(LindMat*UindMat) == nDoses desmat <- desmat[ind,] if(nrow(desmat) == 0) stop("no design is compatible with bounds specified in lowbnd and uppbnd") } if(nrow(desmat) > maxvls2) stop(nrow(desmat), " combinations, increase maxvls2 in control argument if this calculation should be performed") desmat } DoseFinding/R/powMCT_helpers.R0000644000176200001440000001701314654153534015676 0ustar liggesusers powCalc <- function(alternative, critV, df, corMat, deltaMat, control){ nC <- nrow(corMat) # number of contrasts if(alternative[1] == "two.sided"){ lower <- rep(-critV, nC) } else { lower <- rep(-Inf, nC) } upper <- rep(critV, nC) if (!missing(control)) { if(!is.list(control)) { stop("when specified, 'control' must be a list") } ctrl <- do.call("mvtnorm.control", control) } else { ctrl <- control } ctrl$interval <- NULL # not used with pmvt nScen <- ncol(deltaMat) res <- numeric(nScen) for(i in 1:nScen){ pmvtCall <- c(list(lower, upper, df = df, corr = corMat, delta = deltaMat[,i], algorithm = ctrl)) res[i] <- as.vector(1 - do.call(mvtnorm::pmvt, pmvtCall)) } names(res) <- colnames(deltaMat) res } ## print.powMCT <- function(x, ...){ ## attributes(x)[2:5] <- NULL ## print(x) ## } #' Function for power calculation for the multiple contrast test for #' binary data (candidate models formulated on logit link scale) and #' count data (negative binomial distribution with log link is #' assumed; candidate models formulated on log mean scale)- Note this #' function is somewhat limited (e.g. only one-sided testing allowed) #' and not user-friendly (e.g. cannot hand over Mods objects). It is #' not exported. #' #' @param n Vector of sample sizes per dose group #' @param doses vector of doses #' @param candModList List containing the candidate models #' @param respModList List containing the response models to assume #' @param placEffu placebo effect on untransformed scale #' @param maxEffu maximum treatment effect vs placebo on untransformed #' scale #' @param type either "binary_logit" or "negative_binomial" #' @param option whether the optimal contrast should be recalculated #' for each assumed true model (option "A") or not option "B" #' @param alpha Significance level (one-sided testing is assumed) #' @param theta Overdispersion parameter required for the negative #' binomial model. Parameterization of negative binomial: E(Y)=mu, #' Var(Y)=mu*(1+mu/theta) #' @param control Control parameter for mvtnorm::qmvt, mvtnorm::pmvt #' (see ?mvtnorm.control) #' @param contMat Contrast matrix (if non-model-based contrasts should #' be used). If a user-defined contrast matrix the argument option #' is ignored (automatically set to "B"). #' @param addArgs additional arguments for betaMod and linlog model #' (passed to Mods function) #' #' @return Vector of calculated power values #' @noRd #' @examples #'mvt_control <- mvtnorm.control() #'candModList <- list(emax = c(0.25, 1), sigEmax = rbind(c(1, 3), c(2.5, 4)), betaMod = c(1.1, 1.1)) #'powMCTBinCount(rep(20,5), doses = c(0, 0.5, 1.5, 2.5, 4), #' candModList=candModList, respModList=candModList, #' placEffu = 0.1, maxEffu = 0.25, #' type = "binary_logit", option = "A", #' alpha = 0.1, theta, control = mvt_control, #' addArgs = list(scal = 4.8)) powMCTBinCount <- function(n, doses, candModList = NULL, respModList, placEffu, maxEffu, type = c("binary_logit", "negative_binomial"), option = c("A", "B"), alpha, theta = NULL, control, contMat = NULL, addArgs){ type <- match.arg(type) stopifnot(length(doses) == length(n)) if(is.null(candModList) & is.null(contMat)) stop("either candModList or contMat need to be non-NULL") if(type == "binary_logit"){ logit <- function(p) log(p/(1-p)) trafo <- logit } if(type == "negative_binomial"){ if(is.null(theta)) stop("need argument theta for type = \"negative_binomial\"") trafo <- log } placEff_tr <- trafo(placEffu) maxEff_tr <- trafo(placEffu+maxEffu)-placEff_tr if(is.null(contMat)){ mods <- do.call(Mods, append(candModList, list(placEff = placEff_tr, maxEff = maxEff_tr, doses = doses, addArgs=addArgs))) if(option == "B"){ # opt. contrasts not recalculated only calculated here cm <- optContr(mods, w=n)$contMat # assume diagonal cov matrix with entries 1/n_i } } else { option <- "B" cm <- contMat } ## calculate correlation matrix under null-hypothesis resp_null <- do.call(Mods, append(respModList, list(placEff = placEff_tr, maxEff = 0, doses = doses, addArgs=addArgs))) mu_null <- getResp(resp_null)[, 1, drop=FALSE] # under null all models are the same v_null <- getVarBinCount(mu_null, type, theta) S_null <- diag(as.vector(v_null)/n) resp_mods <- do.call(Mods, append(respModList, list(placEff = placEff_tr, maxEff = maxEff_tr, doses = doses, addArgs=addArgs))) resp <- getResp(resp_mods) nMod <- ncol(resp) pow <- numeric(nMod) for(i in 1:nMod){ mu_vec <- resp[,i, drop=FALSE] # column i contains true response vector ## calculate covariance matrix v <- getVarBinCount(mu_vec, type, theta) S <- diag(as.vector(v)/n) if(option == "A"){ # (re)calculate optimal contrasts based on S contMat <- optContr(mods, S=S) cm <- contMat$contMat } ## calculate non-centrality parameter delta <- t(cm) %*% mu_vec covMat <- t(cm) %*% S %*% cm den <- sqrt(diag(covMat)) delta <- delta/den corMat <- cov2cor(covMat) if(option == "A" | (option == "B" & i == 1)){ # for option B critV does not change if(option == "A"){ # ADDPLAN-DF appears to use corMat not corMat_null corMat_null <- corMat # for consistency do the same } if(option == "B"){ covMat_null <- t(cm) %*% S_null %*% cm corMat_null <- cov2cor(covMat_null) } ## calculate critical value (df=0 corresponds to infinite degrees of freedom -> MVN distribution) qmvtCall <- c(list(1 - alpha, tail = "lower.tail", df = 0, corr = corMat_null, algorithm = control, interval = control$interval)) critV <- do.call(mvtnorm::qmvt, qmvtCall)$quantile } ## calculate power lower <- rep(-Inf, ncol(corMat)) upper <- rep(critV, ncol(corMat)) control$interval <- NULL pmvtCall <- c(list(lower, upper, df = 0, corr = corMat, delta = as.vector(delta), algorithm = control)) pow[i] <- as.vector(1 - do.call(mvtnorm::pmvt, pmvtCall)) } names(pow) <- colnames(resp) pow } #' Function to calculate unit variances for mu_hat for binary (with #' logit link) and negative-binomial (with log link). Resulting #' variances need to be multiplied with factor 1/n. #' @param muVec Vector of group means on transformed scale (logit #' scale for binary data, log scale for negative binomial) #' @param type either "binary_logit" or "negative_binomial" #' @param theta Overdispersion parameter required for the negative #' binomial model. Parameterization of negative binomial: E(Y)=mu, #' Var(Y)=mu*(1+mu/theta) #' @return Vector of variances #' @noRd getVarBinCount <- function(muVec, type, theta){ if(type == "binary_logit"){ inv_logit <- function(x) 1/(1+exp(-x)) p <- inv_logit(muVec) # mean responses on probability scale return(1 / (p * (1 - p))) } if(type == "negative_binomial") return((theta+exp(muVec))/(theta*exp(muVec))) } DoseFinding/R/MCTtest_helpers.R0000644000176200001440000000510114654153534016043 0ustar liggesuserscheckAnalyArgs <- function(dose, resp, data, S, type, addCovars, placAdj, na.action, cal){ if(!inherits(addCovars, "formula")) stop("addCovars argument needs to be of class formula") if(!inherits(placAdj, "logical")) stop("placAdj argument needs to be of class logical") if(placAdj){ if(type == "normal") stop("\"placAdj == TRUE\" only allowed for type = \"general\"") } if(!is.null(data)){ # data handed over in data frame if(!is.data.frame(data)) stop("data argument needs to be a data frame") nams <- c(cal[2], cal[3], all.vars(addCovars)) ind <- match(nams, names(data)) if (any(is.na(ind))) stop("variable(s): ", paste(nams[is.na(ind)], collapse= ", "), " not found in ", cal[4]) dd <- na.action(data[,nams]) } else { # data handed over via vectors if(addCovars != ~1) stop("need to hand over data and covariates in data frame") if(!(is.numeric(resp) && is.null(dim(resp)))) { warning(cal[3], " is not a numeric but a ", class(resp)[1], ", converting with as.numeric()") resp <- as.numeric(resp) } if(length(dose) != length(resp)) stop(cal[2], " and ", cal[3], " not of equal length") dd <- na.action(data.frame(dose, resp)) cal[2:3] <- gsub("\\$", "", cal[2:3]) cal[2:3] <- gsub("\\[|\\]", "", cal[2:3]) colnames(dd) <- cal[2:3] } doseNam <- cal[2];respNam <- cal[3] if(placAdj){ if(any(dd[[doseNam]] == 0)) stop("If placAdj == TRUE there should be no placebo group") } if(any(dd[[doseNam]] < -.Machine$double.eps)) stop("dose values need to be non-negative") if(!is.numeric(dd[[doseNam]])) stop("dose variable needs to be numeric") if(!is.numeric(dd[[respNam]])) stop("response variable needs to be numeric") ## check type related arguments if(type == "general" & is.null(S)) stop("S argument missing") if(type == "normal" & !is.null(S)) message("Message: S argument ignored for type == \"normal\"\n") if(type == "general" & addCovars != ~1) message("Message: addCovars argument ignored for type == \"general\"") if(!is.null(S)){ if(!is.matrix(S)) stop("S needs to be of class matrix") nD <- length(dd[[doseNam]]) if(nrow(S) != nD | ncol(S) != nD) stop("S and dose have non-conforming size") } ord <- order(dd[[doseNam]]) dd <- dd[ord, ] Sout <- NULL if(type == "general") Sout <- S[ord, ord] return(list(dd=dd, type = type, S = Sout, ord=ord, doseNam=doseNam, respNam=respNam)) } DoseFinding/R/DoseFinding-package.R0000644000176200001440000004732714762603270016575 0ustar liggesusers #' @description #' The DoseFinding package provides functions for the design and analysis of dose-finding experiments (for example pharmaceutical Phase II clinical trials). It provides functions for: multiple #' contrast tests (MCTtest), fitting non-linear dose-response models (fitMod), a combination of testing and dose-response modelling (MCPMod), and calculating optimal designs (optDesign), both for #' normal and general response variable. #' #' @details #' The main functions are:\cr #' \bold{MCTtest}: Implements a multiple contrast tests\cr #' \bold{powMCT}: Power calculations for multiple contrast tests\cr #' \bold{fitMod}: Fits non-linear dose-response models\cr #' \bold{optDesign}: Calculates optimal designs for dose-response models\cr #' \bold{MCPMod}: Performs MCPMod methodology\cr #' \bold{sampSize}: General function for sample size calculation\cr #' #' @references Bornkamp, B., Bretz, F., Dette, H. and Pinheiro, J. C. (2011). #' Response-Adaptive Dose-Finding under model uncertainty, \emph{Annals of #' Applied Statistics}, \bold{5}, 1611--1631 #' #' Bornkamp B., Pinheiro J. C., and Bretz, F. (2009). MCPMod: An R Package for #' the Design and Analysis of Dose-Finding Studies, \emph{Journal of #' Statistical Software}, \bold{29}(7), 1--23 #' #' Bretz, F., Pinheiro, J. C., and Branson, M. (2005), Combining multiple #' comparisons and modeling techniques in dose-response studies, #' \emph{Biometrics}, \bold{61}, 738--748 #' #' Dette, H., Bretz, F., Pepelyshev, A. and Pinheiro, J. C. (2008). Optimal #' Designs for Dose Finding Studies, \emph{Journal of the American Statisical #' Association}, \bold{103}, 1225--1237 #' #' O'Quigley, J., Iasonos, A. and Bornkamp, B. (2017) Handbook of methods for #' designing, monitoring, and analyzing dose-finding trials, CRC press, Part 3: #' Dose-Finding Studies in Phase II #' #' Pinheiro, J. C., Bornkamp, B., and Bretz, F. (2006). Design and analysis of #' dose finding studies combining multiple comparisons and modeling procedures, #' \emph{Journal of Biopharmaceutical Statistics}, \bold{16}, 639--656 #' #' Pinheiro, J. C., Bornkamp, B., Glimm, E. and Bretz, F. (2014) Model-based #' dose finding under model uncertainty using general parametric models, #' \emph{Statistics in Medicine}, \bold{33}, 1646--1661 #' #' Seber, G.A.F. and Wild, C.J. (2003). Nonlinear Regression, Wiley #' @keywords internal #' @examples #' #' data(IBScovars) #' #' ## perform (model based) multiple contrast test #' ## define candidate dose-response shapes #' models <- Mods(linear = NULL, emax = 0.2, quadratic = -0.17, #' doses = c(0, 1, 2, 3, 4)) #' ## plot models #' plot(models) #' ## perform multiple contrast test #' test <- MCTtest(dose, resp, IBScovars, models=models, #' addCovars = ~ gender) #' #' ## fit non-linear emax dose-response model #' fitemax <- fitMod(dose, resp, data=IBScovars, model="emax", #' bnds = c(0.01,5)) #' ## display fitted dose-effect curve #' plot(fitemax, CI=TRUE, plotData="meansCI") #' #' ## Calculate optimal designs for target dose (TD) estimation #' doses <- c(0, 10, 25, 50, 100, 150) #' fmodels <- Mods(linear = NULL, emax = 25, exponential = 85, #' logistic = c(50, 10.8811), #' doses = doses, placEff=0, maxEff=0.4) #' plot(fmodels, plotTD = TRUE, Delta = 0.2) #' weights <- rep(1/4, 4) #' desTD <- optDesign(fmodels, weights, Delta=0.2, designCrit="TD") #' "_PACKAGE" #' Built-in dose-response models in DoseFinding #' #' @description #' Dose-response model functions and gradients. #' #' Below are the definitions of the model functions: #' #' \bold{Emax model} \deqn{}{f(d,theta)=E0+Emax d/(ED50 + d).}\deqn{ #' f(d,\theta)=E_0+E_{max}\frac{d}{ED_{50}+d}}{f(d,theta)=E0+Emax d/(ED50 + #' d).} #' #' \bold{Sigmoid Emax Model} \deqn{}{f(d,theta)=E0+Emax d^h/(ED50^h + #' d^h).}\deqn{ #' f(d,\theta)=E_0+E_{max}\frac{d^h}{ED^h_{50}+d^h}}{f(d,theta)=E0+Emax #' d^h/(ED50^h + d^h).} #' #' \bold{Exponential Model} \deqn{}{f(d,theta)=E0+E1 (exp(d/delta)-1).}\deqn{ #' f(d,\theta)=E_0+E_1(\exp(d/\delta)-1)}{f(d,theta)=E0+E1 (exp(d/delta)-1).} #' #' \bold{Beta model} \deqn{}{f(d,theta)=E0+Emax #' B(delta1,delta2)(d/scal)^delta1(1-d/scal)^delta2}\deqn{ #' f(d,\theta)=E_0+E_{max}B(\delta_1,\delta_2)(d/scal)^{\delta_1}(1-d/scal)^{\delta_2} #' }{f(d,theta)=E0+Emax B(delta1,delta2)(d/scal)^delta1(1-d/scal)^delta2} #' \deqn{}{f(d,theta)=E0+Emax B(delta1,delta2)(d/scal)^delta1(1-d/scal)^delta2} here #' \deqn{B(\delta_1,\delta_2)=(\delta_1+\delta_2)^{\delta_1+\delta_2}/(\delta_1^{\delta_1} #' }{B(delta1,delta2)=(delta1+delta2)^(delta1+delta2)/(delta1^delta1 #' delta2^delta2).}\deqn{ #' \delta_2^{\delta_2})}{B(delta1,delta2)=(delta1+delta2)^(delta1+delta2)/(delta1^delta1 #' delta2^delta2).} and \eqn{scal}{scal} is a fixed dose scaling parameter. #' #' \bold{Linear Model} \deqn{}{f(d,theta)=E0+delta d.}\deqn{ #' f(d,\theta)=E_0+\delta d}{f(d,theta)=E0+delta d.} #' #' \bold{Linear in log Model} \deqn{}{f(d,theta)=E0+delta log(d + off),}\deqn{ #' f(d,\theta)=E_0+\delta \log(d + off)}{f(d,theta)=E0+delta log(d + off),} #' here \eqn{off}{off} is a fixed offset parameter. #' #' \bold{Logistic Model} \deqn{ #' f(d, \theta) = E_0 + E_{\max}/\left\{1 + \exp\left[ \left(ED_{50} - d #' \right)/\delta \right] \right\}}{f(d,theta)=E0+Emax/(1 + exp((ED50-d)/delta)).} #' #' \bold{Quadratic Model} \deqn{}{f(d,theta)=E0+beta1 d+beta2 d^2.}\deqn{ #' f(d,\theta)=E_0+\beta_1d+\beta_2d^2}{f(d,theta)=E0+beta1 d+beta2 d^2.} The #' standardized model equation for the quadratic model is \eqn{d+\delta #' d^2}{d+delta d^2}, with \eqn{\delta=\beta_2/\beta_1}{delta=beta2/beta1}. #' #' \bold{Linear Interpolation model}\cr The linInt model provides linear #' interpolation at the values defined by the nodes vector. In virtually all #' situations the nodes vector is equal to the doses used in the analysis. For #' example the \code{\link{Mods}} and the \code{\link{fitMod}} function #' automatically use the doses that are used in the context of the function #' call as nodes. The guesstimates specified in the \code{\link{Mods}} function #' need to be the treatment effects at the active doses standardized to the #' interval [0,1] (see the examples in the \code{\link{Mods}} function). #' #' @details #' The \bold{Emax model} is used to represent monotone, concave dose-response #' shapes. To distinguish it from the more general sigmoid emax model it is #' sometimes also called hyperbolic emax model. #' #' The \bold{sigmoid Emax} model is an extension of the (hyperbolic) Emax model #' by introducing an additional parameter h, that determines the steepness of #' the curve at the ed50 value. The sigmoid Emax model describes monotonic, #' sigmoid dose-response relationships. In the toxicology literature this model #' is also called four-parameter log-logistic (4pLL) model. #' #' The \bold{quadratic} model is intended to capture a possible non-monotonic #' dose-response relationship. #' #' The \bold{exponential model} is intended to capture a possible sub-linear or #' a convex dose-response relationship. #' #' The \bold{beta model} is intended to capture non-monotone dose-response #' relationships and is more flexible than the quadratic model. The kernel of #' the beta model function consists of the kernel of the density function of a #' beta distribution on the interval [0,scal]. The parameter scal is not #' estimated but needs to be set to a value larger than the maximum dose. It #' can be set in most functions (\samp{fitMod}, \samp{Mods}) via the #' \samp{addArgs} argument, when omitted a value of \samp{1.2*(maximum dose)} #' is used as default, where the maximum dose is inferred from other input to #' the respective function. #' #' The \bold{linear in log-dose} model is intended to capture concave shapes. #' The parameter \code{off} is not estimated in the code but set to a #' pre-specified value. It can be set in most functions (\samp{fitMod}, #' \samp{Mods}) via the \samp{addArgs} argument, when omitted a value of #' \samp{0.01*(maximum dose)} is used as default, where the maximum dose is #' inferred from other input to the respective function. #' #' The \bold{logistic model} is intended to capture general monotone, sigmoid #' dose-response relationships. The logistic model and the sigmoid Emax model #' are closely related: The sigmoid Emax model is a logistic model in #' log(dose). #' #' The \bold{linInt model} provids linear interpolation of the means at the #' doses. This can be used as a "nonparametric" estimate of the dose-response #' curve, but is probably most interesting for specifying a "nonparametric" #' truth during planning and assess how well parametric models work under a #' nonparametric truth. For the function \samp{Mods} and \samp{fitMod} the #' interpolation \samp{nodes} are selected equal to the dose-levels specified. #' #' @name drmodels #' @rdname drmodels #' @aliases drmodels betaMod emax sigEmax exponential logistic linear linlog #' quadratic linInt betaModGrad emaxGrad sigEmaxGrad exponentialGrad #' logisticGrad linearGrad linlogGrad quadraticGrad linIntGrad #' @usage #' emax(dose, e0, eMax, ed50) #' emaxGrad(dose, eMax, ed50, ...) #' #' sigEmax(dose, e0, eMax, ed50, h) #' sigEmaxGrad(dose, eMax, ed50, h, ...) #' #' exponential(dose, e0, e1, delta) #' exponentialGrad(dose, e1, delta, ...) #' #' quadratic(dose, e0, b1, b2) #' quadraticGrad(dose, ...) #' #' betaMod(dose, e0, eMax, delta1, delta2, scal) #' betaModGrad(dose, eMax, delta1, delta2, scal, ...) #' #' linear(dose, e0, delta) #' linearGrad(dose, ...) #' #' linlog(dose, e0, delta, off = 1) #' linlogGrad(dose, off, ...) #' #' logistic(dose, e0, eMax, ed50, delta) #' logisticGrad(dose, eMax, ed50, delta, ...) #' #' linInt(dose, resp, nodes) #' linIntGrad(dose, resp, nodes, ...) #' @return Response value for model functions or matrix containing the gradient #' evaluations. #' @seealso \code{\link{fitMod}} #' @references MacDougall, J. (2006). Analysis of dose-response studies - Emax #' model,\emph{in} N. Ting (ed.), \emph{Dose Finding in Drug Development}, #' Springer, New York, pp. 127--145 #' #' Pinheiro, J. C., Bretz, F. and Branson, M. (2006). Analysis of dose-response #' studies - modeling approaches, \emph{in} N. Ting (ed.). \emph{Dose Finding #' in Drug Development}, Springer, New York, pp. 146--171 #' @examples #' #' ## some quadratic example shapes #' quadModList <- Mods(quadratic = c(-0.5, -0.75, -0.85, -1), doses = c(0,1)) #' plotMods(quadModList) #' #' ## some emax example shapes #' emaxModList <- Mods(emax = c(0.02,0.1,0.5,1), doses = c(0,1)) #' plotMods(emaxModList) #' ## example for gradient #' emaxGrad(dose = (0:4)/4, eMax = 1, ed50 = 0.5) #' #' ## some sigmoid emax example shapes #' sigEmaxModList <- Mods(sigEmax = rbind(c(0.05,1), c(0.15,3), c(0.4,8), #' c(0.7,8)), doses = c(0,1)) #' plotMods(sigEmaxModList) #' sigEmaxGrad(dose = (0:4)/4, eMax = 1, ed50 = 0.5, h = 8) #' #' ## some exponential example shapes #' expoModList <- Mods(exponential = c(0.1,0.25,0.5,2), doses=c(0,1)) #' plotMods(expoModList) #' exponentialGrad(dose = (0:4)/4, e1 = 1, delta = 2) #' #' ## some beta model example shapes #' betaModList <- Mods(betaMod = rbind(c(1,1), c(1.5,0.75), c(0.8,2.5), #' c(0.4,0.9)), doses=c(0,1), addArgs=list(scal = 1.2)) #' plotMods(betaModList) #' betaModGrad(dose = (0:4)/4, eMax = 1, delta1 = 1, delta2 = 1, scal = 5) #' #' ## some logistic model example shapes #' logistModList <- Mods(logistic = rbind(c(0.5,0.05), c(0.5,0.15), #' c(0.2,0.05), c(0.2,0.15)), doses=c(0,1)) #' plotMods(logistModList) #' logisticGrad(dose = (0:4)/4, eMax = 1, ed50 = 0.5, delta = 0.05) #' #' ## some linInt shapes #' genModList <- Mods(linInt = rbind(c(0.5,1,1), #' c(0,1,1), c(0,0,1)), doses=c(0,0.5,1,1.5)) #' plotMods(genModList) #' linIntGrad(dose = (0:4)/4, resp=c(0,0.5,1,1,1), nodes=(0:4)/4) #' #' NULL ## Documentation of datasets #' Biometrics Dose Response data #' #' An example data set for dose response studies. This data set was used in #' Bretz et al. (2005) to illustrate the MCPMod methodology. #' #' @name biom #' @docType data #' @usage data(biom) #' @format A data frame with 100 observations on the following 2 variables. #' \describe{ #' \item{\code{resp}}{a numeric vector containing the response values} #' \item{\code{dose}}{a numeric vector containing the dose values} #' } #' @source Bretz, F., Pinheiro, J. C., and Branson, M. (2005), Combining #' multiple comparisons and modeling techniques in dose-response studies, #' \emph{Biometrics}, \bold{61}, 738--748 #' @keywords datasets NULL #' Glycopyrronium Bromide dose-response data #' #' Data from a clinical study evaluating Efficacy and Safety of Four Doses of #' Glycopyrronium Bromide in Patients With Stable Chronic Obstructive Pulmonary #' Disease (COPD). This data set was obtained from clinicaltrials.gov #' (NCT00501852). The study design was a 4 period incomplete cross-over #' design. The primary endpoint is the trough forced expiratory volume in 1 #' second (FEV1) following 7 days of Treatment. #' #' The data given here are summary estimates (least-square means) for each #' dose. #' #' @name glycobrom #' @docType data #' @usage data(glycobrom) #' @format A data frame with 5 summary estimates (one per dose). Variables: #' A data frame with 5 summary estimates (one per dose). Variables: #' \describe{ #' \item{\code{dose}}{a numeric vector containing the dose values} #' \item{\code{fev1}}{a numeric vector containing the least square #' mean per dose} #' \item{\code{sdev}}{a numeric vector containing the standard errors #' of the least square means per dose} #' \item{\code{n}}{Number of participants analyzed per treatment group} #' } #' @source http://clinicaltrials.gov/ct2/show/results/NCT00501852 #' @keywords datasets #' @examples #' #' ## simulate a full data set with given means and sdv (here we ignore #' ## the original study was a cross-over design, and simulate a parallel #' ## group design) #' simData <- function(mn, sd, n, doses, fixed = TRUE){ #' ## simulate data with means (mns) and standard deviations (sd), for #' ## fixed = TRUE, the data set will have observed means and standard #' ## deviations as given in mns and sd #' resp <- numeric(sum(n)) #' uppind <- cumsum(n) #' lowind <- c(0,uppind)+1 #' for(i in 1:length(n)){ #' rv <- rnorm(n[i]) #' if(fixed) #' rv <- scale(rv) #' resp[lowind[i]:uppind[i]] <- mn[i] + sd[i]*rv #' } #' data.frame(doses=rep(doses, n), resp=resp) #' } #' data(glycobrom) #' fullDat <- simData(glycobrom$fev1, glycobrom$sdev, glycobrom$n, #' glycobrom$dose) #' NULL #' Irritable Bowel Syndrome Dose Response data with covariates #' #' A subset of the data used by (Biesheuvel and Hothorn, 2002). The data are #' part of a dose ranging trial on a compound for the treatment of the #' irritable bowel syndrome with four active treatment arms, corresponding to #' doses 1,2,3,4 and placebo. Note that the original dose levels have been #' blinded in this data set for confidentiality. The primary endpoint was a #' baseline adjusted abdominal pain score with larger values corresponding to a #' better treatment effect. In total 369 patients completed the study, with #' nearly balanced allocation across the doses. #' #' #' @name IBScovars #' @docType data #' @usage data(IBScovars) #' @format #' A data frame with 369 observations on the following 2 variables. #' \describe{ #' \item{\code{gender}}{a factor specifying the gender} #' \item{\code{dose}}{a numeric vector} #' \item{\code{resp}}{a numeric vector} #' } #' @source Biesheuvel, E. and Hothorn, L. A. (2002). Many-to-one comparisons in #' stratified designs, \emph{Biometrical Journal}, \bold{44}, 101--116 #' @keywords datasets NULL #' Migraine Dose Response data #' #' Data set obtained from clinicaltrials.gov (NCT00712725). This was #' randomized placebo controlled dose-response trial for treatment of acute #' migraine. The primary endpoint was "pain freedom at 2 hours postdose" (a #' binary measurement). #' #' #' @name migraine #' @docType data #' @usage data(migraine) #' @format #' A data frame with 517 columns corresponding to the patients that #' completed the trial #' \describe{ #' \item{\code{dose}}{a numeric vector containing the dose values} #' \item{\code{painfree}}{number of treatment responders} #' \item{\code{ntrt}}{number of subject per treatment group} #' } #' @source http://clinicaltrials.gov/ct2/show/results/NCT00712725 #' @keywords datasets NULL #' Neurodegenerative disease simulated longitudinal dose-finding data set #' #' This simulated data set is motivated by a real Phase 2 clinical study of a #' new drug for a neurodegenerative disease. The state of the disease is #' measured through a functional scale, with smaller values corresponding to #' more severe neurodeterioration. The goal of the drug is to reduce the rate #' of disease progression, which is measured by the linear slope of the #' functional scale over time. #' #' The trial design includes placebo and four doses: 1, 3, 10, and 30 mg, with #' balanced allocation of 50 patients per arm. Patients are followed up for one #' year, with measurements of the functional scale being taken at baseline and #' then every three months. #' #' The functional scale response is assumed to be normally distributed and, #' based on historical data, it is believed that the longitudinal progression #' of the functional scale over the one year of follow up can be modeled a #' simple linear trend. See the example below on how to analyse this type of #' data. #' #' This data set was used in Pinheiro et al. (2014) to illustrate the #' generalized MCPMod methodology. #' #' #' @name neurodeg #' @docType data #' @usage data(neurodeg) #' @format #' A data frame with 100 observations on the following 2 variables. #' \describe{ #' \item{\code{resp}}{a numeric vector containing the response values} #' \item{\code{dose}}{a numeric vector containing the dose values} #' \item{\code{id}}{Patient ID} #' \item{\code{time}}{time of measurement} #' } #' @source Pinheiro, J. C., Bornkamp, B., Glimm, E. and Bretz, F. (2014) #' Model-based dose finding under model uncertainty using general parametric #' models, \emph{Statistics in Medicine}, \bold{33}, 1646--1661 #' @keywords datasets #' @examples #' #' \dontrun{ #' ## reproduce analysis from Pinheiro et al. (2014) #' data(neurodeg) #' ## first fit the linear mixed effect model #' library(nlme) #' fm <- lme(resp ~ as.factor(dose):time, neurodeg, ~time|id, method = "ML") #' muH <- fixef(fm)[-1] # extract estimates #' covH <- vcov(fm)[-1,-1] #' #' ## derive optimal contrasts for candidate shapes #' doses <- c(0, 1, 3, 10, 30) #' mod <- Mods(emax = 1.11, quadratic= -0.022, exponential = 8.867, #' linear = NULL, doses = doses) # #' contMat <- optContr(mod, S=covH) # calculate optimal contrasts #' ## multiple contrast test #' MCTtest(doses, muH, S=covH, type = "general", critV = TRUE, #' contMat=contMat) #' ## fit the emax model #' fitMod(doses, muH, S=covH, model="emax", type = "general", #' bnds=c(0.1, 10)) #' #' #' ## alternatively one can also fit the model using nlme #' nlme(resp ~ b0 + (e0 + eM * dose/(ed50 + dose))*time, neurodeg, #' fixed = b0 + e0 + eM + ed50 ~ 1, random = b0 + e0 ~ 1 | id, #' start = c(200, -4.6, 1.6, 3.2)) #' ## both approaches lead to rather similar results #' } #' NULL DoseFinding/R/sampSize.R0000644000176200001440000004213114654153534014575 0ustar liggesusers## function for sample size calculation and functions to evaluate ## performance metrics for different sample sizes #' Sample size calculations #' #' #' The \samp{sampSize} function implements a bisection search algorithm for sample size calculation. The user can hand #' over a general target function (via \samp{targFunc}) that is then iterated so that a certain \samp{target} is #' achieved. The \samp{sampSizeMCT} is a convenience wrapper of \samp{sampSize} for multiple contrast tests using the #' power as target function. #' #' The \samp{targN} functions calculates a general target function for different given sample sizes. The \samp{powN} #' function is a convenience wrapper of \samp{targN} for multiple contrast tests using the power as target function. #' #' #' @aliases sampSize sampSizeMCT targN plot.targN powN #' @param upperN,lowerN Upper and lower bound for the target sample size. \code{lowerN} defaults to #' \code{floor(upperN/2)}. #' @param targFunc,target The target function needs to take as an input the vector of sample sizes in the different dose #' groups. For \samp{sampSize} it needs to return a univariate number. For function \samp{targN} it should return a #' numerical vector.\cr \cr Example: \samp{targFunc} could be a function that calculates the power of a test, and #' \samp{target} the desired target power value. \cr For function \samp{sampSize} the bisection search iterates the #' sample size so that a specific target value is achieved (the implicit assumption is that targFunc is monotonically #' increasing in the sample size).\cr \cr Function \samp{targN} simply calculates \samp{targFunc} for a given set of #' sample sizes. #' @param tol A positive numeric value specifying the tolerance level for the bisection search algorithm. Bisection is #' stopped if the \samp{targFunc} value is within \samp{tol} of \samp{target}. #' @param alRatio Vector describing the relative patient allocations to the dose groups up to proportionality, e.g. #' \samp{rep(1, length(doses))} corresponds to balanced allocations. #' @param Ntype One of "arm" or "total". Determines, whether the sample size in the smallest arm or the total sample #' size is iterated in bisection search algorithm. #' @param verbose Logical value indicating if a trace of the iteration progress of the bisection search algorithm should #' be displayed. #' @param ... Arguments directly passed to the \code{\link{powMCT}} function in the \samp{sampSizeMCT} and \samp{powN} #' function. #' #' The \samp{placAdj} argument needs to be \samp{FALSE} (which is the default value for this argument). If sample size #' calculations are desired for a placebo-adjusted formulation use \samp{sampSize} or \samp{targN} directly. #' #' In case \code{S} is specified, the specified matrix needs to be proportional to the (hypothetical) covariance #' matrix of one single observation. The covariance matrix used for sample size calculation is 1/N*S, where N is the #' total sample size. Hence \samp{Ntype == "total"} needs to be used if #' \code{S} is specified. When \code{S} is specified, automatically \samp{df = #' Inf} is assumed in the underlying \samp{powMCT} calls. #' #' For a homoscedastic normally distributed response variable only \samp{sigma} needs to be specified, as the sample #' size \samp{n} is iterated in the different \samp{powMCT} calls. #' #' @author Jose Pinheiro, Bjoern Bornkamp #' @seealso \code{\link{powMCT}} #' @references Pinheiro, J. C., Bornkamp, B., and Bretz, F. (2006). Design and analysis of dose finding studies #' combining multiple comparisons and modeling procedures, \emph{Journal of Biopharmaceutical Statistics}, \bold{16}, #' 639--656 #' #' Pinheiro, J.C., Bornkamp, B. (2017) Designing Phase II Dose-Finding Studies: Sample Size, Doses and Dose Allocation #' Weights, in O'Quigley, J., Iasonos, A. and Bornkamp, B. (eds) Handbook of methods for designing, monitoring, and #' analyzing dose-finding trials, CRC press #' @examples #' #' ## sampSize examples #' #' ## first define the target function #' ## first calculate the power to detect all of the models in the candidate set #' fmodels <- Mods(linear = NULL, emax = c(25), #' logistic = c(50, 10.88111), exponential=c(85), #' betaMod=matrix(c(0.33,2.31,1.39,1.39), byrow=TRUE, nrow=2), #' doses = c(0,10,25,50,100,150), placEff=0, maxEff=0.4, #' addArgs = list(scal=200)) #' ## contrast matrix to use #' contMat <- optContr(fmodels, w=1) #' ## this function calculates the power under each model and then returns #' ## the average power under all models #' tFunc <- function(n){ #' powVals <- powMCT(contMat, altModels=fmodels, n=n, sigma = 1, #' alpha=0.05) #' mean(powVals) #' } #' #' ## assume we want to achieve 80% average power over the selected shapes #' ## and want to use a balanced allocations #' \dontrun{ #' sSize <- sampSize(upperN = 80, targFunc = tFunc, target=0.8, #' alRatio = rep(1,6), verbose = TRUE) #' sSize #' #' #' ## Now the same using the convenience sampSizeMCT function #' sampSizeMCT(upperN=80, contMat = contMat, sigma = 1, altModels=fmodels, #' power = 0.8, alRatio = rep(1, 6), alpha = 0.05) #' ## Alternatively one can also specify an S matrix #' ## covariance matrix in one observation (6 total observation result in a #' ## variance of 1 in each group) #' S <- 6*diag(6) #' ## this uses df = Inf, hence a slightly smaller sample size results #' sampSizeMCT(upperN=500, contMat = contMat, S=S, altModels=fmodels, #' power = 0.8, alRatio = rep(1, 6), alpha = 0.05, Ntype = "total") #' #' #' ## targN examples #' ## first calculate the power to detect all of the models in the candidate set #' fmodels <- Mods(linear = NULL, emax = c(25), #' logistic = c(50, 10.88111), exponential=c(85), #' betaMod=matrix(c(0.33,2.31,1.39,1.39), byrow=TRUE, nrow=2), #' doses = c(0,10,25,50,100,150), placEff=0, maxEff=0.4, #' addArgs = list(scal=200)) #' ## corresponding contrast matrix #' contMat <- optContr(fmodels, w=1) #' ## define target function #' tFunc <- function(n){ #' powMCT(contMat, altModels=fmodels, n=n, sigma = 1, alpha=0.05) #' } #' powVsN <- targN(upperN = 100, lowerN = 10, step = 10, tFunc, #' alRatio = rep(1, 6)) #' plot(powVsN) #' #' ## the same can be achieved using the convenience powN function #' ## without the need to specify a target function #' powN(upperN = 100, lowerN=10, step = 10, contMat = contMat, #' sigma = 1, altModels = fmodels, alpha = 0.05, alRatio = rep(1, 6)) #' } #' @export sampSize <- function (upperN, lowerN = floor(upperN/2), targFunc, target, tol = 0.001, alRatio, Ntype = c("arm", "total"), verbose = FALSE){ ## target function to iterate func <- function(n){ targFunc(n) - target } Ntype <- match.arg(Ntype) if (!missing(alRatio)) { if (any(alRatio <= 0)) { stop("all entries of alRatio need to be positive") } else { alRatio <- alRatio/sum(alRatio) } if(Ntype == "arm") { alRatio <- alRatio/min(alRatio) } } else { ## by default assume stop("allocation ratios need to be specified") } ## first call upper <- func(round(upperN*alRatio)) if(length(upper) > 1) stop("targFunc(n) needs to evaluate to a vector of length 1.") if(!is.numeric(upper)) stop("targFunc(n) needs to evaluate to a numeric.") ## bracket solution if (upper < 0) message("upper limit for sample size is raised") while (upper < 0) { upperN <- 2 * upperN upper <- func(round(upperN*alRatio)) } lower <- func(round(lowerN*alRatio)) if (lower > 0) message("lower limit for sample size is decreased") while (lower > 0) { lowerN <- round(lowerN/2) if (lowerN == 0) stop("cannot find lower limit on n") lower <- func(round(lowerN*alRatio)) } ## now start bisection if (verbose) { cat("Upper N:", upperN, "Upper value", round(upper+target, 4), "\n") cat("Lower N:", lowerN, "Lower value", round(lower+target, 4), "\n\n") } current <- tol+1 niter <- 0 ## bisect sample size until tolerance is achieved while (abs(current) > tol & (upperN > lowerN + 1)) { currN <- round((upperN + lowerN)/2) current <- func(round(currN * alRatio)) if (current > 0) { upperN <- currN } else { lowerN <- currN } niter <- niter + 1 if (verbose) { cat("Iter: ", niter, ", N = ", currN, ", current value = ", round(current+target, 4), "\n", sep = "") } } ## increase sample size so that the obtained value is larger than the target while (current < 0) { currN <- currN + 1 current <- func(round(currN * alRatio)) } res <- list(samp.size = round(currN * alRatio), target = round(current+target, 4)) attr(res, "alRatio") <- round(alRatio/min(alRatio), 4) attr(res, "target") <- target attr(res, "Ntype") <- Ntype class(res) <- "sampSize" res } #' @export print.sampSize <- function(x, ...){ cat("Sample size calculation\n\n") cat("alRatio:", attr(x, "alRatio"), "\n") cat("Total sample size:", sum(x$samp.size), "\n") cat("Sample size per arm:", x$samp.size, "\n") cat("targFunc:", x$target,"\n") } #' Sample size calculations for multiple contrast tests #' #' @inheritParams sampSize #' @param ... Arguments directly passed to the \code{\link{powMCT}} function in the \samp{sampSizeMCT} and \samp{powN} #' function. #' @param power,sumFct power is a numeric defining the desired summary power to achieve (in \samp{sampSizeMCT}). sumFct #' needs to be a function that combines the power values under the different alternatives into one value (in #' \samp{sampSizeMCT}). #' @rdname sampSize #' @export sampSizeMCT <- function(upperN, lowerN = floor(upperN/2), ..., power, sumFct = mean, tol = 0.001, alRatio, Ntype = c("arm", "total"), verbose = FALSE){ ## function to calculate sample size for multiple contrast test ## if S is specified this needs to be the (hypothetical) covariance matrix ## for a total sample size of 1 patient Ntype <- match.arg(Ntype) args <- list(...) namargs <- names(args) if(is.element("placAdj", namargs)){ if(args$placAdj) stop("placAdj needs to be FALSE for sampSizeMCT. Use sampSize directly in placebo-adjusted case.") } if(is.element("S", namargs)){ S <- args[["S"]] if(Ntype == "arm"){ Ntype <- "total" message("Only Ntype == \"total\" possible if S is specified") } if(is.element("df", namargs)){ if(is.finite(args$df)) message("df argument set to Inf, if S is specified. Use sampSize directly in case exact df are required.") } args$df <- Inf tFunc <- function(n){ N <- sum(n) Sn <- 1/N*S args$S <- Sn powVals <- do.call("powMCT", args) sumFct(powVals) } } else { if(is.element("n", namargs)) stop("n is not allowed to be specified for sample size calculation") if(!is.element("sigma", namargs)) stop("need sigma if S is not specified") tFunc <- function(n){ powVals <- powMCT(n=n, ...) sumFct(powVals) } } sampSize(upperN, lowerN, targFunc = tFunc, target = power, alRatio = alRatio, Ntype = Ntype, verbose = verbose) } #' Calculate target function for given sample size #' #' @inheritParams sampSize #' @param step Only needed for functions \samp{targN} and \samp{powN}. Stepsize for the sample size at which the target #' function is calculated. The steps are calculated via \code{seq(lowerN,upperN,by=step)}. #' @param power,sumFct power is a numeric defining the desired summary power to achieve (in \samp{sampSizeMCT}). #' @rdname sampSize #' @export targN <- function(upperN, lowerN, step, targFunc, alRatio, Ntype = c("arm", "total"), sumFct = c("min", "mean", "max")){ if(!is.character(sumFct)) stop("sumFct needs to be a character vector") Ntype <- match.arg(Ntype) if (!missing(alRatio)) { if (any(alRatio <= 0)) { stop("all entries of alRatio need to be positive") } else { alRatio <- alRatio/sum(alRatio) } if(Ntype == "arm") { alRatio <- alRatio/min(alRatio) } } else { ## by default assume stop("allocation ratios need to be specified") } nseq <- seq(lowerN, upperN, by=step) out <-t(sapply(nseq, function(x){ targFunc(round(x * alRatio)) })) if(nrow(out) == 1 & length(nseq) > 1){ out <- t(out) colnames(out) <- "" } out2 <- out for(i in 1:length(sumFct)){ out2 <- cbind(out2, apply(out, 1, sumFct[i])) } dimnames(out2) <- list(nseq, c(colnames(out), sumFct)) attr(out2, "alRatio") <- alRatio attr(out2, "sumFct") <- sumFct attr(out2, "Ntype") <- Ntype class(out2) <- "targN" out2 } #' Calculate power for given sample size #' #' @inheritParams targN #' #' @rdname sampSize #' @export powN <- function(upperN, lowerN, step, ..., alRatio, Ntype = c("arm", "total"), sumFct = c("min", "mean", "max")){ args <- list(...) namargs <- names(args) if(is.element("placAdj", namargs)){ if(args$placAdj) stop("placAdj needs to be FALSE for powN. Use targN directly in placebo-adjusted case.") } Ntype <- match.arg(Ntype) if(is.element("S", namargs)){ S <- args[["S"]] if(Ntype == "arm"){ Ntype <- "total" message("Only Ntype == \"total\" possible if S is specified") } if(is.element("df", namargs)){ if(is.finite(args$df)) message("df argument set to Inf, if S is specified. Use sampSize directly in case exact df are required.") } args$df <- Inf tFunc <- function(n){ N <- sum(n) Sn <- 1/N*S args$S <- Sn do.call("powMCT", args) } } else { if(is.element("n", namargs)) stop("n is not allowed to be specified for sample size calculation") if(!is.element("sigma", namargs)) stop("need sigma if S is not specified") tFunc <- function(n) powMCT(n=n, ...) } targN(upperN=upperN, lowerN=lowerN, step=step, targFunc=tFunc, alRatio=alRatio, Ntype = Ntype, sumFct = sumFct) } #' Produce Trellis plot of targN object #' #' @param x,superpose,line.at,xlab,ylab arguments for the plot method of \samp{targN} and \samp{powN}, additional #' arguments are passed down to the low-level lattice plotting routines. #' #' @rdname sampSize #' @method plot targN #' @export plot.targN <- function(x, superpose = TRUE, line.at = NULL, xlab = NULL, ylab = NULL, ...){ nSeq <- as.integer(dimnames(x)[[1]]) alRatio <- attr(x, "alRatio") unbN <- (length(unique(alRatio)) > 1) if (is.null(xlab)) { if(attr(x, "Ntype") == "total" | unbN){ xlab <- "Overall sample size" nSeq <- sapply(nSeq, function(x){ sum(round(x*alRatio)) }) } else { xlab <- "Sample size per dose (balanced)" } } nams <- dimnames(x)[[2]] ## separating model data from summary data x <- as.data.frame(unclass(x)) nams <- names(x) nC <- ncol(x) pMatTr <- data.frame(targ = as.vector(unlist(x)), n = rep(nSeq, nC), type = factor(rep(nams, each = length(nSeq)), levels = nams)) if(superpose){ panelFunc1 <- function(x, y, subscripts, groups, lineAt, ...) { lattice::panel.grid(h = -1, v = -1, col = "lightgrey", lty = 2) if(!is.null(line.at)) lattice::panel.abline(h = lineAt, lty = 3, ..., col = "red") lattice::panel.superpose(x, y, subscripts, groups, ...) } trLn <- lattice::trellis.par.get("superpose.line")[c("col", "lwd", "lty")] for(i in seq(along = trLn)) { if(length(trLn[[i]]) > nC) trLn[[i]] <- trLn[[i]][1:nC] } ltplot <- lattice::xyplot(targ ~ n, pMatTr, groups = pMatTr$type, subscripts = TRUE, panel = panelFunc1, type = "l", lineAt = line.at, xlab = xlab, ylab = ylab, key = list(lines = trLn, text = list(lab = nams), transparent = TRUE, columns = ifelse(nC < 5, nC, min(4,ceiling(nC/min(ceiling(nC/4),3))))), ...) } else { # models in different panels panelFunc2 <- function(x, y, lineAt, ...) { lattice::panel.grid(h = -1, v = -1, col = "lightgrey", lty = 2) if(!is.null(line.at)) lattice::panel.abline(h = lineAt, lty = 3, ..., col = "red") ## used 2 for consistency with above lattice::panel.xyplot(x, y, ...) } ltplot <- lattice::xyplot(targ ~ n | type, pMatTr, panel = panelFunc2, type = "l", lineAt = line.at, xlab = xlab, ylab = ylab, strip = function(...) lattice::strip.default(..., style = 1), ...) } print(ltplot) } DoseFinding/R/bMCTtest.R0000644000176200001440000003603114762603270014466 0ustar liggesusers#' Performs Bayesian multiple contrast test #' #' This function performs a Bayesian multiple contrast test using normal mixture priors for the response on each dose, #' as proposed in Fleischer et al. (2022). For a general description of the multiple contrast test see #' \code{\link{MCTtest}}. #' #' If \samp{type = "normal"}, an ANCOVA model based on a homoscedastic normality assumption is fitted and posteriors for #' dose-response and contrast vectors are obtained assuming a known variance. #' #' For \samp{type = "general"} it is assumed multivariate normally distributed estimates are specified in \samp{resp} #' with covariance given by \samp{S}, which define the likelihood. Posteriors for dose-response and contrast vectors #' are then obtained assuming a known covariance matrix S #' #' The multiple contrast test decision is based on the maximum posterior probability of a contrast being greater than #' zero. Thresholds for the posterior probability can either be supplied or will be derived from frequentist critical #' values. In the latter case the Bayesian test will give approximately the same results as the frequentist multiple #' contrast test if uninformative priors are used. #' #' For the default calculation of optimal contrasts the prior information is ignored (i.e. contrasts are calculated in #' the same way as in \code{\link{MCTtest}}). Fleischer et al. (2022) discuss using contrasts that take the prior #' effective sample sizes into account, which can be slightly more favourable for the Bayesian MCT test. Such #' alternative contrasts can be directly handed over via the \samp{contMat} argument. #' #' For analysis with covariate adjustment, covariate-adjusted \samp{resp} and \samp{S} can be supplied together with #' using \samp{type = "general"}. See `vignette("binary_data")` vignette "Design and analysis template MCP-Mod for binary data" for an example #' on how to obtain covariate adjusted estimates. #' #' @inheritParams MCTtest #' @param prior List of length equal to the number of doses with the prior for each arm. Each element needs to be of #' class \samp{normMix} (See \samp{RBesT} package documentation). It is assumed that the i-th component of the prior #' list corresponds to the i-th largest dose. For example the first entry in the list is the prior for the placebo #' group, the second entry the prior for the second lowest dose and so on. Internally the priors across the different #' arms are combined (densities multiplied) assuming independence. The resulting multivariate normal mixture prior #' will have as many components as the product of the number of components of the individual mixture priors. The #' posterior mixture is part of the result object under "posterior". #' @param alpha Significance level for the frequentist multiple contrast test. If no critical values are supplied via #' \samp{critV} this is used to derive critical values for Bayesian decision rule. #' @param contMat Contrast matrix to apply to the posterior dose-response estimates. The contrasts need to be in the #' columns of the matrix (i.e. the column sums need to be 0). If not specified optimal contrasts are calculated using #' \code{\link{optContr}}. #' @param critV Supply a critical value for the maximum posterior probability of the contrasts being greater than zero #' that needs to be surpassed to establish a non-flat dose-response. If this argument is NULL, this will be derived #' from critical values for frequentist MCP-Mod using the provided \samp{alpha}. #' @return An object of class bMCTtest, a list containing the output. #' @author Marius Thomas #' @export #' @seealso \code{\link{MCTtest}}, \code{\link{optContr}} #' @references Fleischer, F., Bossert, S., Deng, Q., Loley, C. and Gierse, J. (2022). Bayesian MCP-Mod, #' \emph{Pharmaceutical Statistics}, \bold{21}, 654--670 #' @examples #' #' #' if (require("RBesT")) { #' #' ############################### #' ## Normal outcome #' ############################### #' #' data(biom) #' ## define shapes for which to calculate optimal contrasts #' doses <- c(0, 0.05, 0.2, 0.6, 1) #' modlist <- Mods(emax = 0.05, linear = NULL, logistic = c(0.5, 0.1), #' linInt = c(0, 1, 1, 1), doses = doses) #' ## specify an informative prior for placebo, weakly informative for other arms #' plc_prior <- mixnorm(inf = c(0.8, 0.4, 0.1), rob = c(0.2, 0.4, 10)) #' vague_prior <- mixnorm(c(1, 0, 10)) #' ## i-th component of the prior list corresponds to the i-th largest dose #' ## (e.g. 1st component -> placebo prior; last component prior for top dose) #' prior <- list(plc_prior, vague_prior, vague_prior, vague_prior, vague_prior) #' #' m1 <- bMCTtest(dose, resp, biom, models=modlist, prior = prior) #' ## now supply a critical value (= threshold for maxmimum posterior probability) #' m2 <- bMCTtest(dose, resp, biom, models=modlist, prior = prior, critV = 0.99) #' #' #################################### #' ## Binary outcome with covariates #' #################################### #'\dontrun{ #' ## generate data #' logit <- function(p) log(p / (1 - p)) #' inv_logit <- function(y) 1 / (1 + exp(-y)) #' doses <- c(0, 0.5, 1.5, 2.5, 4) #' #' ## set seed and ensure reproducibility across R versions #' set.seed(1, kind = "Mersenne-Twister", sample.kind = "Rejection", normal.kind = "Inversion") #' group_size <- 100 #' dose_vector <- rep(doses, each = group_size) #' N <- length(dose_vector) #' ## generate covariates #' x1 <- rnorm(N, 0, 1) #' x2 <- factor(sample(c("A", "B"), N, replace = TRUE, prob = c(0.6, 0.4))) #' ## assume approximately logit(10%) placebo and logit(35%) asymptotic response with ED50=0.5 #' prob <- inv_logit(emax(dose_vector, -2.2, 1.6, 0.5) + 0.3 * x1 + 0.3 * (x2 == "B")) #' dat <- data.frame(y = rbinom(N, 1, prob), #' dose = dose_vector, x1 = x1, x2 = x2) #' #' ## specify an informative prior for placebo (on logit scale), weakly informative for other arms #' plc_prior <- mixnorm(inf = c(0.8, -2, 0.5), rob = c(0.2, -2, 10)) #' vague_prior <- mixnorm(c(1, 0, 10)) #' prior <- list(plc_prior, vague_prior, vague_prior, vague_prior, vague_prior) #' #' ## candidate models #' mods <- Mods(emax = c(0.25, 1), sigEmax = rbind(c(1, 3), c(2.5, 4)), betaMod = c(1.1, 1.1), #' placEff = logit(0.1), maxEff = logit(0.35)-logit(0.1), #' doses = doses) #' #' fit_cov <- glm(y~factor(dose) + 0 + x1 + x2, data = dat, family = binomial) #' #' covariate_adjusted_estimates <- function(mu_hat, S_hat, formula_rhs, #' doses, other_covariates, n_sim) { #' ## predict every patient under *every* dose #' oc_rep <- as.data.frame(lapply(other_covariates, function(col) rep(col, times = length(doses)))) #' d_rep <- rep(doses, each = nrow(other_covariates)) #' pdat <- cbind(oc_rep, dose = d_rep) #' X <- model.matrix(formula_rhs, pdat) #' ## average on probability scale then backtransform to logit scale #' mu_star <- logit(tapply(inv_logit(X %*% mu_hat), pdat$dose, mean)) #' ## estimate covariance matrix of mu_star #' pred <- replicate(n_sim, logit(tapply(inv_logit(X %*% drop(mvtnorm::rmvnorm(1, mu_hat, S_hat))), #' pdat$dose, mean))) #' return(list(mu_star = as.numeric(mu_star), S_star = cov(t(pred)))) #' } #' #' ca <- covariate_adjusted_estimates(coef(fit_cov), vcov(fit_cov), ~factor(dose)+0+x1+x2, #' doses, dat[, c("x1", "x2")], 1000) #' bMCTtest(doses, ca$mu_star, S = ca$S_star, type = "general", models = mods, prior = prior) #'} #' ################################################ #' ## example with contrasts handed over #' ################################################ #' #' data(biom) #' ## define shapes for which to calculate optimal contrasts #' doses <- c(0, 0.05, 0.2, 0.6, 1) #' modlist <- Mods(emax = 0.05, linear = NULL, sigEmax = c(0.5, 5), #' linInt = c(0, 1, 1, 1), doses = doses) #' #' ## specify an informative prior for placebo, weakly informative for other arms #' plc_prior <- mixnorm(inf = c(0.8, 0.4, 0.1), rob = c(0.2, 0.4, 10), sigma = 0.7) #' vague_prior <- mixnorm(c(1, 0, 10), sigma = 0.7) #' prior <- list(plc_prior, vague_prior, vague_prior, vague_prior, vague_prior) #' #' ## use prior effective sample sizes to calculate optimal contrasts #' prior_ess <- unlist(lapply(prior, ess)) #' n_grp <- as.numeric(table(biom$dose)) #' weights <- n_grp + prior_ess #' cmat <- optContr(modlist, w = weights) #' #' bMCTtest(dose, resp, biom, models=modlist, prior = prior, contMat = cmat) #' } #' bMCTtest <- function (dose, resp, data = NULL, models, S = NULL, type = c("normal", "general"), prior, alpha = 0.025, na.action = na.fail, mvtcontrol = mvtnorm.control(), contMat = NULL, critV = NULL) { type <- match.arg(type) cal <- as.character(match.call()) lst <- checkAnalyArgs_bMCP(dose, resp, data, S, type, prior, na.action, cal) dd <- lst$dd type <- lst$type S <- lst$S doseNam <- lst$doseNam respNam <- lst$respNam doses <- unique(dd[[doseNam]]) k <- length(doses) if (type == "normal") { dd[, doseNam] <- as.factor(dd[, doseNam]) form <- paste(respNam, "~", doseNam, "+", "-1", sep = "") lm.fit <- lm(as.formula(form), data = dd) est <- coef(lm.fit)[1:k] vc <- vcov(lm.fit)[1:k, 1:k] } else { est <- dd[[respNam]] vc <- S } if (is.null(contMat)) { contMat <- optContr(models, doses, S=vc)$contMat rownames(contMat) <- doses } else { if (inherits(contMat, "optContr")) contMat <- contMat$contMat if (nrow(contMat) != length(est)) stop("contMat of incorrect dimensions") } ## calculate frequentist critical values if none supplied if(is.null(critV)){ covMat <- t(contMat) %*% vc %*% contMat corMat <- cov2cor(covMat) critV <- critVal(corMat, alpha, df = Inf, alternative = "one.sided", mvtcontrol) ## using df = INF so values are derived using multivariate normal critV <- pnorm(critV) attr(critV, "Calc") <- TRUE } else{ attr(critV, "Calc") <- FALSE } ## write complete multivariate normal specification for the prior n_comps <- unlist(lapply(prior, ncol)) args <- lapply(1:k, function(x) 1:n_comps[x]) comp_ind <- do.call("expand.grid", args) n_comps_prior <- nrow(comp_ind) prior_weight <- matrix(sapply(1:k, function(x) sapply(1:n_comps_prior, function(y) prior[[x]][1, comp_ind[y,x]])), nrow = n_comps_prior) prior_weight <- apply(prior_weight, 1, prod) prior_mean <- matrix(sapply(1:k, function(x) sapply(1:n_comps_prior, function(y) prior[[x]][2, comp_ind[y,x]])), nrow = n_comps_prior) prior_sd <- matrix(sapply(1:k, function(x) sapply(1:n_comps_prior, function(y) prior[[x]][3, comp_ind[y,x]])), nrow = n_comps_prior) prior_weight <- as.list(prior_weight) prior_mean <- asplit(prior_mean, 1) prior_vc <- lapply(asplit(prior_sd^2, 1), diag) prior_mix <- list(prior_weight, prior_mean, prior_vc) ## Bayesian conjugate posterior post_res <- mvpostmix(prior_mix, est, vc) mu_mat <- do.call(rbind, lapply(post_res[[2]], as.numeric)) ct <- t(contMat) %*% t(mu_mat) ## contrasts for each component (one candidate model per row) den <- lapply(post_res[[3]], function(x) t(contMat) %*% x %*% contMat) den <- sqrt(do.call(cbind, lapply(den, diag))) tStat <- ct/den dec_prob <- pnorm(tStat) %*% unlist(post_res[[1]]) res <- list(contMat = contMat, tStat = tStat, alpha = alpha, critVal = 1 - critV, posterior = post_res) attr(res$tStat, "pVal") <- dec_prob class(res) <- "bMCTtest" res } #' @export print.bMCTtest <- function(x, digits = 3, eps = 1e-3, ...){ cat("Bayesian MCP-Mod\n") cat("\n","Contrasts:","\n", sep="") print(round(x$contMat, digits)) cat("\n","Posterior Mixture Weights:","\n",sep="") w <- round(unlist(x$posterior[[1]]), digits = digits) names(w) <- paste("Comp.", 1:length(w)) print(w) ord <- rev(order(attr(x$tStat, "pVal"))) pval <- format.pval(attr(x$tStat, "pVal"), digits = digits, eps = eps) dfrm <- data.frame(round(x$tStat, digits)[ord, , drop = FALSE], pval[ord]) names(dfrm) <- c(paste0("Comp. ", 1:ncol(x$tStat)), "posterior probability") cat("\n","Bayesian t-statistics:","\n",sep="") print(dfrm) if(!is.null(x$critVal)){ cat("\n","Critical value (for maximum posterior probability): ", round(1- x$critVal, digits), sep="") if(attr(x$critVal, "Calc")){ cat(" (alpha = ", x$alpha,", one-sided) \n", sep="") } else { cat("\n") } } } #' Prior to posterior updating for a multivariate normal mixture #' #' Calculate conjugate posterior mixture of multivariate normals with known covariance matrix #' #' #' @param priormix Prior multivariate normal mixture given as a list of length 3. The first list entry contains the #' mixture weights, the second component the mean vectors and the third component of the list the covariance matrices. #' @param mu_hat estimated mean response for each dose #' @param S_hat estimated covariance matrix #' @return Returns a posterior multivariate normal mixture as a list of length 3, containing mixture weights, mean #' vectors and covariance matrices. #' @author Marius Thomas #' @references Bernardo, J. M., and Smith, A. F. (1994). Bayesian theory. John Wiley & Sons. #' @export mvpostmix <- function(priormix, mu_hat, S_hat) { logSumExp <- function(lx){ lm <- max(lx) lm + log(sum(exp(lx - lm))) } dataPrec <- solve(S_hat) priorPrec <- lapply(priormix[[3]], solve) postPrec <- lapply(priorPrec, function(x) x + dataPrec) SigmaPred <- lapply(priormix[[3]], function(x) x + S_hat) lw <- numeric(length(priormix[[1]])) postmix <- vector("list", 3) names(postmix) <- c("weights", "mean", "covmat") for(i in 1:3) postmix[[i]] <- vector("list", length(lw)) ## The posterior distribution is a mixture of multivariate normals with updated mixture weights. ## Posterior weights are updated based on the prior predictive (marginal) probabilities of the data under each ## component of the mixture. ## In the case of a MVN likelihood with known covariance and MVN priors for the mean the ## prior predictive distributions are MVN distribution with mean vectors equal to the prior components' mean vectors ## and covariance matrices which are the sum of the prior components' covariance matrices and the "known" covariance ## matrix of the data (for which S_hat is plugged in here) for(i in 1:length(lw)){ lw[i] <- log(priormix[[1]][[i]]) + mvtnorm::dmvnorm(mu_hat, priormix[[2]][[i]], SigmaPred[[i]], log = TRUE) postmix[[2]][[i]] <- solve(priorPrec[[i]] + dataPrec) %*% (priorPrec[[i]] %*% priormix[[2]][[i]] + dataPrec %*% mu_hat) postmix[[3]][[i]] <- solve(priorPrec[[i]] + dataPrec) } postmix[[1]] <- as.list(exp(lw - logSumExp(lw))) for(i in 1:3) names(postmix[[i]]) <- paste0("Comp", 1:length(lw)) postmix } DoseFinding/R/Mods_helpers.R0000644000176200001440000007067314762603270015437 0ustar liggesusers## functions related to creating, plotting candidate model sets modCount <- function(models, fullMod = FALSE){ ## counts the number of models in a candidate model-list if(!fullMod){ nr <- lapply(names(models), function(x){ xx <- models[[x]] if(is.null(xx)) return(1) if(is.element(x, c("emax", "quadratic", "exponential"))) return(length(xx)) if(is.element(x, c("sigEmax", "logistic", "betaMod"))) return(length(xx)/2) if(x == "linInt"){ if(is.vector(xx)) return(1) if(is.matrix(xx)) return(nrow(xx)) } }) } else { nr <- lapply(models, function(x){ if(is.vector(x)) return(1) if(is.matrix(x)) return(nrow(x)) }) } Reduce("+",nr) } getAddArgs <- function(addArgs, doses = NULL){ if(!is.null(doses)){ addArgs0 <- list(scal = 1.2*max(doses), off = 0.01*max(doses)) } else { addArgs0 <- list(scal = NULL, off = NULL) } if(!is.null(addArgs)){ if(!is.list(addArgs)) stop("addArgs needs to be of class list") namA <- names(addArgs) if(!all(namA %in% c("scal", "off"))) stop("addArgs need to have entries named scal and/or off") addArgs0[namA] <- addArgs if(length(addArgs0$scal) > 1 | length(addArgs0$off) > 1) stop("scal and/or off need to be of length 1") } list(scal=addArgs0$scal, off=addArgs0$off) } checkEntries <- function(modL, doses, fullMod){ biModels <- c("emax", "linlog", "linear", "quadratic", "exponential", "logistic", "betaMod", "sigEmax", "linInt") checkNam <- function(nam){ if(is.na(match(nam, biModels))) stop("Invalid model specified: ", nam) } checkStand <- function(nam){ pars <- modL[[nam]] ## checks for as many invalid values as possible if(!is.numeric(pars) & !is.null(pars)) stop("entries in Mods need to be of type: NULL, or numeric.\n", " invalid type specified for model ", nam) if((nam %in% c("linear", "linlog")) & !is.null(pars)) stop("For model ", nam, ", model entry needs to be equal to NULL") if((nam %in% c("emax", "sigEmax", "betaMod", "logistic", "exponential")) & any(pars <= 0)) stop("For model ", nam, " model entries needs to be positive") if((nam %in% c("emax", "exponential", "quadratic")) & is.matrix(nam)) stop("For model ", nam, " parameters need to specified in a vector") if((nam %in% c("sigEmax", "betaMod", "logistic"))){ if(is.matrix(pars)){ if(ncol(pars) != 2) stop("Matrix for ", nam, " model needs to have two columns") } if(length(pars)%%2 > 0) stop("Specified parameters need to be a multiple of two for ", nam, " model") } if(nam == "linInt"){ if(is.matrix(pars)){ len <- ncol(pars) } else { len <- length(pars) } if(len != (length(doses)-1)) stop("Need to provide guesstimates for each active dose. ", len, " specified, need ", length(doses)-1, ".") } } if(!fullMod){ lapply(names(modL), function(nam){ checkNam(nam) checkStand(nam) }) } else { lapply(names(modL), function(nam){ checkNam(nam) }) } } ## calculates parameters for all models in the candidate set returns a ## list with all model parameters. fullMod <- function(models, doses, placEff, maxEff, scal, off){ ## check for valid placEff and maxEff arguments nM <- modCount(models, fullMod = FALSE) if(length(placEff) > 1){ if(length(placEff) != nM) stop("placEff needs to be of length 1 or length equal to the number of models") } else { placEff <- rep(placEff, nM) } if(length(maxEff) > 1){ if(length(maxEff) != nM) stop("maxEff needs to be of length 1 or length equal to the number of models") } else { maxEff <- rep(maxEff, nM) } nodes <- doses # nodes parameter for linInt ## calculate linear parameters of models (with standardized ## parameters as in models), to achieve the specified placEff and maxEff complMod <- vector("list", length=length(models)) i <- 0;z <- 1 for(nm in names(models)){ pars <- models[[nm]] if(is.null(pars)){ ## linear and linlog Pars <- getLinPars(nm, doses, NULL, placEff[z], maxEff[z], off); i <- i+1; z <- z+1 } if(is.element(nm,c("emax", "exponential", "quadratic"))){ nmod <- length(pars) if(nmod > 1){ Pars <- matrix(ncol=3, nrow=nmod) for(j in 1:length(pars)){ tmp <- getLinPars(nm, doses, as.vector(pars[j]), placEff[z], maxEff[z]) Pars[j,] <- tmp z <- z+1 } colnames(Pars) <- names(tmp) rownames(Pars) <- 1:length(pars) i <- i+1 } else { Pars <- getLinPars(nm, doses, as.vector(pars), placEff[z], maxEff[z]) i <- i+1; z <- z+1 } } if(is.element(nm,c("logistic", "betaMod", "sigEmax"))){ if(is.matrix(pars)){ Pars <- matrix(ncol=4, nrow=nrow(pars)) for(j in 1:nrow(pars)){ tmp <- getLinPars(nm, doses, as.vector(pars[j,]), placEff[z], maxEff[z]) Pars[j,] <- tmp z <- z+1 } colnames(Pars) <- names(tmp) rownames(Pars) <- 1:nrow(pars) i <- i+1 } else { Pars <- getLinPars(nm, doses, as.vector(pars), placEff[z], maxEff[z]); i <- i+1; z <- z+1 } } if(nm == "linInt"){ if(is.matrix(pars)){ Pars <- matrix(ncol=length(nodes), nrow=nrow(pars)) for(j in 1:nrow(pars)){ Pars[j,] <- getLinPars(nm, doses, as.vector(pars[j,]), placEff[z], maxEff[z]) z <- z+1 } colnames(Pars) <- paste("d", doses, sep="") rownames(Pars) <- 1:nrow(pars) i <- i+1 } else { Pars <- getLinPars(nm, doses, as.vector(pars), placEff[z], maxEff[z]); i <- i+1; z <- z+1 names(Pars) <- paste("d", doses, sep="") } } complMod[[i]] <- Pars } names(complMod) <- names(models) complMod } plotModels <- function(models, nPoints = 200, superpose = FALSE, xlab = "Dose", ylab = "Model means", modNams = NULL, plotTD = FALSE, Delta, ...){ ## models is always assumed to be of class Mods doses <- nodes <- attr(models, "doses") placEff <- attr(models, "placEff") maxEff <- attr(models, "maxEff") off <- attr(models, "off") scal <- attr(models, "scal") if(!inherits(models, "Mods")) stop("\"models\" needs to be of class Mods") nM <- modCount(models, fullMod = TRUE) if(nM > 50) stop("too many models in Mods object to plot (> 50 models).") doseSeq <- sort(union(seq(min(doses), max(doses), length = nPoints), doses)) resp <- calcResp(models, doseSeq, off, scal, nodes) pdos <- NULL if(plotTD){ # also include TD in plot if(missing(Delta)) stop("need Delta, if \"plotTD = TRUE\"") ind <- maxEff > 0 if(length(unique(ind)) > 1) stop("inconsistent directions not possible, when \"plotTD = TRUE\"") direction <- ifelse(all(ind), "increasing", "decreasing") pdos <- TD(models, Delta, direction = direction) yax <- rep(ifelse(direction == "increasing", Delta, -Delta), length(pdos)) } if(length(placEff) == 1) placEff <- rep(placEff, nM) if(length(maxEff) == 1) maxEff <- rep(maxEff, nM) if(is.null(modNams)){ # use alternative model names nams <- dimnames(resp)[[2]] } else { if(length(modNams) != nM) stop("specified model-names in \"modNams\" of invalid length") nams <- modNams } modelfact <- factor(rep(nams, each = length(doseSeq)), levels = nams) if(superpose){ respdata <- data.frame(response = c(resp), dose = rep(doseSeq, ncol(resp)), model = modelfact) spL <- lattice::trellis.par.get("superpose.line") spL$lty <- rep(spL$lty, nM%/%length(spL$lty) + 1)[1:nM] spL$lwd <- rep(spL$lwd, nM%/%length(spL$lwd) + 1)[1:nM] spL$col <- rep(spL$col, nM%/%length(spL$col) + 1)[1:nM] ## data for plotting function within panel panDat <- list(placEff = placEff, maxEff = maxEff, doses = doses) ## number of columns nCol <- ifelse(nM < 5, nM, min(4,ceiling(nM/min(ceiling(nM/4),3)))) key <- list(lines = spL, transparent = TRUE, text = list(nams, cex = 0.9), columns = nCol) ltplot <- lattice::xyplot(response ~ dose, data = respdata, subscripts = TRUE, groups = respdata$model, panel.data = panDat, xlab = xlab, ylab = ylab, panel = function(x, y, subscripts, groups, ..., panel.data) { lattice::panel.grid(h=-1, v=-1, col = "lightgrey", lty=2) lattice::panel.abline(h = c(panel.data$placEff, panel.data$placEff + panel.data$maxEff), lty = 2) lattice::panel.superpose(x, y, subscripts, groups, type = "l", ...) ind <- !is.na(match(x, panel.data$doses)) lattice::panel.superpose(x[ind], y[ind], subscripts[ind], groups, ...) if(plotTD){ for(z in 1:length(pdos)){ lattice::panel.lines(c(0, pdos[z]), c(yax[z], yax[z]),lty=2, col=2) lattice::panel.lines(c(pdos[z], pdos[z]), c(0, yax[z]),lty=2, col=2) } }}, key = key, ...) } else { respdata <- data.frame(response = c(resp), dose = rep(doseSeq, ncol(resp)), model = modelfact) panDat <- list(placEff = placEff, maxEff = maxEff, doses = doses, pdos=pdos) ltplot <- lattice::xyplot(response ~ dose | model, data = respdata, panel.data = panDat, xlab = xlab, ylab = ylab, panel = function(x, y, ..., panel.data){ lattice::panel.grid(h=-1, v=-1, col = "lightgrey", lty=2) z <- lattice::panel.number() lattice::panel.abline(h = c(panel.data$placEff[z], panel.data$placEff[z] + panel.data$maxEff[z]), lty = 2) lattice::panel.xyplot(x, y, type = "l", ...) ind <- match(panel.data$doses, x) lattice::panel.xyplot(x[ind], y[ind], ...) if(plotTD){ if(direction == "increasing"){ delt <- Delta base <- panel.data$placEff[z] delt <- panel.data$placEff[z]+Delta } else { delt <- -Delta base <- panel.data$placEff[z]+panel.data$maxEff[z] delt <- panel.data$placEff[z]-Delta } lattice::panel.lines(c(0, pdos[z]), c(delt, delt), lty=2, col=2) lattice::panel.lines(c(pdos[z], pdos[z]), c(base, delt),lty=2, col=2) } }, strip = function(...) lattice::strip.default(..., style = 1), as.table = TRUE,...) } print(ltplot) } ## calculate target dose calcTD <- function(model, pars, Delta, TDtype = c("continuous", "discrete"), direction = c("increasing", "decreasing"), doses, off, scal, nodes){ ## calculate the smallest dose x for which ## f(x) > f(0) + Delta (increasing) or f(x) < f(0) - Delta (decreasing) ## => f0(x) > Delta (increasing) or f0(x) < - Delta (decreasing) (f0 effect-curve) ## need to multiply f0(x) (=slope parameter) with -1 then decreasing case ## can be covered equivalent to increasing case TDtype <- match.arg(TDtype) direction <- match.arg(direction) if(direction == "decreasing"){ ## transform problem to "increasing" case if(model == "linInt"){ pars <- -pars } else { pars[2] <- -pars[2] if(model == "quadratic") ## also need to negate pars[3] pars[3] <- -pars[3] } } if(model == "betaMod" & missing(scal)) stop("Need \"scal\" parameter for betaMod model") if(model == "linlog" & missing(off)) stop("Need \"off\" parameter for linlog model") if(model == "linInt"){ if(missing(nodes)) stop("Need \"nodes\" parameter for linlog model") if(length(nodes) != length(pars)) stop("nodes and pars of incompatible length") } if(TDtype == "continuous"){ ## calculate target dose analytically cf <- pars if(model == "linear"){ td <- Delta/cf[2] if(td > 0) return(td) return(NA) } if(model == "linlog"){ td <- off*exp(Delta/cf[2])-off if(td > 0) return(td) return(NA) } if(model == "quadratic"){ if(4*cf[3]*Delta+cf[2]^2 < 0) return(NA) d1 <- -(sqrt(4*cf[3]*Delta+cf[2]^2)+cf[2])/(2*cf[3]) d2 <- (sqrt(4*cf[3]*Delta+cf[2]^2)-cf[2])/(2*cf[3]) ind <- c(d1, d2) > 0 if(!any(ind)) return(NA) return(min(c(d1, d2)[ind])) } if(model == "emax"){ if(Delta > cf[2]) return(NA) return(Delta*cf[3]/(cf[2]-Delta)) } if(model == "logistic"){ if(Delta > cf[2] * (1 - logistic(0, 0, 1, cf[3], cf[4]))) return(NA) .tmp1 <- exp(cf[3]/cf[4]) num <- .tmp1*cf[2]-Delta*.tmp1-Delta den <- cf[2]+Delta*.tmp1+Delta return(cf[3]-cf[4]*log(num/den)) } if(model == "sigEmax"){ if(Delta > cf[2]) return(NA) return((Delta*cf[3]^cf[4]/(cf[2]-Delta))^(1/cf[4])) } if(model == "betaMod"){ if(Delta > cf[2]) return(NA) func <- function(x, Emax, delta1, delta2, scal, Delta){ betaMod(x, 0, 1, delta1, delta2, scal)-Delta/Emax } mode <- cf[3]/(cf[3]+cf[4])*scal out <- uniroot(func, lower=0, upper=mode, delta1=cf[3], delta2=cf[4], Emax=cf[2], scal=scal, Delta=Delta)$root return(out) } if(model == "exponential"){ if(Delta/cf[2] < 0) ## wrong direction return(NA) return(cf[3]*log(Delta/cf[2]+1)) } if(model == "linInt"){ inds <- cf < cf[1] + Delta if(all(inds)) return(NA) ind <- min((1:length(cf))[!inds])-1 tmp <- (cf[1]+Delta-cf[ind])/(cf[ind+1]-cf[ind]) td <- nodes[ind] + tmp*(nodes[ind+1]-nodes[ind]) if(td > 0) return(td) else return(NA) } } if(TDtype == "discrete"){ if(missing(doses)) stop("For TDtype = \"discrete\" need the possible doses in doses argument") if(!any(doses == 0)) stop("need placebo dose for TD calculation") if(model == "betaMod") pars <- c(pars, scal) if(model == "linlog") pars <- c(pars, off) doses <- sort(doses) if(model != "linInt"){ resp <- do.call(model, c(list(doses), as.list(pars))) } else { resp <- do.call(model, c(list(doses), as.list(list(pars, nodes)))) } ind <- resp >= resp[1] + Delta if(any(ind)){ ## TD does exist return smallest dose fulfilling threshold return(min(doses[ind])) } else { return(NA) } } } ## calculate gradient of target dose calcTDgrad <- function(model, pars, Delta, direction = c("increasing", "decreasing"), off, scal, nodes){ direction <- match.arg(direction) if(direction == "decreasing"){ ## transform problem to "increasing" case Delta <- -Delta ## TD is smallest x so that: } ## f(x) = f(0) + Delta (incr), f(x) = f(0) - Delta (decr) cf <- pars if(model == "linear") return(c(0, -Delta/cf[2]^2)) if(model == "linlog"){ ## version assuming off unknown ##c(0, -Delta*off*exp(Delta/cf[2])/cf[2]^2, exp(Delta/cf[2])-1) return(c(0, -Delta*off*exp(Delta/cf[2])/cf[2]^2)) } if(model == "quadratic"){ squrt <- sqrt(4*Delta*cf[3]+cf[2]^2) .p1 <- -(squrt-cf[2])/(2*cf[3]*squrt) .p2 <- cf[2]*squrt-2*Delta*cf[3]-cf[2]^2 .p2 <- .p2/(2*cf[3]^2*squrt) return(c(0, .p1, .p2)) } if(model == "emax"){ .p1 <- -Delta*cf[3]/(cf[2]-Delta)^2 .p2 <- -Delta/((Delta/cf[2]-1)*cf[2]) return(c(0, .p1, .p2)) } if(model == "logistic"){ et2t3 <- exp(cf[3]/cf[4]) t1 <- (1/(1+et2t3)+Delta/cf[2]) t2 <- (1/t1-1) .p1 <- -Delta*cf[4]/(cf[2]^2*t1^2*t2) .p2 <- 1-et2t3/((et2t3+1)^2*t1^2*t2) .p3 <- cf[3]*et2t3/(cf[4]*(et2t3+1)^2*t1^2*t2)-log(t2) return(c(0, .p1, .p2, .p3)) } if(model == "sigEmax"){ brack <- (-Delta*cf[3]^cf[4]/(Delta-cf[2]))^(1/cf[4]) .p1 <- brack/((Delta-cf[2])*cf[4]) .p2 <- brack/cf[3] .p3 <- brack*(log(cf[3])/cf[4]-log((-Delta*cf[3]^cf[4])/(Delta-cf[2]))/cf[4]^2) return(c(0, .p1, .p2, .p3)) } if(model == "betaMod"){ h0 <- function(cf, scal, Delta){ func <- function(x, delta1, delta2, Emax, scal, Delta){ betaMod(x, 0, 1, delta1, delta2, scal)-Delta/Emax } mode <- cf[3]/(cf[3]+cf[4])*scal uniroot(func, lower=0, upper=mode, delta1=cf[3], delta2=cf[4], Emax=cf[2], scal=scal, Delta=Delta)$root } td <- h0(cf, scal, Delta) ## calculate target dose .p1 <- -td*(scal-td)/(cf[2]*(cf[3]*(scal-td)-cf[4]*td)) .p2 <- .p1*cf[2]*(log(td/scal)+log(cf[3]+cf[4])-log(cf[3])) .p3 <- .p1*cf[2]*(log(1-td/scal)+log(cf[3]+cf[4])-log(cf[4])) return(c(0, .p1, .p2, .p3)) } if(model == "exponential"){ .p1 <- -Delta*cf[3]/(cf[2]*Delta+cf[2]^2) .p2 <- log(Delta/cf[2] + 1) return(c(0, .p1, .p2)) } if(model == "linInt"){ stop("linInt model not implemented") ## ## the below should be correct ## out <- numeric(length(cf)) ## indx <- 1:max(which(cf==max(cf))) ## ind <- max(indx[cf[indx] < cf[1] + Delta]) ## out[1] <- 1/(cf[ind+1]-cf[ind]) ## out[ind] <- -1/(cf[ind+1]-cf[ind]) ## out[ind+1] <- -(cf[1]+Delta-cf[ind])/(cf[ind+1]-cf[ind])^2 ## return(out*(nodes[ind+1]-nodes[ind])) } } calcED <- function(model, pars, p, maxD, EDtype = c("continuous", "discrete"), doses, off, scal, nodes){ ## calculate the smallest dose x for which ## f(x) > f(0) + p*(f(xmax)-f(0)) ## e.g. the EDp within the observed dose-range EDtype <- match.arg(EDtype) if(model == "betaMod" & missing(scal)) stop("Need \"scal\" parameter for betaMod model") if(model == "linlog" & missing(off)) stop("Need \"off\" parameter for linlog model") if(model == "linInt"){ if(missing(nodes)) stop("Need \"nodes\" parameter for linlog model") if(length(nodes) != length(pars)) stop("nodes and pars of incompatible length") } if(EDtype == "continuous"){ ## calculate target dose analytically cf <- pars if(cf[2] == 0 & model != "linInt"){ return(NA) } if(model == "linear"){ return(p*maxD) } if(model == "linlog"){ return(off*(exp(p*(log(maxD+off)-log(off)))-1)) } if(model == "exponential"){ return(cf[3]*log(p*exp(maxD/cf[3])-p+1)) } if(model == "emax"){ return(p*cf[3]*maxD/((1-p)*maxD+cf[3])) } if(model == "logistic"){ res1 <- ((p-1)*exp(maxD/cf[4]+cf[3]/cf[4])-exp(2*cf[3]/cf[4])-p*exp(cf[3]/cf[4])) res2 <- ((p*exp(cf[3]/cf[4])+1)*exp(maxD/cf[4])+(1-p)*exp(cf[3]/cf[4])) return(cf[3]-cf[4]*log(-res1/res2)) } if(model == "sigEmax"){ out <- p*cf[3]^cf[4]*maxD^cf[4]/((1-p)*maxD^cf[4]+cf[3]^cf[4]) return(out^(1/cf[4])) } if(model == "quadratic"){ mode <- -pars[2]/(2*pars[3]) if(mode > maxD | mode < 0) ## maximum outside dose range mode <- maxD const <- pars[2]*mode+pars[3]*mode^2 d1 <- -(sqrt(4*pars[3]*const*p+pars[2]^2)+pars[2])/pars[3]/2.0 d2 <- (sqrt(4*pars[3]*const*p+pars[2]^2)-pars[2])/pars[3]/2.0 ind <- c(d1, d2) > 0 if(!any(ind)) return(NA) return(min(c(d1, d2)[ind])) } if(model == "betaMod"){ func <- function(x, Emax, delta1, delta2, scal, p, mode){ p - betaMod(x, 0, 1, delta1, delta2, scal)/betaMod(mode, 0, 1, delta1, delta2, scal) } mode <- cf[3]/(cf[3]+cf[4])*scal out <- uniroot(func, lower=0, upper=mode, delta1=cf[3], delta2=cf[4], Emax=cf[2], scal=scal, p=p, mode = mode)$root return(out) } if(model == "linInt"){ dif <- cf-cf[1] ind <- which.max(abs(dif)) maxEff <- abs(dif)[ind] if(dif[ind] > 0){ direc <- "increasing" } else { direc <- "decreasing" } out <- calcTD("linInt", cf, Delta=p*maxEff, TDtype="continuous", direction = direc, off=off, scal=scal, nodes=nodes) return(out) } } if(EDtype == "discrete"){ ## use calcTD function if(missing(doses)) stop("For EDtype = \"discrete\" need the possible doses in doses argument") if(!any(doses == 0)) stop("need placebo dose for ED calculation") if(any(doses > maxD)) stop("Doses provided may not exceed the observed dose range") doseSeq <- unique(c(sort(doses), maxD)) if(model != "linInt"){ if(model == "betaMod") pars <- c(pars, scal) if(model == "linlog") pars <- c(pars, off) resp0 <- do.call(model, c(list(0), as.list(pars))) resp <- abs(do.call(model, c(list(doseSeq), as.list(pars)))-resp0) } else { resp0 <- do.call(model, c(list(0), as.list(list(pars, nodes)))) resp <- abs(do.call(model, c(list(doseSeq), as.list(list(pars, nodes))))-resp0) } ## calculate maximum response if(model %in% c("betaMod", "quadratic")){ func2 <- function(x){ resp0 <- do.call(model, c(list(0), as.list(pars))) abs(do.call(model, c(list(x), as.list(pars)))-resp0) } opt <- optimize(func2, range(doseSeq), maximum=TRUE) maxResp <- opt$objective } else { maxResp <- max(resp) } } ind <- which(resp > p*maxResp) if(length(ind) == 0) return(NA) edose <- min(doseSeq[ind]) if (EDtype == "continuous" | edose %in% doses) {## don't return maxD if it was not in originally provided doses for discrete type return(edose) } else { return(NA) } } calcEDgrad <- function(model, pars, maxD, p, off, scal, nodes){ cf <- pars if(model == "linear") return(c(0,0)) if(model == "linlog"){ return(c(0,0)) } if(model == "emax"){ p <- (1-p)*p*maxD^2/(p*maxD-maxD-cf[3])^2 return(c(0, 0, p)) } if(model == "exponential"){ p <- log(p*exp(maxD/cf[3])-p+1)-p*maxD*exp(maxD/cf[3])/(cf[3]*(p*exp(maxD/cf[3])-p+1)) return(c(0, 0, p)) } ## for other models calculate gradient numerically (formulas more complicated) if(model == "linInt"){ stop("linInt model not implemented") } avail <- requireNamespace("numDeriv", quietly = TRUE) if(!avail) stop("Need suggested package numDeriv for this calculation") func0 <- function(pars, model, p, maxD, off, scal){ calcED(model, pars, p, maxD, EDtype = "continuous", off=off, scal=scal) } scal0 <- off0 <- NULL if(model == "betaMod") scal0 <- scal if(model == "linlog") off0 <- off numDeriv::grad(func0, pars, model=model, p=p, maxD=maxD, off=off, scal=scal) } calcResp <- function(models, doses, off, scal, nodes){ ## generate response vectors for models and guesstimates in "models" ## models - candidate model list of class Mods nModels <- length(models) # number of model elements parList <- val <- vector("list", modCount(models, fullMod = TRUE)) k <- 1 nams <- character() for(nm in names(models)) { pars <- models[[nm]] if (!is.null(pars) && !is.numeric(pars)) { stop("elements of \"models\" must be NULL or numeric") } if (is.matrix(pars)) { # multiple models nmod <- nrow(pars) # number of models if(nm == "linlog") pars <- cbind(pars, off) if(nm == "betaMod") pars <- cbind(pars, scal) ind <- 1:nmod nams <- c(nams, paste(nm, ind, sep = "")) for(j in 1:nmod) { if(nm != "linInt"){ val[[k]] <- do.call(nm, c(list(doses), as.list(pars[j,]))) } else { val[[k]] <- linInt(doses, pars[j,], nodes) } parList[[k]] <- pars[j,] k <- k + 1 } } else { # single model if(nm == "linlog") pars <- c(pars, off) if(nm == "betaMod") pars <- c(pars, scal) nams <- c(nams, nm) if(nm != "linInt"){ val[[k]] <- do.call(nm, c(list(doses), as.list(pars))) } else { val[[k]] <- linInt(doses, pars, nodes) } parList[[k]] <- pars k <- k + 1 } } muMat <- do.call("cbind", val) dimnames(muMat) <- list(doses, nams) names(parList) <- nams attr(muMat, "parList") <- parList muMat } ## calculates the location and scale parameters corresponding to ## given placEff, maxEff, and guesstimates getLinPars <- function(model, doses, guesstim, placEff, maxEff, off, scal){ if(model == "linear"){ e1 <- maxEff/max(doses) return(c(e0=placEff, delta=e1)) } if(model == "linlog"){ e1 <- maxEff/(log(max(doses) + off) - log(off)) return(c(e0=(placEff-e1*log(off)), delta=e1)) } if(model == "quadratic"){ dMax <- 1/(-2*guesstim) b1 <- maxEff/(dMax + guesstim*dMax^2) b2 <- guesstim * b1 return(c(e0=placEff, b1=b1, b2=b2)) } if(model == "emax"){ emax.p <- maxEff * (guesstim + max(doses))/max(doses) return(c(e0=placEff, eMax=emax.p, ed50=guesstim)) } if(model == "exponential"){ e1 <- maxEff/(exp(max(doses)/guesstim) - 1) e0 <- placEff return(c(e0=e0, e1=e1, delta=guesstim)) } if(model == "logistic"){ emax.p <- maxEff/ (logistic(max(doses),0,1, guesstim[1], guesstim[2]) - logistic(0, 0, 1, guesstim[1], guesstim[2])) e0 <- placEff-emax.p*logistic(0,0,1,guesstim[1], guesstim[2]) return(c(e0=e0, eMax=emax.p, ed50=guesstim[1], delta=guesstim[2])) } if(model == "betaMod"){ return(c(e0=placEff, eMax=maxEff, delta1=guesstim[1], delta2=guesstim[2])) } if(model == "sigEmax"){ ed50 <- guesstim[1] h <- guesstim[2] dmax <- max(doses) eMax <- maxEff*(ed50^h+dmax^h)/dmax^h return(c(e0 = placEff, eMax = eMax, ed50 = ed50, h = h)) } if(model == "linInt"){ ind <- which.max(abs(guesstim)) return(c(placEff, placEff+maxEff*guesstim/guesstim[ind])) } } getModNams <- function(parList){ ## extract model names with parameter values nM <- length(parList) mod_nams <- names(parList) for(i in 1:nM){ if(startsWith(mod_nams[i], "linlog")) mod_nams[i] <- sprintf("linlog (off=%s)", parList[[i]][3]) if(startsWith(mod_nams[i], "emax")) mod_nams[i] <- sprintf("emax (ED50=%s)", parList[[i]][3]) if(startsWith(mod_nams[i], "exponential")) mod_nams[i] <- sprintf("exponential (delta=%s)", parList[[i]][3]) if(startsWith(mod_nams[i], "quadratic")) mod_nams[i] <- sprintf("quadratic (delta=%s)", parList[[i]][3]/parList[[i]][2]) if(startsWith(mod_nams[i], "sigEmax")) mod_nams[i] <- sprintf("sigEmax (ED50=%s,h=%s)", parList[[i]][3], parList[[i]][4]) if(startsWith(mod_nams[i], "logistic")) mod_nams[i] <- sprintf("logistic (ED50=%s,delta=%s)", parList[[i]][3], parList[[i]][4]) if(startsWith(mod_nams[i], "betaMod")) mod_nams[i] <- sprintf("betaMod (delta1=%s,delta2=%s,scal=%s)", parList[[i]][3], parList[[i]][4], parList[[i]][5]) if(startsWith(mod_nams[i], "linInt")) mod_nams[i] <- sprintf("linInt (%s)", paste0(parList[[i]], collapse=",")) } mod_nams }DoseFinding/R/Mods.R0000644000176200001440000006212114762603270013702 0ustar liggesusers## functions related to creating, plotting candidate model sets #' Define dose-response models #' #' The Mods functions allows to define a set of dose-response models. The function is used as input object for a number #' of other different functions. #' #' The dose-response models used in this package (see \code{\link{drmodels}} for details) are of form #' #' \deqn{f(d) = \theta_0+\theta_1 f^0(d,\theta_2)}{f(d) = theta0+theta1 #' f0(d,theta2)} #' #' where the parameter \eqn{\theta_2}{theta2} is the only non-linear parameter and can be one- or two-dimensional, #' depending on the used model. #' #' One needs to hand over the effect at placebo and the maximum effect in the dose range, from which #' \eqn{\theta_0,\theta_1}{theta0,theta1} are then back-calculated, the output object is of class \samp{"Mods"}. This #' object can form the input for other functions to extract the mean response (\samp{getResp}) or target doses #' (\code{\link{TD}} and \code{\link{ED}}) corresponding to the models. It is also needed as input to the functions #' \code{\link{powMCT}}, \code{\link{optDesign}} #' #' Some models, for example the beta model (\samp{scal}) and the linlog model (\samp{off}) have parameters that are not #' estimated from the data, they need to be specified via the \samp{addArgs} argument. #' #' The default plot method for \samp{Mods} objects is based on a plot using the \samp{lattice} package for backward #' compatibility. The function \samp{plotMods} function implements a plot using the \samp{ggplot2} package. #' #' NOTE: If a decreasing effect is beneficial for the considered response #' variable it needs to specified here, either by using \samp{direction = #' "decreasing"} or by specifying a negative "maxEff" argument. #' #' #' @aliases Mods getResp plot.Mods plotMods #' @param ... In function Mods:\cr Dose-response model names with parameter values specifying the guesstimates for the #' \eqn{\theta_2}{theta2} parameters. See \code{\link{drmodels}} for a complete list of dose-response models #' implemented. See below for an example specification.\cr \cr In function plot.Mods:\cr Additional arguments to the #' \samp{xyplot} call. #' @param doses Dose levels to be used, this needs to include placebo. #' @param addArgs List containing two entries named "scal" and "off" for the "betaMod" and "linlog". When addArgs is #' NULL the following defaults are used \samp{list(scal = 1.2*max(doses), off = 0.01*max(doses), nodes = doses)}. #' @param fullMod Logical determining, whether the model parameters specified in the Mods function (via the ... #' argument) should be interpreted as standardized or the full model parameters. #' @param placEff,maxEff Specify used placebo effect and the maximum effect over placebo. Either a numeric vector of #' the same size as the number of candidate models or of length one.\cr When these parameters are not specified #' \samp{placEff = 0} is assumed, for \samp{maxEff = 1} is assumed, if \samp{direction = "increasing"} and #' \samp{maxEff = -1} is assumed, for \samp{direction = "decreasing"}. #' @param direction Character determining whether the beneficial direction is \samp{increasing} or \samp{decreasing} #' with increasing dose levels. This argument is ignored if \samp{maxEff} is specified. #' @return Returns an object of class \samp{"Mods"}. The object contains the specified model parameter values and the #' derived linear parameters (based on \samp{"placEff"} and \samp{"maxEff"}) in a list. #' @author Bjoern Bornkamp #' @seealso \code{\link{Mods}}, \code{\link{drmodels}}, \code{\link{optDesign}}, \code{\link{powMCT}} #' @references Pinheiro, J. C., Bornkamp, B., and Bretz, F. (2006). Design and analysis of dose finding studies #' combining multiple comparisons and modeling procedures, \emph{Journal of Biopharmaceutical Statistics}, \bold{16}, #' 639--656 #' @examples #' #' ## Example on how to specify candidate models #' #' ## Suppose one would like to use the following models with the specified #' ## guesstimates for theta2, in a situation where the doses to be used are #' ## 0, 0.05, 0.2, 0.6, 1 #' #' ## Model guesstimate(s) for theta2 parameter(s) (name) #' ## linear - #' ## linear in log - #' ## Emax 0.05 (ED50) #' ## Emax 0.3 (ED50) #' ## exponential 0.7 (delta) #' ## quadratic -0.85 (delta) #' ## logistic 0.4 0.09 (ED50, delta) #' ## logistic 0.3 0.1 (ED50, delta) #' ## betaMod 0.3 1.3 (delta1, delta2) #' ## sigmoid Emax 0.5 2 (ED50, h) #' ## linInt 0.5 0.75 1 1 (perc of max-effect at doses) #' ## linInt 0.5 1 0.7 0.5 (perc of max-effect at doses) #' #' ## for the linInt model one specifies the effect over placebo for #' ## each active dose. #' ## The fixed "scal" parameter of the betaMod is set to 1.2 #' ## The fixed "off" parameter of the linlog is set to 0.1 #' ## These (standardized) candidate models can be specified as follows #' #' models <- Mods(linear = NULL, linlog = NULL, emax = c(0.05, 0.3), #' exponential = 0.7, quadratic = -0.85, #' logistic = rbind(c(0.4, 0.09), c(0.3, 0.1)), #' betaMod = c(0.3, 1.3), sigEmax = c(0.5, 2), #' linInt = rbind(c(0.5, 0.75, 1, 1), c(0.5, 1, 0.7, 0.5)), #' doses = c(0, 0.05, 0.2, 0.6, 1), #' addArgs = list(scal=1.2, off=0.1)) #' ## "models" now contains the candidate model set, as placEff, maxEff and #' ## direction were not specified a placebo effect of 0 and an effect of 1 #' ## is assumed #' #' ## display of specified candidate set using default plot (based on lattice) #' plot(models) #' ## display using ggplot2 #' plotMods(models) #' #' ## example for creating a candidate set with decreasing response #' doses <- c(0, 10, 25, 50, 100, 150) #' fmodels <- Mods(linear = NULL, emax = 25, #' logistic = c(50, 10.88111), exponential = 85, #' betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), #' linInt = rbind(c(0, 1, 1, 1, 1), #' c(0, 0, 1, 1, 0.8)), #' doses=doses, placEff = 0.5, maxEff = -0.4, #' addArgs=list(scal=200)) #' plot(fmodels) #' plotMods(fmodels) #' ## some customizations (different model names, symbols, line-width) #' plot(fmodels, lwd = 3, pch = 3, cex=1.2, col="red", #' modNams = paste("mod", 1:8, sep="-")) #' #' ## for a full-model object one can calculate the responses #' ## in a matrix #' getResp(fmodels, doses=c(0, 20, 100, 150)) #' #' ## calculate doses giving an improvement of 0.3 over placebo #' TD(fmodels, Delta=0.3, direction = "decreasing") #' ## discrete version #' TD(fmodels, Delta=0.3, TDtype = "discrete", doses=doses, direction = "decreasing") #' ## doses giving 50% of the maximum effect #' ED(fmodels, p=0.5) #' ED(fmodels, p=0.5, EDtype = "discrete", doses=doses) #' #' plot(fmodels, plotTD = TRUE, Delta = 0.3) #' #' ## example for specifying all model parameters (fullMod=TRUE) #' fmods <- Mods(emax = c(0, 1, 0.1), linear = cbind(c(-0.4,0), c(0.2,0.1)), #' sigEmax = c(0, 1.1, 0.5, 3), #' doses = 0:4, fullMod = TRUE) #' getResp(fmods, doses=seq(0,4,length=11)) #' ## calculate doses giving an improvement of 0.3 over placebo #' TD(fmods, Delta=0.3) #' ## discrete version #' TD(fmods, Delta=0.3, TDtype = "discrete", doses=0:4) #' ## doses giving 50% of the maximum effect #' ED(fmods, p=0.5) #' ED(fmods, p=0.5, EDtype = "discrete", doses=0:4) #' plot(fmods) #' @export Mods <- function(..., doses, placEff = 0, maxEff, direction = c("increasing", "decreasing"), addArgs = NULL, fullMod = FALSE){ if(missing(doses)) stop("Need to specify dose levels") doses <- sort(doses) if(doses[1] < -.Machine$double.eps ^ 0.5) stop("Only dose-levels >= 0 allowed") if(abs(doses[1]) > .Machine$double.eps ^ 0.5) stop("Need to include placebo dose") ## check for adequate addArgs lst <- getAddArgs(addArgs, doses) if(lst$scal < max(doses)) stop("\"scal\" parameter needs to be >= max(doses)") if(lst$scal < 0) stop("\"scal\" parameter needs to be positive") if(lst$off < 0) stop("\"off\" parameter needs to be positive") ## obtain model list modL <- list(...) nams <- names(modL) ## perform some simple check for a valid standModel list if(length(nams) != length(unique(nams))) stop("only one list entry allowed for each model class") checkEntries(modL, doses, fullMod) if(!fullMod){ ## assume standardized models direction <- match.arg(direction) if (missing(maxEff)) maxEff <- ifelse(direction == "increasing", 1, -1) modL <- fullMod(modL, doses, placEff, maxEff, lst$scal, lst$off) } else { ## calculate placEff and maxEff from model pars. For unimodal ## models maxEff determination might fail if the dose with maximum ## efficacy is not among those used! resp <- calcResp(modL, doses, lst$off, lst$scal, lst$nodes) placEff <- resp[1,] maxEff <- apply(resp, 2, function(x){ difs <- x-x[1] indMax <- which.max(difs) indMin <- which.min(difs) if(difs[indMax] > 0) return(difs[indMax]) if(difs[indMin] < 0) return(difs[indMin]) }) } attr(modL, "placEff") <- placEff attr(modL, "maxEff") <- maxEff direc <- unique(ifelse(maxEff > 0, "increasing", "decreasing")) if(length(direc) > 1) stop("Inconsistent direction of effect specified in maxEff") attr(modL, "direction") <- direc class(modL) <- "Mods" attr(modL, "doses") <- doses attr(modL, "scal") <- lst$scal attr(modL, "off") <- lst$off return(modL) } #' Extract mean response from set of dose-response models #' #' @inheritParams Mods #' @param fmodels An object of class Mods #' #' @rdname Mods #' @export getResp <- function(fmodels, doses){ ## convenience function for getting the mean responses of ## the models in a Mods object (output in matrix) if(!inherits(fmodels, "Mods")) stop("\"fmodels\" needs to be of class Mods") if(missing(doses)) doses <- attr(fmodels, "doses") off <- attr(fmodels, "off") scal <- attr(fmodels, "scal") nodes <- attr(fmodels, "doses") calcResp(fmodels, doses, off=off, scal=scal, nodes=nodes) } #' Plot dose-response models using ggplot #' #' @param ModsObj For function \samp{plotMods} the \samp{ModsObj} should contain an object of class \samp{Mods}. #' @param trafo For function \samp{plotMods} there is the option to plot the candidate model set on a transformed scale #' (e.g. probability scale if the candidate models are formulated on log-odds scale). The default for \samp{trafo} is #' the identity function. #' @param nPoints Number of points for plotting #' @param superpose Logical determining, whether model plots should be superposed #' @param xlab,ylab Label for y-axis and x-axis. #' @param modNams When \samp{modNams == NULL}, the names for the panels are determined by the underlying model #' functions, otherwise the contents of \samp{modNams} are used. #' #' @rdname Mods #' @export plotMods <- function(ModsObj, nPoints = 200, superpose = FALSE, xlab = "Dose", ylab = "Model means", modNams = NULL, trafo = function(x) x){ ## candidate model plot using ggplot2 ## check for class Mods if(!inherits(ModsObj, "Mods")) stop("\"ModsObj\" needs to be of class Mods") doses <- nodes <- attr(ModsObj, "doses") placEff <- attr(ModsObj, "placEff") maxEff <- attr(ModsObj, "maxEff") off <- attr(ModsObj, "off") scal <- attr(ModsObj, "scal") nM <- modCount(ModsObj, fullMod = TRUE) if(nM > 50) stop("too many models in Mods object to plot (> 50 models).") doseSeq <- sort(union(seq(min(doses), max(doses), length = nPoints), doses)) resp <- calcResp(ModsObj, doseSeq, off, scal, nodes) resp <- trafo(resp) if(is.null(modNams)){ # use default model names parList <- attr(resp, "parList") mod_nams <- getModNams(parList) } else { # use specified model names if(length(modNams) != nM) stop("specified model-names in \"modNams\" of invalid length") mod_nams <- modNams } modelfact <- factor(rep(mod_nams, each = length(doseSeq)), levels = mod_nams) respdata <- data.frame(response = c(resp), dose = rep(doseSeq, ncol(resp)), model = modelfact) if(superpose){ pp <- ggplot2::ggplot(respdata, ggplot2::aes(x=.data$dose, y=.data$response, col=.data$model))+ ggplot2::geom_line(size=1.2)+ ggplot2::theme_bw()+ ggplot2::theme(legend.position = "top", legend.title = ggplot2::element_blank()) } else { pp <- ggplot2::ggplot(respdata, ggplot2::aes(x=.data$dose, y=.data$response))+ ggplot2::geom_line(size=1.2)+ ggplot2::theme_bw()+ ggplot2::facet_wrap(~model, labeller = ggplot2::label_wrap_gen()) } resp2 <- calcResp(ModsObj, doses, off, scal, nodes) resp2 <- trafo(resp2) modelfact2 <- factor(rep(mod_nams, each = length(doses)), levels = mod_nams) respdata2 <- data.frame(response = c(resp2), dose = rep(doses, ncol(resp)), model = modelfact2) pp + ggplot2::geom_point(ggplot2::aes(x=.data$dose, y=.data$response), size=1.8, data=respdata2) + ggplot2::xlab(xlab) + ggplot2::ylab(ylab) } #' Plot dose-response models #' #' @inheritParams plotMods #' @param Delta Delta: The target effect size use for the target dose (TD) #' (Delta should be > 0). #' @param x Object of class Mods with type Mods #' @param plotTD \samp{plotTD} is a logical determining, whether the TD should #' be plotted. \samp{Delta} is the target effect to estimate for the TD. #' #' @rdname Mods #' @method plot Mods #' @export plot.Mods <- function(x, nPoints = 200, superpose = FALSE, xlab = "Dose", ylab = "Model means", modNams = NULL, plotTD = FALSE, Delta, ...){ plotModels(x, nPoints = nPoints, superpose = superpose, xlab = xlab, ylab = ylab, modNams = modNams, plotTD = plotTD, Delta, ...) } #' Calculate dose estimates for a fitted dose-response model (via \code{\link{fitMod}}, \code{\link{bFitMod}}) #' or \code{\link{maFitMod}}) or a \code{\link{Mods}} object #' #' @description The TD (target dose) is defined as the dose that achieves a target effect of Delta over placebo (if #' there are multiple such doses, the smallest is chosen): #' #' \deqn{TD_\Delta = \min \{x|f(x) > f(0)+\Delta\}}{TD = min {x|f(x) > f(0)+Delta}} #' #' If a decreasing trend is beneficial the definition of the TD is #' #' \deqn{TD_\Delta = \min \{x|f(x) < f(0)-\Delta\}}{TD = min {x|f(x) < f(0)-Delta}} #' #' When \eqn{\Delta}{Delta} is the clinical relevance threshold, then the TD is similar to the usual definition of the #' minimum effective dose (MED). #' #' The ED (effective dose) is defined as the dose that achieves a certain percentage p of the full effect size (within #' the observed dose-range!) over placebo (if there are multiple such doses, the smallest is chosen). #' \deqn{ED_p=\min\{x|f(x) > f(0) + p(f(dmax)-f(0))}{ EDp=min{x|f(x) > f(0) + p(f(dmax)-f(0))}} #' #' Note that this definition of the EDp is different from traditional definition based on the Emax model, #' where the EDp is defined relative to the \emph{asymptotic} maximum effect (rather than the maximum effect in the observed dose-range). #' #' ED or TD calculation for bootstrap model averaging (maFit) objects is based on first calculating the pointwise median dose-response curve estimate. Then calculating the dose estimate based on this curve. #' #' @name Target doses #' @rdname targdose #' @aliases ED #' @param object An object of class c(Mods, fullMod), DRMod, bFitMod or maFit #' @param Delta,p #' Delta: The target effect size use for the target dose (TD) (Delta should be > 0). #' #' p: The percentage of the dose to use for the effective dose. #' @param TDtype,EDtype character that determines, whether the dose should be treated as a continuous #' variable when calculating the TD/ED or whether the TD/ED should be calculated based on a grid of doses specified in \samp{doses} #' @param direction Direction to be used in defining the TD. This depends on whether an increasing #' or decreasing of the response variable is beneficial. In case of ED calculation only needed for maFit objects. #' @param doses Dose levels to be used if \samp{TDtype} or \samp{EDtype} are #' equal to \samp{"discrete"}. Needs to include placebo, and may not exceed the dose range of the model(s) provided in \samp{object}. #' #' @return Returns the dose estimate #' #' @author Bjoern Bornkamp #' @seealso \code{\link{Mods}}, \code{\link{drmodels}}, #' \code{\link{fitMod}}, \code{\link{bFitMod}} #' #' @examples #' ## example for creating a "full-model" candidate set placebo response #' ## and maxEff already fixed in Mods call #' doses <- c(0, 10, 25, 50, 100, 150) #' fmodels <- Mods(linear = NULL, emax = 25, #' logistic = c(50, 10.88111), exponential = 85, #' betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), #' linInt = rbind(c(0, 1, 1, 1, 1), #' c(0, 0, 1, 1, 0.8)), #' doses=doses, placEff = 0, maxEff = 0.4, #' addArgs=list(scal=200)) #' ## calculate doses giving an improvement of 0.3 over placebo #' TD(fmodels, Delta=0.3) #' ## discrete version #' TD(fmodels, Delta=0.3, TDtype = "discrete", doses=doses) #' ## doses giving 50% of the maximum effect #' ED(fmodels, p=0.5) #' ED(fmodels, p=0.5, EDtype = "discrete", doses=doses) #' plot(fmodels, plotTD = TRUE, Delta = 0.3) #' @export TD <- function(object, Delta, TDtype = c("continuous", "discrete"), direction = c("increasing", "decreasing"), doses = NULL){ ## calculate target doses for Mods or DRMod object, return in a numeric if(missing(Delta)) stop("need \"Delta\" to calculate TD") if(Delta <= 0) stop("\"Delta\" needs to be > 0") modNams <- tds <- NULL if(inherits(object, "Mods")){ off <- attr(object, "off") scal <- attr(object, "scal") nodes <- attr(object, "doses") maxD <- max(attr(object, "doses")) TDtype <- match.arg(TDtype) if(TDtype == "discrete" & any(doses > maxD)) stop("Doses provided may not exceed the observed dose range") ## loop through list for(nam in names(object)){ par <- object[[nam]] if(is.matrix(par)){ for(i in 1:nrow(par)){ td <- calcTD(nam, par[i,], Delta, TDtype, direction, doses, off, scal, nodes) modNams <- c(modNams, paste(nam, i, sep="")) tds <- c(tds, td) } } else { # single model td <- calcTD(nam, par, Delta, TDtype, direction, doses, off, scal, nodes) modNams <- c(modNams, nam) tds <- c(tds, td) } } names(tds) <- modNams return(tds) } if(inherits(object, "DRMod")){ # if fmodel is a DRMod object nam <- attr(object, "model") par <- sepCoef(object)$DRpars scal <- attr(object, "scal") off <- attr(object, "off") nodes <- attr(object, "nodes") doseNam <- attr(object, "doseRespNam")[1] maxD <- max(attr(object,"data")[[doseNam]]) TDtype <- match.arg(TDtype) if(TDtype == "discrete" & any(doses > maxD)) stop("Doses provided may not exceed the observed dose range") if(attr(object, "placAdj")){ par <- c(0, par) if(nam == "linInt") nodes <- c(0, nodes) } td <- calcTD(nam, par, Delta, TDtype, direction, doses, off, scal, nodes) names(td) <- NULL return(td) } if(inherits(object, "bFitMod")){ # if fmodel is a bFitMod object nam <- attr(object, "model") scal <- attr(object, "scal") off <- attr(object, "off") nodes <- attr(object, "nodes") doseNam <- attr(object, "doseRespNam")[1] maxD <- max(attr(object,"data")[[doseNam]]) TDtype <- match.arg(TDtype) if(TDtype == "discrete" & any(doses > maxD)) stop("Doses provided may not exceed the observed dose range") if(attr(object, "placAdj")){ if(nam == "linInt") nodes <- c(0, nodes) } td <- apply(object$samples, 1, function(x){ if(attr(object, "placAdj")){ par <- c(0, x) } else { par <- x } calcTD(nam, par, Delta, TDtype, direction, doses, off, scal, nodes) }) return(td) } if(inherits(object, "maFit")){ direction <- match.arg(direction, c("increasing", "decreasing")) TDtype <- match.arg(TDtype) maxD <- max(object$args$dose) if(TDtype == "discrete"){ if(is.null(doses)) stop("For TDtype = \"discrete\" need the possible doses in doses argument") if(doses[1] != 0) stop("need placebo dose for TD calculation") if(any(doses > maxD)) stop("Doses provided may not exceed the observed dose range") doseSeq <- doses } else { # TDtype == "continuous" doseSeq <- seq(0, maxD, length=501) } pred_med <- predict(object, doseSeq = doseSeq, summaryFct = stats::median) if(direction == "decreasing") pred_med <- -pred_med ind <- which(pred_med > pred_med[1] + Delta) if (length(ind)>0) { return(min(doseSeq[ind])) } else { return(NA) } } } #' #' Calculate effective dose for a dose-response model #' #' @inheritParams targdose #' #' @rdname targdose #' @export ED <- function(object, p, EDtype = c("continuous", "discrete"), direction = c("increasing", "decreasing"), doses = NULL){ ## calculate target doses for Mods or DRMod object, return in a numeric if(missing(p)) stop("need \"p\" to calculate ED") if(p <= 0 | p >= 1) stop("\"p\" needs to be in (0,1)") modNams <- eds <- NULL if(inherits(object, "Mods")){ off <- attr(object, "off") scal <- attr(object, "scal") nodes <- attr(object, "doses") maxD <- max(attr(object, "doses")) ## loop through list for(nam in names(object)){ par <- object[[nam]] if(is.matrix(par)){ for(i in 1:nrow(par)){ ed <- calcED(nam, par[i,], p, maxD, EDtype, doses, off, scal, nodes) modNams <- c(modNams, paste(nam, i, sep="")) eds <- c(eds, ed) } } else { # single model ed <- calcED(nam, par, p, maxD, EDtype, doses, off, scal, nodes) modNams <- c(modNams, nam) eds <- c(eds, ed) } } names(eds) <- modNams return(eds) } if(inherits(object, "DRMod")){ # if fmodel is a DRMod object nam <- attr(object, "model") par <- sepCoef(object)$DRpars doseNam <- attr(object, "doseRespNam")[1] maxD <- max(attr(object,"data")[[doseNam]]) scal <- attr(object, "scal") off <- attr(object, "off") nodes <- attr(object, "nodes") if(attr(object, "placAdj")){ par <- c(0, par) if(nam == "linInt") nodes <- c(0, nodes) } ed <- calcED(nam, par, p, maxD, EDtype, doses, off, scal, nodes) names(ed) <- NULL return(ed) } if(inherits(object, "bFitMod")){ # if fmodel is a bFitMod object nam <- attr(object, "model") scal <- attr(object, "scal") off <- attr(object, "off") nodes <- attr(object, "nodes") if(attr(object, "placAdj")){ if(nam == "linInt") nodes <- c(0, nodes) } doseNam <- attr(object, "doseRespNam")[1] maxD <- max(attr(object,"data")[[doseNam]]) ed <- apply(object$samples, 1, function(x){ if(attr(object, "placAdj")){ par <- c(0, x) } else { par <- x } calcED(nam, par, p, maxD, EDtype, doses, off, scal, nodes) }) return(ed) } if(inherits(object, "maFit")){ EDtype <- match.arg(EDtype) maxD <- max(object$args$dose) if(EDtype == "discrete"){ if(is.null(doses)) stop("For EDtype = \"discrete\" need the possible doses in doses argument") if(!any(doses == 0)) stop("need placebo dose for ED calculation") if(any(doses > maxD)) stop("Doses provided may not exceed the observed dose range.") } if(missing(direction)){ stop("Need to provide direction of dose-response (\"increasing\" or \"decreasing\") for objects of class maFitMod.") } else { direction <- match.arg(direction, c("increasing", "decreasing")) } if(EDtype == "discrete"){ doseSeq <- unique(c(sort(doses), maxD)) } else { # EDtype == "continuous" doseSeq <- seq(0, maxD, length=501) } pred_med <- predict(object, doseSeq = doseSeq, summaryFct = stats::median) if(direction == "decreasing") pred_med <- -pred_med difs <- (pred_med - pred_med[1]) ind <- which(difs > p*max(difs)) if(length(ind) == 0) return(NA) edose <- min(doseSeq[ind]) if (EDtype == "continuous" | edose %in% doses) {## don't return maxD if it was not in originally provided doses for discrete type return(edose) } else { return(NA) } } }DoseFinding/R/fitMod.R0000644000176200001440000010313014762603270014216 0ustar liggesusers## functions related to fitting dose-response models using ML or generalized approach #' Calculates default bounds for non-linear parameters in dose-response models #' #' Calculates reasonable bounds for non-linear parameters for the built-in non-linear regression model based on the dose #' range under investigation. #' #' For the logistic model the first row corresponds to the ED50 parameter and the second row to the delta parameter. For #' the sigmoid Emax model the first row corresponds to the ED50 parameter and the second row to the h parameter, while #' for the beta model first and second row correspond to the delta1 and delta2 parameters. See \code{\link{logistic}}, #' \code{\link{sigEmax}} and \code{\link{betaMod}} for details. #' #' #' @param mD Maximum dose in the study. #' @param emax,exponential,logistic,sigEmax,betaMod values for the nonlinear parameters for these model-functions #' @return List containing bounds for the model parameters. #' @author Bjoern Bornkamp #' @seealso \code{\link{fitMod}} #' @examples #' #' defBnds(mD = 1) #' defBnds(mD = 200) #' @export defBnds <- function(mD, emax = c(0.001, 1.5)*mD, exponential = c(0.1, 2)*mD, logistic = matrix(c(0.001, 0.01, 1.5, 1/2)*mD, 2), sigEmax = matrix(c(0.001*mD, 0.5, 1.5*mD, 10), 2), betaMod = matrix(c(0.05,0.05,4,4), 2)){ list(emax = emax, logistic = logistic, sigEmax = sigEmax, exponential = exponential, betaMod = betaMod) } #' Fit non-linear dose-response model #' #' Fits a dose-response model. Built-in dose-response models are "linlog", "linear", "quadratic", "emax", "exponential", #' "sigEmax", "betaMod" and "logistic" (see \code{\link{drmodels}}). #' #' When \samp{type = "normal"} ordinary least squares is used and additional additive covariates can be specified in #' \samp{addCovars}. The underlying assumption is hence normally distributed data and homoscedastic variance. #' #' For \samp{type = "general"} a generalized least squares criterion is used #' \deqn{}{(f(dose,theta)-resp)'S^{-1}(f(dose,theta)-resp)}\deqn{ #' (f(dose,\theta)-resp)'S^{-1}(f(dose,\theta)-resp)}{(f(dose,theta)-resp)'S^{-1}(f(dose,theta)-resp)} #' and an inverse weighting matrix is specified in \samp{S}, \samp{type = #' "general"} is primarily of interest, when fitting a model to AN(C)OVA type #' estimates obtained in a first stage fit, then \samp{resp} contains the estimates and \samp{S} is the estimated #' covariance matrix for the estimates in \samp{resp}. Statistical inference (e.g. confidence intervals) rely on #' asymptotic normality of the first stage estimates, which makes this method of interest only for sufficiently large #' sample size for the first stage fit. A modified model-selection criterion can be applied to these model fits (see #' also Pinheiro et al. 2014 for details). #' #' For details on the implemented numerical optimizer see the Details section below. #' #' Details on numerical optimizer for model-fitting:\cr For linear models fitting is done using numerical linear algebra #' based on the QR decomposition. For nonlinear models numerical optimization is performed only in the nonlinear #' parameters in the model and optimizing over the linear parameters in each iteration (similar as the Golub-Pereyra #' implemented in \code{\link{nls}}). For models with 1 nonlinear parameter the \code{\link{optimize}} function is used #' for 2 nonlinear parameters the \code{\link{nlminb}} function is used. The starting value is generated using a #' grid-search (with the grid size specified via \samp{control$gridSize}), or can directly be handed over via #' \samp{start}. #' #' For details on the asymptotic approximation used for \samp{type = "normal"}, see Seber and Wild (2003, chapter 5). #' For details on the asymptotic approximation used for \samp{type = "general"}, and the gAIC, see Pinheiro et al. #' (2014). #' #' @aliases fitMod coef.DRMod vcov.DRMod predict.DRMod plot.DRMod logLik.DRMod AIC.DRMod gAIC gAIC.DRMod #' @param dose,resp Either vectors of equal length specifying dose and response values, or names of variables in the #' data frame specified in \samp{data}. #' @param data Data frame containing the variables referenced in dose and resp if \samp{data} is not specified it is #' assumed that \samp{dose} and \samp{resp} are variables referenced from data (and no vectors) #' @param model The dose-response model to be used for fitting the data. Built-in models are "linlog", "linear", #' "quadratic", "emax", "exponential", "sigEmax", "betaMod" and "logistic" (see \link{drmodels}). #' @param S The inverse weighting matrix used in case, when \samp{type = "general"}, see Description. For later #' inference statements (vcov or predict methods) it is assumed this is the estimated covariance of the estimates in #' the first stage fit. #' @param type Determines whether inference is based on an ANCOVA model under a homoscedastic normality assumption (when #' \samp{type = "normal"}), or estimates at the doses and their covariance matrix and degrees of freedom are specified #' directly in \samp{resp}, \samp{S} and \samp{df}. See also the Description above and Pinheiro et al. (2014). #' @param addCovars Formula specifying additional additive linear covariates (only for \samp{type = "normal"}) #' @param placAdj Logical, if true, it is assumed that placebo-adjusted #' estimates are specified in \samp{resp} (only possible for \samp{type = #' "general"}). #' @param bnds Bounds for non-linear parameters. If missing the the default bounds from \code{\link{defBnds}} is used. #' #' When the dose-response model has only one non-linear parameter (for example Emax or exponential model), \samp{bnds} #' needs to be a vector containing upper and lower bound. For models with two non-linear parameters \samp{bnds} needs #' to be a matrix containing the bounds in the rows, see the Description section of \code{\link{defBnds}} for details #' on the formatting of the bounds for the individual models. #' @param df Degrees of freedom to use in case of \samp{type = "general"}. If this argument is missing \samp{df = Inf} #' is used. For \samp{type = "normal"} this argument is ignored as the exact degrees of freedom can be deduced from #' the model. #' @param start Vector of starting values for the nonlinear parameters (ignored for linear models). When equal to NULL, #' a grid optimization is performed and the best value is used as starting value for the local optimizer. #' @param na.action A function which indicates what should happen when the data contain NAs. #' @param control A list with entries: "nlminbcontrol", "optimizetol" and "gridSize". #' #' The entry nlminbcontrol needs to be a list and it is passed directly to control argument in the nlminb function, #' that is used internally for models with 2 nonlinear parameters. #' #' The entry optimizetol is passed directly to the tol argument of the optimize function, which is used for models #' with 1 nonlinear parameters. #' #' The entry gridSize needs to be a list with entries dim1 and dim2 giving the size of the grid for the gridsearch in #' 1d or 2d models. #' @param addArgs List containing two entries named "scal" and "off" for the "betaMod" and "linlog" model. When addArgs #' is NULL the following defaults is used \samp{list(scal = 1.2*max(doses), off = 0.01*max(doses))}. #' @return An object of class DRMod. Essentially a list containing information about the fitted model coefficients, the #' residual sum of squares (or generalized residual sum of squares), #' @author Bjoern Bornkamp #' @seealso \code{\link{defBnds}}, \code{\link{drmodels}} #' @references Pinheiro, J. C., Bornkamp, B., Glimm, E. and Bretz, F. (2014) Model-based dose finding under model #' uncertainty using general parametric models, \emph{Statistics in Medicine}, \bold{33}, 1646--1661 #' #' Seber, G.A.F. and Wild, C.J. (2003). Nonlinear Regression, Wiley. #' @examples #' #' ## Fit the emax model to the IBScovars data set #' data(IBScovars) #' fitemax <- fitMod(dose, resp, data=IBScovars, model="emax", #' bnds = c(0.01, 4)) #' #' ## methods for DRMod objects #' summary(fitemax) #' ## extracting coefficients #' coef(fitemax) #' ## (asymptotic) covariance matrix of estimates #' vcov(fitemax) #' ## predicting #' newdat <- data.frame(dose = c(0,0.5,1), gender=factor(1)) #' predict(fitemax, newdata=newdat, predType = "full-model", se.fit = TRUE) #' ## plotting #' plot(fitemax, plotData = "meansCI", CI=TRUE) #' #' ## now include (additive) covariate gender #' fitemax2 <- fitMod(dose, resp, data=IBScovars, model="emax", #' addCovars = ~gender, bnds = c(0.01, 4)) #' vcov(fitemax2) #' plot(fitemax2) #' ## fitted log-likelihood #' logLik(fitemax2) #' ## extracting AIC (or BIC) #' AIC(fitemax2) #' #' ## Illustrating the "general" approach for a binary regression #' ## produce first stage fit (using dose as factor) #' data(migraine) #' PFrate <- migraine$painfree/migraine$ntrt #' doseVec <- migraine$dose #' doseVecFac <- as.factor(migraine$dose) #' ## fit logistic regression with dose as factor #' fitBin <- glm(PFrate~doseVecFac-1, family = binomial, #' weights = migraine$ntrt) #' drEst <- coef(fitBin) #' vCov <- vcov(fitBin) #' ## now fit an Emax model (on logit scale) #' gfit <- fitMod(doseVec, drEst, S=vCov, model = "emax", bnds = c(0,100), #' type = "general") #' ## model fit on logit scale #' plot(gfit, plotData = "meansCI", CI = TRUE) #' ## model on probability scale #' logitPred <- predict(gfit, predType ="ls-means", doseSeq = 0:200, #' se.fit=TRUE) #' plot(0:200, 1/(1+exp(-logitPred$fit)), type = "l", ylim = c(0, 0.5), #' ylab = "Probability of being painfree", xlab = "Dose") #' LB <- logitPred$fit-qnorm(0.975)*logitPred$se.fit #' UB <- logitPred$fit+qnorm(0.975)*logitPred$se.fit #' lines(0:200, 1/(1+exp(-LB))) #' lines(0:200, 1/(1+exp(-UB))) #' #' #' ## now illustrate "general" approach for placebo-adjusted data (on #' ## IBScovars) note that the estimates are identical to fitemax2 above) #' anovaMod <- lm(resp~factor(dose)+gender, data=IBScovars) #' drFit <- coef(anovaMod)[2:5] # placebo adjusted estimates at doses #' vCov <- vcov(anovaMod)[2:5,2:5] #' dose <- sort(unique(IBScovars$dose))[-1] #' ## now fit an emax model to these estimates #' gfit2 <- fitMod(dose, drFit, S=vCov, model = "emax", type = "general", #' placAdj = TRUE, bnds = c(0.01, 2)) #' ## some outputs #' summary(gfit2) #' coef(gfit2) #' vcov(gfit2) #' predict(gfit2, se.fit = TRUE, doseSeq = c(1,2,3,4), predType = "effect-curve") #' plot(gfit2, CI=TRUE, plotData = "meansCI") #' gAIC(gfit2) #' #' @export fitMod <- function(dose, resp, data = NULL, model = NULL, S = NULL, type = c("normal", "general"), addCovars = ~1, placAdj = FALSE, bnds, df = NULL, start = NULL, na.action = na.fail, control = NULL, addArgs = NULL){ ## check for valid dose, resp and data cal <- as.character(match.call()) type <- match.arg(type) lst <- checkAnalyArgs(dose, resp, data, S, type, addCovars, placAdj, na.action, cal) doseNam <- lst$doseNam;respNam <- lst$respNam dose <- lst$dd[[doseNam]];type <- lst$type resp <- lst$dd[[respNam]];data <- lst$dd;S <- lst$S covarsUsed <- addCovars != ~1 ## check type related arguments if(type == "general"){ if(placAdj & model %in% c("linlog", "logistic")) # stop as fitting algorithm assumes f^0(0) = 0 stop("logistic and linlog models cannot be fitted to placebo adjusted data") if(covarsUsed) stop("addCovars argument ignored for type == \"general\"") if(is.null(df)) df <- Inf } ## check whether model has been specified correctly builtIn <- c("linlog", "linear", "quadratic", "linInt", "emax", "exponential", "logistic", "betaMod", "sigEmax") if(missing(model)) stop("Need to specify the model that should be fitted") modelNum <- match(model, builtIn) if(is.na(modelNum)) stop("Invalid dose-response model specified") ## check for start argument if(modelNum < 5 & !is.null(start)) message("Message: Starting values in \"start\" ignored for linear models") ## check for valid bnds if(modelNum > 4){ if(missing(bnds)){ message("Message: Need bounds in \"bnds\" for nonlinear models, using default bounds from \"defBnds\".") bnds <- defBnds(max(dose))[[model]] } else { if(is.null(bnds)){ message("Message: Need bounds in \"bnds\" for nonlinear models, using default bounds from \"defBnds\".") bnds <- defBnds(max(dose))[[model]] } } } ## addArgs argument scal <- off <- nodes <- NULL if(model %in% c("linlog", "betaMod")){ aPar <- getAddArgs(addArgs, sort(unique(dose))) if(model == "betaMod") scal <- aPar$scal if(model == "linlog") off <- aPar$off } if(model == "linInt"){ ## not allowed to use nodes different from used doses nodes <- sort(unique(dose)) } ## call fit-model raw! out <- fitMod.raw(dose, resp, data, model, S, type, addCovars, placAdj, bnds, df, start, na.action, control, doseNam=doseNam, respNam=respNam, off = off, scal = scal, nodes=nodes, covarsUsed) ## attach data to object reord <- order(lst$ord) if(type == "normal"){ if(covarsUsed){ attr(out, "data") <- data[reord,] } else { dat <- data.frame(dose=dose, resp=resp) colnames(dat) <- c(doseNam, respNam) attr(out, "data") <- dat[reord,] } } else { lst <- list(dose=dose[reord], resp=resp[reord], S=S[reord,reord]) names(lst) <- c(doseNam, respNam, "S") attr(out, "data") <- lst } out } #' @export print.DRMod <- function(x, digits = 4, ...){ if (length(x) == 1) { cat("NA\n") return() } cat("Dose Response Model\n\n") cat(paste("Model:", attr(x, "model")), "\n") cat(paste("Fit-type:", attr(x, "type")), "\n\n") Coefs <- sepCoef(x) cat("Coefficients dose-response model\n") print(signif(Coefs$DRpars, digits)) if(attr(x, "type") == "normal"){ if(x$addCovars != ~1){ cat("Coefficients additional covariates\n") print(signif(Coefs$covarPars, digits)) } cat("\nDegrees of freedom:", x$df, "\n") cat("Residual standard error:", signif(sqrt(x$RSS/x$df), digits),"\n") } if(attr(x, "type") == "general"){ cat("\nFitted to:\n") doseRespNam <- attr(x, "doseRespNam") resp <- attr(x, "data")[[doseRespNam[2]]] names(resp) <- attr(x, "data")[[doseRespNam[1]]] print(signif(resp, digits)) cat("\nGeneralized residual sum of squares:", signif(x$gRSS, digits),"\n") } } #' @export summary.DRMod <- function(object, digits = 3, ...){ class(object) <- "summary.DRMod" print(object, digits = digits) } #' @export print.summary.DRMod <- function(x, digits = 3, data, ...){ if(length(x) == 1){ cat("NA\n") return() } data <- attr(x, "data") cat("Dose Response Model\n\n") cat(paste("Model:", attr(x, "model")), "\n") type <- attr(x, "type") cat(paste("Fit-type:", type), "\n") if(type == "normal"){ ## residual information cat("\nResiduals:\n") nam <- c("Min", "1Q", "Median", "3Q", "Max") respNam <- attr(x, "doseRespNam")[2] resid <- predict.DRMod(x, predType = "full-model")-data[[respNam]] rq <- structure(quantile(resid), names = nam) print(rq, digits = digits, ...) } cat("\nCoefficients with approx. stand. error:\n") coefs <- x$coef sdv <- sqrt(diag(vcov.DRMod(x))) datf <- matrix(nrow = length(coefs), ncol = 2) datf[,1] <- coefs datf[,2] <- sdv colnam <- c("Estimate", "Std. Error") dimnames(datf) <- list(names(coefs), colnam) print(datf, digits = digits) if(type == "normal"){ cat("\nResidual standard error:", signif(sqrt(x$RSS/x$df), digits), "\n") cat("Degrees of freedom:", x$df, "\n") } if(type == "general"){ doseRespNam <- attr(x, "doseRespNam") dose <- attr(x, "data")[[doseRespNam[1]]] drEst <- attr(x, "data")[[doseRespNam[2]]] names(drEst) <- dose S <- attr(x, "data")$S dimnames(S) <- list(dose, dose) cat("\nFitted to:\n") print(signif(drEst, digits)) cat("\nwith Covariance Matrix:\n") print(signif(S, digits)) } } #' Extract dose-response model coefficients #' #' @param object,x DRMod object #' @param sep Logical determining whether all coefficients should be returned in one numeric or separated in a list. #' @param ... Additional arguments for plotting for the plot method. For all other cases additional arguments are #' ignored. #' #' @rdname fitMod #' @method coef DRMod #' @export #' coef.DRMod <- function(object, sep = FALSE, ...){ if(length(object) == 1){ # object does not contain a converged fit warning("DRMod object does not contain a converged fit") return(NA) } if(sep){ return(sepCoef(object)) } object$coefs } #' Extract dose-response vcov matrix #' #' @inheritParams coef.DRMod #' #' @rdname fitMod #' @method vcov DRMod #' @export vcov.DRMod <- function(object, ...){ ## object - DRMod object ## uGrad - function returning gradient for userModel if(length(object) == 1){ # object does not contain a converged fit warning("DRMod object does not contain a converged fit") return(NA) } type <- attr(object, "type") model <- attr(object, "model") cf <- sepCoef(object)$DRpars nams <- names(coef(object)) scal <- attr(object, "scal") off <- attr(object, "off") nodes <- attr(object, "nodes") doseNam <- attr(object, "doseRespNam")[1] if(type == "normal"){ addCovars <- object$addCovars xlev <- attr(object, "xlev") RSS <- object$RSS df <- object$df data <- attr(object, "data") dose <- attr(object, "data")[[doseNam]] m <- model.matrix(addCovars, data, xlev = xlev) } if(type == "general"){ placAdj <- attr(object, "placAdj") if(placAdj) # no intercept cf <- c(0, cf) dose <- attr(object, "data")[[doseNam]] inS <- solve(attr(object, "data")$S) } grd <- gradCalc(model, cf, dose, off, scal, nodes) if(type == "normal"){ J <- cbind(grd, m[,-1]) JtJ <- crossprod(J) covMat <- try(solve(JtJ)*RSS/df, silent=TRUE) if(!inherits(covMat, "matrix")){ covMat <- try(chol2inv(qr.R(qr(J)))*RSS/df, silent=TRUE) # more stable (a little slower) if(!inherits(covMat, "matrix")){ warning("cannot calculate covariance matrix. singular matrix in calculation of covariance matrix.") nrw <- length(grd[1,]) covMat <- matrix(NA, nrow=nrw, ncol=nrw) } dimnames(covMat) <- dimnames(JtJ) } } if(type == "general"){ if(placAdj){ if(model != "linInt") grd <- grd[,-1] } covMat <- try(solve(t(grd)%*%inS%*%grd), silent = TRUE) if(!inherits(covMat, "matrix")) { warning("cannot calculate covariance matrix. singular matrix in calculation of covariance matrix.") nrw <- length(grd[1,]) covMat <- matrix(NA, nrow=nrw, ncol=nrw) } } dimnames(covMat) <- list(nams, nams) covMat } #'Make predictions from dose-response model #' #'@inheritParams coef.DRMod #'@param predType,newdata,doseSeq,se.fit predType determines whether predictions are returned for the full model #' (including potential covariates), the ls-means (SAS type) or the effect curve (difference to placebo). #' #' newdata gives the covariates to use in producing the predictions (for predType = "full-model"), if missing the #' covariates used for fitting are used. #' #' doseSeq dose-sequence on where to produce predictions (for predType = "effect-curve" and predType = "ls-means"). If #' missing the doses used for fitting are used. #' #' se.fit: logical determining, whether the standard error should be calculated. #' #'@rdname fitMod #'@method predict DRMod #'@export predict.DRMod <- function(object, predType = c("full-model", "ls-means", "effect-curve"), newdata = NULL, doseSeq = NULL, se.fit = FALSE, ...){ ## Extract relevant information from object scal <- attr(object, "scal") off <- attr(object, "off") nodes <- attr(object, "nodes") model <- attr(object, "model") addCovars <- attr(object, "addCovars") xlev <- attr(object, "xlev") doseNam <- attr(object, "doseRespNam")[1] data <- attr(object, "data") type <- attr(object, "type") if(missing(predType)) stop("need to specify the type of prediction in \"predType\"") predType <- match.arg(predType) ## if model fitted on plac-adj. data can only produce predictions for effect-curve if(attr(object, "placAdj") & predType != "effect-curve"){ message("Message: Setting predType to \"effect-curve\" for placebo-adjusted data") predType <- "effect-curve" } if(type == "general" & predType == "full-model"){ ## there are no covariates message("Message: Setting predType to \"ls-means\" for \"type = general\"") predType <- "ls-means" } if(predType %in% c("ls-means", "full-model")){ ## create design-matrix according to the SAS predType ls-means if(predType == "ls-means"){ if(!is.null(newdata)) stop("newdata is ignored for \"predType = \"ls-means\"") if(is.null(doseSeq)){ ## use doses used for fitting if(type == "normal") doseSeq <- data[, doseNam] if(type == "general") doseSeq <- data[[doseNam]] } covarsUsed <- addCovars != ~1 if(covarsUsed){ nams <- all.vars(addCovars) out <- list() z <- 1 for(covar in nams){ varb <- data[,covar] if(is.numeric(varb)){ out[[z]] <- mean(varb) } else if(is.factor(varb)){ k <- nlevels(varb) out[[z]] <- rep(1/k, k-1) } z <- z+1 } out <- do.call("c", out) m <- matrix(rep(out, length(doseSeq)), byrow=TRUE, nrow = length(doseSeq)) } } ## create design-matrix either from newdata or data used for fitting if(predType == "full-model"){ if(!is.null(doseSeq) & predType == "full-model") stop("doseSeq should only be used when predType = \"effect-curve\" or \"ls-means\"") if(is.null(newdata)){ ## if not provided use covariates in observed data if(type == "normal"){ m <- model.matrix(addCovars, data) doseSeq <- data[, doseNam] } else { doseSeq <- data[[doseNam]] } } else { tms <- c(doseNam, attr(terms(addCovars), "term.labels")) missind <- !is.element(tms, names(newdata)) if(any(missind)){ chct <- paste("No values specified in newdata for", paste(tms[missind], collapse=", ")) stop(chct) } else { m <- model.matrix(addCovars, newdata, xlev = xlev) doseSeq <- newdata[, doseNam] if(nrow(m) != length(doseSeq)) stop("incompatible model matrix and doseSeq created from newdata") } } m <- m[,-1, drop=FALSE] # remove intercept column (is necessary) } coeflist <- sepCoef(object) # separate coefs of DR model and additional covars DRpars <- coeflist$DRpars covarPars <- coeflist$covarPars ## predictions if(model != "linInt"){ call <- c(list(doseSeq), as.list(c(DRpars, scal, off))) } else { call <- c(list(doseSeq), as.list(list(DRpars, nodes))) } mn <- do.call(model, call) if(addCovars != ~1) mn <- mn + as.numeric(m%*%covarPars) if(!se.fit){ return(as.numeric(mn)) } else { ## calculate standard error of predictions covMat <- vcov(object) if(any(is.na(covMat))){ seFit <- (rep(NA, length(doseSeq))) } else { grd <- gradCalc(model, DRpars, doseSeq, off, scal, nodes) if(addCovars != ~1) grd <- cbind(grd, m) cholcovMat <- try(chol(covMat), silent = TRUE) if (!inherits(cholcovMat, "matrix")) { warning("Cannot cannot calculate standard deviation for ", model, " model.\n") seFit <- rep(NA, length(doseSeq)) } else { seFit <- sqrt(rowSums((grd%*%t(cholcovMat))^2)) # t(grd)%*%covMat%*%grd } } return(list(fit = mn, se.fit = as.vector(seFit))) } } if(predType == "effect-curve") { ## predict effect curve if(!is.null(newdata)) stop("newdata is ignored for \"predType = \"effect-curve\"") if(is.null(doseSeq)){ if(type == "normal") doseSeq <- data[, doseNam] if(type == "general") doseSeq <- data[[doseNam]] } coeflist <- sepCoef(object) DRpars <- coeflist$DRpars if(attr(object, "placAdj")){ DRpars <- c(0, DRpars) if(model == "linInt") nodes <- c(0, nodes) } else { if(model != "linInt"){ DRpars[1] <- 0 } else { DRpars <- DRpars - DRpars[1] } } ## predictions if(model != "linInt"){ call <- c(list(doseSeq), as.list(c(DRpars, scal, off))) } else { call <- c(list(doseSeq), as.list(list(DRpars, nodes))) } mn <- do.call(model, call) if(is.element(model,c("logistic", "linlog"))){ # if standardized model not 0 at placebo call <- c(0, as.list(c(DRpars, scal, off))) predbase <- do.call(model, call) mn <- mn-predbase } if(!se.fit){ return(as.numeric(mn)) } else { ## calculate st. error (no need to calculate full covMat here) covMat <- vcov(object) if(addCovars != ~1) ## remove columns corresponding to covariates covMat <- covMat[1:length(DRpars), 1:length(DRpars)] if(!attr(object, "placAdj")){ ## remove intercept from cov-matrix if(model != "linInt"){ covMat <- covMat[-1,-1] } else { diffMat <- cbind(-1,diag(length(DRpars)-1)) covMat <- diffMat%*%covMat%*%t(diffMat) } } if(any(is.na(covMat))){ seFit <- (rep(NA, length(doseSeq))) } else { grd <- gradCalc(model, DRpars, doseSeq, off, scal, nodes) if(!is.matrix(grd)){ # can happen if length(doseSeq) == 1 grd <- matrix(grd, nrow = 1) } if(model == "linInt"){ grd <- grd[,-1, drop = FALSE] } else { grd0 <- gradCalc(model, DRpars, 0, off, scal, nodes) grd <- grd[, -1, drop=FALSE] grd0 <- grd0[,-1] grd <- sweep(grd, 2, grd0, "-") } cholcovMat <- try(chol(covMat), silent = TRUE) if (!inherits(cholcovMat, "matrix")) { warning("Cannot cannot calculate standard deviation for ", model, " model.\n") seFit <- rep(NA, length(doseSeq)) } else { seFit <- sqrt(rowSums((grd%*%t(cholcovMat))^2)) # t(grd)%*%covMat%*%grd } } res <- list(fit = mn, se.fit = as.vector(seFit)) return(res) } } } ## plot.DRMod <- function(x, CI = FALSE, level = 0.95, ## plotData = c("means", "meansCI", "none"), ## lenDose = 201, ...){ ## ## arguments passed to plot ## pArgs <- list(...) ## ## Extract relevant information from object ## scal <- attr(x, "addArgs")$scal ## off <- attr(x, "addArgs")$off ## model <- attr(x, "model") ## addCovars <- attr(x, "addCovars") ## covarsUsed <- addCovars != ~1 ## xlev <- attr(x, "xlev") ## doseNam <- attr(x, "doseRespNam")[1] ## respNam <- attr(x, "doseRespNam")[2] ## data <- attr(x, "data") ## type <- attr(x, "type") ## placAdj <- attr(x, "placAdj") ## doseSeq <- seq(0, max(data[[doseNam]]), length=lenDose) ## plotData <- match.arg(plotData) ## if(type == "normal"){ ## ## first produce estimates for ANOVA type model ## if(plotData %in% c("means", "meansCI")){ ## data$doseFac <- as.factor(data[[doseNam]]) ## form <- as.formula(paste(respNam, "~ doseFac +", addCovars[2])) ## fit <- lm(form, data=data) ## ## build design matrix for prediction ## dose <- sort(unique(data[[doseNam]])) ## preddat <- data.frame(doseFac=factor(dose)) ## m <- model.matrix(~doseFac, data=preddat) ## if(covarsUsed){ ## ## get sas type ls-means ## nams <- all.vars(addCovars) ## out <- list() ## z <- 1 ## for(covar in nams){ ## varb <- data[,covar] ## if(is.numeric(varb)){ ## out[[z]] <- mean(varb) ## } else if(is.factor(varb)){ ## k <- nlevels(varb) ## out[[z]] <- rep(1/k, k-1) ## } ## z <- z+1 ## } ## out <- do.call("c", out) ## m0 <- matrix(rep(out, length(dose)), byrow=TRUE, nrow = length(dose)) ## m <- cbind(m, m0) ## } ## mns <- as.numeric(m%*%coef(fit)) ## lbndm <- ubndm <- rep(NA, length(mns)) ## if(plotData == "meansCI"){ ## sdv <- sqrt(diag(m%*%vcov(fit)%*%t(m))) ## quant <- qt(1 - (1 - level)/2, df=x$df) ## lbndm <- mns-quant*sdv ## ubndm <- mns+quant*sdv ## } ## } ## } ## if(type == "general"){ ## ## extract ANOVA estimates ## if(plotData %in% c("means", "meansCI")){ ## dose <- data[[doseNam]] ## mns <- data[[respNam]] ## sdv <- sqrt(diag(data$S)) ## lbndm <- ubndm <- rep(NA, length(dose)) ## if(plotData == "meansCI"){ ## quant <- qnorm(1 - (1 - level)/2) ## lbndm <- mns-quant*sdv ## ubndm <- mns+quant*sdv ## } ## } ## } ## ## curve produced (use "ls-means" apart when data are fitted on placAdj scale) ## predtype <- ifelse(placAdj, "effect-curve", "ls-means") ## predmn <- predict(x, doseSeq = doseSeq, predType = predtype, se.fit = CI) ## lbnd <- ubnd <- rep(NA, length(doseSeq)) ## if(CI){ ## quant <- qt(1 - (1 - level)/2, df=x$df) ## lbnd <- predmn$fit-quant*predmn$se.fit ## ubnd <- predmn$fit+quant*predmn$se.fit ## predmn <- predmn$fit ## } ## ## determine plotting range ## if(plotData %in% c("means", "meansCI")){ ## rng <- range(lbndm, ubndm, mns, predmn, ubnd, lbnd, na.rm=TRUE) ## } else { ## rng <- range(predmn, ubnd, lbnd, na.rm=TRUE) ## } ## dff <- diff(rng) ## ylim <- c(rng[1] - 0.02 * dff, rng[2] + 0.02 * dff) ## ## default title ## main <- "Dose-Response Curve" ## main2 <- ifelse(placAdj, "(placebo-adjusted)", "(ls-means)") ## main <- paste(main, main2) ## ## plot ## callList <- list(doseSeq, predmn, type = "l", col = "white", ## xlab = doseNam, ylim = ylim, ## ylab = respNam, main = main) ## callList[names(pArgs)] <- pArgs ## do.call("plot", callList) ## grid() ## if(plotData %in% c("means", "meansCI")){ ## points(dose, mns, pch = 19, cex = 0.75) ## if(plotData == "meansCI"){ ## for(i in 1:length(dose)){ ## lines(c(dose[i],dose[i]), c(lbndm[i], ubndm[i]), lty=2) ## } ## } ## } ## lines(doseSeq, predmn, lwd=1.5) ## lines(doseSeq, ubnd, lwd=1.5) ## lines(doseSeq, lbnd, lwd=1.5) ## } #'Plot fitted dose-response model #' #'@inheritParams coef.DRMod #'@param CI,level,plotData,plotGrid,colMn,colFit Arguments for plot method: \samp{CI} determines whether confidence #' intervals should be plotted. \samp{level} determines the level of the confidence intervals. \samp{plotData} #' determines how the data are plotted: Either as means or as means with CI, raw data or none. In case of \samp{type = #' "normal"} and covariates the ls-means are displayed, when \samp{type = "general"} the option "raw" is not available. #' \samp{colMn} and \samp{colFit} determine the colors of fitted model and the raw means. #' #'@rdname fitMod #'@method plot DRMod #'@export plot.DRMod <- function(x, CI = FALSE, level = 0.95, plotData = c("means", "meansCI", "raw", "none"), plotGrid = TRUE, colMn = 1, colFit = 1, ...){ plotFunc(x, CI, level, plotData, plotGrid, colMn, colFit, ...) } #' Extract log-likelihood of dose-response model #' #' @inheritParams coef.DRMod #' #' @rdname fitMod #' @method logLik DRMod #' @export logLik.DRMod <- function(object, ...){ type <- attr(object, "type") data <- attr(object, "data") if(type == "normal"){ RSS <- object$RSS n <- nrow(data) sig2 <- RSS/n val <- -n/2*(log(2*pi) + 1 + log(sig2)) attr(val, "df") <- length(object$coefs)+1 # +1 because of sigma parameter class(val) <- "logLik" return(val) } if(type == "general") stop("method glogLik only available for type == \"normal\"") } #' Extract AIC of dose-response model #' #' @inheritParams coef.DRMod #' @param k Penalty to use for model-selection criterion (AIC uses 2, BIC uses log(n)). #' #' @rdname fitMod #' @method AIC DRMod #' @export AIC.DRMod <- function(object, ..., k = 2){ type <- attr(object, "type") if(type == "general") stop("use method gAIC for type == \"general\"") logL <- logLik(object) -2*as.vector(logL) + k*(attr(logL, "df")) } #' Extract gAIC of dose-response model #' #' @inheritParams AIC.DRMod #' #' @rdname fitMod #' @method gAIC DRMod #' @export gAIC.DRMod <- function(object, ..., k = 2){ type <- attr(object, "type") if(type == "normal") stop("use method AIC for type == \"normal\"") object$gRSS+k*length(object$coefs) } DoseFinding/R/optDesign.R0000644000176200001440000006370514654153534014750 0ustar liggesusers## optimal designs for model-fitting #' Function to calculate optimal designs #' #' Given a set of models (with full parameter values and model probabilities) the \samp{optDesign} function calculates #' the optimal design for estimating the dose-response model parameters (D-optimal) or the design for estimating the #' target dose (TD-optimal design) (see Dette, Bretz, Pepelyshev and Pinheiro (2008)), or a mixture of these two #' criteria. The design can be plotted (together with the candidate models) using \samp{plot.design}. \samp{calcCrit} #' calculates the design criterion for a discrete set of design(s). \samp{rndDesign} provides efficient rounding for the #' calculated continous design to a finite sample size. #' #' Let \eqn{M_m}{M_m} denote the Fisher information matrix under model m (up to #' proportionality). \eqn{M_m}{M_m} is given by \eqn{\sum a_i w_i }{\sum a_i #' w_i g_i^Tg_i}\eqn{ g_i^Tg_i}{\sum a_i w_i g_i^Tg_i}, where \eqn{a_i}{a_i} is #' the allocation weight to dose i, \eqn{w_i}{w_i} the weight for dose i specified via \samp{weights} and \eqn{g_i}{g_i} #' the gradient vector of model m evaluated at dose i. #' #' For \samp{designCrit = "Dopt"} the code minimizes the design criterion #' #' \deqn{-\sum_{m}p_m/k_m \log(\det(M_m))}{-sum_m p_m/k_m log(det(M_m))} where \eqn{p_m}{p_m} is the probability for #' model m and \eqn{k_m}{k_m} is the number of parameters for model m. When \samp{standDopt = FALSE} the \eqn{k_m}{k_m} #' are all assumed to be equal to one. #' #' For \samp{designCrit = "TD"} the code minimizes the design criterion #' #' \deqn{\sum_{m}p_m \log(v_m)}{sum_m p_m log(v_m)} where \eqn{p_m}{p_m} is the probability for model m and #' \eqn{v_m}{v_m} is proportional to the asymptotic #' variance of the TD estimate and given by \eqn{b_m'M_m^{-}b_m}{b_m'Minv_m #' b_m} (see Dette et al. (2008), p. 1227 for details). #' #' For \samp{designCrit = "Dopt&TD"} the code minimizes the design criterion #' \deqn{\sum_{m}p_m(-0.5\log(\det(M_m))/k_m+0.5\log(v_m))}{sum_m #' p_m(-0.5log(det(M_m))/k_m+0.5log(v_m))} #' #' Again, for \samp{standDopt = FALSE} the \eqn{k_m}{k_m} are all assumed to be equal to one. #' #' For details on the \samp{rndDesign} function, see Pukelsheim (1993), Chapter 12. #' #' @aliases optDesign plot.DRdesign calcCrit rndDesign #' @param models An object of class \samp{c(Mods, fullMod)}, see the \code{\link{Mods}} function for details. When an TD #' optimal design should be calculated, the TD needs to exist for all models. If a D-optimal design should be #' calculated, you need at least as many doses as there are parameters in the specified models. #' @param probs Vector of model probabilities for the models specified in \samp{models}, assumed in the same order as #' specified in models #' @param doses Optional argument. If this argument is missing the doses attribute in the \samp{c(Mods, fullMod)} object #' specified in \samp{models} is used. #' @param designCrit Determines which type of design to calculate. "TD&Dopt" uses both optimality criteria with equal #' weight. #' @param Delta Target effect needed for calculating "TD" and "TD&Dopt" type designs. #' @param standDopt Logical determining, whether the D-optimality criterion (specifically the log-determinant) should be #' standardized by the number of parameters in the model or not (only of interest if type = "Dopt" or type = #' "TD&Dopt"). This is of interest, when there is more than one model class in the candidate model set (traditionally #' standardization this is done in the optimal design literature). #' @param weights Vector of weights associated with the response at the doses. Needs to be of the same length as the #' \samp{doses}. This can be used to calculate designs for heteroscedastic or for generalized linear model #' situations. #' @param nold,n When calculating an optimal design at an interim analysis, \samp{nold} specifies the vector of sample #' sizes already allocated to the different doses, and \samp{n} gives sample size for the next cohort. #' #' For \samp{optimizer = "exact"} one always needs to specify the total sample size via \samp{n}. #' @param control List containing control parameters passed down to numerical optimization algorithms #' (\code{\link{optim}}, \code{\link{nlminb}} or solnp function).\cr #' #' For \samp{type = "exact"} this should be a list with possible entries \samp{maxvls1} and \samp{maxvls2}, #' determining the maximum number of designs allowed for passing to the criterion function (default #' \samp{maxvls2=1e5}) and for creating the initial unrestricted matrix of designs (default \samp{maxvls1=1e6}). In #' addition there can be an entry \samp{groupSize} in case the patients are allocated a minimum group size is #' required. #' @param optimizer Algorithm used for calculating the optimal design. Options "Nelder-Mead" and "nlminb" use the #' \code{\link{optim}} and \code{\link{nlminb}} function and use a trigonometric transformation to turn the #' constrained optimization problem into an unconstrained one (see Atkinson, Donev and Tobias, 2007, pages 130,131). #' #' Option "solnp" uses the solnp function from the Rsolnp package, which implements an optimizer for non-linear #' optimization under general constraints. #' #' Option "exact" tries all given combinations of \samp{n} patients to the given dose groups (subject to the bounds #' specified via \samp{lowbnd} and \samp{uppbnd}) and reports the best design. When patients are only allowed to be #' allocated in groups of a certain \samp{groupSize}, this can be adjusted via the control argument. #' \samp{n/groupSize} and \samp{length(doses)} should be rather small for this approach to be feasible. #' #' When the number of doses is small (<8) usually \samp{"Nelder-Mead"} and \samp{"nlminb"} are best suited #' (\samp{"nlminb"} is usually a bit faster but less stable than \samp{"Nelder-Mead"}). For a larger number of doses #' \samp{"solnp"} is the most reliable option (but also slowest) (\samp{"Nelder-Mead"} and \samp{"nlminb"} often #' fail). When the sample size is small \samp{"exact"} provides the optimal solution rather quickly. #' @param lowbnd,uppbnd Vectors of the same length as dose vector specifying upper and lower limits for the allocation #' weights. This option is only available when using the "solnp" and "exact" optimizers. #' @param userCrit User defined design criterion, should be a function that given a vector of allocation weights and the #' doses returns the criterion function. When specified \samp{models} does not need to be handed over. #' #' The first argument of \samp{userCrit} should be the vector of design weights, while the second argument should be #' the \samp{doses} argument (see example below). Additional arguments to \samp{userCrit} can be passed via ... #' @param ... For function \samp{optDesign} these are additional arguments passed to \samp{userCrit}.\cr \cr For #' function \samp{plot.design} these are additional parameters passed to \code{\link{plot.Mods}}.\cr #' @note In some cases (particularly when the number of doses is large, e.g. 7 or larger) it might be necessary to allow #' a larger number of iterations in the algorithm (via the argument \samp{control}), particularly for the Nelder-Mead #' algorithm. Alternatively one can use the solnp optimizer that is usually the most reliable, but not fastest option. #' @author Bjoern Bornkamp #' @seealso \code{\link{Mods}}, \code{\link{drmodels}} #' @references Atkinson, A.C., Donev, A.N. and Tobias, R.D. (2007). Optimum Experimental Designs, with SAS, Oxford #' University Press #' #' Dette, H., Bretz, F., Pepelyshev, A. and Pinheiro, J. C. (2008). Optimal #' Designs for Dose Finding Studies, \emph{Journal of the American Statisical #' Association}, \bold{103}, 1225--1237 #' #' Pinheiro, J.C., Bornkamp, B. (2017) Designing Phase II Dose-Finding Studies: Sample Size, Doses and Dose Allocation #' Weights, in O'Quigley, J., Iasonos, A. and Bornkamp, B. (eds) Handbook of methods for designing, monitoring, and #' analyzing dose-finding trials, CRC press #' #' Pukelsheim, F. (1993). Optimal Design of Experiments, Wiley #' @examples #' #' ## calculate designs for Emax model #' doses <- c(0, 10, 100) #' emodel <- Mods(emax = 15, doses=doses, placEff = 0, maxEff = 1) #' optDesign(emodel, probs = 1) #' ## TD-optimal design #' optDesign(emodel, probs = 1, designCrit = "TD", Delta=0.5) #' ## 50-50 mixture of Dopt and TD #' optDesign(emodel, probs = 1, designCrit = "Dopt&TD", Delta=0.5) #' ## use dose levels different from the ones specified in emodel object #' des <- optDesign(emodel, probs = 1, doses = c(0, 5, 20, 100)) #' ## plot models overlaid by design #' plot(des, emodel) #' ## round des to a sample size of exactly 90 patients #' rndDesign(des, n=90) ## using the round function would lead to 91 patients #' #' ## illustrating different optimizers (see Note above for more comparison) #' optDesign(emodel, probs=1, optimizer="Nelder-Mead") #' optDesign(emodel, probs=1, optimizer="nlminb") #' ## optimizer solnp (the default) can deal with lower and upper bounds: #' optDesign(emodel, probs=1, designCrit = "TD", Delta=0.5, #' optimizer="solnp", lowbnd = rep(0.2,3)) #' ## exact design using enumeration of all possibilites #' optDesign(emodel, probs=1, optimizer="exact", n = 30) #' ## also allows to fix minimum groupSize #' optDesign(emodel, probs=1, designCrit = "TD", Delta=0.5, #' optimizer="exact", n = 30, control = list(groupSize=5)) #' #' #' ## optimal design at interim analysis #' ## assume there are already 10 patients on each dose and there are 30 #' ## left to randomize, this calculates the optimal increment design #' optDesign(emodel, 1, designCrit = "TD", Delta=0.5, #' nold = c(10, 10, 10), n=30) #' #' ## use a larger candidate model set #' doses <- c(0, 10, 25, 50, 100, 150) #' fmods <- Mods(linear = NULL, emax = 25, exponential = 85, #' linlog = NULL, logistic = c(50, 10.8811), #' doses = doses, addArgs=list(off=1), #' placEff=0, maxEff=0.4) #' probs <- rep(1/5, 5) # assume uniform prior #' desDopt <- optDesign(fmods, probs, optimizer = "nlminb") #' desTD <- optDesign(fmods, probs, designCrit = "TD", Delta = 0.2, #' optimizer = "nlminb") #' desMix <- optDesign(fmods, probs, designCrit = "Dopt&TD", Delta = 0.2) #' ## plot design and truth #' plot(desMix, fmods) #' #' ## illustrate calcCrit function #' ## calculate optimal design for beta model #' doses <- c(0, 0.49, 25.2, 108.07, 150) #' models <- Mods(betaMod = c(0.33, 2.31), doses=doses, #' addArgs=list(scal=200), #' placEff=0, maxEff=0.4) #' probs <- 1 #' deswgts <- optDesign(models, probs, designCrit = "Dopt", #' control=list(maxit=1000)) #' ## now compare this design to equal allocations on #' ## 0, 10, 25, 50, 100, 150 #' doses2 <- c(0, 10, 25, 50, 100, 150) #' design2 <- c(1/6, 1/6, 1/6, 1/6, 1/6, 1/6) #' crit2 <- calcCrit(design2, models, probs, doses2, designCrit = "Dopt") #' ## ratio of determinants (returned criterion value is on log scale) #' exp(deswgts$crit-crit2) #' #' ## example for calculating an optimal design for logistic regression #' doses <- c(0, 0.35, 0.5, 0.65, 1) #' fMod <- Mods(linear = NULL, doses=doses, placEff=-5, maxEff = 10) #' ## now calculate weights to use in the covariance matrix #' mu <- as.numeric(getResp(fMod, doses=doses)) #' mu <- 1/(1+exp(-mu)) #' weights <- mu*(1-mu) #' des <- optDesign(fMod, 1, doses, weights = weights) #' #' ## one can also specify a user defined criterion function #' ## here D-optimality for cubic polynomial #' CubeCrit <- function(w, doses){ #' X <- cbind(1, doses, doses^2, doses^3) #' CVinv <- crossprod(X*w) #' -log(det(CVinv)) #' } #' optDesign(doses = c(0,0.05,0.2,0.6,1), #' designCrit = "userCrit", userCrit = CubeCrit, #' optimizer = "nlminb") #' @export optDesign <- function(models, probs, doses, designCrit = c("Dopt", "TD", "Dopt&TD", "userCrit"), Delta, standDopt = TRUE, weights, nold = rep(0, length(doses)), n, control=list(), optimizer = c("solnp", "Nelder-Mead", "nlminb", "exact"), lowbnd = rep(0, length(doses)), uppbnd = rep(1, length(doses)), userCrit, ...){ if(!missing(models)){ if(!inherits(models, "Mods")) stop("\"models\" needs to be of class Mods") direction <- attr(models, "direction") off <- attr(models, "off") scal <- attr(models, "scal") if(missing(doses)) doses <- attr(models, "doses") } else { if(missing(userCrit)) stop("either \"models\" or \"userCrit\" need to be specified") if(missing(doses)) stop("For userCrit one always needs to specify doses") } ## check arguments designCrit <- match.arg(designCrit) optimizer <- match.arg(optimizer) if(missing(n)){ if(optimizer == "exact") stop("need to specify sample size via n argument") if(any(nold > 0)) stop("need to specify sample size for next cohort via n argument") n <- 1 ## value is arbitrary in this case } else { if(length(n) > 1) stop("n needs to be of length 1") } if(missing(Delta)){ if(designCrit %in% c("TD", "Dopt&TD")) stop("need to specify target difference \"Delta\"") } else { if(Delta <= 0) stop("\"Delta\" needs to be > 0, if curve decreases use \"direction = decreasing\"") } if(missing(weights)){ weights <- rep(1, length(doses)) } else { if(length(weights) != length(doses)) stop("weights and doses need to be of equal length") } if(length(lowbnd) != length(doses)) stop("lowbnd needs to be of same length as doses") if(length(uppbnd) != length(doses)) stop("uppbnd needs to be of same length as doses") if(any(lowbnd > 0) | any(uppbnd < 1)){ if(optimizer != "solnp" & optimizer != "exact") stop("only optimizers solnp or exact can handle additional constraints on allocations") } if(sum(lowbnd) > 1) stop("Infeasible lower bound specified (\"sum(lowbnd) > 1\"!)") if(sum(uppbnd) < 1) stop("Infeasible upper bound specified (\"sum(lowbnd) < 1\"!)") if(!is.logical(standDopt)) stop("standDopt needs to contain a logical value") standInt <- as.integer(standDopt) # use standardized or non-stand. D-optimality nD <- length(doses) if(designCrit == "TD" | designCrit == "Dopt&TD"){ # check whether TD exists in (0,max(dose)) if(length(unique(direction)) > 1) stop("need to provide either \"increasing\" or \"decreasing\" as direction to optDesign, when TD optimal designs should be calculated") direction <- unique(direction) tdMods <- TD(models, Delta, "continuous", direction) tdMods[tdMods > max(doses)] <- NA if(any(is.na(tdMods))) stop("TD does not exist for ", paste(names(tdMods)[is.na(tdMods)], collapse=", " ), " model(s)") } if(designCrit == "Dopt" | designCrit == "Dopt&TD"){ # check whether Fisher matrix can be singular np <- nPars(names(models)) if(max(np) > length(doses)) stop("need at least as many dose levels as there are parameters to calculate Dopt design.") } ## use transformation for Nelder-Mead and nlminb if(is.element(optimizer, c("Nelder-Mead", "nlminb"))){ transform <- transTrig } else { transform <- idtrans } if(designCrit != "userCrit"){ # prepare criterion function ## check arguments if(abs(sum(probs)-1) > sqrt(.Machine$double.eps)){ stop("probs need to sum to 1") } ## prepare criterion function lst <- calcGrads(models, doses, weights, Delta, off, scal, direction, designCrit) ## check for invalid values (NA, NaN and +-Inf) checkInvalid <- function(x) any(is.na(x)|(is.nan(x)|!is.finite(x))) grInv <- checkInvalid(lst$modgrads) MvInv <- ifelse(designCrit != "Dopt", checkInvalid(lst$TDgrad), FALSE) if(grInv | MvInv) stop("NA, NaN or +-Inf in gradient or bvec") ## prepare arguments before passing to C M <- as.integer(length(probs)) if(M != length(lst$nPar)) stop("probs of wrong length") if(length(lst$modgrads) != length(doses)*sum(lst$nPar)) stop("Gradient of wrong length.") if(length(nold) != nD) stop("Either nold or doses of wrong length.") nD <- as.integer(nD) p <- as.integer(lst$nPar) intdesignCrit <- match(designCrit, c("TD", "Dopt", "Dopt&TD")) objFunc <- function(par){ optFunc(par, xvec=as.double(lst$modgrads), pvec=as.integer(p), nD=nD, probs=as.double(probs), M=M, n=as.double(n), nold = as.double(nold), bvec=as.double(lst$TDgrad), trans = transform, standInt = standInt,designCrit = as.integer(intdesignCrit)) } } else { # user criterion if(missing(userCrit)) stop("need design criterion in userCrit when specified") if(!is.function(userCrit)) stop("userCrit needs to be a function") objFunc <- function(par){ par2 <- do.call("transform", list(par, nD)) userCrit((par2*n+nold)/(sum(nold)+n), doses, ...) } } ## perform actual optimization if(optimizer != "exact"){ # use callOptim function res <- callOptim(objFunc, optimizer, nD, control, lowbnd, uppbnd) if(optimizer == "Nelder-Mead" | optimizer == "nlminb"){ # transform results back des <- transTrig(res$par, length(doses)) if(optimizer == "Nelder-Mead"){ crit <- res$value } else { crit <- res$objective } } if(optimizer == "solnp"){ # no need to transform back des <- res$pars crit <- res$values[length(res$values)] } if(res$convergence){ message("Message: algorithm indicates no convergence, the 'optimizerResults' attribute of the returned object contains more details.") } } else { # exact criterion (enumeration of all designs) ## enumerate possible exact designs con <- list(maxvls1 = 1e6, maxvls2 = 1e5, groupSize = 1) con[(namc <- names(control))] <- control mat <- getDesMat(n, nD, lowbnd, uppbnd, con$groupSize, con$maxvls1, con$maxvls2) designmat <- sweep(mat*n, 2, nold, "+") res <- sweep(designmat, 2, n+sum(nold), "/") ## evaluate criterion function if(designCrit != "userCrit"){ critv <- calcCrit(res, models, probs, doses, designCrit, Delta, standDopt, weights, nold, n) } else { critv <- apply(res, 1, objFunc) } des <- mat[which.min(critv),] crit <- min(critv) } out <- list(crit = crit, design = des, doses = doses, n = n, nold = nold, designCrit = designCrit) attr(out, "optimizerResults") <- res class(out) <- "DRdesign" out } #' Calculate design criteria for set of designs #' #' @inheritParams optDesign #' @param design Argument for \samp{rndDesign} and \samp{calcCrit} functions: Numeric vector (or matrix) of allocation #' weights for the different doses. The rows of the matrices need to sum to 1. Alternatively also an object of class #' "DRdesign" can be used for \samp{rndDesign}. Note that there should be at least as many design points available as #' there are parameters in the dose-response models selected in \code{models} (otherwise the code returns an NA). #' #' @rdname optDesign #' @export calcCrit <- function(design, models, probs, doses, designCrit = c("Dopt", "TD", "Dopt&TD"), Delta, standDopt = TRUE, weights, nold = rep(0, length(doses)), n){ if(!inherits(models, "Mods")) stop("\"models\" needs to be of class Mods") off <- attr(models, "off") scal <- attr(models, "scal") if(missing(doses)) doses <- attr(models, "doses") ## extract design if(inherits(design, "DRdesign")) design <- design$design if(!is.numeric(design)) stop("design needs to be numeric") if(!is.matrix(design)) design <- matrix(design, ncol = length(design)) if(ncol(design) != length(doses)) stop("design and doses should be of the same length") if(any(abs(rowSums(design)-1) > 0.001)) stop("design needs to sum to 1") if(missing(n)){ n <- 1 # value arbitrary } else { if(length(n) > 1) stop("n needs to be of length 1") } if(missing(weights)){ weights <- rep(1, length(doses)) } else { if(length(weights) != length(doses)) stop("weights and doses need to be of equal length") } designCrit <- match.arg(designCrit) if(missing(Delta) & substr(designCrit, 1, 3) == "TD") stop("need to specify clinical relevance parameter") direction <- attr(models, "direction") if(designCrit == "TD" | designCrit == "Dopt&TD"){ # check whether TD exists in (0,max(dose)) if(length(unique(direction)) > 1) stop("need to provide either \"increasing\" or \"decreasing\" as direction to optDesign, when TD optimal designs should be calculated") direction <- unique(direction) tdMods <- TD(models, Delta, "continuous", direction) tdMods[tdMods > max(doses)] <- NA if(any(is.na(tdMods))) stop("TD does not exist for ", paste(names(tdMods)[is.na(tdMods)], collapse=", " ), " model(s)") } if(designCrit == "Dopt" | designCrit == "Dopt&TD"){ # check whether Fisher matrix can be singular np <- nPars(names(models)) if(max(np) > length(doses)) stop("need more dose levels to calculate Dopt design.") } if(!is.logical(standDopt)) stop("standDopt needs to contain a logical value") standInt <- as.integer(standDopt) lst <- calcGrads(models, doses, weights, Delta, off, scal, direction, designCrit) ## check for invalid values (NA, NaN and +-Inf) checkInvalid <- function(x) any(is.na(x)|(is.nan(x)|!is.finite(x))) grInv <- checkInvalid(lst$modgrads) MvInv <- ifelse(designCrit != "Dopt", checkInvalid(lst$TDgrad), FALSE) if(grInv | MvInv) stop("NA, NaN or +-Inf in gradient or bvec") ## prepare for input into C M <- as.integer(length(probs)) nD <- as.integer(length(doses)) if(M != length(lst$nPar)) stop("Probs of wrong length") if(length(lst$modgrads) != length(doses)*sum(lst$nPar)) stop("Gradient of wrong length.") if(length(nold) != nD) stop("Either nold or doses of wrong length.") p <- as.integer(lst$nPar) intdesignCrit <- match(designCrit, c("TD", "Dopt", "Dopt&TD")) res <- numeric(nrow(design)) ## check for sufficient number of design points iter <- 1:nrow(design) design0 <- sweep(design, 2, nold, "+") count <- apply(design0, 1, function(x) sum(x > 0.0001)) ind <- count < max(p[probs > 0]) if(any(ind)){ iter <- iter[!ind] res[ind] <- NA if(all(is.na(res))) warning("need at least as many dose levels in the design as parameters in the model") } for(i in iter){ res[i] <- optFunc(design[i,], xvec=as.double(lst$modgrads), pvec=as.integer(p), nD=nD, probs=as.double(probs), M=M, n=as.double(n), nold = as.double(nold), bvec=as.double(lst$TDgrad), trans = idtrans, standInt = standInt, designCrit = as.integer(intdesignCrit)) } res } #' @export print.DRdesign <- function(x, digits = 5, eps = 0.001, ...){ nam <- switch(x$designCrit, "TD" = "TD", "Dopt" = "D", "Dopt&TD" = "TD and D mixture", "userCrit" = "userCrit") cat("Calculated", nam, "- optimal design:\n") ind <- x$design > eps vec <- x$design[ind] names(vec) <- x$doses[ind] print(round(vec, digits = digits)) } #' Efficiently round calculated design to a finite sample size #' #' @inheritParams calcCrit #' @param eps Argument for \samp{rndDesign} function: Value under which elements of w will be regarded as 0. #' @rdname optDesign #' @export rndDesign <- function(design, n, eps = 0.0001){ if(missing(n)) stop("total sample size \"n\" needs to be specified") n <- round(n) # ensure n is an integer (at least numerically) if(inherits(design, "DRdesign")){ design <- design$design } if(!inherits(design, "numeric")) stop("design needs to be a numeric vector.") zeroind <- design < eps if(any(zeroind)){ design <- design[!zeroind]/sum(design[!zeroind]) } l <- sum(!zeroind) nn <- ceiling((n-0.5*l)*design) while(sum(nn)!=n){ if(sum(nn) 0) z <- 1 for(i in 1:nc){ for(j in 1:nr){ if(z > total) break lattice::trellis.focus("panel", i, j) args <- lattice::trellis.panelArgs() miny <- min(args$y) maxy <- max(args$y) dy <- maxy-miny for(k in 1:length(x$doses)){ yy <- c(0,(x$design*dy)[k])+miny xx <- rep(x$doses[k],2) lattice::panel.xyplot(xx, yy, type="l", col = colDes, lwd = lwdDes) } z <- z+1 lattice::trellis.unfocus() } } } DoseFinding/R/MCTtest.R0000644000176200001440000003604614654153534014335 0ustar liggesusers## here the multiple contrast test related functions #' Performs multiple contrast test #' #' This function performs a multiple contrast test. The contrasts are either directly specified in \samp{contMat} or #' optimal contrasts derived from the \samp{models} argument. The directionality of the data (i.e. whether an increase #' or decrease in the response variable is beneficial is inferred from the \samp{models} object, see #' \code{\link{Mods}}). #' #' For \samp{type = "normal"} an ANCOVA model based on a homoscedastic normality assumption (with additive covariates #' specified in \samp{addCovars}) is fitted. #' #' For \samp{type = "general"} it is assumed multivariate normally distributed estimates are specified in \samp{resp} #' with covariance given by \samp{S}, and the contrast test statistic is calculated based on this assumption. Degrees of #' freedom specified in \samp{df}. #' #' Integrals over the multivariate t and multivariate normal distribution are calculated using the \samp{mvtnorm} #' package. #' #' @param dose,resp Either vectors of equal length specifying dose and response values, or names of variables in the #' data frame specified in \samp{data}. #' @param data Data frame containing the variables referenced in dose and resp if \samp{data} is not specified it is #' assumed that \samp{dose} and \samp{resp} are variables referenced from data (and no vectors) #' @param models An object of class \samp{Mods}, see \code{\link{Mods}} for details #' @param S The covariance matrix of \samp{resp} when \samp{type = "general"}, see Description. #' @param type Determines whether inference is based on an ANCOVA model under a homoscedastic normality assumption (when #' \samp{type = "normal"}), or estimates at the doses and their covariance matrix and degrees of freedom are specified #' directly in \samp{resp}, \samp{S} and \samp{df}. See also \code{\link{fitMod}} and Pinheiro et al. (2014). #' @param addCovars Formula specifying additive linear covariates (for \samp{type = "normal"}) #' @param placAdj Logical, if true, it is assumed that placebo-adjusted #' estimates are specified in \samp{resp} (only possible for \samp{type = #' "general"}). #' @param alpha Significance level for the multiple contrast test #' @param df Specify the degrees of freedom to use in case \samp{type = "general"}. If this argument is missing #' \samp{df = Inf} is used (which corresponds to the multivariate normal distribution). For type = "normal" the #' degrees of freedom deduced from the AN(C)OVA fit are used and this argument is ignored. #' @param critV Supply a pre-calculated critical value. If this argument is NULL, no critical value will be calculated #' and the test decision is based on the p-values. If \samp{critV = TRUE} the critical value will be calculated. #' @param pVal Logical determining, whether p-values should be calculated. #' @param alternative Character determining the alternative for the multiple contrast trend test. #' @param na.action A function which indicates what should happen when the data contain NAs. #' @param mvtcontrol A list specifying additional control parameters for the \samp{qmvt} and \samp{pmvt} calls in the #' code, see also \code{\link{mvtnorm.control}} for details. #' @param contMat Contrast matrix to apply to the ANCOVA dose-response estimates. The contrasts need to be in the #' columns of the matrix (i.e. the column sums need to be 0). #' @return An object of class MCTtest, a list containing the output. #' @author Bjoern Bornkamp #' @seealso \code{\link{powMCT}}, \code{\link{optContr}} #' @references Hothorn, T., Bretz, F., and Westfall, P. (2008). Simultaneous Inference in General Parametric Models, #' \emph{Biometrical Journal}, \bold{50}, 346--363 #' #' Pinheiro, J. C., Bornkamp, B., Glimm, E. and Bretz, F. (2014) Model-based dose finding under model uncertainty #' using general parametric models, \emph{Statistics in Medicine}, \bold{33}, 1646--1661 #' @examples #' #' ## example without covariates #' data(biom) #' ## define shapes for which to calculate optimal contrasts #' modlist <- Mods(emax = 0.05, linear = NULL, logistic = c(0.5, 0.1), #' linInt = c(0, 1, 1, 1), doses = c(0, 0.05, 0.2, 0.6, 1)) #' m1 <- MCTtest(dose, resp, biom, models=modlist) #' ## now calculate critical value (but not p-values) #' m2 <- MCTtest(dose, resp, biom, models=modlist, critV = TRUE, pVal = FALSE) #' ## now hand over critical value #' m3 <- MCTtest(dose, resp, biom, models=modlist, critV = 2.24) #' #' ## example with covariates #' data(IBScovars) #' modlist <- Mods(emax = 0.05, linear = NULL, logistic = c(0.5, 0.1), #' linInt = c(0, 1, 1, 1), doses = c(0, 1, 2, 3, 4)) #' MCTtest(dose, resp, IBScovars, models = modlist, addCovars = ~gender) #' #' ## example using general approach (fitted on placebo-adjusted scale) #' ancMod <- lm(resp~factor(dose)+gender, data=IBScovars) #' ## extract estimates and information to feed into MCTtest #' drEst <- coef(ancMod)[2:5] #' vc <- vcov(ancMod)[2:5, 2:5] #' doses <- 1:4 #' MCTtest(doses, drEst, S = vc, models = modlist, placAdj = TRUE, #' type = "general", df = Inf) #' #' ## example with general alternatives handed over #' data(biom) #' ## calculate contrast matrix for the step-contrasts #' ## represent them as linInt models #' models <- Mods(linInt=rbind(c(1,1,1,1), #' c(0,1,1,1), #' c(0,0,1,1), #' c(0,0,0,1)), #' doses=c(0,0.05,0.2,0.6,1)) #' plot(models) #' ## now calculate optimal contrasts for these means #' ## use weights from actual sample sizes #' weights <- as.numeric(table(biom$dose)) #' contMat <- optContr(models, w = weights) #' ## plot contrasts #' plot(contMat) #' ## perform multiple contrast test #' MCTtest(dose, resp, data=biom, contMat = contMat) #' #' ## example for using the Dunnett contrasts #' ## Dunnett contrasts #' doses <- sort(unique(biom$dose)) #' contMat <- rbind(-1, diag(4)) #' rownames(contMat) <- doses #' colnames(contMat) <- paste("D", doses[-1], sep="") #' MCTtest(dose, resp, data=biom, contMat = contMat) #' #' @export MCTtest <- function(dose, resp, data = NULL, models, S = NULL, type = c("normal", "general"), addCovars = ~1, placAdj = FALSE, alpha = 0.025, df = NULL, critV = NULL, pVal = TRUE, alternative = c("one.sided", "two.sided"), na.action = na.fail, mvtcontrol = mvtnorm.control(), contMat = NULL){ ## perform multiple contrast test type <- match.arg(type) alternative <- match.arg(alternative) ## check for valid arguments cal <- as.character(match.call()) lst <- checkAnalyArgs(dose, resp, data, S, type, addCovars, placAdj, na.action, cal) dd <- lst$dd;type <- lst$type;S <- lst$S doseNam <- lst$doseNam;respNam <- lst$respNam ## calculate optimal contrasts and test-statistics doses <- unique(dd[[doseNam]]) k <- length(doses) if(type == "normal"){ dd[, doseNam] <- as.factor(dd[, doseNam]) form <- paste(respNam, "~", doseNam, "+", addCovars[2], "-1", sep="") lm.fit <- lm(as.formula(form), data = dd) est <- coef(lm.fit)[1:k] vc <- vcov(lm.fit)[1:k, 1:k] df <- lm.fit$df.residual } else { est <- dd[[respNam]] vc <- S if(is.null(df)) df <- Inf } if(is.null(contMat)){ # calculate optimal contrasts contMat <- optContr(models, doses, S=vc, placAdj=placAdj)$contMat rownames(contMat) <- doses } else { # contrast matrix specified if(inherits(contMat, "optContr")) contMat <- contMat$contMat if(nrow(contMat) != length(est)) stop("contMat of incorrect dimensions") } ct <- as.vector(est %*% contMat) covMat <- t(contMat) %*% vc %*% contMat den <- sqrt(diag(covMat)) tStat <- ct/den if(alternative == "two.sided"){ tStat <- abs(tStat) } corMat <- cov2cor(covMat) if(is.null(critV)){ if(!pVal){ stop("either p-values or critical value need to be calculated.") } } else if(is.logical(critV) & critV == TRUE){ critV <- critVal(corMat, alpha, df, alternative, mvtcontrol) attr(critV, "Calc") <- TRUE # determines whether cVal was calculated } else { pVal <- FALSE # pvals are not calculated if critV is supplied attr(critV, "Calc") <- FALSE } if(pVal){ pVals <- MCTpval(contMat, corMat, df, tStat, alternative, mvtcontrol) } res <- list(contMat = contMat, corMat = corMat, tStat = tStat, alpha = alpha, alternative = alternative[1]) if(pVal) attr(res$tStat, "pVal") <- pVals res$critVal <- critV class(res) <- "MCTtest" res } #' @export print.MCTtest <- function(x, digits = 3, eps = 1e-3, ...){ cat("Multiple Contrast Test\n") cat("\n","Contrasts:","\n", sep="") print(round(x$contMat, digits)) cat("\n","Contrast Correlation:","\n", sep="") print(round(x$corMat, digits)) cat("\n","Multiple Contrast Test:","\n",sep="") ord <- rev(order(x$tStat)) if(!any(is.null(attr(x$tStat, "pVal")))){ pval <- format.pval(attr(x$tStat, "pVal"), digits = digits, eps = eps) dfrm <- data.frame(round(x$tStat, digits)[ord], pval[ord]) names(dfrm) <- c("t-Stat", "adj-p") } else { dfrm <- data.frame(round(x$tStat, digits)[ord]) names(dfrm) <- c("t-Stat") } print(dfrm) if(!is.null(x$critVal)){ twoSide <- x$alternative == "two.sided" vec <- c(" one-sided)", " two-sided)") cat("\n","Critical value: ", round(x$critVal, digits), sep="") if(attr(x$critVal, "Calc")){ cat(" (alpha = ", x$alpha,",", vec[twoSide+1], "\n", sep="") } else { cat("\n") } } } #' Calculate critical value for multiple contrast test #' #' Calculation of the critical value for a maximum contrast test. This is based on the equicoordinate quantile function #' of the multivariate normal or t distribution as implemented in the \code{qmvt} function from the mvtnorm package. #' #' @inheritParams MCTtest #' @param corMat Correlation matrix of contrasts #' @param df Specify the degrees of freedom to use, if this argument is missing \samp{df = Inf} is used (which #' corresponds to the multivariate normal distribution). #' @param control A list specifying additional control parameters for the \samp{qmvt} and \samp{pmvt} calls in the code, #' see also \code{\link{mvtnorm.control}} for details. #' @author Bjoern Bornkamp #' @seealso \code{\link{powMCT}}, \code{\link{optContr}}, \code{\link{MCTtest}} #' @examples #' #' R <- matrix(c(1,0.5,0.5,1), nrow=2) #' critVal(R, alpha = 0.05, df = 1) #' critVal(R, alpha = 0.05, df = 20) #' critVal(R, alpha = 0.05, df = Inf) #' #' @export critVal <- function(corMat, alpha = 0.025, df = NULL, alternative = c("one.sided", "two.sided"), control = mvtnorm.control()){ ## calculate critical value alternative <- match.arg(alternative) if(missing(corMat)) stop("corMat needs to be specified") if(is.null(df)) stop("degrees of freedom need to be specified") tail <- ifelse(alternative[1] == "two.sided", "both.tails", "lower.tail") if (!missing(control)) { if(!is.list(control)) { stop("when specified, 'control' must be a list") } ctrl <- do.call("mvtnorm.control", control) } else { ctrl <- control } if(!is.finite(df)) # normal case df <- 0 qmvtCall <- c(list(1-alpha, tail = tail, df = df, corr = corMat, algorithm = ctrl, interval = ctrl$interval)) do.call(mvtnorm::qmvt, qmvtCall)$quantile } #' Calculate multiplicity adjusted p-values for multiple contrast test #' #' Calculate multiplicity adjusted p-values for a maximum contrast test corresponding to a set of contrasts and given a #' set of observed test statistics. This function is exported as it may be a useful building block and used in more #' complex testing situations that are not covered by \code{\link{MCTtest}}. Most users probably don't need to use this #' function. #' #' @inheritParams critVal #' @param contMat Contrast matrix to use. The individual contrasts should be saved in the columns of the matrix #' @param df Degrees of freedom to use for calculation. #' @param tStat Vector of contrast test statistics #' @return Numeric containing the calculated p-values. #' @author Bjoern Bornkamp #' @seealso \code{\link{MCTtest}}, \code{\link{optContr}} #' @references Pinheiro, J. C., Bornkamp, B., and Bretz, F. (2006). Design and analysis of dose finding studies #' combining multiple comparisons and modeling procedures, \emph{Journal of Biopharmaceutical Statistics}, \bold{16}, #' 639--656 #' @examples #' data(biom) #' ## define shapes for which to calculate optimal contrasts #' modlist <- Mods(emax = 0.05, linear = NULL, logistic = c(0.5, 0.1), #' linInt = c(0, 1, 1, 1), doses = c(0, 0.05, 0.2, 0.6, 1)) #' contMat <- optContr(modlist, w=1)$contMat #' ## calculate inputs needed for MCTpval #' fit <- lm(resp~factor(dose)-1, data=biom) #' est <- coef(fit) #' vc <- vcov(fit) #' ct <- as.vector(est %*% contMat) #' covMat <- t(contMat) %*% vc %*% contMat #' den <- sqrt(diag(covMat)) #' tStat <- ct/den #' corMat <- cov2cor(t(contMat) %*% vc %*% contMat) #' MCTpval(contMat, corMat, df=100-5, tStat) #' ## compare to #' test <- MCTtest(dose, resp, biom, models=modlist) #' attr(test$tStat, "pVal") #' @export MCTpval <- function(contMat, corMat, df, tStat, alternative = c("one.sided", "two.sided"), control = mvtnorm.control()){ ## function to calculate p-values nD <- nrow(contMat) nMod <- ncol(contMat) if(missing(corMat)) stop("corMat needs to be specified") if(missing(df)) stop("degrees of freedom need to be specified") if(length(tStat) != nMod) stop("tStat needs to have length equal to the number of models") alternative <- match.arg(alternative) ctrl <- mvtnorm.control() if (!missing(control)) { control <- as.list(control) ctrl[names(control)] <- control } if(!is.finite(df)) # normal case df <- 0 lower <- switch(alternative[1], one.sided = matrix(rep(-Inf, nMod^2), nrow = nMod), two.sided = matrix(rep(-tStat, each = nMod), nrow = nMod)) upper <- switch(alternative[1], one.sided = matrix(rep(tStat, each = nMod), nrow = nMod), two.sided = matrix(rep(tStat, each = nMod), nrow = nMod)) pVals <- numeric(nMod) for(i in 1:nMod){ tmp <- 1 - mvtnorm::pmvt(lower[,i], upper[,i], df = df, corr = corMat, algorithm = ctrl) pVals[i] <- tmp if(attr(tmp,"msg") != "Normal Completion"){ warning(sprintf("Warning from mvtnorm::pmvt: %s.", attr(tmp, "msg"))) if(attr(tmp, "msg") == "Covariance matrix not positive semidefinite"){ warning("Setting calculated p-value to NA") pVals[i] <- NA } } } pVals } DoseFinding/R/bMCTtest_helpers.R0000644000176200001440000000412114654153534016206 0ustar liggesusers checkAnalyArgs_bMCP <- function (dose, resp, data, S, type, prior, na.action, cal) { if (!is.null(data)) { if (!is.data.frame(data)) stop("data argument needs to be a data frame") nams <- c(cal[2], cal[3]) ind <- match(nams, names(data)) if (any(is.na(ind))) stop("variable(s): ", paste(nams[is.na(ind)], collapse = ", "), " not found in ", cal[4]) dd <- na.action(data[, nams]) } else { if (!(is.numeric(resp) && is.null(dim(resp)))) { warning(cal[3], " is not a numeric but a ", class(resp)[1], ", converting with as.numeric()") resp <- as.numeric(resp) } if (length(dose) != length(resp)) stop(cal[2], " and ", cal[3], " not of equal length") dd <- na.action(data.frame(dose, resp)) cal[2:3] <- gsub("\\$", "", cal[2:3]) cal[2:3] <- gsub("\\[|\\]", "", cal[2:3]) colnames(dd) <- cal[2:3] } doseNam <- cal[2] respNam <- cal[3] if (any(dd[[doseNam]] < -.Machine$double.eps)) stop("dose values need to be non-negative") if (!is.numeric(dd[[doseNam]])) stop("dose variable needs to be numeric") if (!is.numeric(dd[[respNam]])) stop("response variable needs to be numeric") if (type == "general" & is.null(S)) stop("S argument missing") if (type == "normal" & !is.null(S)) message("Message: S argument ignored for type == \"normal\"\n") if (!is.null(S)) { if (!is.matrix(S)) stop("S needs to be of class matrix") nD <- length(dd[[doseNam]]) if (nrow(S) != nD | ncol(S) != nD) stop("S and dose have non-conforming size") } ord <- order(dd[[doseNam]]) dd <- dd[ord, ] Sout <- NULL if (type == "general") Sout <- S[ord, ord] if (length(unique(dd[[doseNam]])) != length(prior)) stop("Dose and prior have non-conforming size") if (!all(unlist(lapply(prior, function(x) "normMix" %in% class(x))))) stop("priors need to be of class normMix") return(list(dd = dd, type = type, S = Sout, ord = ord, doseNam = doseNam, respNam = respNam)) } DoseFinding/R/DesignMCPModApp.R0000644000176200001440000000130514654153534015652 0ustar liggesusers#' Start externally hosted DesignMCPMod Shiny App #' #' #' This function starts the externally hosted DesignMCPMod Shiny App in a #' browser window. The app was developed by Sophie Sun [aut, cre], Danyi Xiong #' [aut], Bjoern Bornkamp [ctb], Frank Bretz [ctb], Ardalan Mirshani [ctb]. #' This app performs power and sample size calculations for a multiple contrast #' test for normal, binary and negative binomial outcomes. The app uses the #' DoseFinding package as calculation backend and the R code underlying the #' calculations in the app can be extracted from the app. #' #' @export DesignMCPModApp <- function(){ browseURL("https://huisophiesunrshiny.shinyapps.io/designmcpmod/") } DoseFinding/R/optContr.R0000644000176200001440000002546514762603270014622 0ustar liggesusers## functions for calculating optimal contrasts and critical value #' Calculate optimal contrasts #' #' This function calculates a contrast vectors that are optimal for detecting #' certain alternatives. The contrast is optimal in the sense of maximizing the #' non-centrality parameter of the underlying contrast test statistic: #' \deqn{\frac{c'\mu}{\sqrt{c'Sc}}}{c'mu/sqrt(c'Sc).} Here \eqn{\mu}{mu} is the #' mean vector under the alternative and \eqn{S}{S} the covariance matrix #' associated with the estimate of \eqn{\mu}{mu}. The optimal contrast is #' given by \deqn{c^{opt} \propto S^{-1}\left(\mu - \frac{\mu^{\prime}S^{-1}1} #' {1^\prime S^{-1} 1}\right),}{c propto S^(-1) (mu - mu'S^(-1)1)/(1'S^(-1)1),} #' see Pinheiro et al. (2014). #' #' Note that the directionality (i.e. whether in "increase" in the response #' variable is beneficial or a "decrease", is inferred from the specified #' \samp{models} object, see \code{\link{Mods}} for details). #' #' Constrained contrasts (type = "constrained") add the additional constraint #' in the optimization that the sign of the contrast coefficient for control #' and active treatments need to be different. The quadratic programming #' algorithm from the quadprog package is used to calculate the contrasts. #' #' #' @aliases optContr plot.optContr plotContr #' @param models An object of class \samp{Mods} defining the dose-response #' shapes for which to calculate optimal contrasts. #' @param doses Optional argument. If this argument is missing the doses #' attribute in the \samp{Mods} object specified in \samp{models} is used. #' @param w,S Arguments determining the matrix S used in the formula for the #' optimal contrasts. Exactly one of \samp{w} and \samp{S} has to be specified. #' Note that \samp{w} and \samp{S} only have to be specified up to #' proportionality \cr \describe{ \item{w}{ Vector specifying weights for the #' different doses, in the formula for calculation of the optimal contrasts. #' Specifying a weights vector is equivalent to specifying S=diag(1/w) (e.g. in #' a homoscedastic case with unequal sample sizes, \samp{w} should be #' proportional to the group sample sizes). } \item{S}{ Directly specify a #' matrix proportional to the covariance matrix to use. } } #' @param placAdj Logical determining, whether the contrasts should be applied #' to placebo-adjusted estimates. If yes the returned coefficients are no #' longer contrasts (i.e. do not sum to 0). However, the result of multiplying #' of this "contrast" matrix with the placebo adjusted estimates, will give the #' same results as multiplying the original contrast matrix to the unadjusted #' estimates. #' @param type For \samp{type = "constrained"} the contrast coefficients of the #' zero dose group are constrained to be different from the coefficients of the #' active treatment groups. So that a weighted sum of the active treatments is #' compared against the zero dose group. For an increasing trend the #' coefficient of the zero dose group is negative and all other coefficients #' have to be positive (for a decreasing trend the other way round). #' @return Object of class \samp{optContr}. A list containing entries contMat #' and muMat (i.e. contrast, mean and correlation matrix). #' @author Bjoern Bornkamp #' @seealso \code{\link{MCTtest}} #' @references Bretz, F., Pinheiro, J. C., and Branson, M. (2005), Combining #' multiple comparisons and modeling techniques in dose-response studies, #' \emph{Biometrics}, \bold{61}, 738--748 #' #' Pinheiro, J. C., Bornkamp, B., Glimm, E. and Bretz, F. (2014) Model-based #' dose finding under model uncertainty using general parametric models, #' \emph{Statistics in Medicine}, \bold{33}, 1646--1661 #' @examples #' #' doses <- c(0,10,25,50,100,150) #' models <- Mods(linear = NULL, emax = 25, #' logistic = c(50, 10.88111), exponential= 85, #' betaMod=rbind(c(0.33,2.31), c(1.39,1.39)), #' doses = doses, addArgs = list(scal = 200)) #' contMat <- optContr(models, w = rep(50,6)) #' plot(contMat) #' plotContr(contMat) # display contrasts using ggplot2 #' #' ## now we would like the "contrasts" for placebo adjusted estimates #' dosPlac <- doses[-1] #' ## matrix proportional to cov-matrix of plac. adj. estimates for balanced data #' S <- diag(5)+matrix(1, 5,5) #' ## note that we explicitly hand over the doses here #' contMat0 <- optContr(models, doses=dosPlac, S = S, placAdj = TRUE) #' ## -> contMat0 is no longer a contrast matrix (columns do not sum to 0) #' colSums(contMat0$contMat) #' ## calculate contrast matrix for unadjusted estimates from this matrix #' ## (should be same as above) #' aux <- rbind(-colSums(contMat0$contMat), contMat0$contMat) #' t(t(aux)/sqrt(colSums(aux^2))) ## compare to contMat$contMat #' #' ## now calculate constrained contrasts #' if(requireNamespace("quadprog", quietly = TRUE)){ #' optContr(models, w = rep(50,6), type = "constrained") #' optContr(models, doses=dosPlac, S = S, placAdj = TRUE, #' type = "constrained") #' } #' @export optContr <- function(models, doses, w, S, placAdj = FALSE, type = c("unconstrained", "constrained")){ ## calculate optimal contrasts and critical value if(!(inherits(models, "Mods"))) stop("models needs to be of class Mods") if(missing(doses)) doses <- attr(models, "doses") scal <- attr(models, "scal") off <- attr(models, "off") nodes <- attr(models, "doses") direction <- unique(attr(models, "direction")) if(length(direction) > 1) stop("need to provide either \"increasing\" or \"decreasing\" as direction to optContr") mu <- getResp(models, doses) if(placAdj){ mu0 <- getResp(models, 0) mu <- mu-matrix(mu0[1,], byrow = TRUE, nrow=nrow(mu), ncol=ncol(mu)) } type <- match.arg(type) if(type == "constrained"){ avail <- requireNamespace("quadprog", quietly = TRUE) if(!avail) stop("Need suggested package quadprog to calculate constrained contrasts") } if(any(doses == 0) & placAdj) stop("If placAdj == TRUE there should be no placebo group in \"doses\"") ## check for n and vCov arguments if(!xor(missing(w), missing(S))) stop("Need to specify exactly one of \"w\" or \"S\"") if(!missing(w)){ if(length(w) == 1){ # assume equal weights S <- Sinv <- diag(length(doses)) } else { if(length(w) != length(doses)) stop("w needs to be of length 1 or of the same length as doses") S <- diag(1/w) Sinv <- diag(w) } } else { if(!is.matrix(S)) stop("S needs to be a matrix") Sinv <- solve(S) } contMat <- modContr(mu, Sinv=Sinv, placAdj = placAdj, type = type, direction = direction) rownames(contMat) <- doses corMat <- cov2cor(t(contMat) %*% S %*% contMat) res <- list(contMat = contMat, muMat = mu, corMat = corMat) attr(res, "type") <- type attr(res, "placAdj") <- placAdj class(res) <- "optContr" res } #' @export print.optContr <- function(x, digits = 3, ...){ cat("Optimal contrasts\n") print(round(x$contMat, digits)) } #' @export summary.optContr <- function(object, digits = 3, ...){ class(object) <- "summary.optContr" print(object, digits = digits) } #' @export print.summary.optContr <- function(x, digits = 3, ...){ cat("Optimal contrasts\n") cat("\n","Optimal Contrasts:","\n", sep="") print(round(x$contMat, digits)) cat("\n","Contrast Correlation Matrix:","\n", sep="") print(round(x$corMat, digits)) cat("\n") } #' Plot optimal contrasts #' #' @param x,superpose,xlab,ylab,plotType Arguments for the plot method for #' optContr objects. plotType determines, whether the contrasts or the #' underlying (standardized) mean matrix should be plotted. #' @param ... Additional arguments for plot method #' #' @rdname optContr #' @method plot optContr #' @export plot.optContr <- function (x, superpose = TRUE, xlab = "Dose", ylab = NULL, plotType = c("contrasts", "means"), ...){ plotType <- match.arg(plotType) if (is.null(ylab)) { if (plotType == "contrasts") { ylab <- "Contrast coefficients" } else { ylab <- "Normalized model means" } } cM <- x$contMat if (plotType == "means") cM <- t(t(x$muMat)/apply(x$muMat, 2, max)) nD <- nrow(cM) nM <- ncol(cM) cMtr <- data.frame(resp = as.vector(cM), dose = rep(as.numeric(dimnames(cM)[[1]]), nM), model = factor(rep(dimnames(cM)[[2]], each = nD), levels = dimnames(cM)[[2]])) if(superpose){ spL <- lattice::trellis.par.get("superpose.line") spL$lty <- rep(spL$lty, nM%/%length(spL$lty) + 1)[1:nM] spL$lwd <- rep(spL$lwd, nM%/%length(spL$lwd) + 1)[1:nM] spL$col <- rep(spL$col, nM%/%length(spL$col) + 1)[1:nM] ## number of columns in legend nCol <- ifelse(nM < 5, nM, min(4,ceiling(nM/min(ceiling(nM/4),3)))) key <- list(lines = spL, transparent = TRUE, text = list(levels(cMtr$model), cex = 0.9), columns = nCol) ltplot <- lattice::xyplot(resp ~ dose, data = cMtr, subscripts = TRUE, groups = cMtr$model, panel = panel.superpose, type = "o", xlab = xlab, ylab = ylab, key = key, ...) } else { ltplot <- lattice::xyplot(resp ~ dose | model, data = cMtr, type = "o", xlab = xlab, ylab = ylab, strip = function(...){ lattice::strip.default(..., style = 1) }, ...) } print(ltplot) } #' Plot optimal contrasts #' #' @inheritParams plot.optContr #' @param optContrObj For function \samp{plotContr} the \samp{optContrObj} #' should contain an object of class \samp{optContr}. #' #' @rdname optContr #' @export plotContr <- function(optContrObj, xlab = "Dose", ylab = "Contrast coefficients"){ if(!inherits(optContrObj, "optContr")) stop("\"optContrObj\" needs to be of class Mods") parList <- attr(optContrObj$muMat, "parList") mod_nams <- getModNams(parList) cM <- optContrObj$contMat nD <- nrow(cM) nM <- ncol(cM) cMtr <- data.frame(resp = as.vector(cM), dose = rep(as.numeric(dimnames(cM)[[1]]), nM), model = factor(rep(mod_nams, each = nD), levels=mod_nams), levels = dimnames(cM)[[2]]) ggplot2::ggplot(cMtr, ggplot2::aes(.data$dose, .data$resp, col=.data$model))+ ggplot2::geom_line(size=1.2)+ ggplot2::geom_point()+ ggplot2::theme_bw()+ ggplot2::geom_point(size=1.8)+ ggplot2::xlab(xlab)+ggplot2::ylab(ylab)+ ggplot2::theme(legend.position = "top", legend.title = ggplot2::element_blank()) } DoseFinding/R/planMod_helpers.R0000644000176200001440000002270614654153534016124 0ustar liggesusers## various functions for assessing the operating characteristics of a design ## for model-based estimation of dose-response functions ## calculates the variance of the estimated curve getPredVar <- function(model, cf, V, pDose, off, scal){ gr <- gradCalc(model, cf, pDose, off, scal) gr0 <- gradCalc(model, cf, 0, off, scal) grd <- sweep(gr, 2, gr0) out <- apply(grd, 1, function(x){ as.numeric(t(x)%*%V%*%x) }) out } ## calculates the variance of the EDp estimate getEDVar <- function(model, cf, V, scale = c("unrestricted", "logit"), p, maxD, off, scal, nodes){ grd <- calcEDgrad(model, cf, maxD, p, off, scal, nodes) if(scale == "logit"){ tmp <- calcED(model, cf, p, maxD, "continuous", off=off, scal=scal, nodes=nodes) grd <- grd*(-maxD/(tmp*(tmp-maxD))) } grd <- as.numeric(grd) return(as.numeric(t(grd)%*%V%*%grd)) } ## calculates the variance of the TD estimate getTDVar <- function(model, cf, V, scale = c("unrestricted", "log"), Delta, direction = c("increasing", "decreasing"), off, scal, nodes){ tmp <- calcTD(model, cf, Delta, "continuous", direction, off=off, scal=scal, nodes = nodes) grd <- calcTDgrad(model, cf, Delta, direction, off, scal, nodes) if(scale == "log") grd <- grd/tmp grd <- as.numeric(grd) return(as.numeric(t(grd)%*%V%*%grd)) } ## calculates approximate covariance matrix for parameter estimates aprCov <- function(doses, model, cf, S, off, scal){ F <- gradCalc(model, cf, doses, off, scal) V <- try(solve(t(F)%*%solve(S)%*%F)) if(inherits(V, "try-error")){ warning("Could not calculate covariance matrix; Fisher information singular.") return(NA) } V } tableMatch <- function(x, match){ ## like "table", but also returns categories with 0 counts out <- numeric(length(match)) for(i in 1:length(match)){ out[i] <- sum(x == match[i], na.rm=TRUE) } names(out) <- match out } ## calculate the predictions for the fitted models getSimEst <- function(x, type = c("dose-response", "ED", "TD"), doseSeq, direction, p, Delta, placAdj = FALSE){ modelSel <- attr(x$sim, "modelSel") model <- attr(x, "model") coefs <- attr(x$sim, "coefs") off <- attr(x, "off") scal <- attr(x, "scal") nSim <- attr(x$sim, "nSim") altModels <- attr(x, "altModels") nAlt <- modCount(altModels, fullMod=TRUE) doses <- attr(x, "doses") maxD <- max(doses) type <- match.arg(type) if(type == "TD"){ if(missing(direction)) stop("need direction for TD calculation") if(Delta <= 0) stop("\"Delta\" needs to be > 0") } out <- vector("list", nAlt) for(i in 1:nAlt){ ind <- matrix(ncol = length(model), nrow = nSim) if(type == "dose-response"){ resMat <- matrix(nrow = nSim, ncol = length(doseSeq)) colnames(resMat) <- doseSeq rownames(resMat) <- 1:nSim for(j in 1:length(model)){ ind[,j] <- modelSel[,i] == model[j] if(any(ind[,j])){ cf <- do.call("rbind", (coefs[[i]])[ind[,j]]) resMat[ind[,j]] <- predSamples(samples=cf, placAdjfullPars = TRUE, doseSeq=doseSeq, placAdj=placAdj, model=model[j], scal=scal, off=off, nodes = NULL) } out[[i]] <- resMat } } if(is.element(type, c("TD", "ED"))){ resVec <- numeric(nSim) for(j in 1:length(model)){ ind[,j] <- modelSel[,i] == model[j] if(any(ind[,j])){ cf <- do.call("rbind", (coefs[[i]])[ind[,j]]) if(type == "TD"){ resVec[ind[,j]] <- apply(cf, 1, function(z){ calcTD(model[j], z, Delta, "continuous", direction, off=off, scal=scal) }) } if(type == "ED"){ resVec[ind[,j]] <- apply(cf, 1, function(z){ calcED(model[j], z, p, maxD, "continuous", off=off, scal=scal) }) } } } out[[i]] <- resVec } } names(out) <- colnames(getResp(attr(x, "altModels"), doses=0)) ## horrible hack need to improve! out } plotDoseSims <- function(x, type = c("ED", "TD"), p, Delta, xlab){ altMods <- attr(x, "altModels") direction <- attr(altMods, "direction") if(type == "ED"){ out <- getSimEst(x, "ED", p=p) trueDoses <- ED(altMods, p=p, EDtype="continuous") } else { out <- getSimEst(x, "TD", Delta=Delta, direction=direction) trueDoses <- TD(altMods, Delta=Delta, TDtype="continuous", direction=direction) } ## write plotting data frame nams <- names(out) group <- factor(rep(1:length(nams), each=length(out[[1]])), labels=nams) pdat <- data.frame(est = do.call("c", out), group = group) ## determine limits for x-axis rngQ <- tapply(pdat$est, pdat$group, function(x){ quantile(x, c(0.025, 0.975), na.rm=TRUE) }) rngQ <- do.call("rbind", rngQ) rng <- c(min(rngQ[,1], na.rm = TRUE), max(rngQ[,2], na.rm = TRUE)) delt <- diff(rng)*0.04 ## truncate x-axis to 2*maxdose maxdose <- max(attr(x, "doses")) xlimU <- min(2*maxdose, max(rng[2], maxdose)+delt) xlimL <- max(-0.05*maxdose, min(0, rng[1])-delt) xlim <- c(xlimL, xlimU) parVal <- ifelse(type == "ED", paste("p=", p, sep=""), paste("Delta=", Delta, sep="")) maintxt <- paste("95%, 80%, 50% intervals and median of simulated ", type, " estimates (", parVal, ")", sep = "") key <- list(text = list(maintxt, cex = 0.9)) lattice::bwplot(~est|group, data=pdat, xlab = xlab, trueDoses=trueDoses, xlim = xlim, panel = function(...){ z <- lattice::panel.number() lattice::panel.grid(v=-1, h=0, lty=2, col = "lightgrey") lattice::panel.abline(v=trueDoses[z], col = "red", lwd=2) lattice::panel.abline(v=c(0, max(attr(x, "doses"))), col = "grey", lwd=2) probs <- c(0.025, 0.1, 0.25, 0.5, 0.75, 0.9, 0.975) simDoseEst <- list(...)$x quants <- quantile(simDoseEst, probs, na.rm = TRUE) lattice::llines(c(quants[1], quants[7]), c(1,1), lwd=2, col=1) lattice::llines(c(quants[2], quants[6]), c(1,1), lwd=5, col=1) lattice::llines(c(quants[3], quants[5]), c(1,1), lwd=10, col=1) lattice::lpoints(quants[4], 1, cex=2, pch="|", col=1) if(type == "TD") lattice::ltext(xlim[2], 1.5, pos = 2, cex = 0.75, labels = paste("% No TD:", mean(is.na(simDoseEst))*100, "%")) }, layout = c(1,length(out)), as.table = TRUE, key = key) } plotDRSims <- function(x, placAdj = FALSE, xlab, ylab){ altMods <- attr(x, "altModels") rng <- range(attr(x, "doses")) doseSeq <- seq(rng[1], rng[2], length = 51) out <- getSimEst(x, type = "dose-response", doseSeq=doseSeq, placAdj = placAdj) trueMn <- getResp(altMods, doses=doseSeq) if(placAdj){ trueMn <- trueMn-trueMn[1,] } nM <- length(out) resp <- vector("list", length=nM) for(i in 1:nM){ qMat <-apply(out[[i]], 2, function(y){ quantile(y, c(0.025, 0.25, 0.5, 0.75, 0.975)) }) resp[[i]] <- c(t(qMat)) } resp <- do.call("c", resp) quant <- rep(rep(c(0.025, 0.25, 0.5, 0.75, 0.975), each = 51), nM) dose <- rep(doseSeq, nM*5) model <- factor(rep(1:nM, each = 5*51), labels = names(out)) key <- list(text = list("Pointwise 95%, 50% intervals and median of simulated dose-response estimates", cex = 0.9)) lattice::xyplot(resp~dose|model, groups = quant, xlab=xlab, ylab = ylab, panel = function(...){ ## plot grid lattice::panel.grid(v=-1, h=-1, col = "lightgrey", lty=2) ## plot estimates panel.dat <- list(...) ind <- panel.dat$subscripts LB95.x <- panel.dat$x[panel.dat$groups[ind] == 0.025] LB95 <- panel.dat$y[panel.dat$groups[ind] == 0.025] UB95.x <- panel.dat$x[panel.dat$groups[ind] == 0.975] UB95 <- panel.dat$y[panel.dat$groups[ind] == 0.975] lattice::lpolygon(c(LB95.x, rev(UB95.x)), c(LB95, rev(UB95)), col = "lightgrey", border = "lightgrey") LB50.x <- panel.dat$x[panel.dat$groups[ind] == 0.25] LB50 <- panel.dat$y[panel.dat$groups[ind] == 0.25] UB50.x <- panel.dat$x[panel.dat$groups[ind] == 0.75] UB50 <- panel.dat$y[panel.dat$groups[ind] == 0.75] lattice::lpolygon(c(LB50.x, rev(UB50.x)), c(LB50, rev(UB50)), col = "darkgrey", border = "darkgrey") MED.x <- panel.dat$x[panel.dat$groups[ind] == 0.5] MED <- panel.dat$y[panel.dat$groups[ind] == 0.5] lattice::llines(MED.x, MED, col = 1,lwd = 1.5) ## plot true curve z <- lattice::panel.number() lattice::llines(doseSeq, trueMn[,z], col=2, lwd=1.5) }, as.table = TRUE, key=key) } DoseFinding/vignettes/0000755000176200001440000000000014764013017014456 5ustar liggesusersDoseFinding/vignettes/sample_size.Rmd0000644000176200001440000002566614654153534017463 0ustar liggesusers--- title: "Sample size calculations for MCP-Mod" output: rmarkdown::html_vignette bibliography: refs.bib vignette: > %\VignetteIndexEntry{Sample size template for MCP-Mod for normally distributed data} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, child="children/settings.txt"} ``` In this vignette we will take a closer look at the design stage and see how to perform power and sample size calculations for MCP-Mod with the DoseFinding package. We will consider the same example study and the same candidate models as in the [vignette for analysis of normally distributed data](analysis_normal.html). ```{r, setup, fig.asp = 1, out.width = "50%", fig.width = 5} library(DoseFinding) library(ggplot2) doses <- c(0, 12.5, 25, 50, 100) guess <- list(emax = c(2.6, 12.5), sigEmax = c(30.5, 3.5), quadratic = -0.00776) mods <- do.call(Mods, append(guess, list(placEff = 1.25, maxEff = 0.15, doses = doses))) plotMods(mods) ``` ## Power for multiple contrast test versus group sample size In this section we will investigate at how power varies with sample size. Note that the maximum effect size within the dose-range is fixed through `maxEff` in the candidate models. First we calculate the matrix of optimal contrasts (`w=1` denotes homoscedastic residuals with equal group sizes, see `?optContr`). In `powN` we specify the sample sizes for which to calculate the power. We request five equally sized groups with `alRatio = rep(1, 5)`. We fix the residual standard deviation with `sigma = 0.34`, and calculate the power for a one-sided test at level 0.05. ```{r, power_sample_size_1} contMat <- optContr(mods, w=1) pows <- powN(upperN = 100, lowerN = 10, step = 10, contMat = contMat, sigma = 0.34, altModels = mods, alpha = 0.05, alRatio = rep(1, 5)) plot(pows) ``` This shows the power values of the maximum contrast test assuming each of the different candidate models to be true. The minimum, mean and maximum power over the candidate models are also included in the plot. There also is a wrapper function that calculates the group sample sizes needed in order to attain a specific power. The powers under each alternative model are combined with `sumFct`. Here we look at the minimum power, other potential choices are `mean` or `max`. ```{r, power_sample_size_2} sampSizeMCT(upperN = 150, contMat = contMat, sigma = 0.34, altModels = mods, power = 0.9, alRatio = rep(1, 5), alpha = 0.05, sumFct = min) ``` ## Power versus treatment effect In this section we fix the group sample size at 90 and vary the treatment Effect `maxEff`. Note how power decreases if we assume a higher residual standard deviation. ```{r, power_effect_size} plot_power_vs_treatment_effect <- function(guess, doses, group_size, placEff, maxEffs, sigma_low, sigma_mid, sigma_high, alpha) { mods_args_fixed <- append(guess, list(placEff = placEff, doses = doses)) grd <- expand.grid(max_eff = maxEffs, sigma = c(sigma_low, sigma_mid, sigma_high)) min_power <- mean_power <- NA for (i in 1:nrow(grd)) { mods <- do.call(Mods, append(mods_args_fixed, list(maxEff = grd$max_eff[i]))) p <- powMCT(optContr(mods, w = 1), alpha, mods, group_size, grd$sigma[i]) min_power[i] <- min(p) mean_power[i] <- mean(p) } grd$sigma <- factor(grd$sigma) pdat <- cbind(grd, power = c(min_power, mean_power), sumFct = rep(factor(1:2, labels = c("min", "mean")), each = nrow(grd))) subt <- sprintf("group size = %d, α = %.3f", group_size, alpha) gg <- ggplot(pdat) + geom_line(aes(max_eff, power, lty = sigma)) + facet_wrap(~sumFct, labeller = label_both)+ xlab("maximum treatment effect") + ylab("power") + labs(title = "Minimum power vs effect size for different residual standard deviations", subtitle = subt) + theme(legend.position = "bottom") + scale_y_continuous(limits = c(0,1), breaks = seq(0,1,by=.1)) return(gg) } plot_power_vs_treatment_effect(guess, doses, group_size = 90, placEff = 1.25, maxEffs = seq(0.01, 0.3, length.out = 15), sigma_low = 0.3, sigma_mid = 0.34, sigma_high = 0.4, alpha = 0.05) ``` ## Power under mis-specification MCP-Mod depends on the candidate models selected. What if the true model is not among the chosen candidate shapes? Often MCP-Mod is rather robust. To illustrate this, let's assume an exponential model shape is the true model, which is not among the candidate shapes. Let this exponential model have small responses for all doses but the last (here assuming 20% of the overall treatment effect is achieved at the 50μg dose). All other candidate shapes assume that almost the full effect is achieved for the 50μg dose, so this shape is quite different from all other shapes included in the candidate set. ```{r, power_miss_1} guess_miss <- list(exponential = guesst(50, 0.2, "exponential", Maxd = max(doses))) mods_miss <- do.call(Mods, c(guess, guess_miss, list(placEff = 1.25, maxEff = 0.15, doses = doses))) plot(mods_miss, superpose = TRUE) ``` Now we compare the power calculation under the exponential model with those based on the original candidate set, in both cases only the contrasts from the original candidate set are used. ```{r, power_miss_2} plot_power_misspec <- function(guess, guess_miss, placEff, maxEff, doses, upperN, lowerN, step, sigma, alpha) { mods_extra_par <- list(placEff = placEff, maxEff = maxEff, doses = doses) pown_extra_par <- list(upperN = upperN, lowerN = lowerN, step = step, sigma = sigma, alpha = alpha, alRatio = rep(1, length(doses))) mods_miss <- do.call(Mods, c(guess_miss, mods_extra_par)) mods_ok <- do.call(Mods, c(guess, mods_extra_par)) cm_ok <- optContr(mods_ok, w = 1) p_miss <- do.call(powN, c(pown_extra_par, list(contMat = cm_ok, altModels = mods_miss))) p_ok <- do.call(powN, c(pown_extra_par, list(contMat = cm_ok, altModels = mods_ok))) pwr <- rbind(data.frame(n = as.numeric(rownames(p_ok)), p_ok[, c("min", "mean")], miss = FALSE), data.frame(n = as.numeric(rownames(p_miss)), p_miss[, c("min", "mean")], miss = TRUE)) gg <- ggplot(pwr, aes(group = miss, color = miss)) + geom_line(aes(n, min, linetype = "minimum")) + geom_line(aes(n, mean, linetype = "mean")) + scale_color_discrete(name = "miss-specified") + scale_linetype_discrete(name = "aggregation") + labs(title = "Mean and minimum power under mis-specification") + xlab("group size") + ylab("power") + scale_y_continuous(limits = c(0,1), breaks = seq(0,1,by=.1)) return(gg) } plot_power_misspec(guess, guess_miss, placEff = 1.25, maxEff = 0.15, doses = doses, upperN = 100, lowerN = 10, step = 10, sigma = 0.34, alpha = 0.05) ``` As expected, the power decreases as the assumed underlying exponential model shape differs substantially from the shapes included in the candidate set. However, the power loss is only in the range of 10-15%. ## Sample size based on metrics other than power for the multiple contrast test The main purpose of a dose-finding study is selection of a dose to take forward into Phase 3. Establishment of a trend over placebo is hence only a minimum requirement before considering dose-selection. If one considers sample size calculation to allow for adequate dose selection (see `?TD`) it turns out that this is a much harder problem than establishing a dose-response effect versus placebo based on the MCP-part: The sample size required for adequate accuracy in estimation of a target dose (e.g. the smallest dose achieving a relevant improvement over placebo) is usually several-fold higher than the sample size needed to have adequate power for the MCP-part. This should not come as a surprise as dose-estimation is primarily a comparison among the investigational doses, while the MCP-part establishes an effect versus placebo. Chapter 12 in @oquigley2017 illustrates this with simulations, based on the `planMod` function (see `?planMod` for example usage). Here we only consider a brief example: Consider the `sigEmax(30.5, 3.5)` model from the first section and assume that it is the "true model" under which we want to investigate the operating characteristics of fitting sigEmax models. Suppose we want to achieve a target improvement of $\Delta=0.12 L$ over placebo. One can calculate that this needs a target dose TD of 44.4 mg under the true model. Keep this number in mind for later. Now we can ask the question what the variability in TD estimation would be. To answer it, we can run a simulation using the `planMod` function. If we use the sample size n=93 from the power calculation above, we find: ```{r, tdci93, warning = FALSE} set.seed(42) ## Note: Warnings related to vcov.DRMod can be ignored if small relative to the total number of simulations pm <- planMod("sigEmax", Mods(sigEmax=c(30.5, 3.5), placEff=1.25, maxEff=0.15, doses=doses), n=93, sigma = 0.34, doses=doses, simulation=TRUE, nSim=5000, showSimProgress = FALSE, bnds = defBnds(max(doses))) summary(pm, Delta=0.12) ``` The output shows different outputs (see `?planMod` for details) of most interest here is the length of the quantile range for a target dose (`lengthTDCI`). By default this is calculated by taking the difference of 5\% and 95\% quantile of the empirical distribution of the dose estimates in the simulation. The metric `P(no TD)` indicates in how many simulations runs no TD could be identified. From the output it can be seen that the variation in the TD estimates is quite large and quite unsatisfactory. Experimenting with different values of `n`, one quickly realizes that we would need for example 1650 patients to get the length of this interval down to 20 mg. ```{r, tdci1650} pm <- planMod("sigEmax", Mods(sigEmax=c(30.5, 3.5), placEff=1.25, maxEff=0.15, doses=doses), n=1650, sigma = 0.34, doses=doses, simulation=TRUE, nSim=5000, showSimProgress = FALSE, bnds = defBnds(max(doses))) summary(pm, Delta=0.12) ``` Note that the variability in TD estimation depends quite strongly on the assumed true dose-response model, see the simulation results in Chapter 12 in @oquigley2017. In practice, to keep the size of the study feasible, one needs to find a compromise between dose-response signal detection and estimation precision as the criteria for sample size determination. Irrespective, it is important to properly evaluate the operating characteristics of a given design (including sample size) to understand its strengths and limitations. In practice of course the dose-response curve of the main efficacy endpoint, is not the only consideration in dose-selection for Phase III: Results for other efficacy/biomarker endpoints, but also the results for tolerability or safety markers, will contribute to that decision. ## References DoseFinding/vignettes/american-statistical-association.csl0000644000176200001440000001457114654153534023613 0ustar liggesusers DoseFinding/vignettes/faq.Rmd0000644000176200001440000004615214654153534015710 0ustar liggesusers--- title: "MCP-Mod FAQ" output: rmarkdown::html_vignette: toc: true toc_depth: 2 bibliography: refs.bib link-citations: yes csl: american-statistical-association.csl vignette: > %\VignetteIndexEntry{Frequently Asked Questions for MCP-Mod} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{css, echo=FALSE} h2 { font-size: 20px; line-height: 1.35; } #TOC { width: 100%; } ``` ## Preliminaries The purpose of this FAQ document is to provide answers to some commonly asked questions, based on personal opinions and experiences. For an introduction to MCP-Mod please see @bretz2005 and @pinheiro2014. ## For which types of study designs can I use MCP-Mod? MCP-Mod has been developed with having efficacy dose-finding studies in mind, as they are performed in Phase 2 of clinical drug-development. Typically these studies are large scale parallel group randomized studies (e.g. from around 50 to almost 1000 patients in total). It is also possible to use MCP-Mod in crossover designs using generalized MCP-Mod (see below). Titration designs are out of scope, because the administered dose levels depend on observed responses in the same patients, thereby making any naïve dose-response modelling inappropriate. Phase 1 dose escalation safety studies are also out of scope. The major question is dose selection for the next cohort during the trial, and tools have been developed specifically for this purpose. In addition assessment of a dose-response signal over placebo is not so much of interest in these studies. ## What is the difference between the original and generalized MCP-Mod, and what type of response can generalized MCP-Mod handle? The original MCP-Mod approach was derived for a normally distributed response variable assuming homoscedasticity across doses. The generalized MCP-Mod approach [@pinheiro2014] is a flexible extension that allows for example for binary, count, continuous or time-to-event outcomes. In both variants one tests and estimates the dose-response relationship among $K$ doses $x_1,\dots,x_K$ utilizing $M$ candidate models given by functions $f_m(x_k, \theta_m)$. The original MCP-Mod approach assumes normally distributed observations \[ y_{k,j} \sim \mathrm{Normal}(\mu_k, \sigma^2) \] for $k=1,\dots,K$ and $j=1,\dots,n_k$ in each group, where $\mu_k = f_m(x_k, \theta_m)$ under the $m$-th candidate model. In the MCP part the null hypothesis of a flat response profile $c_m^T \mu = 0$ vs $c_m^T \mu > 0$ (or $\neq 0$) is tested with $c_m$ chosen to maximize power under the $m$-th candidate model. Critical values are taken from the multivariate t distribution with $(\sum_{k=1}^K n_k) - k$ degrees of freedom. In the Mod part the dose-response model parameters $\theta$ are estimated by OLS, minimizing $\sum_{k,j} (y_{k,j} - f_m(x_{k,j}, \theta))^2$. In the generalized MCP-Mod approach no specific type of distribution is assumed for the observations, \[ y_{k,j} \sim \mathrm{SomeDistribution}(\mu_k), \] only that $\mu_k$ can be interpreted as a kind of "average response" for dose $k$. The key assumption is that an estimator $\hat\mu=(\hat\mu_1,\dots,\hat\mu_k)$ exists, which has (at least asymptotically) a multivariate normal distribution, \[ \hat\mu \sim \mathrm{MultivariateNormal}(\mu, S), \] and that a first-stage fitting procedure can provide estimates $\hat\mu$ and $\hat S$. The $m$-th candidate model is taken to imply $\mu_k = f_m(x_k, \theta)$ and the null hypothesis $c_m^T \mu = 0$ is tested with optimal contrasts. The estimate $\hat S$ is used in place of the unknown $S$, and critical values are taken from the multivariate normal distribution. Alternatively, degrees of freedom for a multivariate t distribution can be specified. For the Mod part the model parameters $\theta$ are estimated with GLS by minimizing \[ (\hat\mu - f_m(x, \theta))^T\hat{S}^{-1}(\hat\mu - f_m(x, \theta)). \] In generalized MCP-Mod with an ANOVA as the first stage (based on an normality assumption), the multiple contrast test (with appropriate degrees of freedom) will provide the same result as the original MCP-Mod approach. In summary generalized MCP-Mod is a two-stage approach, where in the first stage a model is fitted, that allows to extract (covariate adjusted) estimates at each dose level, as well as an associated covariance matrix. Then in a second stage MCP-Mod is performed on these summary estimates in many ways similar as the original MCP-Mod approach. We discuss the situation when the first stage fit is a logistic regression [in this vignette](binary_data.html), but many other first stage models could be used, as long as the first fit is able to produce adjusted estimates at the doses as long as the associated covariance matrix. See also the help page of the neurodeg data set `?neurodeg`, for a different longitudinal example. ## How many doses do we need to perform MCP-Mod? When using two active doses + placebo it is technically possible to perform the MCP and Mod steps, but in particular for the Mod step only a very limited set of dose-response models can be fitted. In addition limited information on the dose-response curve can be obtained. For both the MCP and the Mod step to make sense, three active doses and placebo should be available, with the general recommendation to use 4-7 active doses. When these doses cover the effective range well (i.e., increasing part and plateau), a large number of active doses is unlikely to produce a benefit, as the simulations in @bornkamp2007 have also shown. Optimal design calculations can also provide useful information on the number of doses (and which doses) to use. From experience with optimal design calculations for different candidate sets, the number of doses from an optimal design calculation often tend to be smaller than 7 (see also `?optDesign`). ## How to determine the doses to be used for a trial using MCP-Mod? To gain most information on the compound, one should evaluate a dose-range that is as large as feasible in terms of lowest and highest dose. As a rule of thumb at minimum a dose-range of > 10-fold should be investigated (i.e., the ratio of highest versus lowest dose should be > 10). Plasma drug exposure values (e.g., steady state AUC values) can be a good predictor of effect. In these situations one can try to select doses to achieve a uniform coverage of the exposure values. These exposure values per patient per dose often follow a log-normal distribution (i.e., positively skewed, with the variance increasing with the mean), so that the spaces between doses should get larger with increasing doses. Often log-spacing of doses (i.e., the ratio of consecutive doses is constant for example equal to 2 or 3) is used. An alternative approach to calculate adequate doses is optimal design theory (see `?optDesign`). The idea is to calculate a design (i.e. the doses and dose allocation weights) under a given fixed sample size so that the variability of the dose-response parameter estimates (or variance of some target dose estimate) is "small" in a specified way [see @bretz2010]. ## How to set up the candidate set of models? Rule of thumb: 3 - 7 dose response shapes through 2 - 4 models are often sufficient. The multiple contrast test is quite robust, even if the model-shapes are mis-specified. What information to utilize? It is possible to use __existing information__: _Similar compounds:_ Information might be available on the dose-response curve for a similar compound in the same indication or the same compound in a different indication. _Other models:_ A dose-exposure-response (PK/PD) model might have been developed based on earlier data (e.g. data from the proof-of-concept (PoC) study). This can be used to predict the dose-response curve at a specific time-point. _Emax model:_ An Emax type model should always be included in the candidate set of models. Meta-analyses of the dose-response curves over the past years showed, that in many situations the monotonic standard Emax model, or the sigmoid Emax model is able to describe the data adequately [see @thomas2014; @thomas2017]. There are also some __statistical considerations__ to be aware of: _Small number of doses and model fitting:_ If only a few active doses are feasible to be used in a trial, it is difficult to fit the more complex models, for example the sigmoid Emax or the beta model with four parameters in a trial with three active doses. Such models would not be included in the candidate set and one would rather use more dose-response models with fewer parameters to obtain an adequate breadth of the candidate set (such as the simple Emax, exponential or quadratic model). Some sigmoid Emax (or beta) model shapes cannot be approximated well by these models. If one still would like to include for example a sigmoid shape this can be achieved by fixing the Hill parameter to a given value (for example 3 and/or 5), and then use different sigmoid Emax candidate models with fixed Hill parameter also for model fitting. Model fitting of these models can be performed with the standard Emax model but utilizing $doses^h$ instead of $doses$ as the dose variable, where $h$ is the assumed fixed Hill parameter (note that the interpretation of ED50 parameter returned by `fitMod` then changes). _Consequence of model misspecification:_ Omission of the “correct†dose-response shape from the set of candidate models might not necessarily have severe consequences, if other models can pick up the omitted shape. This can be evaluated for the MCP part (impact on power) using explicit calculations (see @pinheiro2006 and [the vignette on sample size](sample_size.html)). For the Mod part (impact on estimation precision for dose-response and dose estimation) using simulations see `?planMod`. _Impact on sample size:_ Using a very broad and flexible set of candidate models does not come “for freeâ€. Generally the critical value for the MCP test will increase, if many different (uncorrelated) candidate shapes are included, and consequently also the sample size. The actual impact will have to be investigated on a case-by-case basis. A similar trade-off exists in terms of dose-response model fitting (Mod part), as a broader candidate set will decrease potential bias (in the case of a mis-specified model) but increase the variance of the estimates. _Umbrella-shaped dose-response curve:_ While biological exposure-response relationships are often monotonic, down-turns of the clinical dose-response relationship at higher doses have been observed. For example if, due to tolerability issues, more patients will discontinue treatment with higher doses of the drug. Depending on the estimand strategy of handling this intercurrent event (e.g. for treatment policy or composite) this might lead to a decrease in clinical efficacy at higher doses. It is important to discuss the plausibility of an umbrella-shaped dose-response stage at design stage and make a decision on whether to include such a shape or not. _Caution with linear models:_ Based on simulation studies utilizing the AIC, it has been observed that the linear model (as it has fewest parameters) is often too strongly favored (with the BIC this trend is even stronger), see also results in @schorning2016. The recommendation would be to exclude the linear model usually from the candidate set. The Emax and exponential model (and also the sigmoid Emax model) can approximate a linear shape well in the limiting case. ## Can MCP-Mod be used in trials without placebo control? In some cases the use of a placebo group is not possible due to ethical reasons (e.g., because good treatments exist already or the condition is very severe). In such cases, the MCP part of MCP-Mod focuses on establishing a dose-response trend among the active doses, which would correspond to a very different question rather than a dose-response effect versus placebo, and may not necessarily be of interest. The Mod step would be conducted to model the dose-response relationship among the active doses. Due to non-inclusion of a placebo group, this may be challenging to perform. One aim of such a dose-finding trial could be to estimate the smallest dose of the new compound achieving the same treatment effect as the active control. ## Why are bounds used for the nonlinear parameters in the fitMod function? Most of the common dose-response models are nonlinear in the parameters. This means that iterative algorithms need to be used to calculate the parameter estimates. Given that the number of dose levels is usually relatively small and the noise relatively large in these studies, convergence often fails. This is usually due to the fact that the best fitting model shape corresponds to the case, where one of the model parameters is infinite or 0. When observing these cases more closely, one observes that while on the parameter scale no convergence is obtained, typically convergence towards a fixed model shape is obtained. One approach to overcome this problem is to use bounds on the nonlinear parameters for the model, which thus ensure existence of an estimate. In many situations the assumed bounds can be justified in terms of requiring that the shape-space underlying the corresponding model is covered almost exhaustively (see the `defBnds` function, for the proposed default bounds). When utilizing bounds for model fitting, it bootstrapping/bagging can be used for estimation of the dose-response functions and for the confidence intervals, see @pinheiro2014. Standard asymptotic confidence intervals are not reliable. ## Should model-selection or model-averaging be used for analysis? The Mod step can be performed using either a single model selected from the initial candidate set or a weighted average of the candidate models. Model averaging has two main advantages _Improved estimation performance:_ Simulations in the framework of dose-response analyses in Phase II have shown (over a range of simulation scenarios) that model-averaging leads to a slightly better performance in terms of dose-response estimation and dose-estimation [see @schorning2016]. _Improved coverage probability of confidence intervals:_ Model averaging techniques generally lead to a better performance in terms of confidence interval coverage under model uncertainty (confidence intervals are typically closer to their nominal level). There are two main (non-Bayesian) ways of performing model averaging: _Approximate Bayesian approach:_ The models are weighted according exp(-0.5*IC), where IC is an information criterion (e.g., AIC) corresponding to the model under consideration. All subsequent estimation for quantities of interest would then be based on a weighted mean with the weights above. For numerical stability the minimum IC across all models is typically subtracted from the IC for each model, which does not change the model weights. _Bagging:_ One takes bootstrap samples, performs model selection on each bootstrap re-sample (using, for example AIC) and then uses the mean over all bootstrap predictions as the overall estimate [see @breiman1996]. As the predictions typically come from different models (for each bootstrap resample), this method can be considered to be an “implicit†way of model averaging. Bagging has the advantage that one automatically gets bootstrap confidence intervals for quantities of interest (dose-response curve or target doses) from the performed simulations. ## Which model selection criterion should be used? Whether MCP-Mod is implemented using model selection or model averaging, a suitable model selection criterion needs to be specified. See @schorning2016 for a brief review of the mathematical background of different selection criteria. A simulation in this paper supports a recommendation to utilize the AIC criterion. ## How to deal with intercurrent events and missing data? As in any other trial intercurrent events and handling strategies need to be identified, as well as missing data handling (see [ICH E9(R1) guideline](https://database.ich.org/sites/default/files/E9-R1_Step4_Guideline_2019_1203.pdf)). In many situations (e.g. if multiple imputation is used as part of the analysis) it may be easiest to use generalized MCP-Mod, where the first stage model already accounts for intercurrent events and missing data. This model is then used to produce covariate adjusted estimates at the doses (as well as their covariance matrix), which are then utilized in generalized MCP-Mod. ## Can MCP-Mod be used in trials with multiple treatment regimens? Many of the dose-finding trials study not only multiple doses of one treatment regimen, but include more than one treatment regimen (e.g., once daily (od), twice daily (bid)). MCP-Mod is focused around assessing only one dose-response relationship, but can be extended to handle some of these cases, when one is willing to make additional assumptions. Out of scope are situations, when the primary question of the trial is the regimen and not the dose, e.g., multiple regimen are employed but each with only one or two doses. Out of scope are also situations when the different regimens differ substantially. For example in situations when some treatment groups include a loading dose others do not. In a naïve dose-response modelling approach the dosing regimen cannot be easily reduced to a single dose per patient and is inappropriate. In scope are situations when the primary question focuses around the dose-response curve in the regimen. One possible assumption is to use a dose-response model on a common dose scale (e.g. daily dose) but then to assume that some of the parameters of the dose-response curves within the regimen are shared between regimen, while others are different (e.g. same or different E0, Emax, ED50 parameters between the regimen for an Emax dose-response model). See [the vignette on this topic](mult_regimen.html). To be feasible this approach requires an adequate number of doses per regimen to be able to detect a dose-response signal in each regimen and to estimate the dose-response curve in each regimen. Whether or not simplifying assumptions of parameters shared between regimen are plausible depends on the specifics of every drug. ## What about dose-response estimates, when the MCP part was (or some of the model shapes were) not significant? For practical reasons, the proposal is to perform the Mod step always with all specified models (even if all or only some of the dose-response models are not significant). The obtained dose-response estimate, however, needs to be interpreted very cautiously, when no overall dose-response trend has been established in the MCP step. Using all models is advisible, because non-significance of a particular contrast may only have been due to a particular inadequate choice of guesstimates - nevertheless once the model parameters are estimated from the data in the Mod step, the model may fit the data adequately (if not it will be downweighted automatically by the AIC). ## References DoseFinding/vignettes/overview.Rmd0000644000176200001440000000605514654153534017005 0ustar liggesusers--- title: "Overview DoseFinding package" output: rmarkdown::html_vignette: bibliography: refs.bib link-citations: yes csl: american-statistical-association.csl vignette: > %\VignetteIndexEntry{Overview DoseFinding package} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, child="children/settings.txt"} ``` The DoseFinding package provides functions for the design and analysis of dose-finding experiments (for example pharmaceutical Phase II clinical trials). It provides functions for: multiple contrast tests (`MCTtest` for analysis and `powMCT`, `sampSizeMCT` for sample size calculation), fitting non-linear dose-response models (`fitMod` for ML estimation and `bFitMod` for Bayesian and bootstrap/bagging ML estimation), calculating optimal designs (`optDesign` or `calcCrit` for evaluation of given designs), both for normal and general response variable. In addition the package can be used to implement the MCP-Mod procedure, a combination of testing and dose-response modelling (`MCPMod`) (@bretz2005, @pinheiro2014). A number of vignettes cover practical aspects on how MCP-Mod can be implemented using the DoseFinding package. For example a [FAQ](faq.html) document for MCP-Mod, analysis approaches for [normal](analysis_normal.html) and [binary](binary_data.html) data, [sample size and power calculations](sample_size.html) as well as handling data from more than one dosing [regimen](mult_regimen.html) in certain scenarios. Below a short overview of the main functions. ## Perform multiple contrast test ```{r, overview, fig.asp = .4} library(DoseFinding) data(IBScovars) head(IBScovars) ## perform (model based) multiple contrast test ## define candidate dose-response shapes models <- Mods(linear = NULL, emax = 0.2, quadratic = -0.17, doses = c(0, 1, 2, 3, 4)) ## plot models plotMods(models) ## perform multiple contrast test ## functions powMCT and sampSizeMCT provide tools for sample size ## calculation for multiple contrast tests test <- MCTtest(dose, resp, IBScovars, models=models, addCovars = ~ gender) test ``` ## Fit non-linear dose-response models here illustrated with Emax model ```{r, overview 2} fitemax <- fitMod(dose, resp, data=IBScovars, model="emax", bnds = c(0.01,5)) ## display fitted dose-effect curve plot(fitemax, CI=TRUE, plotData="meansCI") ``` ## Calculate optimal designs, here illustrated for target dose (TD) estimation ```{r, overview 3} ## optimal design for estimation of the smallest dose that gives an ## improvement of 0.2 over placebo, a model-averaged design criterion ## is used (over the models defined in Mods) doses <- c(0, 10, 25, 50, 100, 150) fmodels <- Mods(linear = NULL, emax = 25, exponential = 85, logistic = c(50, 10.8811), doses = doses, placEff=0, maxEff=0.4) plot(fmodels, plotTD = TRUE, Delta = 0.2) weights <- rep(1/4, 4) desTD <- optDesign(fmodels, weights, Delta=0.2, designCrit="TD") desTD plot(desTD, fmodels) ``` ## References DoseFinding/vignettes/binary_data.Rmd0000644000176200001440000003141414762603270017406 0ustar liggesusers--- title: "Binary Data MCP-Mod" output: rmarkdown::html_vignette bibliography: refs.bib link-citations: yes csl: american-statistical-association.csl vignette: > %\VignetteIndexEntry{Design and analysis template MCP-Mod for binary data} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, child = "children/settings.txt"} ``` In this vignette we illustrate how to use the DoseFinding package with binary observations by fitting a first-stage GLM and applying the generalized MCP-Mod methodology to the resulting estimates. We also show how to deal with covariates. For continuously distributed data see [the corresponding vignette][v2]. [v2]: analysis_normal.html ## Background and data set Assume a dose-finding study is planned for an hypothetical investigational treatment in atopic dermatitis, for the binary endpoint Investigator's Global Assessment (IGA). The treatment is tested with doses 0, 0.5, 1.5, 2.5, 4. It is assumed the response rate for placebo will be around 10%, while the response rate for the top dose may be 35%. This is an example where the generalized MCP-Mod approach can be applied, i.e. dose-response testing and estimation will be performed on the logit scale. We generate some example data in the setting just described. The 10% placebo effect translates to -2.2 on the logit scale, and the asymptotic effect of 25 percentage points above placebo becomes `logit(0.35) - logit(0.1)`, approximately 1.6. ```{r, example_data} library(DoseFinding) library(ggplot2) logit <- function(p) log(p / (1 - p)) inv_logit <- function(y) 1 / (1 + exp(-y)) doses <- c(0, 0.5, 1.5, 2.5, 4) ## set seed and ensure reproducibility across R versions set.seed(1, kind = "Mersenne-Twister", sample.kind = "Rejection", normal.kind = "Inversion") group_size <- 100 dose_vector <- rep(doses, each = group_size) N <- length(dose_vector) ## generate covariates x1 <- rnorm(N, 0, 1) x2 <- factor(sample(c("A", "B"), N, replace = TRUE, prob = c(0.6, 0.4))) ## assume approximately logit(10%) placebo and logit(35%) asymptotic response with ED50=0.5 prob <- inv_logit(emax(dose_vector, -2.2, 1.6, 0.5) + 0.3 * x1 + 0.3 * (x2 == "B")) dat <- data.frame(y = rbinom(N, 1, prob), dose = dose_vector, x1 = x1, x2 = x2) ``` ## Candidate models We will use the following candidate set of models for the mean response on the logit scale: ```{r, setup, fig.width = 8, out.width = '100%'} mods <- Mods(emax = c(0.25, 1), sigEmax = rbind(c(1, 3), c(2.5, 4)), betaMod = c(1.1, 1.1), placEff = logit(0.1), maxEff = logit(0.35)-logit(0.1), doses = doses) plotMods(mods) ## plot candidate models on probability scale plotMods(mods, trafo = inv_logit) ``` ## Analysis without covariates First assume covariates had not been used in the analysis (not recommended in practice). Let $\mu_k$ denote the logit response probability at dose $k$, so that for patient $j$ in group $k$ we have \[ \begin{aligned} Y_{kj} &\sim \mathrm{Bernoulli}(p_{kj}) \\ \mathrm{logit}(p_{kj}) &= \mu_{k} \end{aligned} \] We perform the MCP-Mod test on the logit scale estimates $\hat\mu=(\hat\mu_1,\dots,\hat\mu_K)$ and their estimated covariance matrix $\hat S$. We can extract both from the object returned by the `glm()` call. ```{r, test_no_covariates} fit_nocov <- glm(y~factor(dose) + 0, data = dat, family = binomial) mu_hat <- coef(fit_nocov) S_hat <- vcov(fit_nocov) MCTtest(doses, mu_hat, S = S_hat, models = mods, type = "general") ``` Dose-response modeling then can proceed with a combination of bootstrapping and model averaging. For detailed explanations refer to the [vignette for analysis of continuous data][v2]. Fitting is done on the logit scale, for plotting transfer the fit back to the probability scale. ```{r, estimate_no_covariates} fit_mod_av <- maFitMod(doses, mu_hat, S = S_hat, models = c("emax", "sigEmax", "betaMod")) plot(fit_mod_av, plotData = "meansCI", title = "Bootstrap estimates for population response probability", trafo = function(x) 1/(1+exp(-x))) ``` ## Analysis with covariates In many situations there are important prognostic covariates (main effects) to adjust for in the analysis. Denote the vector of these additional covariates for patient $j$ with $x_{kj}$. \[ \begin{aligned} Y_{kj} &\sim \mathrm{Bernoulli}(p_{kj}) \\ \mathrm{logit}(p_{kj}) &= \mu_k^d + x_{kj}^T\beta \end{aligned} \] Fitting this model gives us estimated coefficients $\hat\mu=(\hat\mu^d, \hat\beta)$ and an estimate $\hat S$ of the covariance matrix of the estimator $\hat\mu$. In principle we could perform testing and estimation based on $\hat\mu^d$ and the corresponding sub-matrix of $\hat S$, but this would produce estimates for a patient with covariate vector $\beta=0$, and not reflect the overall population. To produce adjusted estimates per dose and to accommodate potential systematic differences in the covariates we predict the mean response probability at dose k for all observed values of the covariates and transform back to logit scale: \[ \mu^*_k := \mathrm{logit}\biggl(\frac{1}{n} \sum_{i=1}^n \mathrm{logit}^{-1}(\hat\mu^d_k + x_{i}^T\hat\beta)\biggr) \] Note here we index $x$ with $i$ that runs from 1 to $n$ (all patients randomized in the study). To obtain a variance estimate for $\mu^*$ we repeat this with draws from $\mathrm{MultivariateNormal}(\hat\mu, \hat S)$ and calculate the empirical covariance matrix $S^*$ of theses draws. Then we use $\mu^*$ and $S^*$ in `MCTtest()`. ```{r, test_covariates} fit_cov <- glm(y~factor(dose) + 0 + x1 + x2, data = dat, family = binomial) covariate_adjusted_estimates <- function(mu_hat, S_hat, formula_rhs, doses, other_covariates, n_sim) { ## predict every patient under *every* dose oc_rep <- as.data.frame(lapply(other_covariates, function(col) rep(col, times = length(doses)))) d_rep <- rep(doses, each = nrow(other_covariates)) pdat <- cbind(oc_rep, dose = d_rep) X <- model.matrix(formula_rhs, pdat) ## average on probability scale then backtransform to logit scale mu_star <- logit(tapply(inv_logit(X %*% mu_hat), pdat$dose, mean)) ## estimate covariance matrix of mu_star pred <- replicate(n_sim, logit(tapply(inv_logit(X %*% drop(mvtnorm::rmvnorm(1, mu_hat, S_hat))), pdat$dose, mean))) return(list(mu_star = as.numeric(mu_star), S_star = cov(t(pred)))) } ca <- covariate_adjusted_estimates(coef(fit_cov), vcov(fit_cov), ~factor(dose)+0+x1+x2, doses, dat[, c("x1", "x2")], 1000) MCTtest(doses, ca$mu_star, S = ca$S_star, type = "general", models = mods) ``` In the case at hand the results here are not dramatically different. Adjusting for covariates gives slightly lower variance estimates. ```{r, compare} ggplot(data.frame(dose = rep(doses, 4), est = c(inv_logit(mu_hat), diag(S_hat), inv_logit(ca$mu_star), diag(ca$S_star)), name = rep(rep(c("mean", "var"), each = length(doses)), times = 2), a = rep(c(FALSE, TRUE), each = 2*length(doses)))) + geom_point(aes(dose, est, color = a)) + scale_color_discrete(name = "adjusted") + facet_wrap(vars(name), scales = "free_y") + ylab("") ``` Dose-response modelling proceeds in the same way as before, but now on the adjusted estimates. ```{r, estimate_covariates} fit_cov_adj <- maFitMod(doses, ca$mu_star, S = ca$S_star, models = c("emax", "sigEmax", "betaMod")) # plotting on probability scale, need to transform predictions on logit scale plot(fit_cov_adj, plotData = "meansCI", title = "Bootstrap estimates for population response probability", trafo = function(x) 1/(1+exp(-x))) ``` ## Avoiding problems with complete seperation and 0 responders In a number of situations it makes sense to replace ML estimation for logistic regression via `glm(..., family=binomial)`, with the Firth logistic regression [see @heinze2002], implemented as the `logistf` function from the `logistf` package. This is particularly important for small sample size per dose and if small number of responses are expected on some treatment arms. The estimator of Firth regression corresponds to the posterior mode in a Bayesian logistic regression model with Jeffrey's prior on the parameter vector. This estimator is well defined even in situations where the ML estimate for logistic regression does not exist (e.g. for complete separation). ## Considerations around optimal contrasts at design stage and analysis stage The formula for the optimal contrasts is given by \[ c^{\textrm{opt}} \propto S^{-1}\biggl(\mu^0_m - \frac{(\mu^0_m)^T S^{-1}1_K}{1_K^T S^{-1} 1_K}\biggr) \] where $\mu^0_m$ is the standardized mean response, $K$ is the number doses, and $1_K$ is an all-ones vector of length $K$ and $S$ is the covariance matrix of the estimates at the doses [see @pinheiro2014]. For calculating the optimal contrast for the generalized MCP step the covariance matrix $S$ of the estimator $\hat\mu$ can be re-estimated once the trial data are available. With normally distributed data this is possible with decent accuracy even at rather low sample sizes. In the case of binary data, $\hat\mu$ is on the logit scale and the diagonal elements of $S$ are approximately $(np(1-p))^{-1}$, where $n$ is the sample size of the dose group. This can be derived using the delta method. An estimate of this variance depends on the observed response rate and can thus be quite variable in particular for small sample sizes per group (e.g. smaller than 20). A crude alternative in these situations is to not use the estimated $S$ but a diagonal matrix with the inverse of the sample size per dose on the diagonal in the formula for calculation of the optimal contrast. The contrast calculated this way will asymptotically not be equal to the "optimal" contrast for the underlying model, but simulations show that they can be closer to the "true" optimal contrast (calculated based on the true variance per dose group) for small sample size, compared to the contrast calculated based on the estimated variance. To re-run the adjusted analysis above for the contrasts, calculated as outlined above, we need to calculate and hand-over the contrast matrix manually via `contMat` in the `MCTtest()` function. In our case (with 100 patients per group) we obtain a result that is only slightly different. ```{r} ## here we have balanced sample sizes across groups, so we select w = 1 ## otherwise would select w proportional to group sample sizes optCont <- optContr(mods, doses, w = 1) MCTtest(doses, ca$mu_star, S = ca$S_star, type = "general", contMat = optCont) ``` ## Power and sample size considerations We can calculate the power under each of the candidate models from the top of this vignette. For example, we assume a `Mods(emax = 0.25)` and calculate the vector of mean responses `lo` on the logit scale. When we transform it back to probability scale `p`, we can calculate the approximate variance of the (logit-scale) estimator `mu_hat` with the formula \[ \mathrm{Var}(\hat\mu) = \frac{1}{np(1-p)} \] (see the section above). Next we calculate the minimum power across the candidate set using `powMCT()` and plot it for increasing `n`. See also the [vignette on sample size calculation](sample_size.html). ```{r, sample_size} ## for simplicity: contrasts as discussed in the previous section contMat <- optContr(mods, w=1) ## we need each alternative model as a separate object alt_model_par <- list(emax = 0.25, emax = 1, sigEmax = c(1, 3), sigEmax = c(2.5, 4), betaMod = c(1.1, 1.1)) alt_common_par <- list(placEff = logit(0.1), maxEff = logit(0.35)-logit(0.1), doses = doses) ## this is a bit hackish because we need to pass named arguments to Mods() alt_mods <- lapply(seq_along(alt_model_par), function(i) { do.call(Mods, append(alt_model_par[i], alt_common_par)) }) prop_true_var_mu_hat <- lapply(seq_along(alt_model_par), function(i) { ## mean responses on logit scale lo <- getResp(do.call(Mods, append(alt_model_par[i], alt_common_par))) p <- inv_logit(lo) # mean responses on probability scale v <- 1 / (p * (1-p)) # element-wise variance of mu_hat up to a factor of 1/n return(as.numeric(v)) # drop unnecessary attributes }) min_power_at_group_size <- function(n) { pwr <- mapply(function(m, v) powMCT(contMat, alpha=0.025, altModels=m, S=diag(v/n), df=Inf), alt_mods, prop_true_var_mu_hat) return(min(pwr)) } n <- seq(5, 80, by=5) pwrs <- sapply(n, min_power_at_group_size) qplot(n, pwrs, geom="line", ylab="Min. Power over candidate set")+ scale_y_continuous(breaks = seq(0,1,by=0.1), limits = c(0,1)) ``` ## References DoseFinding/vignettes/refs.bib0000644000176200001440000001113414654153534016102 0ustar liggesusers@article{bretz2005, title={Combining multiple comparisons and modeling techniques in dose-response studies}, author={Bretz, Frank and Pinheiro, Jos{\'e} C and Branson, Michael}, journal={Biometrics}, volume={61}, number={3}, pages={738--748}, year={2005}, doi = {10.1111/j.1541-0420.2005.00344.x}, publisher={Wiley Online Library} } @Article{bays2020, author = {Bays, Harold E and Kozlovski, Plamen and Shao, Qing and Proot, Pieter and Keefe, Deborah}, title = {Licogliflozin, a Novel SGLT1 and 2 Inhibitor: Body Weight Effects in a Randomized Trial in Adults with Overweight or Obesity}, journaltitle = {Obesity}, year = 2020, volume = 28, issue = 5, doi = {10.1002/oby.22764}, pages = {870-881}} @Article{bornkamp2007, author = {Bornkamp, Björn and Bretz, Frank and Dmitrienko, Alex and Enas, Greg and Gaydos, Brenda and Hsu, Chyi-Hung and König, Franz and Krams, Michael and Liu, Qing and Neuenschwander, Beat and Parke, Tom and Pinheiro, José and Roy, Amit and Sax, Rick and Shen, Frank}, title = {Innovative approaches for designing and analyzing adaptive dose-ranging trials}, journaltitle = {Journal of Biopharmaceutical Statistics}, year = 2007, volume = 17, issue = 6, doi = {10.1080/10543400701643848}, pages = {965-995}} @Article{breiman1996, author = {Breiman, Leo}, title = {Baggin predictors}, journaltitle = {Machine Learning}, year = 1996, volume = 24, issue = 2, pages = {123-140}, doi = {10.1007/bf00058655}} @Article{bretz2010, author = {Bretz, Frank and Dette, Holger and Pinheiro, José}, title = {Practical considerations for optimal designs in clinical dose finding studies}, journaltitle = {Statistics in Medicine}, year = 2010, volume = 29, issue = {7-8}, pages = {731-742}, doi = {10.1002/sim.3802}} @Article{heinze2002, author = {Heinze, Georg and Schemper, Michael}, title = {A solution to the problem of separation in logistic regression}, journaltitle = {Statistics in Medicine}, year = 2002, volume = 21, issue = 16, pages = {2409-2419}, doi = {10.1002/sim.1047}} @Book{oquigley2017, title={Handbook of methods for designing, monitoring, and analyzing dose-finding trials}, author={O'Quigley, John and Iasonos, Alexia and Bornkamp, Björn}, year=2017, publisher={CRC Press}, doi = {10.1201/9781315151984}} @Article{pinheiro2006, author = {Pinheiro, José and Bornkamp, Björn and Bretz, Frank}, title = {Design and Analysis of Dose Finding Studies Combining Multiple Comparisons and Modeling Procedures}, year = 2006, volume = 16, pages = {639-656}, journaltitle = {Journal of Biopharmaceutical Statistics}, doi = {10.1080/10543400600860428}} @Article{pinheiro2014, author = {Pinheiro, José and Bornkamp, Björn and Glimm, Ekkehard and Bretz, Frank}, title = {Model-based dose finding under model uncertainty using general parametric models}, year = 2014, volume = 33, pages = {1646-1661}, journaltitle = {Statistics in Medicine}, doi = {10.1002/sim.6052}} @Article{schorning2016, author = {Schorning, Kirsten and Bornkamp, Björn and Bretz, Frank and Holger Dette}, title = {Model selection versus model averaging in dose finding studies}, journaltitle = {Statistics in Medicine}, year = 2016, volume = 35, issue = 22, pages = {4021-4040}, doi = {10.1002/sim.6991}} @Article{thomas2014, author = {Thomas, Neal and Sweeney, Kevin and Somayaji, Veena}, title = {Meta-analysis of clinical dose response in a large drug development portfolio}, journaltitle = {Statistics in Biopharmaceutical Research}, year = 2015, volume = 6, issue = 4, pages = {302-217}, doi = {10.1080/19466315.2014.924876}} @Article{thomas2017, author = {Thomas, Neal and Roy, Dooti}, title = {Analysis of Clinical Dose–Response in Small-Molecule Drug Development: 2009–2014}, journaltitle = {Statistics in Biopharmaceutical Research}, year = 2017, volume = 9, issue = 2, pages = {137-146}, doi = {10.1080/19466315.2016.1256229}} @Article{verkindre2010, author = { Verkindre, C. and Fukuchi, Y. and Flémale, A. and Takeda, A. and Overend, T. and Prasad, N. and Dolker, M.}, title = {Sustained 24-h efficacy of NVA237, a once-daily long-acting muscarinic antagonist, in COPD patients}, journaltitle = {Respiratory Medicine}, year = 2010, volume = 104, issue = 10, pages = {1482-1489}, doi = {10.1016/j.rmed.2010.04.006}} DoseFinding/vignettes/analysis_normal.Rmd0000644000176200001440000003017014762603270020322 0ustar liggesusers--- title: "Continuous data MCP-Mod" output: rmarkdown::html_vignette bibliography: refs.bib csl: american-statistical-association.csl link-citations: yes vignette: > %\VignetteIndexEntry{Analysis template MCP-Mod for continuous data} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, child="children/settings.txt"} ``` ## Background and Data In this vignette we will illustrate the usage of the DoseFinding package for analyzing continuously distributed data. There is a separate vignette with details on [sample size and power calculation](sample_size.html). We will use data from @verkindre2010, who actually use a cross-over design and utilize MCP-Mod in a supportive analysis. More information can be found at the corresponding [clinicaltrials.gov page](https://www.clinicaltrials.gov/study/NCT00501852) and on the R help page `?glycobrom`. The main purpose @verkindre2010 was to provide safety and efficacy data on Glycopyrronium Bromide (NVA237) in patients with stable Chronic Obstructive Pulmonary Disease ([COPD](https://en.wikipedia.org/wiki/Chronic_obstructive_pulmonary_disease)). The primary endpoint in this study was the mean of two measurements of forced expiratory volume in 1 second ([FEV1](https://en.wikipedia.org/wiki/FEV1#Forced_expiratory_volume_in_1_second_(FEV1))) at 23h 15min and 23h 45min post dosing, following 7 days of treatment. In order to keep this exposition simple, we will ignore the active control and focus on the placebo group and the four dose groups (12.5, 25, 50, and 100μg). For the purpose here, we recreate a dataset that mimicks a parallel group design, based on the published summary statistics. These can be found in the `glycobrom` dataset coming with the `DoseFinding` package. Here `fev1` and `sdev` contain the mean and standard deviation of the mean (standard error) of the primary endpoint for each group, while `n` denotes the number of participants. ```{r, load_data} library(DoseFinding) data(glycobrom) print(glycobrom) ``` We want to create a dataset with 60 participants in each of the five groups. Noticing that the standard errors are essentially equal across all groups, we draw five vectors of measurement errors centered at `0` with identical variances `60 * 0.015^2` which we add to the observed means. Note that here we use `MASS::mvrnorm` instead of `rnorm` because it lets us generate random numbers with the specified _sample_ mean and sd. ```{r, simulate_dataset} set.seed(1, kind = "Mersenne-Twister", sample.kind = "Rejection", normal.kind = "Inversion") rand <- rep(MASS::mvrnorm(60, 0, 60 * 0.015^2, empirical = TRUE), 5) NVA <- data.frame(dose = rep(glycobrom$dose, each = 60), FEV1 = rep(glycobrom$fev1, each = 60) + rand) ggplot(NVA) + geom_jitter(aes(dose, FEV1), height = 0, width = 4) + labs(title = "Simulated FEV1 by dose (jittered horizontally)") + xlab("dose [μg]") + ylab("FEV1 [l]") ``` ## Design stage Now let's forget we already saw the data and imagine we had to design this trial with MCP-Mod. First we decide that we want to include two Emax models, one sigmoid Emax model and one quadratic model in the analysis (see `?drmodels` for other choices). While the (sigmoid) Emax type covers monotonic dose-response-relationships, the quadratic model is there to accommodate a potentially decreasing effect at high doses. Next we have to supply guesstimates for the nonlinear parameters: - ED50 for an Emax model - ED50 and the Hill parameter h for a sigmoid emax model - coefficient ratio $\delta = \beta_2/\lvert\beta_1\rvert$ in the quadratic model $f(d, \theta) = E_0 + \beta_1 d + \beta_2 d^2$ The following choices cover a range of plausible relationships: - ED50 = 2.6 and ED25 = 12.5 for the Emax models (all doses have substantive effects) - ED50 = 30.5 and h = 3.5 for the sigEmax model (first dose has a negligible effect) - delta = -0.00776 for the quadratic model (downturn for the fourth dose) We also fix the effect of placebo at an FEV1 of `1.25` liters and the maximum effect at `0.15` liters above placebo. This implicitly sets the common linear parameters of all the models. Note the syntax of the arguments to the `Mods` function: `emax = c(2.6, 12.5)` specifies *two* Emax models, but `sigEmax = c(30.5, 3.5)` only specifies *one* Sigmoid Emax model. ```{r, models} doses <- c(0, 12.5, 25, 50, 100) mods <- Mods(emax = c(2.6, 12.5), sigEmax = c(30.5, 3.5), quadratic = -0.00776, placEff = 1.25, maxEff = 0.15, doses = doses) ``` It's always a good idea to perform a visual sanity check of the functional relationships implied by the guesstimates. ```{r, plot_models} plotMods(mods, ylab = "FEV1") ``` This concludes the design phase. We can also take a look at the calculated optimal contrasts. Each contrast has maximum power to detect a non-flat effect profile in the hypothetical world where the particular guesstimate is actually the true value. ```{r, contrasts} optC <- optContr(mods, w=1) print(optC) plot(optC) ``` It can be seen that in the balanced sample size case and equal variance assumed for each dose group, the optimal contrasts reflect the underlying assumed mean dose-response shape. This is no surprise, given that the optimal contrasts are given by \[ c^{\textrm{opt}} \propto S^{-1}\biggl(\mu^0_m - \frac{(\mu^0_m)^T S^{-1}1_K}{1_K^T S^{-1} 1_K}\biggr) \] where $\mu^0_m$ is the standardized mean response, $K$ is the number doses, and $1_K$ is an all-ones vector of length $K$ and $S$ is the covariance matrix of the estimates at the doses [see @pinheiro2014 for a detailed account]. As we have equal variance in all dose groups in our case and no correlation, the optimal contrasts are all proportional to the shapes of the candidate model mean vectors. As the standardized model is used in the formula, the values of the linear parameters of the models do not impact the optimal contrasts. ## Analysis stage Now fast-forward to the time when we have collected the data. ### Multiple comparisons We run the multiple contrast test with the pre-specified models. Note that the `type` parameter defaults to `type="normal"`, which means that we assume a homoscedastic ANOVA model for `FEV1`, i.e. critical values are taken from a multivariate t distribution. Further note that when `data` is supplied, the first two arguments `dose` and `FEV1` are _not evaluated_, but symbolically refer to the columns in `data=NVA`. ```{r, mctest_normal} test_normal <- MCTtest(dose = dose, resp = FEV1, models = mods, data = NVA) print(test_normal) ``` The test results suggest a clear dose-response trend. Alternatively we can use generalized MCP-Mod (see the FAQ for the [difference](faq.html)). We use R's builtin `lm()` function to manually fit the ANOVA model and extract estimates for the model coefficients and their covariance matrix. We also need the model degrees of freedom. ```{r, fit_lm_1} fitlm <- lm(FEV1 ~ factor(dose) - 1, data = NVA) mu_hat <- coef(fitlm) S_hat <- vcov(fitlm) anova_df <- fitlm$df.residual ``` Next we supply them to the `MCTtest` function together with `type="general"`. Note that in contrast to the invocation above we here supply the `doses` and the estimates `mu_hat` and `S_hat` directly and not within a `data.frame`. ```{r, mctest_generalizes} test_general <- MCTtest(dose = doses, resp = mu_hat, S = S_hat, df = anova_df, models = mods, type = "general") print(test_general) ``` For the simple ANOVA case at hand the results of the original and the generalized MCP-Mod approaches actually coincide. The p-values differ due to the numerical methods used for obtaining them. ```{r, compare_normal_generalized} cbind(normal = test_normal$tStat, generalized = test_general$tStat) cbind(normal = attr(test_normal$tStat, "pVal"), generalized = attr(test_general$tStat, "pVal")) ``` ## Dose-response estimation In the simplest case we would now proceed to fit only a single model type, for example the one with the largest t-statistic (or alternatively smallest AIC or BIC): ```{r, fit_single} fit_single <- fitMod(dose, FEV1, NVA, model = "emax") plot(fit_single) ``` But actually we want to use a more robust approach that combines bootstrapping with model averaging in the generalized MCP-Mod framework. First we draw bootstrap samples from the multivariate normal distribution of the estimates originating from the first-stage model. Next, for each bootstrapped data set we fit our candidate models, select the one with lowest AIC and save the corresponding estimated quantities of interest. This selection step implies that the bootstrap samples potentially come from different models. Finally we use these bootstrapped estimates for inference. For example, we can estimate a dose-response curve by using the median over the bootstrapped means at each dose. Similarly we can derive confidence intervals based on bootstrap quantiles. Inference for other quantities of interest can be performed in an analogous way. As different models contribute to the bootstrap resamples, the approach can be considered more robust than simple model selection [see also @schorning2016 for simulations on this topic]. Now let's apply this general idea to the case at hand. Our first-stage model is an ANOVA, and we're interested in an estimate of the dose-response curve plus confidence intervals. Our set of candidate model types consists of Emax, sigEmax and quadratic. We us R's builtin `lm()` function to fit an ANOVA model without intercept and extract estimates for the model coefficients and their covariance matrix. ```{r, fit_lm_2} fitlm <- lm(FEV1 ~ factor(dose) - 1, data = NVA) dose <- unique(NVA$dose) mu_hat <- coef(fitlm) S_hat <- vcov(fitlm) ``` The bootstrap procedure described above is implemented in the `maFitMod` function. Note that for technical reasons we have to supply boundaries to the fitting algorithm via the `bnds` argument to `maFitMod` (see `?fitMod` and `?defBnds` for details). ```{r, bootstrap_draw} fit_mod_av <- maFitMod(dose, mu_hat, S = S_hat, models = c("emax", "sigEmax", "quadratic")) ``` With the `predict` method we can obtain the predictions from the fitted model on each boostrap sample. The `plot` method allows to summarize the model fits (some limited customization is possible see `?plot.maFit`). ```{r, bootstrap_summarize} # point estimates (median) and bootstrap quantile intervals can be extracted via ma_pred <- predict(fit_mod_av, doseSeq = c(0, 12.5, 25, 50, 100)) # individual bootstrap estimates via indiv_pred <- predict(fit_mod_av, doseSeq = c(0, 12.5, 25, 50, 100), summaryFct = NULL) # plotting can be done via plot(fit_mod_av, plotData = "meansCI", ylab = "Model averaging estimate with 95% CI") ``` ## How to adjust for covariates? In all practical situations covariates will be used to adjust for in the analysis. The MCP step can then be performed for example by including the covariates in the `addCovars` argument. Another approach to perform the MCP step is based on the differences to placebo: In a first stage `lm(.)` is fit _with_ an intercept included. Then the treatment differences and corresponding covariance matrix would be extracted. This could then be fed into the `MCTtest` function, with the `placAdj = TRUE` argument, see `?MCTtest` for an example. Both approaches will give the same result. A third alternative is to calculate the adjusted means (and corresponding covariance matrix) and then perform generalized MCP-Mod based on these estimates (following the same steps as in the unadjusted analysis above, but adding the `type = "general"` argument as well as the estimated covariance matrix via `S`). The procedure is very similar to the situation explained in detail in the vignette for the [analysis of binary data](binary_data.html), so not repeated here. For the case of normally distributed data adjusted means are calculated by predicting the outcome (using the covariate adjusted model) of each patient in the study under every dose, and then averaging over all patients per dose. ## References DoseFinding/vignettes/children/0000755000176200001440000000000014654153534016255 5ustar liggesusersDoseFinding/vignettes/children/settings.txt0000644000176200001440000000055414654153534020662 0ustar liggesusers```{r, settings-knitr, include=FALSE} library(ggplot2) knitr::opts_chunk$set(echo = TRUE, message = FALSE, cache = FALSE, comment = NA, dev = "png", dpi = 150, fig.asp = 0.618, fig.width = 7, out.width = "85%", fig.align = "center") options(rmarkdown.html_vignette.check_title = FALSE) theme_set(theme_bw()) ``` DoseFinding/vignettes/mult_regimen.Rmd0000644000176200001440000003330414654153534017623 0ustar liggesusers--- title: "Multiple Regimen MCP-Mod" output: rmarkdown::html_vignette bibliography: refs.bib link-citations: yes csl: american-statistical-association.csl vignette: > %\VignetteIndexEntry{Analysis template: MCP-Mod with multiple regimen} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, child="children/settings.txt"} ``` ## Background Often more than one regimen is studied in dose-finding studies. If there are enough doses within each regimen, one may still utilize MCP-Mod. But specific assumptions are needed, and it depends on the situation, whether or not these are appropriate (and thus usage of MCP-Mod). The first idea is to bring the doses for each regimen on a common scale (total dose per time unit). For example if once daily (od) dosing and twice daily (bid) dosing are used in a study, one might utilize the total daily dose. It is usually not appropriate to then perform MCP-Mod on the total daily dose (ignoring from which regimen the doses originate): The study investigated more than one regimen, so assessing the difference between regimen (for example for the same total daily dose) is of interest. This would not be possible with a modelling approach that ignores the regimen. The most general approach would be to perform MCP-Mod separately by regimen, and for example to adjust p-values originating from the MCP-part using a Bonferroni correction. This approach assumes that the regimen don't share any similarity. Due to the double-blind nature of trials, all patients would receive two administrations per day (patients in the od group receive one placebo per day), so that there is no real od group and in particular no separate placebo od group. So it often makes more sense to assume that the placebo group is common to both the od and bid dose-response curve. For the MCP-step contrasts for both od and bid are taken with respect to the same placebo group and in the modelling step one would assume the intercept to be the same across regimen, but all other parameters separate. One could also assume further parameters to be common across regimen (for example the Emax or the ED50 parameter for the Emax model), but in the following example no such assumption is made. The motivation for the simulated data below is taken from a recently completed dose-finding study, where the dose-response of the drug Licogliflozin was assessed for the od and bid regimen [@bays2020], see also the [corresponding page at clinicaltrials.gov](https://clinicaltrials.gov/ct2/show/results/NCT03100058). Note that this study used MCP-Mod, but the analysis presented here has been modified and simplified (in terms of candidate models and dose-response modelling strategy). For most of the following code it is useful to structure the first-stage estimates like this: \[ \hat\mu=(\hat\mu_{\mathrm{placebo}}, \hat\mu_{\mathrm{od}}, \hat\mu_{\mathrm{bid}}) \] The length of the sub-vectors $\hat\mu_{\mathrm{od}}$ and $\hat\mu_{\mathrm{bid}}$ correspond to the number of different doses in the two regimens. They can be different, but in our example both have 4 elements. Also as discussed above everything is modeled on the total daily dose scale. ```{r, data} library(DoseFinding) library(ggplot2) ## collect estimates and dosage information in one place example_estimates <- function() { ## ANOVA mean estimates and ci bounds extracted from fig. 3 of Bays (2020). ## clinicaltrials.gov page already seems to contain values from the dose-response model fit mn <- c(-0.55, -1.78, -1.95, -3.29, -4.43, -1.14, -2.74, -4.03, -4.47) lb <- c(-1.56, -3.15, -3.36, -4.85, -5.40, -2.49, -4.10, -5.50, -5.50) ub <- c( 0.40, -0.30, -0.54, -1.76, -3.48, 0.24, -1.38, -2.65, -3.44) se <- (ub - lb)/(2*qnorm(0.975)) # approximate standard error return(list(mu_hat = mn, daily_dose = c(0, 2.5, 10, 50, 150, 5, 10, 50, 100), S_hat = diag(se^2), # keep track of which elements correspond to which regimen: index = list(placebo = 1, od = 2:5, bid = 6:9))) } ## restructure estimates for easy plotting with ggplot tidy_estimates <- function(est) { se <- sqrt(diag(est$S_hat)) tidy <- data.frame(daily_dose = est$daily_dose, mu_hat = est$mu_hat, ub = est$mu_hat + qnorm(0.975) * se, lb = est$mu_hat - qnorm(0.975) * se) tidy <- rbind(tidy[1, ], tidy) # duplicate placebo tidy$regimen <- c("od", "bid", rep("od", length(est$index$od)), rep("bid", length(est$index$bid))) return(tidy) } plot_estimates <- function(est) { df <- tidy_estimates(est) ggplot(df, aes(daily_dose, mu_hat)) + geom_point() + geom_errorbar(aes(ymin = lb, ymax = ub)) + facet_wrap(vars(regimen), labeller = label_both) + xlab("daily dose") + ylab("percent body weight cange") + labs(title = "ANOVA estimates with 95% confindence intervals") } est <- example_estimates() plot_estimates(est) ``` ## Candidate models Even though not necessary and not always desired we will use the same candidate models for both regimen here. ```{r, candidate_models} mods <- list( od = Mods(emax = c(5, 50), sigEmax = rbind(c(75, 3.5), c(25, 0.7)), maxEff = -1, doses = est$daily_dose[c(est$index$placebo, est$index$od)]), bid = Mods(emax = c(5, 50), sigEmax = rbind(c(75, 3.5), c(25, 0.7)), maxEff = -1, doses=est$daily_dose[c(est$index$placebo, est$index$bid)])) plotMods(mods$od, superpose = TRUE, xlab = "daily dose") plotMods(mods$bid, superpose = TRUE, xlab = "daily dose") ``` ## Multiple contrast test The matrix of contrasts is built up from a separate matrix for each regimen. We stick them together in such a way that we compare $\hat\mu_{\mathrm{od}}$ and $\hat\mu_{\mathrm{bid}}$ with the common placebo response estimate $\hat\mu_{\mathrm{placebo}}$. ```{r, contrasts} calculate_contrasts <- function(est, mods) { S_hat <- est$S_hat i <- est$index cm_od <- optContr(mods$od, S=S_hat[c(i$placebo, i$od), c(i$placebo, i$od)])$contMat cm_bid <- optContr(mods$bid, S=S_hat[c(i$placebo, i$bid), c(i$placebo, i$bid)])$contMat colnames(cm_od) <- paste0("od_", colnames(cm_od)) rownames(cm_od)[-1] <- paste0("od_", rownames(cm_od)[-1]) colnames(cm_bid) <- paste0("bid_", colnames(cm_bid)) rownames(cm_bid)[-1] <- paste0("bid_", rownames(cm_bid)[-1]) # now build a block matrix (contrasts in columns) like this: # [ row of placebo coefficients od | row of placebo coefficients bid ] # [----------------------------------+-----------------------------------] # [ remaining doses' coefficents od | fill with all zeros ] # [----------------------------------+-----------------------------------] # [ fill with all zeros | remaining doses' coefficients bid ] cm_full <- rbind( "0"=c(cm_od[1,], cm_bid[1,] ), cbind(cm_od[-1,], matrix(0, nrow(cm_od) - 1, ncol(cm_bid))), cbind(matrix(0, nrow(cm_bid) - 1, ncol(cm_od)), cm_bid[-1, ] )) return(cm_full) } cont_mat <- calculate_contrasts(est, mods) print(round(cont_mat, 2)) ``` We also need to calculate the test statistics by hand. ```{r, test} mct_test <- function(cont_mat, est) { cont_cov <- t(cont_mat) %*% est$S_hat %*% cont_mat t_stat <- drop(est$mu_hat %*% cont_mat) / sqrt(diag(cont_cov)) # FIXME: calling non-exported function p <- MCTpval(contMat = cont_mat, corMat = cov2cor(cont_cov), df=Inf, tStat=t_stat, alternative = "one.sided") ord <- rev(order(t_stat)) return(data.frame(tStat = t_stat[ord], pVals = p[ord])) } mct_test(cont_mat, est) ``` A clear dose-response trend can be established for both regimen. ## Dose-response modelling Dose-response estimation needs a handful of auxiliary functions. The model for $\hat\mu$ has a common intercept parameter for both regimen together and two sets of the remaining parameters of the family in question. For example, a model based on the Emax family has 5 parameters: one common `e0`, `(eMax, ed50)` for the od regimen, and `(eMax, ed50)` for the bid regimen. The following function calculates the responses given dose values and a model family. ```{r, estimation_1} ## calculate response under `model` for od/bid with common e0, but separate remaining parameters ## arguments: ## - model: as a string like "emax", ## - i_par: list of vectors named "placebo", "od", "bid", used for indexing `par` ## - par: numeric, model parameter structured as c(e0, pars_od, pars_bid) ## returns: response at placebo, dose_od, dose_bid (in this order) eval_model_shared_e0 <- function(model, dose_od, dose_bid, par, i_par) { resp_placebo <- par[1] # e0 resp_od <- do.call(model, append(list(dose_od, par[1]), as.list(par[i_par$od]))) resp_bid <- do.call(model, append(list(dose_bid, par[1]), as.list(par[i_par$bid]))) resp <- c(resp_placebo, resp_od, resp_bid) return(resp) } ``` Next, we need to be able to fit a model family to the observed $\hat\mu$. For this we employ the usual generalized MCP-Mod approach, i.e. generalized least squares with the estimated covariance matrix $\hat S$ [@pinheiro2014]. ```{r, estimation_2} ## find sensible starting values for `fit_model_shared_e0` by fitting separate models, ## index: list of vectors named "placebo", "od", "bid", used for indexing `dose` ## bounds: passed through to `fitMod` calc_start_values <- function(model, full_mu, full_S, dose, index, bounds) { separate_coefs <- sapply(c("od", "bid"), function(regimen) { inds <- c(index$placebo, index[[regimen]]) coef(fitMod(dose[inds], full_mu[inds], S = full_S[inds, inds], type = "general", model = model, bnds = bounds))[-1] # drop e0 estimate }) ## remove names to prevent error in do.call() in eval_model_shared_e0; ## od, bid coefs are in 1st / second column start <- c(full_mu[1], as.numeric(separate_coefs), use.names=FALSE) return(start) } ## fits 'model' to mu_hat with GLS (using S_hat_inv as weight matrix), using a common e0 for od and bid regimens. ## i_reg: list of vectors named "placebo", "od", "bid", used for indexing `dose` ## i_par: passed through to `eval_model_shared_e0` ## dose: numeric with doses for placebo, od, bid ## lower, upper, start: control parameters fro `nlminb` fit_model_shared_e0 <- function(model, dose, mu_hat, S_hat_inv, lower, upper, start, i_reg, i_par) { opt_fun <- function(par) { # make use of lexical scope resp <- eval_model_shared_e0(model, dose[i_reg$od], dose[i_reg$bid], par, i_par) delta <- resp - mu_hat return(drop(t(delta) %*% S_hat_inv %*% delta)) } fit <- nlminb(start, opt_fun, lower = lower, upper = upper) return(fit) } ``` Finally, instead of only fitting a single model, we use the same bootstrap-plus-averaging approach that is detailed in the [vignette for analysis of continuous data](analysis_normal.html#dose-response-estimation). ```{r, estimation_3} ## predict population response in each regimen for dose_seq_* ## note: both dose_seq_* vectors should contain a 0 if response at placebo is of interest one_bootstrap_sample <- function(est, dose_seq_od, dose_seq_bid) { mu_new <- drop(mvtnorm::rmvnorm(1, est$mu_hat, est$S_hat)) mod_info <- list(list(name = "emax", bounds = rbind(c(0.15, 225)), i_par = list(od = 2:3, bid = 4:5), n_par_gaic = 5), list(name = "sigEmax", bounds = rbind(c(0.15, 225), c(0.5, 5)), i_par = list(od = 2:4, bid = 5:7), n_par_gaic = 7)) fit <- lapply(mod_info, function(m) { start <- calc_start_values(m$name, mu_new, est$S_hat, est$daily_dose, est$index, m$bounds) low <- c(-Inf, -Inf, m$bounds[,1]) # no bounds on e0, eMax up <- c(Inf, Inf, m$bounds[,2]) fit_model_shared_e0(m$name, est$daily_dose, mu_new, solve(est$S_hat), lower = low, upper = up, start = start, i_reg = est$index, i_par = m$i_par) }) ## calculate gAICs gaics <- sapply(fit, `[[`, "objective") + 2 * sapply(mod_info, `[[`, "n_par_gaic") sel <- which.min(gaics) mod <- mod_info[[sel]] ## drop the placebo element pred <- eval_model_shared_e0(mod$name, dose_seq_od, dose_seq_bid, fit[[sel]]$par, mod$i_par)[-1] return(pred) } summarize_bootstrap_samples <- function(samples, probs = c(0.025, 0.25, 0.75, 0.975)) { stopifnot(length(probs) == 4) med <- apply(samples, 1, median) quants <- apply(samples, 1, quantile, probs = probs) bs_df <- as.data.frame(cbind(med, t(quants))) names(bs_df) <- c("median", "low_out", "low_in", "high_in", "high_out") return(bs_df) } dose_seq_od <- seq(0, 150, length.out = 21) # do include placebo! dose_seq_bid <- seq(0, 100, length.out = 21) set.seed(1, kind = "Mersenne-Twister", sample.kind = "Rejection", normal.kind = "Inversion") reps <- replicate(1000, one_bootstrap_sample(est, dose_seq_od, dose_seq_bid)) bs_sum <- summarize_bootstrap_samples(reps) bs_sum$daily_dose <- c(dose_seq_od, dose_seq_bid) bs_sum$regimen <- c(rep("od", length(dose_seq_od)), rep("bid", length(dose_seq_bid))) ggplot(bs_sum) + geom_ribbon(aes(daily_dose, ymin=low_out, ymax=high_out), alpha = 0.2) + geom_ribbon(aes(daily_dose, ymin=low_in, ymax=high_in), alpha = 0.2) + geom_line(aes(daily_dose, median)) + geom_point(aes(daily_dose, mu_hat), tidy_estimates(est)) + facet_wrap(vars(regimen), labeller = label_both) + labs(title = "Bootstrap estimates for population response", subtitle = "Least squares estimates plus 50% and 95% confidence bands") + xlab("daily dose") + ylab("percent body weigh change") + coord_cartesian(ylim = c(-6, 0)) ``` ## References DoseFinding/data/0000755000176200001440000000000014654153534013366 5ustar liggesusersDoseFinding/data/migraine.rda0000644000176200001440000000031214654153534015645 0ustar liggesusers‹]= Â0EŸI[üuwp”⤃ .®Nu 6•‚m%-¸ºøŸ¬7ðÒÀÉI/7Éù¯Â8$"Ab$IH,•ÀÔ!EÜ˳›ÕYaˆä{×0tuâ±Wì){Á^³Oì ;ó'iÀ9Î.¥ Æ Ïw8f}o0K°c` 6­ww ›Š%URVÆì_¥Öø½*j[·C®w]ù_ ]ë(µÈoµ¶|Fþ^÷hñÂÔ4Íú:~ÌMpDoseFinding/data/IBScovars.rda0000644000176200001440000000421314654153534015711 0ustar liggesusers‹íXWTÇûP@AAÄÆx09ȉMšªèÝå ÓP‹Å˜¢ÁU1$ùÔEðQ =ÖÔ rª¶–Ô6A­Ê¥„UQ$òµ Â.»|Z vîœáÿÖwÎ{óÞÌ;÷þîïÞ™ó‚ü7.±Ùh#‚\Û+¹B|UÊŇLP SÅvj€ßúmQ»5±q‚ p;D Å4qj镽/K$ò/m‹ÐÄ¡8S²C³->*V|ïéc[ .w,Tm2€®¾¾þ«i%Pà‘sôìShYìgŠ„2úý»ºæ»‹ Ðéïïï¿Œ­y -K‰ÁT¹Â)óWÐIÛ6M†ËÎãÃ`Š,®û…S:˜…ñ L‰*’Wô’+17]û»ƒ.888uÁ.qhœ>%ç×LînpðÏ‹œ¡¯.²x q)yXPð¥ÕÚ'Dï¢I¿×íÀôÖþÃ;{¥ÙŒV‡ÃGÓfá_c×mòÈTé›í2š×¼™šæ¾:,ò½Hmü~ì:Æú£Ö:FŸ¹ =¥9—ÑoŽ—o°;¢%g4®†ÁQ.ña6ô×EžµñC=¸´äxœîØ«’Õæf5d‡Ãwö+¯Z!Τ$¡5oÕA;0‰vB˜+tuuu»{hûûø“fRYü°êÔÒºu÷ëŸ.ʇ"cèl¯´OÉ1õ©y‘ï’C)3×Ö­&ÕËkKv3{ ÿï¨þÒ3Þ¯Ê!ÔÒ@ýù>Dwup©‹ÃEMÆì++Y¼Ç^q|eä*ø67ë¾y«Œá%†§®9­º}M•óoX©dÀdçsÝgñ•‚Æ[Ÿî¼1¿œ´{ä¼s¯Œ¾©ä¢½'~x’­‡q¿1õ…㦿€âÙïsc¸Õî‰ ž÷œÊä[×í²ÎÞdÆÐYÆØ‹kàvVmÞ”â$è§xQûHãrǯžºý;™ý  NˆÔü`ü‚üÆé3<ÖÊ}]¸Üé¥JÔ‹~†9”-©kÞL*³Ê+h¢qh@Þ[ð`¼Ò݉ßìã7DºÌ'“BI=µ›úG0Z©ß=–<`xÜVkç.Šö†¦¯&]ôarÉÂcÔOŒÎ¥q—bˆVäŸÛ^7R¼^¯}ÍǸõ…èJVCX¾ãø3ÇÂe#UL®âµ[ç<0YE^—,^Çð¤vPÞ“?;2§d}Ô«µî/ŠfüËFëçÛä¬Zëfý·Br.ÀãpLg4`Kë¡|d¼ê›?¾í²™,NÚÔ5oM]ò1˜}®Û½¸h|àª;ñ¥¶m §v"ïÐ?Z?Úy't–¡ýÇíÌ_ÊC¢ë܉–40ÆožýG‚zé|¨¢<ù7ÕOýb8àú´.­y{< l=Œ'­wŒ/úÁ¨£ÂÞès'ˆp?°ö#LŽÖEVo°Eš;Ëeq×à[MÆœ”}—ÉÓ¬ÚܤÕó oÇøí–x‘ö¨ß ¦¼Uú×·îvI†?•FÌ48¹¡ÿ„®Ëêúƒõ«‹Æë2­‡,:cnº¥Ø%SárÇRç* zšÅïÄòI®Zë‘wþ4èJBôÊû ›Äxÿ´Çñ¦ó½òÄ$›…¬=£8 |Þö¾o›‡ùi2€B÷× ¤ñkǧ¯øŒà~<@>Ió„ÊCu‘WЖ£’ë”_úÓo¨<ÿ.TèJ6ɺ¿Ä:Íêò˜òFn‹8°_‰û)i¶È‘êˆ?¼Ö¡ O-õW%Û-·6“šJ_sЫPe±C%§ù@ý#5Ôäß•WËÜŽ‰£ë¹7YA<†Ä6¨·„ùƒzmEÿ£³ü{*âf,‹eñÅ:Ð/ÖÙÕ'‰úGýe|xFëüeŠÝ'¿]?¿d[4LZÈ;æÏúw’†ëv>õK‡TŠ…KN¾ýÏØ~Úg±“`þá~„çŠÞžÇÞBÿ]À:ƒûV{mîyk2Ë+Š/˜333cò0 úOýSÉÄÖsÏchÔº«¯í飸/›Ë» -7«v_õÆ´£m¥}šëêÄϬÎ7Lä ǼdöZÖ'ÆS/«Ë¦Ÿ&µXï)_Pãb˜¸_±¼êI=³,á¾=îCä®õº]ûæî'˜_ÈZ¯Ø|ä÷-šÿ ‰¯XŸuOÇ|d³,5¹÷‹Ö=œßNùƒç¼ Ž¸ß่Ž“ｚ®;³:_6mÞÑ)^p.OíeoH'Xo±þv§ ¼R¬ý-«ÔQÿëFAakå\Ÿôö£¼Œ›#pcJ‰,/Çë’qzN‡’Êðºqž’ǹÒõø1´ex[•ÜÍ÷Ißq '´ ý˜ ;Þ\›ŸË¯…ß<æ2a¢ ra"6xñ˜(…ÿ¶—·çòºy9©¼~ÞN>¶§‡×Íc-WÞ>Ƽ-¨g2<¤6â7/#ãú…Iú±ïy6óñD=¼ÿrI¿t};žŸ²çèã9Ä牔ßRý<–¼í¨s²¸ð²ÏÓ/&Ç_&Ú ]_ªKêŸ4RîKû¥¼‘æo+?Wšÿ¼?Òœ“Îáù.}@?îç0ÊIs†×¥”|Of—4¾œÜÄ_1;5‘aø+F¿b> Û¹=,–~)cÃâ¢ñ}{T\˜ôWlÔ'Þ¨fÚغÉâcttäEP1*LüÓc³]¯ñÞ+N,{Fþz_ÞQDoseFinding/data/neurodeg.rda0000644000176200001440000002415614654153534015676 0ustar liggesusers‹í݉WÍoû/ðJJI¤ATŠ2”’±ð¦2¥4•jŸiïŠ$D†"Š$D¦ŒQÈ*CR†(¡($Ræ¡Ð¹¿¿óTU!(+©*iØi.»0bÃòJJôþù"Ñ…„—à[÷®º nÚ-þ»G‚y÷¨c- Ééi›Rnt‚hîqgç§ï®ÉÙ»è*„äó'MËX`˜ ‰KGé›êDˆT{9WN±1÷k¡÷g°E›õË­'ƒ]U¯~‚¹é†×}s@Ú½mZ˜¹²ÉÉK¦'¯ç3öX° ÿüç¦Ã!®;‘ïf шû“–=¶@ˆÃAã}¦ÏÀmY¤”yÉÒíi O™OGÀßæŽýáSÔfôÕ¾°R¦ða)Ø¥CÓ[×@¢=¯nçmÌÙ¦ÕG»¿+f%ffÍ©„l˜é›§;À%®6÷zLð®{ƒ!ΞcµùÄ:uf7ÂòƒÌ¬ãÀ¦Lì†ÜËæ»ö bÊ!V?ß±£ùsùW”O:sÂàËÎÁCƒ¿¼iúÂקÁ…¿¬I´þ Nm¿§‹#XÛG÷ÅÔBf“§¬xÜÓ ®Z×íÜýzHÚ;Hóvuª® qa7Ôe!äF¦Úzƒ{’öÜøl¤ƒµóBSœÓÞÚ[øj?¨®… Ú'yéŒ.àöËëÿ`˜f;ƒ¨jlmmoˆ…dí¡Š«]ÚÀ'^¼_þÍÜoãUžSýÀY&ù„uLèj£üà ù{o­™õõvü6£|×â%W” Á„WβK’@ìxñ–Õm–çcÍÿh‰ÚˆÀ=äüz:Så(˜B³}îxBrèàYÇ‘Þ·L²Œ‰R‡0~9¿!ììÚiÌ´2ÈRúŸ[íeÙº®•½̆| ÷¢FÛÁW-¶N{:ÜÏì–ä¼5«u5Í 6Á5ÎÀÁ ¬Rî<ùÔõ优h„%ƒÕSÍ\«±Òá±w¤ÇÂCµ ]ïÛ t>2ÙŒØëMàööùÙm$$>.A· (­Ló›Q„™×{îêpÃ2½£v³™$pϾ40}!½ÒìZ–±íõò#ÈkíÜ£_ y–cþ›ngÁ7ŒËŠXpƒ¬ç#kUï3G´~ÝÒäàéÜ®DæäãVyÐ×¼IX•íÍÁ`zG?±ŒM†(,þýMð»ñÝ>wÓQÈ“®¬»ñ‚׸Þ-oÀhn®ZÿªD–/-%‚NwuãÚÈÖ¼ð;í{Â_ÃŒÛ6e–;Æ®Lÿ@Ýãm`¸8W­h‹)É»n-Ê€lññMqü ;á¦YR ¡Iïì%/ -‹#Þ^Œ‡lÇNûªÙ›É÷eFØ÷>vAóËùÖÙv|vÁ’¿‰ÍÉöáå×î\4ÜûØSÑ‹!õì±­»û}»M¹¤»%³£ÓCæ _‰}‹¬’" š5t×U;pf6JWƒk!½àüÝ ïDçÚÓ»?y~3ׯnâað±†]?½ô›‘<·Kk0× ´ ¾=€ÔàSøÉM|¿†‰[ÀÝ·L{9ù˜Š‡›(A2¤ã7ÿÄH<›îœ¹Ù2‹?–Á)~à=CïŸQ VëË_5çÏîr¶¿ÒñÄÍwïé©°3ÌƒË šÁ•?Ê^¹´'º ‡@lïs%döN¸žæä¹!­CmWÎÝ >κ_·àþ>ðmÖâHˆú·ymò}?ÍÕš56:tØœR{v—hì/rìïÑps3Êþ¬9f¤Eø™‰U7¯Si „!ž&›Ž9äèÒû—$c:8Ô\õC°¡ï´+SþB~²«hšõ&pÊÇ8 ‚´Á§uÚŠ6ˆã>ïhŸ ƒË]ö¥¹wÿ~e­î'ð™çöTI»ßÒkn‡-ðñWkÞïΟÀ/ïÕé$øu#U× Øfå€ØÅ ,ÁÚù=‹·3³µ~Ÿ¼¡ã¯CSšÀe'[l’Ž¿ÉºyíRrÿ¢eNSæ}ƒÐì~«GÉxÈÎþí9©62¥#ºímÁOµ?ª­ºLtÅù#F©·¶¶­ïŽ`ßíc³Ÿ€üöâÒ—z7!ˆuTj·­ˆXÚ¶D™ïiㇷ§#8µdH¾ì&øò²Î³<3Á˜çwÖE ܲ:ûÎwÔÁæ±å390s ™ï †d½[íWÖÔÈ°¡òÀJ°ÏR‹4oísz]΄¡…þzzË×ðg ɸ’GÖ×÷/¶™¦`›W»ÆGºmÈN¬È ‡0ÀÉÌúÌpÊG#LÑYq HÏ_îé°/“ßöˇð$*‹wÜW¥~Ÿ•9°¯~¿þ,9 é\ÕoUëK!É=àðÁÈ òëv!׉øRž»e#„G#;ôË~ñ]fnVøIY¶/* Ý°>tTBǒƱ¶gÁq3kÇÏÖëpž]€ ¤¾]Ÿ+kxC¾Å%ÚSãd:S†õ ÖkÆ9äÝŸ8"Ô@¾ýžQ—ÌÉ”§æó½ÁÛGºV.™6Ô56äO ûâÂÀfXt~ÍòvšÌ[Y®·ØÄòz¤–lûCÆ"ã$ÿyæ™ð‹¬èþ`bcº%äÔ9èóÑE¡¤NkoUŸ} ’h· «“CX05&Ýò>N­®»!- (dðìêÞ´a¾àËÌÜØAêK‚ 5Ó÷©oZç÷’}c†h·tíI°ÚcGÈš'BrÈå~j&Ä7÷ê?Ý™á~yZÉVðs}Ò½°+z¦›d@ZžbØlñ©ˆ ÖýË!3è¦è 9îz½üéõàW85Λúã£ÕÌl°ÉŽÏ}¶¿×”§†6SÓÌÈõ}úàñátÚrÆ¥z‚ë?Ž‰ê®¹MlxÝ„ƒY^ª¾V‚iÃ6­ÚW _Ýè\Ò üÒ…>uV™l<üýú øQRë7z€«^´,lÇ8p·WæV´ÇÓÛp/I2rkk_›"r¼ïÇ;39¤´nò2ˆïîTýr,æ|>0bÞzSk˜úŸÁ‹§älh'u}ɲ~f_´Á´åÕ¥†µCêðçê–UéË·š@Ž»Nva-„Ë~Ct{Ù™¾šÏû¹Cæ×ǯ©Z‡|\ø®k<øS©mowƒOÙ5×}•=ø§ãƒÿ=AýØÉÖ—äõªÜþr“FêLÀ`³.³ÀúžÓ”D€tq3;·óˆ-µ \øüŽ£ÊÍ î`• ^Úˆ MÖTÜ¢åíqá>iôFß6‘Ô¡ˆÂcv—Áû,éöF?ìm•Ëk¿î{k_²Ÿ[)˜#¥st„‹jîŽûó)œœOÕÂå{|ªš6 RoNµUÇ ëû&"p=„Œý±Ç¶Cø¬yx`!„§{¤©G;AX4¾Òõ$ aÂÌék$o!½á±ã(_fƺZWO»ué±u¹¾_¿ºo©Ÿ×~[®&×á§'ìSɱ»×n¸Øü”¡ñUàÄk®º5쑶™ƒ¯k@æà6âF Ùßm§äÉ:Ÿ㧣Õ.Úq“Οïë¤:"Mi(îábcçÑÁ಺•uŽW3¦¶Øüñoˆ$õ'.@ ÉâµÓºCîPÍ&_5ƒpµ,âÈ:ü1Ç÷붬çç7Ýjl ˜|Wë*äyUäxlø®aÍ€«¾'À>5ÑØ&mÚÑúƒuPùb¾²‘Ï|“+H?fÄ´¥5AZ•šš"2¨ûÄ(îJ/\=ö2óøÖ?O‹lH}ÓÓ÷ÿûf/¤O6v YZ‰ÁޭÞ>(U{hc`%äz'µ?=·Æ-mEô50fp[°É¢æ¨È;¿‘þý±»p»¸Êc£Ç–‚›·\¯ÿ˜r°ö6-3æ{±Ýtvt¥Ù_­urƒ !&çÛÁ§]m^¶h¸ÓgkoÌ„tb¢¶¶ó rݵÜßã?2î鬭 ǃUýPDö{ùíÁû Y¾þcD¬‚þƯ•z²ã¾®08 AnüÌ`^¹(y÷žJ°on·Ì¼™ æ†z­O¾ ø=kGÄ«‘ý¢vFÒŒŽ`ô†¯÷õ(ƒþÆzÛA¤"»4ÈסªOwÔ¿ a…Ϲ ¡› má ÔOo ý†ê×W¿ýáûk[®~j „ Ó&¹VƒË¯[xôíÊO÷úZï'ÏóŒyn'r¼^‚æÍ©-;eqêG¥÷' —<0%}…\kA7Å‚‘»š^Kæ²]jôÁG&«]‘CòÖä½Kƒ]‘+›_²Œe“[ÆR?öt[Ùkæ.°íÊç7ùïÀ/ƒÐ©³0Ëëm÷çßÊ05Þ§§nPð×'=ù2Ÿ¬»³Kò\æC|V#09íüËtþJOL‚¯¹ÍÕVÙŸ['Õù ^%¸À¤!’/mã»í€ .¾ÂÔE~˜uvß@MÛà ~ßþè¡êÔ—OãÈyž-®æ~‘×ý㈬„ßÁdžÚpý"yoý§u}4À›¦>IXzŒ¤«W[Üpˆ7n.èÍǜ֤ãF‰Ö÷üÙùÆ“J2×Î3®vò†t›çïúÎ!3æïöÛ€œF½C^H|ôGµFxÝ•ùËV‚™æ•;²ÔÝ°ºK}!Ž‹×ÛÒ”Á³û›×ñ¾`x~0QÞ él›Í¥³f@¬ÙéVÙ›sHÉ«ms®‚lóÊ)¦3€÷_næðó9¸™Í' Éœ¤µW_|ŒçH¯üŸ$}ïO#À¿µÜæjú½øÃÁK΀ߍµX ÁÜ]åÕõ*pS{gÙd€9#׿9âE;ïjË*¤•›eµ³?¤t/?h ùˆM[‡üPƒLSv7I§'øzõÓÌþ›`ƒUj~”ø‚aã¯uÜt²‡ï—ßúEêŒEÞY2„êÜÙ¤Ëd]tÐÞpqø€5ï{>"ëÊk_ÄX×-à^æ›'ëÁæðÕËÑ¿ aòGÖk6Deuý£³!|{Xï´9¬¿2?•Âsàb›r,ôÀ|W™¸²¤e ç|èCöÉu¯Eô0†°6iy±Ò}R/ ¼èz ܘ˜5Γº€ﶌì£3&%^N²†lÒ£Ùiû!«:¡oPûò‚þÍ~â3™: 9¯‹×ñSº ÓøŠ™ÿ`+$†ùÞ‹=5d>Š¿ð1~ Ùn‰3 häÌÿñüK¥ã Á/ÈsR:ìåœ^ΚY`Õš§–Lƒ|JHM"RÇŽ¸EìëDúµ”̈ˆq`£t¼7l_ éÎãµõÃëÈ>_ùÛ~àR2ÇÈÂk¦QÉIOÈ&o™wÂ@ãD·&XÍw!s ^-Lˇ|Û¦¤£Úû2!|ôŽ‹£!/Ê}<´÷B„ˆÚ—Dª FÈ M§¹õ»Ÿya8„°êuêÇ~‚;6ìá›å`¬4ô®œY‡õZãÛ’zÔ8{¢™ÿM½ ÍÛø.ÓK†‘ë:ÿúé4kð'žOm ó-W7s¼¾i©›íJ‹ZÀL·x¢yN â†Cæ5{_@vé蹓 ÃÈýý4l´„ƒjz>’ïïQ[wl*¹þuHOÿ¾ïæР»`«ª²»ÈúU-RXHÍsB»ÍÙ q¤²—Z²î3=_N… Tˆ¶`s‡MÚîæ]€j~îOHíîßXJöµëu]'“ú?¬ð ‚wzòýµ·À‡ño4^Z‘¾c¥êÂSé×Æ4ø~íÜecÁÞÜÖ´̪“;kò¤´¯“=[UÙß”¿gÖA8ÚÞËC ç­p…IL"ÆÉi/wÒßÍ}=¬`óbȇ ­ÓײWZ—‘ë¤û) ៀ Œ­ÔÜ0Ø<›×ÍÈò  ëNgGØÍœ’ÚKBæ¶Ê¯Ö¡o\~bþÖ­‹f¿ó$OúüÖö®…‡Á…ÆXëþåÂ_pë;†]žÎúO•ÍÕΗî˜ÙË:‚Ú¨w*ñ¤/xÞ`–ó’ÌE?bάz‘û—™9×!ÜŽzíbïGæé2‹ŒóýH_ñ7aÙý³¤ïxZòùÚSȆv6xk9¬ã¨k!f¤.ü»=ß[¬y§èuQ3 =úÇ;ñšâƒµò'ŒŠqS¹ YŠëú¶ŸNè.ϯò†0xNÊ2Ç|ܱ꺽 ™Ï¿l˜î±ÜÍÑí¾ƒÝÁ¹xF.úIúÊgÙY>Ž¡à:,šòwx#‹Çë:¶ƒ}x`Ò3CÁºel¬ß•†Ù²ÿzHGÎÄ3I=/éxÅ'ÝrÿŸ›N É@Ho«í³ƒôÒÒ``a\Ðñü.¼)w­Víkš øaÙ+M5IŸk²¦yÆÉñJÚ'žßj ™‹“플öùçMcž‡AÐéÒ8½©•ô‘©âœó£ÀJ-ÿöœÔÑÜ % ?öyõ«W¬¨ ‚óê3w F‚¯²2ká+R÷ÚXKÖQ}@î©[M9Û¯cÙ÷¶¥-ø´²Ã'&ỵ0–ïc!kµûÛ’ü²™ûüöŽ¶lܹ†þqÞå.Kýûdù~]Þf™“×Ð5ë7˜|^wü ó!4½ëÖe 9¯Ïn<Þ\>±Óß’ÙÀÝOë?òÄ"ÒˆnÕ¹ËÈ:YïU÷KLvCôZwH'þÂ$â£*ýLVí¼×ì÷z²O±ŸS‹¢ÁöÞÝý–<’u=2uÂ!òW¿»Ç-²C"M{3ðí/ê7u%uüíæm.˜¥ç³‡7†Dl›ZîPDúÔ¹’&²¾'ZXÛ<ìüGýÆ÷3h’¯ÇhCHD-l‡¬ç3Ç5Àç¾I }òÜðsÅM›û€MœZõ$°˜ÒEß'-/AèŠÉîYM_!|5)itìÓ=ì´$Eu?¾–A4lK¨Õt²þXû'ì“3Ú^NöìqÂÉõ× Âû¹Å$Ø¢ì¿;&&ÎMúÉ˲÷¤Žô|Ú·fÚqpËÃä{ú{ßx»¬Ò¬NFÜÞü.ÝÞ"ZÖeÈͱѧ VÍÙvÝà þ‰‹N¿Z} >w3\o…’ý,¦,·´¼êxG—}öà ¢üîîõ‚4´Ãà% l!¾UdõŽÌ‰…$î§Á—† ï7î*™÷7:´[=Ü·Éî0©×ÍÊv}Ú\§2ŸJŸ6X RU˜ ª!}Ú_fœ‹9AU›¥o ë{1ñœVé#®è÷_Î\{`¿õ¤?Mˆaâµ épÔ÷»ÊmÈw=ÿà=‚anÏmqI¼Ûq+éˤ{ï|qîz’‰N§¶Lu‡ÜçuÃx²Ã%›c“^@Xø¢Õ1›ôAÓ= œÃûƒ-Š-q¾ô‚ènñ³3×ÁY)+ h©„ôËÝ5ƒ—Ç@´;Ù‰S[…À¤) f~ž·, “”¯?ÀêM~Ä°Ýs©GAòrt“›Óÿ)ÛìYAöåíÞ‡2 È>~bÃÈ d^îôé¸òÊ=N5dÞ¨5Õ8\^ ù §ž·I½bW•i R{¢äbZõzHÇIÒÛÔŽC´Ñ«÷ó)Ï¥2[I=˧õ.ç,x,ŸCú™!FûF ø ÉÉÆͽ ªU³Oé=ä/÷m]ûpä~¾œ˜ì?¾ÄÕ!¤ÜË­—çëÃ-NèutwO\ææb° 8]9¦ Fgm­½±/$i)?£gõ‡ÌþÞ˜]cÀ¿^6ÿÒH¼–¬êR,AÐù®qÝ>ò˜ÝšsqÊ ²#%Æñå+pÅÆ‹ =K®Ó ÷Ô\R´öº\pK!óXý £ª½kgvÇ ²ñ]Öµ©‘ùiTÑÉaá{ íàóv“îR_\×íÑ+ò¸þòñ¶NàšÏ3­$sÈt§ÃÙ…Üë7ãÑ͉fOÎ}öþ©‡yû²kÖýúyOµæÍàäÙ¬Ù+°Nó<ïº]€LÙåúÞß2Žùvì‰%¸¾¹3go»ÖÙÛ~èÒ*0‘ón®¨ ™QFßw»rIŸå&×!ÝœÁ4U´’ýlÙóè(3ø½\¸:Ã÷+øsœÉd½ÞOÛ°VÌ‚³³hy±=ìÉÊÄv÷0ü>Ù«2ǧ@Öv4yi)Y'6+oΚy´ÉÔ7fqÕ0~ÖM ~Iú™Å/2ÁÝyps}:x­Ë:Û“ÿùwŽ“Om®Å‚Ë,žZ6mø›Û§8úì¶ÍGænãZ-×ëd}®^eØ°¬Á-Ü·æhR—–WÔ?X !.Ëm¡},øýIïÜ"n‚óJ¬=×ææûÞª~[ɼ}q]itÈòzÞòñ1*çóõ{Šuo°Y‡šŽ_Ù fåî^_›²!¥ºÿ̲Ÿ{M1„W·Š‡‹Àw²”Ç8ÞùçýÄ3%f¡àc÷ò«’}¨4:ñz¬?¤5û -Z‚ Öqÿ­±c‚•?Û¹òêþ“_ƒLþ(«%# üÏ•›Èq¶,©¸óA ¬Ï¤œ„lw󙧼 LmqÿÀ/*»Æ°|JÏ’¼ÌéàE~{®·Ç äנȳ«dþ¹¯WIæîÒƬÛcHÕ{Ú>[ˆÀuaºüOBï:ßÍ—Ìůt:ë<RÏ®qÏçAìÝ4Vº ‚î?ÕîNŽó¼Ï¸ËM“!¨ŠÙLê¹µž8ûZXn†¿^¢6˜®³¶ÿ5È'oU{´=2YSÀü.¤Ÿ]ß0Å”ì—.ãSû}ófР©ÕdŽº®Ä¼ß~Òíª’Ô±å+ëm[!—}P‰»’€;”V–ßö«c·Ã]TÞŽ8®jlYUâ6ðjkÚz?ûÚÿä¬ÞKÁ¯Ú=ïÜg¢S~ô&ûúߟ®{,„lîN[2DÎí<©ü~-#õ-ÝÕÀë8äfOý:xòÔƃ¬6!dá¸g×jAÖ’þh™Ï*²ìâ’Z!«û±²‹,„Uï«uŠN€o7™à춓Ì_Aö¬yRÏß[(¯¾_øñ£¤ÏâVX왥FÖ1W¨}†ô»¹® ÜÈ>þàv‡ÊÓdÿŠz¸Ó!ŒÁª­=-~C¼½ã’ISÈ|gÿ>%ó9/ZÝ¿í¸f€¿í ˆZ½» ²9…9—–Èt{O€°béÆøœ·àÅ玅çƒõô±3Ùº¬WO‡F©.˜Ógön9¹šAcud~:ÇŽ…‘> ó\žÙ‘çÿPl}(µüõáW~\ð uã·saÙ§uw÷ëgG®ç̹"㣕à«#b÷½H"}~—>&߶’ynÆøqiãHßaå´} Ùçäý³I}ÉՒߪ%sÕEѶS² »¾xM´Žd¯ÿâþ–Cnà1g©‹¦o/Vß®€ÜŽµ”TG‘yuÑõ9äz“×fW½V'õªøçàÎ`®FTŸ”)Û{£Oúçss/'‘9®Beµí¤Þül‘^½ ò†çïøŸEÈ•õ?_ 5‡,:gШ-‡Á»Ö~q+#s¹­²kE¡ ˜nËÛ DHo^iµ›Dö[ßÈÝ®“ùÃç…Ǫ9¤N©Y§Jæï{wtv¡+é.ýþSLæÞZ‘×À=[·‹ôUdzã—m5Ó¯0«oçH–GF^ûR¹Íû–…5b[½Ÿ>+¨Ë}æž)¤¯û+VÎIû é1Bõ2ç5=zvbä{ðá–5 ØÓ:Sâ“vIRÏ¡wÞƒéæáÜ/v©W–—Õn¥‚Ÿæh¶jZ8ÿkƒ."ýUlÁšççƒs”ƒ©_å«DA°?¸Ñ´”¼®1¡·ÓSHë´neýU²Þ¶îȯƒÛýŠ®‘ë$RcÞÊÀ0¡µç‰«!¾2ègpxG//1!óz÷/Â¥ùúäuQR권ÿÔú¬½}êÁÖ4=¥Fž·¦gi¯dþšÏöÑy¸f»FE@Úh—]ØÉšú mó?õ5p[tiäÝ"LÍÇÍàÕ'ì]ŸJ]kÍÛN旴ᵫÀνñ¸>] òz‹S¬ÆoȤqsÔ%à&ÌwZ–oéGî¢T{$üÝòåg_@ÞE:Ð*œ—â÷&¦Ÿ/‚éiýäðщè¶Ev=[… Ó¾cŒTEÿ¼?Ù¨Û‰Ì'²ïÅïz:‚o^kàΑú¿2½?_AöÃðë0™k/—^æ³ÈÜ=1éÍUŽ^4{¸nÃwˆeh tD¹~Ö“Ò?ÜÞ÷Zíò\ÈŠnLJÊI¿/:qø𬄠XqmãZ„„Yx嶇P™™pó5ø†Æùí]À6lpÄÜ~ßï—v“ý™ÐniGæ¹eJ»Ê ˜Þ·ºm¿¨©J$Ù¯m‚|Ì !ü~öMeäLÛáó·À/ßëu*8ÒCžBõÝ ö0žÛ1¹?ú¨;\ëµ²nv7wC¶|½õ×p-™î£înÙ@êÁŒÁ''‚mù¡tødOfŸ:_:Ü“V/犰ñ–/œ>ô„äýBþ[ÛU·µ*ÕMA(Ôæ´ !ï8cw¸¾.d/ºn5ÇÈ&^¸ÜÙ6‡œïû<ÙFÑ$ï_ðãRâÇx*ƒ]öUTí ¦~›Ñ£>:j ÒÁR„ìÚÜp)?" ¶‡XéÊÓµ#0;äô“ÊšzL9’ÝÌ ÖÓoµäë½hBÚ32Ÿk]ðy¼ãØN ‘¼g£[?2{¼¯Þ,ÿ0_JêŠé©¼R°Qsœk §’:¹­x„ú@0»Ì'L?óÂþ†}ƒ†+A8ÝO×N—ÌF¢õ?ywùIÛ†÷†Lóv¹ÉÎwàòíkN½.–×Ø-û¾ºãCõZÒŸ¿Yp/ï1سϣFŒØGæžç·­·~ƒ0ÙÆNÝ÷Qo.‘AHx¸÷!é'BÂÝØ·GÁ~Ë=XiŽ÷ÁQ ∻êÝ—#ÄèR¸CÚ>ŽoO\9H^¿1ÍËUL&shÚûÕ÷@P|¤øDÑDñ™â E3ÅWŠoß)Z(~Pü¤øEÑJÑå_ïÇ)nŠ›â¦¸)nŠ›âö_~÷YQQQÿÛ#:)¢"*¢"*¢"*â}´PDETDETDETÄÿú8VQQQÿÛ£Òü\Üÿ™Û þÍÿ­”þ¯›"O‘§ÈSä)òyŠ¦4T¼àßùïOj2âH± !þç~•þþã@¥~@¶‰DoseFinding/data/biom.rda0000644000176200001440000000175214654153534015011 0ustar liggesusers‹ÕUýSÓuÿîAQ XrœEa“!#DG ½w§à!ó:ÕjñtÙáz‡$™§(§PÐÜb‰ç }ã!Ôµc;&¬1bt$_áF|]Å/üôº{¿_¯ÏçÞ?|îs¯´ÄŒï oAˆÑ„InI&º!#[=‡Ü÷ øBò_­A_wp@tŃ«–‡68OîYņe YÅFåÿþý'v±/j7(õœ²lÿX´cGѳñ¬Ë`i'ðòeýðHÕÈö-‡Ñw%“YW5¨pÐLJ¦cÁÜžWá…˜â’zÝ è~¸ÜtÉñô¶t¾à:ð˜Ò­•gn¡_—;É;ƒþÃhëj{8J¤×Ÿ±ÛAj~Y¦?¬­XãF×Uèº7Ã02‹ˆÂÂ`näõpmhoJÒÀ ˆ–3PåŸXé®sp¯¨T“"›¼í>íÍ[aÎÔÌúûF.“Ôù˜BÝ‹šÛ‚«1uˆHÒ£ßgÕƒõà¥öä'ûÁlë5»ÊÎÁEûírƒ?,twš›{·\­óÛجU8A}PL!c;Œ3w{&Ã8N7Ëîôåpâö 0šZýkÌ+xjc*S§šÕ¯=„•¢ÜÃÅ > î Pu@bkHëJYUzÝô=0}c÷ç•ÁgAE #æ¼â„¥]œe–õüs¼»£NÚÝw‚Ke 1.¥ny4IÜá VXâ³.’1>8Å,ƒl| œ ÑÔꦗ³ø¶eô/ö G˜„¤_Ä9¢“0…ÕxÓV¨LŠ&2SZÍ$äu-–~ƒÅme)Ÿt®«üI@ç¡ÕôP^ ‘·×Ö4‚ëÊ&ÂÓ`%ö(ÏÞ;ö¤ÅÍ÷{| ¿(†Ù/F[]Œ¯Ò0‰Îܾ÷<|É3ç«Pm…5øÝQÔ„ŸvùʳÑ!Mãm»-Îã!Çtðû’¯Íy º*çyÔËŒöåç;ø÷¯Áœ’‡K#03¬çk²aáA=ä\hYç5›>dó¹B·  ³ùÏ€8Bîšp……ë›ò>` ךÖ.½9ìbvT¾À=o]ùVAAiÔÚÏžÏÜÉår]sÓSOü°‚ÈDoseFinding/data/glycobrom.rda0000644000176200001440000000037714654153534016062 0ustar liggesusers‹ r‰0âŠàb```b`b&f “… H02°0piÎôœÊäü¤¢ü\fa,ó1+8hBiK(í ¥#a* êí??þ~ýW¡¼é½þ÷í¿‚¸bíö_?ÏévžfÿMãë¡þM¸úþOOúº ïÙ÷nÒå c‘´ï{³ct¸½}ŸYüµk`4L½ƒGÄ^o(í ¥½Pi4²æ%æ¦`ÏAYRò‹Saì´Ô2C»8%µ ÊfÌCª¢ür=˜i¼ 0YøÿÿÿßèV&ç$ì„ r¥$–$ê¥õyÿ@ÑHpžDoseFinding/src/0000755000176200001440000000000014764013015013233 5ustar liggesusersDoseFinding/src/DoseFinding_init.c0000644000176200001440000000150414654153534016624 0ustar liggesusers#include // for NULL #include /* FIXME: Check these declarations against the C/Fortran source code. */ /* .C calls */ extern void critfunc(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void getcomp(void *, void *, void *, void *, void *); extern void sample(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); static const R_CMethodDef CEntries[] = { {"critfunc", (DL_FUNC) &critfunc, 14}, {"getcomp", (DL_FUNC) &getcomp, 5}, {"sample", (DL_FUNC) &sample, 17}, {NULL, NULL, 0} }; void R_init_DoseFinding(DllInfo *dll) { R_registerRoutines(dll, CEntries, NULL, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } DoseFinding/src/Makevars0000644000176200001440000000006014654153534014734 0ustar liggesusersPKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) DoseFinding/src/optDes.c0000644000176200001440000001245514654153534014655 0ustar liggesusers/* ####################################################################### ## This program is Open Source Software: you can redistribute it ## and/or modify it under the terms of the GNU General Public License ## as published by the Free Software Foundation, either version 3 of ## the License, or (at your option) any later version. ## ## This program is distributed in the hope that it will be useful, ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ## General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program. If not, see http://www.gnu.org/licenses/. */ #define USE_FC_LEN_T #include #include #ifndef FCONE # define FCONE #endif #include #include #include #include #include #include void rank1vec(double *grad, int *nPar, double *alpha, double *A){ // calculates alpha*grad*grad'+A char uplo='U'; int inc=1; F77_CALL(dsyr)(&uplo, nPar, alpha, grad, &inc, A, nPar FCONE); } // calculate design matrix void calcMat(double *grad, int *nPar, double *design, int *nD, double *A, int *incr){ // nD - number of doses (length of design) // nPar - number of parameters = ncol(A) = nrow(A) double gradsub[4]={0.0}; int i,j=0; for(i=0;i<*nD;i++){ for(j=0;j<*nPar;j++){ gradsub[j] = grad[*incr+*nPar*i+j]; } rank1vec(gradsub, nPar, &design[i], A); } // complete symmetric matrix from upper triang. part for(i=0;i<*nPar;i++){ for(j=0;j 0){ incgrad+=*nD*nPar[m-1]; incb+=nPar[m-1]; } setzero(A, 16);resM = 0.0; // calulate matrix calcMat(grad, &nPar[m], design, nD, A, &incgrad); // calculate det and/or MP-Inverse calcDetGinv(A, &nPar[m], work, s, VT, U, tol, type, &resD); if(*type == 1){ // calculate quadratic form (for MED designs) calcQuadform(MEDgrad, A, &nPar[m], &resM, &incb); *res += probs[m]*log(resM); } if(*type == 2){ if(*stand == 1){ fracp = (double) nPar[m]; *res += probs[m]*(-log(resD)/fracp); } else { *res += probs[m]*(-log(resD)); } } if(*type == 3){ // calculate quadratic form (for MED designs) calcQuadform(MEDgrad, A, &nPar[m], &resM, &incb); if(*stand == 1){ fracp = (double) nPar[m]; *res += probs[m]*(-0.5*log(resD)/fracp+0.5*log(resM)); } else { *res += probs[m]*(-0.5*log(resD)+0.5*log(resM)); } } } } DoseFinding/src/combinations.c0000644000176200001440000000323714654153534016102 0ustar liggesusers/* ####################################################################### ## This program is Open Source Software: you can redistribute it ## and/or modify it under the terms of the GNU General Public License ## as published by the Free Software Foundation, either version 3 of ## the License, or (at your option) any later version. ## ## This program is distributed in the hope that it will be useful, ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ## General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program. If not, see http://www.gnu.org/licenses/. */ #include #include /* General idea of the algorithm: It is easier to generate all possible "border" positions (instead of the actual numbers per group). And then count the number of objects between the borders (simple differencing). Example for N=5 and M=3: oo|ooo|o this has border positions 2, 5 and number of objects per group is 2, 3, 1 (2-0, 5-2, 6-5). */ void getcomp(int *out, int *work, int *N, int *B, int *nComp){ int i,j,k,row; for(i=0;i<*nComp;i++){ row = i*(*B+1); /* calculate number of obj in each group from borders */ out[row] = work[0]; for(j=1;j<*B;j++){ out[row+j] = work[j]-work[j-1]; } out[row+*B] = *N-work[*B-1]; /* always increment rightmost number */ work[*B-1] += 1; /* set right numbers to left number */ for(j= *B-1;j>0;j--){ if(work[j] == *N+1){ work[j-1] += 1; for(k=j;k<*B;k++){ work[k] = work[j-1]; } } } } } DoseFinding/src/bFitMod.c0000644000176200001440000002554714654153534014751 0ustar liggesusers/* ####################################################################### ## This program is Open Source Software: you can redistribute it ## and/or modify it under the terms of the GNU General Public License ## as published by the Free Software Foundation, either version 3 of ## the License, or (at your option) any later version. ## ## This program is distributed in the hope that it will be useful, ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ## General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program. If not, see http://www.gnu.org/licenses/. */ /* To do: - rwm - re-introduce random walk metropolis (for efficiency in linear models, optimal tuning parameter can be pre-calculated!, maybe also for linear parameters of nonlinear models, or leave it optional) - dbeta seems to be really slow in R (pre-calculate normalizing constant?) */ #define USE_FC_LEN_T #include #include #ifndef FCONE # define FCONE #endif #include #include #include #include #include #include #include /* structure to store basic information on problem */ struct modpars{ double *doses; int *modelId; int *nPar; double *work; double *drEst; double *clinvCov; int *dim; double *prior; int *prnr; int *noint; }; void R_CheckUserInterrupt(void); #include #include #include #include #include #include #include /* calculates A*x with A upper triangular */ void trmatvec(double *A, int *dim, double *x){ char *uplo="U", *trans="N", *diag="N"; int incx=1; F77_CALL(dtrmv)(uplo, trans, diag, dim, A, dim, x, &incx FCONE FCONE FCONE); } /* calculates A*x for general A */ void matvec(double *A, int *nrow, int *ncol, double *x, double *y){ char *trans="N"; double alpha = 1.0, beta = 0.0; int incx=1; F77_CALL(dgemv)(trans, nrow, ncol, &alpha, A, nrow, x, &incx, &beta, y, &incx FCONE); } void crsprod(double *A, double *B, int *nrow, int *ncol, double *C){ /* calculate A'B */ /* Nrow - nrows of A*/ /* ncol - ncols of A*/ char *transa="T", *transb="N"; double alpha = 1.0, beta = 0.0; F77_CALL(dgemm)(transa, transb, ncol, nrow, nrow, &alpha, A, nrow, B, nrow, &beta, C, ncol FCONE FCONE); } /* model functions */ void linear(double *doses, const int dim, const double e0, const double delta, double *resp){ int i; for(i=0;i 0) ? (log(x)) : (0.0); } void logprior(double *par, int *npar, double *prior, int *prnr, int *noint, double *out){ /* prnr - number for prior (1- normal. 2-t, 3-log-normal, 4-beta) prior - prior parameters noint - equals 1 if there is no intercept in the model */ *out =0.0; int i,count=0,i2=0; double p1=0.0,p2=0.0,p3=0.0,p4=0.0; for(i=0;i<(*npar-*noint);i++){ i2 = i+*noint; p1 = prior[count];p2 = prior[count+1]; if(prnr[i] == 1){ // normal-distribution *out += dnorm(par[i2],p1,p2, 1); count += 2; } if(prnr[i] == 2){ // t-distribution p3 = prior[count+2]; *out += dt((par[i2]-p1)/p2, p3, 1)-log(p2); count += 3; } if(prnr[i] == 3){ // log-normal-distribution *out += dlnorm(par[i2], p1, p2, 1); count += 2; } if(prnr[i] == 4){ // scaled-beta-distribution p3 = prior[count+2];p4 = prior[count+3]; *out += dbeta((par[i2]-p1)/(p2-p1), p3, p4, 1)-log(p2-p1); count += 4; } } } /* function to evaluate the pseudo-log-likelihood and log-prior */ double logPost(double *par, struct modpars *mp){ double out=0.0,out2=0.0; logprior(par, mp->nPar, mp->prior, mp->prnr, mp->noint, &out); if(isfinite(out)){ /* only evaluate likelihood if prior > 0 */ loglik(par, mp->doses, mp->modelId, mp->work, mp->drEst, mp->clinvCov, mp->dim, &out2); out += out2; } return out; } double logPost1d(double *actpar, int *ind, double *par, struct modpars *mp){ double out=0.0; par[*ind] = *actpar; out = logPost(par, mp); return out; } /* get parameter bounds for non-linear parameters (from info on prior density) */ void getBnds(int *npar, double *prior, int *prnr, double *lower, double *upper, int *noint){ /* prnr - number for prior (1-normal, 2-t-distribution, 3-log-normal, 4-beta) prior - prior parameters */ int i,count=0,i2=0; for(i=0;i<*npar-*noint;i++){ i2 = i+*noint; lower[i2] = -DBL_MAX;upper[i2] = DBL_MAX; if(prnr[i] == 1) // normal-distribution count += 2; if(prnr[i] == 2)// t-distribution count += 3; if(prnr[i] == 3){ // log-normal-distribution lower[i2] = 0.0; count += 2; } if(prnr[i] == 4){ // scaled-beta-distribution lower[i2] = prior[count];upper[i2] = prior[count+1]; count += 4; } } } /* slice sampler */ /* stepping out procedure */ void getIntStep(double *par, int *ind, double *L, double *R, const double z, const double w, const double lower, const double upper, struct modpars *mp){ double r,temp; r = unif_rand(); temp = par[*ind]; *L = temp - r*w; if(*L < lower) *L = lower; *R = temp + (1-r)*w; if(*R > upper) *R = upper; while(logPost1d(L, ind, par, mp) > z){ *L -= w; if(*L < lower){ *L = lower; break; } } while(logPost1d(R, ind, par, mp) > z){ *R += w; if(*R > upper){ *R = upper; break; } } par[*ind] = temp; } void slice1step(double *par, int *ind, const double w, double *lpostx, const double lower, const double upper, struct modpars *mp){ /* x - current value of chain (will contain output) ind - current dimension lpostx - logposterior evaluated at x w - tuning parameter of slice sampler */ double z,tmp,xOld,xNew,L,R; z = *lpostx - exp_rand(); xOld = par[*ind]; /* get enclosing interval */ getIntStep(par, ind, &L, &R, z, w, lower, upper, mp); while(1){ xNew = unif_rand()*(R-L) + L; tmp = logPost1d(&xNew, ind, par, mp); if(tmp >= z - DBL_EPSILON){ break; } else { // shrink interval if(xNew > xOld){ R = xNew; } else { L = xNew; } } } par[*ind] = xNew; *lpostx = tmp; } /* whole sampler */ void sample(int *nSim, int *thin, double *out, double *par, int *noint, const double *w, double *doses, int *modelId, int *nPar, double *work, double *drEst, double *clinvCov, int *dim, double *prior, int *prnr, double *lower, double *upper){ int i=0,count=0,j=0,d=0,actSimI=0; double lds,actSimD=0; /* initialize structural information */ struct modpars mp = {doses, modelId, nPar, work, drEst, clinvCov, dim, prior, prnr, noint}; actSimD = ((double) *nSim) / ((double) *thin); actSimI = (int) actSimD; /* calculate lower and upper bounds for parameters */ getBnds(nPar, prior, prnr, lower, upper, noint); /* initialize R random number generator */ GetRNGstate(); lds = logPost(par, &mp); /* starting likelihood value */ /* actual MCMC loop */ for(i=0;i< *nSim;i++){ for(d=*noint;d < *nPar;d++){ slice1step(par, &d, w[d], &lds, lower[d], upper[d], &mp); } /* store information when desired */ if(!(i%(*thin))){ for(j = 0; j < *nPar; j++){ out[count+j*(actSimI)] = par[j]; } count++; } } PutRNGstate(); } DoseFinding/NAMESPACE0000644000176200001440000000413514762603270013674 0ustar liggesusersimport(mvtnorm, lattice, ggplot2) importFrom("grDevices", "rgb") importFrom("graphics", "lines", "plot", "points") importFrom("stats", "AIC", "IQR", "acf", "approx", "as.formula", "binomial", "coef", "cov2cor", "glm", "lm", "logLik", "model.matrix", "na.fail", "nlminb", "optim", "optimize", "pnorm", "predict", "qnorm", "qt", "quantile", "quasi", "sd", "terms", "uniroot", "var", "vcov") importFrom("utils", "setTxtProgressBar", "txtProgressBar", "browseURL") export(fitMod, defBnds, bFitMod, maFitMod, MCTtest, bMCTtest, MCPMod, betaMod, quadratic, emax, exponential,linear, linlog, logistic, sigEmax, linInt, betaModGrad, quadraticGrad, emaxGrad, exponentialGrad, linearGrad, linlogGrad, logisticGrad, sigEmaxGrad, linIntGrad, Mods, getResp, TD, ED, plotMods, guesst, MCTtest, MCTpval, critVal, mvpostmix, gAIC, mvtnorm.control, optContr, plotContr, powMCT, sampSize, sampSizeMCT, targN, powN, planMod, optDesign, calcCrit, rndDesign, DesignMCPModApp) S3method(predict, MCPMod) S3method(print, MCPMod) S3method(print, sampSize) S3method(plot, MCPMod) S3method(summary, MCPMod) S3method(print, summary.MCPMod) S3method(summary, DRMod) S3method(print, summary.DRMod) S3method(print, DRMod) S3method(plot, DRMod) S3method(vcov, DRMod) S3method(coef, DRMod) S3method(predict, DRMod) S3method(print, MCTtest) S3method(print, bMCTtest) S3method(print, DRdesign) S3method(plot, DRdesign) S3method(print, optContr) S3method(summary, optContr) S3method(print, summary.optContr) S3method(plot, optContr) S3method(plot, Mods) S3method(AIC, DRMod) S3method(gAIC, DRMod) S3method(logLik, DRMod) S3method(gAIC, DRMod) S3method(predict, bFitMod) S3method(plot, bFitMod) S3method(print, bFitMod) S3method(coef, bFitMod) S3method(print, maFit) S3method(predict, maFit) S3method(plot, maFit) S3method(plot, targN) S3method(plot, planMod) S3method(print, planMod) S3method(summary, planMod) S3method(print, summary.planMod) useDynLib(DoseFinding, .registration = TRUE) DoseFinding/NEWS.md0000644000176200001440000004107314762635176013567 0ustar liggesusers# DoseFinding 1.3-1 * Added maFitMod function to implement fitting of dose-response models via model averaging (#11, thanks to Björn Bornkamp) * Fixed the way ED dose estimation works with type = "discrete". Previously the maximum effect size for ED calculation was taken to be the highest effect among the doses provided as arguments, rather than across the observed dose range for the fitted model (#18) * replaced uses of ggplot2::aes_string, which is deprecated (#14) * added additional tests for several functions # DoseFinding 1.2-1 * Documentation revised and updated, documentation now uses roxygen, README and NEWS (replacing old changelog) added * Former "Depends" packages changed to "Imports" * nlme added as suggested package * Marius Thomas is the new maintainer of the package, Novartis Pharma AG added as copyright holder and funder * Package is now hosted on https://github.com/openpharma/DoseFinding # DoseFinding 1.1-1 * Big thanks to Marius Thomas for adding the bMCTtest function, implementing a generalized version of the Bayesian MCP-Mod methodology from Fleischer et al (2022) (https://doi.org/10.1002/pst.2193) * Thanks to Sebastian Bossert for feedback on bMCTtest * Function critVal is now exported # DoseFinding 1.0-5 * Fixed bug in non-exported function powMCTBinCount, for situation when user defined contrast matrix is handed over. * Added function DesignMCPModApp which starts the externally hosted R-Shiny app DesignMCPMod to perform power and sample size calculations (main authors of the app are Sophie Sun and Danyi Xiong). # DoseFinding 1.0-4 * Added non-exported function powMCTBinCount, for power calculation for binary and count data. # DoseFinding 1.0-3 * Stop and throw error if calculated df=0 in powMCT (passed to mvtnorm where df=0 implies use of a normal distribution) * Added function plotMods to plot candidate models using ggplot2 and function plotContr to plot optimal contrasts using ggplot2 (thanks to Sophie Sun for testing and feedback) * Added documentation for quadratic model (definition of delta) * Fixed local options in guesst for logistic and sigEmax models # DoseFinding 1.0-2 * Define USE_FC_LEN_T and add length of character arguments in Fortran code called from C, to reflect recent changes in gfortran. * Fix incorrect error message in fitMod (in case placAdj = TRUE and data are handed over in a data frame via data argument) # DoseFinding 1.0-1 * Big thanks to Ludger Sandig, who was instrumental in adding vignettes for practical MCP-Mod implementation guidance; introducing tests based on testthat and further bug fixes. * Thanks to Dong Xi, Hilke Kracker for review of earlier versions of the draft vignettes * Thanks to Julia Duda for her helpful comments on the package # DoseFinding 0.9-17 * Added citation to DESCRIPTION file * Removed alpha argument for pValues function (not used) * Propagate error messages from mvtnorm in pValues function (e.g. cov-matrix not psd), (thx to Daisy Bai) * Make direction attribute in Mods object unique (thx to Yuhan Li) # DoseFinding 0.9-16 * Fixed minor bug in print.summary.planMod # DoseFinding 0.9-15 * Mods Added parameter names for all models in the output list (thanks to Dong Xi for catching this) DoseFinding 0.9-14 * planMod.Rd Documentation slightly extended. * qmvtDF moved back to qmvt function from mvtnorm, as problems in mvtnorm are fixed. DoseFinding 0.9-13 * projPrBnds now also covers the case when parameter was exactly on the bound * bFitMod doseNam changes * critVal Added self-written qmvt function qmvtDF (as mvtnorm::qmvt got instable on Windows 32bit from release 1.0-3), hopefully superfluous once mvtnorm fixes this. DoseFinding 0.9-12 * glycobrom dataset: Included column for number of observations per treatment. * calcCrit now takes into account "nold" in determining whether enough design points were specified to be able to calculate the design criteria. * bFitMod documentation for plot.bFitMod and predict.bFitMod methods added. coef.bFitMod method added. Thanks to Lieven Nils Kennes for pointing towards the issue. DoseFinding 0.9-11 * Mods Introduce fullMod argument to allow specification of full model parameters (again). * calcTDgrad now calculates the analytical gradient for TD optimal designs for the beta model. The previous numerical gradient could get unstable for particular parameter values. Thanks to Tobias Mielke for the calculations! * planMod.Rd, powMCT.Rd More description on what "sigma" is * optDesign, optContr Catch Mods objects with multiple direction attributes properly in these functions. # DoseFinding 0.9-10 * plot.MCPMod In case of no significant model, do not plot anything. * optContr Bugfix in function constOptC, previous algorithm selected in some situation an incorrect active set (and hence a suboptimal solution), the current implementation uses quadratic programming (hence the new suggested package quadprog). # DoseFinding 0.9-9 * bFitMod.Bayes Stop if starting values lie outside of bounds specified for the prior distribution * predict.bFitMod Remove incorrect "if" statement (use "effect-curve" not "EffectCurve") * fitModels.bndnls now uses narrowed bounds for 1d models again (as in 0.9-5 and earlier), thanks to Tobias Mielke for reporting the three points above. * optContr now allows for constrained contrasts, i.e. where the contrast coefficients in placebo and active treatment groups are required to have different signs. # DoseFinding 0.9-8 * MCPMod Major changes needed (also in fitMod and MCTtest) to allow for dose/response names different from "dose", "resp" when a data-frame is specified (the problem existed as MCTtest, fitMod were called from inside MCPMod). * bFitMod.Bayes Ensure that the starting values for the parameters are within the bounds specified by the prior (if no starting values are specified). Thanks to Tobias Mielke for reporting this. * bFitMod.bootstrap Remove bug for model = "linear" and placAdj = TRUE. Thanks to Tobias Mielke for reporting this. # DoseFinding 0.9-7 * fitMod ensure that the data set returned with DRMod objects is in the original order (not sorted by dose). Also ensure the right S matrix is used for fitting for type = "general" and unsorted dose, resp. * MCTtest fixed problems for type = "general" and unsorted dose, resp. * glycobrom Added glycobrom data set * planMod Added planning functions for non-linear modelling * Coded calculations of compositions to be able to remove dependency on the partitions package * man files: added reference to paper on generalized MCPMod * plot.DRMod Minor changes to ensure raw means are always inside the plotting region (for plotData = "means") # DoseFinding 0.9-6 * optDesign Re-named "fmodels" argument to "models". * optDesign for solnp if lowbnd and uppbnd are specified now use a feasible starting value (otherwise solnp might get into problems). * plot.DRMod, plot.MCPMod now use lattice graphics * powMCT removed bug in case of placAdj = TRUE (thanks to Tobias Mielke for reporting this) * ess.mcmc minor change to avoid occasional NA's * Mods removed class c("Mods", "standMod"), now there is only a class "Mods", this changes the API of MCTtest, optContr and MCPMod function (direction argument no longer needed, as this info is now contained in the "Mods" object). * neurodeg added the simulated longitudinal dose-finding data set neurodeg * targN catch incorrect matrix dimension, when in case of only one alternative model * fitModel.bndnls old version used narrowed bnds for 1-dim model, when a starting value was supplied manually (instead of calculated via optGrid); fixed. * MCTtest re-name of p-value column to "adj-p". # DoseFinding 0.9-5 * targN, powN added function targN to evaluate a target function (e.g. power) for different sample sizes (similar to the old powerMM function). powN is a convenience function for multiple contrast tests using the power. * sampSizeMCT added convenience function for sample size calculation for multiple contrast tests using the power. * optContr Re-named "weights" argument to "w" # DoseFinding 0.9-4 * TD, ED Fixed bug for model = linInt and placAdj = TRUE * powMCT Fixed bug for nr(altModels)=1 in case placAdj=TRUE * Mods Add requirement that placebo dose needs to be included * print.bFitMod Do not show n.eff for bootstrap samples * ess.mcmc return NA, if there is just one unique value in chain * fitMod, MCTtest catch situations, where type = "normal" and placAdj = TRUE * bFitMod fixed bug for column names of linear model in case of placAdj = TRUE * MCPMod: Fixed sign error in model selection, when critV was specified # DoseFinding 0.9-3 * fitMod Improvements of efficiency (removed calls to do.call in optLoc) * MCPMod passes direction argument now also to TD * optDesign solnp is now the default optimizer * calcCrit default for arg designCrit in calcCrit changed (to harmonize calcCrit and optDesign) * bFitMod use fitMod.raw in bFitMod.bootstrap (for efficiency) * critVal Remove contMat argument (was unused) * powMCT Allow power calculation for placebo adjusted data # DoseFinding 0.9-1 * Complete re-structuring and tidying up of the package. Main ideas: (i) smoother integration of g-functions (ii) focus on core functionality (iii) more general code/easier extensibility. * New features: Bayesian dose-response fitting, nicer plots, optimal designs for non-normal responses, ... * Special Thanks to Tobias Mielke for testing of the package and numerous bug reports. * Previous versions of the source are available under http://cran.r-project.org/package=DoseFinding under "Old sources", a Windows binary of the last version before the changes is available under http://goo.gl/p1UZ7. # DoseFinding 0.6-3 * Added PACKAGE = "DoseFinding" to ".C" calls # DoseFinding 0.6-2 * calcOptDesign partial rewrite of optDes.c and optDesign.R to fix segfault bug. # DoseFinding 0.6-1 * vcov.gDRMod is now functional, predict.gDRMod now allows calculation of confidence intervals * gFitDRModel minor changes in underlying optimizer * explicitly export the gradients of the model functions now # DoseFinding 0.5-7 * gFitDRModel now always returns an estimate (either the best value from nlminb or from the grid search if nlminb fails) * gMCPtest: use sigma = corMat instead of corr = corMat in p/qmvnorm calls (mvtnorm complained in 1-dimensional case) * gFitDRModel: Introduced default for bnds argument. * plot.MCPMod: Plot clinRel in the right place, when direction is equal to "decreasing" (thanks to Jan Rekowski) * planMM, critVal: When vCov is specified now right correlation matrix is calculated * calcOptDesign: Additional argument (standDopt) to allow for optional standardization (division of the log determinant by the number of parameters) of the D-optimal design criterion. # DoseFinding 0.5-6 * getGrid corrected bug for Ngrd > 75025 * calcOptDesign: For method = "exact" and n2 > 0 the function did not return the optimal incremental design but the overall optimal design # DoseFinding 0.5-5 * gFitDRModel can now fit dose-response models without intercept * gMCPtest minor changes to allow for user defined contrast matrix # DoseFinding 0.5-4 * MCPtest now uses correct degrees of freedom if addCovars != ~1 * Feedback from Andreas Krause led to a number smaller changes in the package (e.g., plot.(g)DRMod or fitDRModel). Thanks Andreas! * Print lattice plots explicitly to increase compability with Sweave. # DoseFinding 0.5-3 * Ensure in rndDesign that N is recognized as an integer by using N <- round(N), to avoid floating point problems. * Remove naming bug in gFitDRModel (drFit instead of drEst) # DoseFinding 0.5-2 * Corrected bug in b-vector for sigEmax model (calcBvec, only affected MED-type optimal designs) * Included INDEX file to order the overview help-page better * predict.DRMod now stops when type = "fullModel" and the argument newdata does not contain values for all variables specified in addCovars (thanks to Mouna). # DoseFinding 0.5-1 * Restructured calcOptDesign function to allow for user defined criteria functions. * The MCPMod object now always contains a estDose and fm entry (which is NA in case of non-significance or non-convergence) * Added generalized fitting code, variances and covariances of estimates are not available at the moment. * Added vCov argument to planMM, sampSize, powerMM (so it is possible to take into account covariances when calculating optimal contrasts) * Changed order in trellis plots in plotModels (order as specified in models list instead of alphanumerical order) * Restructured and summarized help pages * Removed dependency on numDeriv package (only suggested now), this is only needed for calculating optimal designs involving the beta model. # DoseFinding 0.4-3 * Minor change in Makevars file (so that DoseFinding works on Solaris). # DoseFinding 0.4-2 * calcBayesEst, getUpdDesign: Minor changes to make functions more suited for general purpose use. # DoseFinding 0.4-1 * Introduced new functions calcBayesEst and getUpdDesign, both were used for simulation purposes in the paper Bornkamp et al. (2011) "Response Adaptive Dose-Finding under Model Uncertainty" (to appear in Annals of Applied Statistics). # DoseFinding 0.3-1 * calcOptDesign now has an additional optimizer "exact". This methods calculates all possible designs for a given sample size and then selects the best. * Changed order in MakeVars as requested * calcCrit now checks whether there are not less design points than parameters. * Code now checks for positive sigma in powCalc and powerMM # DoseFinding 0.2-3 * MED function now checks for clinRel > 0 (thanks to Georgina). * Changed minor bug in output from print.MCPtest (print one-sided just once) * Code now outputs a warning, when 'models' argument is missing (in MCPMod and fullMod function); in fitDRModel it outputs a warning if 'model' is missing * Introduced a default base = 0 and maxEff = 1 for the plotModels function. * Added a summary method for DRMod objects. * Removed superfluous addCovarVals argument from predict.DRMod * Removed option method = "mult" in calcOptDesign # DoseFinding 0.2-2 * calcCrit and calcOptDesign now check for NA, NaN or +-Inf values in the gradient and bvector (and stop execution when these values occur) before passing these values to the C code. * Introduced a logLik method for DRMod objects * Changed mvtnorm.control default argument for "interval" to reflect recent changes in mvtnorm package. # DoseFinding 0.2-1 * Made the getGrad function (gradient for dose-response model), including documentation available for end-user (was previously hidden in NAMESPACE) * Changes in the plot.MCPMod function (col argument for panel.superpose was read in different order depending on lattice options, now there is a manual workaround with panel.xyplot calls for each group) # DoseFinding 0.1-3 * Smaller changes in calcCrit functions (the parameter p is now calculated by the nPars function as in getOptDesign) * Add further options to powerScenario function (now possible to for user-specified row and column names for output matrix) # DoseFinding 0.1-2 * Removed one example from sampSize to reduce check time. * modelSelect: Use first model when two models have exactly the same AIC or BIC value. * predict.DRMod: Return NA as standard deviation if code cannot calculate Cholesky transformation of covariance matrix (thanks to Setia Pramana for the hint). * calcCrit: Code now allows for specifying multiple designs in a matrix. # DoseFinding 0.1-1 * fitModel.nls now checks whether nls with plinear option made a positive number of iterations (as additional convergence check). In some cases (eg. when number of parameters = number of doses) plinear does not do any iteration and does *not* put out a warning message that the algorithm failed. * The calcOptDesign function now allows for upper and lower bounds on the allocation weights. * There is no longer the need to specify clinRel, when one wants to calculate a D-optimal design. * Output of bootMCPMod function in case of model averaging now also includes dose estimates under each model & corrected bug in print.bootMCPMod function (thanks to Setia Pramana) # DoseFinding 0.1 * 1st Release as version 0.1. Improvements over MCPMod package: - Extended and improved version of MCPMod (allowing for covariates and robustified self-developed optimizer) - Functions for MCP (MCPtest) and Modelling (fitDRModel) part now available to the user - New functions (eg. bootMCPMod, powerScenario) - Functions for calculating optimal designs DoseFinding/inst/0000755000176200001440000000000014764013015013421 5ustar liggesusersDoseFinding/inst/doc/0000755000176200001440000000000014764013015014166 5ustar liggesusersDoseFinding/inst/doc/sample_size.Rmd0000644000176200001440000002566614654153534017175 0ustar liggesusers--- title: "Sample size calculations for MCP-Mod" output: rmarkdown::html_vignette bibliography: refs.bib vignette: > %\VignetteIndexEntry{Sample size template for MCP-Mod for normally distributed data} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, child="children/settings.txt"} ``` In this vignette we will take a closer look at the design stage and see how to perform power and sample size calculations for MCP-Mod with the DoseFinding package. We will consider the same example study and the same candidate models as in the [vignette for analysis of normally distributed data](analysis_normal.html). ```{r, setup, fig.asp = 1, out.width = "50%", fig.width = 5} library(DoseFinding) library(ggplot2) doses <- c(0, 12.5, 25, 50, 100) guess <- list(emax = c(2.6, 12.5), sigEmax = c(30.5, 3.5), quadratic = -0.00776) mods <- do.call(Mods, append(guess, list(placEff = 1.25, maxEff = 0.15, doses = doses))) plotMods(mods) ``` ## Power for multiple contrast test versus group sample size In this section we will investigate at how power varies with sample size. Note that the maximum effect size within the dose-range is fixed through `maxEff` in the candidate models. First we calculate the matrix of optimal contrasts (`w=1` denotes homoscedastic residuals with equal group sizes, see `?optContr`). In `powN` we specify the sample sizes for which to calculate the power. We request five equally sized groups with `alRatio = rep(1, 5)`. We fix the residual standard deviation with `sigma = 0.34`, and calculate the power for a one-sided test at level 0.05. ```{r, power_sample_size_1} contMat <- optContr(mods, w=1) pows <- powN(upperN = 100, lowerN = 10, step = 10, contMat = contMat, sigma = 0.34, altModels = mods, alpha = 0.05, alRatio = rep(1, 5)) plot(pows) ``` This shows the power values of the maximum contrast test assuming each of the different candidate models to be true. The minimum, mean and maximum power over the candidate models are also included in the plot. There also is a wrapper function that calculates the group sample sizes needed in order to attain a specific power. The powers under each alternative model are combined with `sumFct`. Here we look at the minimum power, other potential choices are `mean` or `max`. ```{r, power_sample_size_2} sampSizeMCT(upperN = 150, contMat = contMat, sigma = 0.34, altModels = mods, power = 0.9, alRatio = rep(1, 5), alpha = 0.05, sumFct = min) ``` ## Power versus treatment effect In this section we fix the group sample size at 90 and vary the treatment Effect `maxEff`. Note how power decreases if we assume a higher residual standard deviation. ```{r, power_effect_size} plot_power_vs_treatment_effect <- function(guess, doses, group_size, placEff, maxEffs, sigma_low, sigma_mid, sigma_high, alpha) { mods_args_fixed <- append(guess, list(placEff = placEff, doses = doses)) grd <- expand.grid(max_eff = maxEffs, sigma = c(sigma_low, sigma_mid, sigma_high)) min_power <- mean_power <- NA for (i in 1:nrow(grd)) { mods <- do.call(Mods, append(mods_args_fixed, list(maxEff = grd$max_eff[i]))) p <- powMCT(optContr(mods, w = 1), alpha, mods, group_size, grd$sigma[i]) min_power[i] <- min(p) mean_power[i] <- mean(p) } grd$sigma <- factor(grd$sigma) pdat <- cbind(grd, power = c(min_power, mean_power), sumFct = rep(factor(1:2, labels = c("min", "mean")), each = nrow(grd))) subt <- sprintf("group size = %d, α = %.3f", group_size, alpha) gg <- ggplot(pdat) + geom_line(aes(max_eff, power, lty = sigma)) + facet_wrap(~sumFct, labeller = label_both)+ xlab("maximum treatment effect") + ylab("power") + labs(title = "Minimum power vs effect size for different residual standard deviations", subtitle = subt) + theme(legend.position = "bottom") + scale_y_continuous(limits = c(0,1), breaks = seq(0,1,by=.1)) return(gg) } plot_power_vs_treatment_effect(guess, doses, group_size = 90, placEff = 1.25, maxEffs = seq(0.01, 0.3, length.out = 15), sigma_low = 0.3, sigma_mid = 0.34, sigma_high = 0.4, alpha = 0.05) ``` ## Power under mis-specification MCP-Mod depends on the candidate models selected. What if the true model is not among the chosen candidate shapes? Often MCP-Mod is rather robust. To illustrate this, let's assume an exponential model shape is the true model, which is not among the candidate shapes. Let this exponential model have small responses for all doses but the last (here assuming 20% of the overall treatment effect is achieved at the 50μg dose). All other candidate shapes assume that almost the full effect is achieved for the 50μg dose, so this shape is quite different from all other shapes included in the candidate set. ```{r, power_miss_1} guess_miss <- list(exponential = guesst(50, 0.2, "exponential", Maxd = max(doses))) mods_miss <- do.call(Mods, c(guess, guess_miss, list(placEff = 1.25, maxEff = 0.15, doses = doses))) plot(mods_miss, superpose = TRUE) ``` Now we compare the power calculation under the exponential model with those based on the original candidate set, in both cases only the contrasts from the original candidate set are used. ```{r, power_miss_2} plot_power_misspec <- function(guess, guess_miss, placEff, maxEff, doses, upperN, lowerN, step, sigma, alpha) { mods_extra_par <- list(placEff = placEff, maxEff = maxEff, doses = doses) pown_extra_par <- list(upperN = upperN, lowerN = lowerN, step = step, sigma = sigma, alpha = alpha, alRatio = rep(1, length(doses))) mods_miss <- do.call(Mods, c(guess_miss, mods_extra_par)) mods_ok <- do.call(Mods, c(guess, mods_extra_par)) cm_ok <- optContr(mods_ok, w = 1) p_miss <- do.call(powN, c(pown_extra_par, list(contMat = cm_ok, altModels = mods_miss))) p_ok <- do.call(powN, c(pown_extra_par, list(contMat = cm_ok, altModels = mods_ok))) pwr <- rbind(data.frame(n = as.numeric(rownames(p_ok)), p_ok[, c("min", "mean")], miss = FALSE), data.frame(n = as.numeric(rownames(p_miss)), p_miss[, c("min", "mean")], miss = TRUE)) gg <- ggplot(pwr, aes(group = miss, color = miss)) + geom_line(aes(n, min, linetype = "minimum")) + geom_line(aes(n, mean, linetype = "mean")) + scale_color_discrete(name = "miss-specified") + scale_linetype_discrete(name = "aggregation") + labs(title = "Mean and minimum power under mis-specification") + xlab("group size") + ylab("power") + scale_y_continuous(limits = c(0,1), breaks = seq(0,1,by=.1)) return(gg) } plot_power_misspec(guess, guess_miss, placEff = 1.25, maxEff = 0.15, doses = doses, upperN = 100, lowerN = 10, step = 10, sigma = 0.34, alpha = 0.05) ``` As expected, the power decreases as the assumed underlying exponential model shape differs substantially from the shapes included in the candidate set. However, the power loss is only in the range of 10-15%. ## Sample size based on metrics other than power for the multiple contrast test The main purpose of a dose-finding study is selection of a dose to take forward into Phase 3. Establishment of a trend over placebo is hence only a minimum requirement before considering dose-selection. If one considers sample size calculation to allow for adequate dose selection (see `?TD`) it turns out that this is a much harder problem than establishing a dose-response effect versus placebo based on the MCP-part: The sample size required for adequate accuracy in estimation of a target dose (e.g. the smallest dose achieving a relevant improvement over placebo) is usually several-fold higher than the sample size needed to have adequate power for the MCP-part. This should not come as a surprise as dose-estimation is primarily a comparison among the investigational doses, while the MCP-part establishes an effect versus placebo. Chapter 12 in @oquigley2017 illustrates this with simulations, based on the `planMod` function (see `?planMod` for example usage). Here we only consider a brief example: Consider the `sigEmax(30.5, 3.5)` model from the first section and assume that it is the "true model" under which we want to investigate the operating characteristics of fitting sigEmax models. Suppose we want to achieve a target improvement of $\Delta=0.12 L$ over placebo. One can calculate that this needs a target dose TD of 44.4 mg under the true model. Keep this number in mind for later. Now we can ask the question what the variability in TD estimation would be. To answer it, we can run a simulation using the `planMod` function. If we use the sample size n=93 from the power calculation above, we find: ```{r, tdci93, warning = FALSE} set.seed(42) ## Note: Warnings related to vcov.DRMod can be ignored if small relative to the total number of simulations pm <- planMod("sigEmax", Mods(sigEmax=c(30.5, 3.5), placEff=1.25, maxEff=0.15, doses=doses), n=93, sigma = 0.34, doses=doses, simulation=TRUE, nSim=5000, showSimProgress = FALSE, bnds = defBnds(max(doses))) summary(pm, Delta=0.12) ``` The output shows different outputs (see `?planMod` for details) of most interest here is the length of the quantile range for a target dose (`lengthTDCI`). By default this is calculated by taking the difference of 5\% and 95\% quantile of the empirical distribution of the dose estimates in the simulation. The metric `P(no TD)` indicates in how many simulations runs no TD could be identified. From the output it can be seen that the variation in the TD estimates is quite large and quite unsatisfactory. Experimenting with different values of `n`, one quickly realizes that we would need for example 1650 patients to get the length of this interval down to 20 mg. ```{r, tdci1650} pm <- planMod("sigEmax", Mods(sigEmax=c(30.5, 3.5), placEff=1.25, maxEff=0.15, doses=doses), n=1650, sigma = 0.34, doses=doses, simulation=TRUE, nSim=5000, showSimProgress = FALSE, bnds = defBnds(max(doses))) summary(pm, Delta=0.12) ``` Note that the variability in TD estimation depends quite strongly on the assumed true dose-response model, see the simulation results in Chapter 12 in @oquigley2017. In practice, to keep the size of the study feasible, one needs to find a compromise between dose-response signal detection and estimation precision as the criteria for sample size determination. Irrespective, it is important to properly evaluate the operating characteristics of a given design (including sample size) to understand its strengths and limitations. In practice of course the dose-response curve of the main efficacy endpoint, is not the only consideration in dose-selection for Phase III: Results for other efficacy/biomarker endpoints, but also the results for tolerability or safety markers, will contribute to that decision. ## References DoseFinding/inst/doc/overview.html0000644000176200001440000025167014764012720016737 0ustar liggesusers Overview DoseFinding package

Overview DoseFinding package

The DoseFinding package provides functions for the design and analysis of dose-finding experiments (for example pharmaceutical Phase II clinical trials). It provides functions for: multiple contrast tests (MCTtest for analysis and powMCT, sampSizeMCT for sample size calculation), fitting non-linear dose-response models (fitMod for ML estimation and bFitMod for Bayesian and bootstrap/bagging ML estimation), calculating optimal designs (optDesign or calcCrit for evaluation of given designs), both for normal and general response variable. In addition the package can be used to implement the MCP-Mod procedure, a combination of testing and dose-response modelling (MCPMod) (Bretz et al. (2005), Pinheiro et al. (2014)). A number of vignettes cover practical aspects on how MCP-Mod can be implemented using the DoseFinding package. For example a FAQ document for MCP-Mod, analysis approaches for normal and binary data, sample size and power calculations as well as handling data from more than one dosing regimen in certain scenarios.

Below a short overview of the main functions.

Perform multiple contrast test

library(DoseFinding)
data(IBScovars)
head(IBScovars)
  gender      resp dose
1      1 1.5769231    1
2      1 0.6833333    3
3      1 0.2857143    0
4      1 0.6307692    3
5      1 0.1428571    2
6      1 0.1571429    1
## perform (model based) multiple contrast test
## define candidate dose-response shapes
models <- Mods(linear = NULL, emax = 0.2, quadratic = -0.17,
               doses = c(0, 1, 2, 3, 4))
## plot models
plotMods(models)

## perform multiple contrast test
## functions powMCT and sampSizeMCT provide tools for sample size
## calculation for multiple contrast tests
test <- MCTtest(dose, resp, IBScovars, models=models,
                addCovars = ~ gender)
test
Multiple Contrast Test

Contrasts:
  linear   emax quadratic
0 -0.616 -0.889    -0.815
1 -0.338  0.135    -0.140
2  0.002  0.226     0.294
3  0.315  0.252     0.407
4  0.638  0.276     0.254

Contrast Correlation:
          linear  emax quadratic
linear     1.000 0.768     0.843
emax       0.768 1.000     0.948
quadratic  0.843 0.948     1.000

Multiple Contrast Test:
          t-Stat   adj-p
emax       3.208 0.00160
quadratic  3.083 0.00231
linear     2.640 0.00844

Fit non-linear dose-response models here illustrated with Emax model

fitemax <- fitMod(dose, resp, data=IBScovars, model="emax",
                  bnds = c(0.01,5))
## display fitted dose-effect curve
plot(fitemax, CI=TRUE, plotData="meansCI")

Calculate optimal designs, here illustrated for target dose (TD) estimation

## optimal design for estimation of the smallest dose that gives an
## improvement of 0.2 over placebo, a model-averaged design criterion
## is used (over the models defined in Mods)
doses <- c(0, 10, 25, 50, 100, 150)
fmodels <- Mods(linear = NULL, emax = 25, exponential = 85,
                logistic = c(50, 10.8811),
                doses = doses, placEff=0, maxEff=0.4)
plot(fmodels, plotTD = TRUE, Delta = 0.2)

weights <- rep(1/4, 4)
desTD <- optDesign(fmodels, weights, Delta=0.2, designCrit="TD")
desTD
Calculated TD - optimal design:
      0      10      25      50     100     150 
0.34960 0.09252 0.00366 0.26760 0.13342 0.15319 
plot(desTD, fmodels)

References

Bretz, F., Pinheiro, J. C., and Branson, M. (2005), “Combining multiple comparisons and modeling techniques in dose-response studies,†Biometrics, Wiley Online Library, 61, 738–748. https://doi.org/10.1111/j.1541-0420.2005.00344.x.
Pinheiro, J., Bornkamp, B., Glimm, E., and Bretz, F. (2014), “Model-based dose finding under model uncertainty using general parametric models,†Statistics in Medicine, 33, 1646–1661. https://doi.org/10.1002/sim.6052.
DoseFinding/inst/doc/overview.R0000644000176200001440000000357114764012717016175 0ustar liggesusers## ----settings-knitr, include=FALSE-------------------------------------------- library(ggplot2) knitr::opts_chunk$set(echo = TRUE, message = FALSE, cache = FALSE, comment = NA, dev = "png", dpi = 150, fig.asp = 0.618, fig.width = 7, out.width = "85%", fig.align = "center") options(rmarkdown.html_vignette.check_title = FALSE) theme_set(theme_bw()) ## ----overview, fig.asp = .4--------------------------------------------------- library(DoseFinding) data(IBScovars) head(IBScovars) ## perform (model based) multiple contrast test ## define candidate dose-response shapes models <- Mods(linear = NULL, emax = 0.2, quadratic = -0.17, doses = c(0, 1, 2, 3, 4)) ## plot models plotMods(models) ## perform multiple contrast test ## functions powMCT and sampSizeMCT provide tools for sample size ## calculation for multiple contrast tests test <- MCTtest(dose, resp, IBScovars, models=models, addCovars = ~ gender) test ## ----overview 2--------------------------------------------------------------- fitemax <- fitMod(dose, resp, data=IBScovars, model="emax", bnds = c(0.01,5)) ## display fitted dose-effect curve plot(fitemax, CI=TRUE, plotData="meansCI") ## ----overview 3--------------------------------------------------------------- ## optimal design for estimation of the smallest dose that gives an ## improvement of 0.2 over placebo, a model-averaged design criterion ## is used (over the models defined in Mods) doses <- c(0, 10, 25, 50, 100, 150) fmodels <- Mods(linear = NULL, emax = 25, exponential = 85, logistic = c(50, 10.8811), doses = doses, placEff=0, maxEff=0.4) plot(fmodels, plotTD = TRUE, Delta = 0.2) weights <- rep(1/4, 4) desTD <- optDesign(fmodels, weights, Delta=0.2, designCrit="TD") desTD plot(desTD, fmodels) DoseFinding/inst/doc/binary_data.R0000644000176200001440000001422314764012635016577 0ustar liggesusers## ----settings-knitr, include=FALSE-------------------------------------------- library(ggplot2) knitr::opts_chunk$set(echo = TRUE, message = FALSE, cache = FALSE, comment = NA, dev = "png", dpi = 150, fig.asp = 0.618, fig.width = 7, out.width = "85%", fig.align = "center") options(rmarkdown.html_vignette.check_title = FALSE) theme_set(theme_bw()) ## ----example_data------------------------------------------------------------- library(DoseFinding) library(ggplot2) logit <- function(p) log(p / (1 - p)) inv_logit <- function(y) 1 / (1 + exp(-y)) doses <- c(0, 0.5, 1.5, 2.5, 4) ## set seed and ensure reproducibility across R versions set.seed(1, kind = "Mersenne-Twister", sample.kind = "Rejection", normal.kind = "Inversion") group_size <- 100 dose_vector <- rep(doses, each = group_size) N <- length(dose_vector) ## generate covariates x1 <- rnorm(N, 0, 1) x2 <- factor(sample(c("A", "B"), N, replace = TRUE, prob = c(0.6, 0.4))) ## assume approximately logit(10%) placebo and logit(35%) asymptotic response with ED50=0.5 prob <- inv_logit(emax(dose_vector, -2.2, 1.6, 0.5) + 0.3 * x1 + 0.3 * (x2 == "B")) dat <- data.frame(y = rbinom(N, 1, prob), dose = dose_vector, x1 = x1, x2 = x2) ## ----setup, fig.width = 8, out.width = '100%'--------------------------------- mods <- Mods(emax = c(0.25, 1), sigEmax = rbind(c(1, 3), c(2.5, 4)), betaMod = c(1.1, 1.1), placEff = logit(0.1), maxEff = logit(0.35)-logit(0.1), doses = doses) plotMods(mods) ## plot candidate models on probability scale plotMods(mods, trafo = inv_logit) ## ----test_no_covariates------------------------------------------------------- fit_nocov <- glm(y~factor(dose) + 0, data = dat, family = binomial) mu_hat <- coef(fit_nocov) S_hat <- vcov(fit_nocov) MCTtest(doses, mu_hat, S = S_hat, models = mods, type = "general") ## ----estimate_no_covariates--------------------------------------------------- fit_mod_av <- maFitMod(doses, mu_hat, S = S_hat, models = c("emax", "sigEmax", "betaMod")) plot(fit_mod_av, plotData = "meansCI", title = "Bootstrap estimates for population response probability", trafo = function(x) 1/(1+exp(-x))) ## ----test_covariates---------------------------------------------------------- fit_cov <- glm(y~factor(dose) + 0 + x1 + x2, data = dat, family = binomial) covariate_adjusted_estimates <- function(mu_hat, S_hat, formula_rhs, doses, other_covariates, n_sim) { ## predict every patient under *every* dose oc_rep <- as.data.frame(lapply(other_covariates, function(col) rep(col, times = length(doses)))) d_rep <- rep(doses, each = nrow(other_covariates)) pdat <- cbind(oc_rep, dose = d_rep) X <- model.matrix(formula_rhs, pdat) ## average on probability scale then backtransform to logit scale mu_star <- logit(tapply(inv_logit(X %*% mu_hat), pdat$dose, mean)) ## estimate covariance matrix of mu_star pred <- replicate(n_sim, logit(tapply(inv_logit(X %*% drop(mvtnorm::rmvnorm(1, mu_hat, S_hat))), pdat$dose, mean))) return(list(mu_star = as.numeric(mu_star), S_star = cov(t(pred)))) } ca <- covariate_adjusted_estimates(coef(fit_cov), vcov(fit_cov), ~factor(dose)+0+x1+x2, doses, dat[, c("x1", "x2")], 1000) MCTtest(doses, ca$mu_star, S = ca$S_star, type = "general", models = mods) ## ----compare------------------------------------------------------------------ ggplot(data.frame(dose = rep(doses, 4), est = c(inv_logit(mu_hat), diag(S_hat), inv_logit(ca$mu_star), diag(ca$S_star)), name = rep(rep(c("mean", "var"), each = length(doses)), times = 2), a = rep(c(FALSE, TRUE), each = 2*length(doses)))) + geom_point(aes(dose, est, color = a)) + scale_color_discrete(name = "adjusted") + facet_wrap(vars(name), scales = "free_y") + ylab("") ## ----estimate_covariates------------------------------------------------------ fit_cov_adj <- maFitMod(doses, ca$mu_star, S = ca$S_star, models = c("emax", "sigEmax", "betaMod")) # plotting on probability scale, need to transform predictions on logit scale plot(fit_cov_adj, plotData = "meansCI", title = "Bootstrap estimates for population response probability", trafo = function(x) 1/(1+exp(-x))) ## ----------------------------------------------------------------------------- ## here we have balanced sample sizes across groups, so we select w = 1 ## otherwise would select w proportional to group sample sizes optCont <- optContr(mods, doses, w = 1) MCTtest(doses, ca$mu_star, S = ca$S_star, type = "general", contMat = optCont) ## ----sample_size-------------------------------------------------------------- ## for simplicity: contrasts as discussed in the previous section contMat <- optContr(mods, w=1) ## we need each alternative model as a separate object alt_model_par <- list(emax = 0.25, emax = 1, sigEmax = c(1, 3), sigEmax = c(2.5, 4), betaMod = c(1.1, 1.1)) alt_common_par <- list(placEff = logit(0.1), maxEff = logit(0.35)-logit(0.1), doses = doses) ## this is a bit hackish because we need to pass named arguments to Mods() alt_mods <- lapply(seq_along(alt_model_par), function(i) { do.call(Mods, append(alt_model_par[i], alt_common_par)) }) prop_true_var_mu_hat <- lapply(seq_along(alt_model_par), function(i) { ## mean responses on logit scale lo <- getResp(do.call(Mods, append(alt_model_par[i], alt_common_par))) p <- inv_logit(lo) # mean responses on probability scale v <- 1 / (p * (1-p)) # element-wise variance of mu_hat up to a factor of 1/n return(as.numeric(v)) # drop unnecessary attributes }) min_power_at_group_size <- function(n) { pwr <- mapply(function(m, v) powMCT(contMat, alpha=0.025, altModels=m, S=diag(v/n), df=Inf), alt_mods, prop_true_var_mu_hat) return(min(pwr)) } n <- seq(5, 80, by=5) pwrs <- sapply(n, min_power_at_group_size) qplot(n, pwrs, geom="line", ylab="Min. Power over candidate set")+ scale_y_continuous(breaks = seq(0,1,by=0.1), limits = c(0,1)) DoseFinding/inst/doc/faq.Rmd0000644000176200001440000004615214654153534015422 0ustar liggesusers--- title: "MCP-Mod FAQ" output: rmarkdown::html_vignette: toc: true toc_depth: 2 bibliography: refs.bib link-citations: yes csl: american-statistical-association.csl vignette: > %\VignetteIndexEntry{Frequently Asked Questions for MCP-Mod} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{css, echo=FALSE} h2 { font-size: 20px; line-height: 1.35; } #TOC { width: 100%; } ``` ## Preliminaries The purpose of this FAQ document is to provide answers to some commonly asked questions, based on personal opinions and experiences. For an introduction to MCP-Mod please see @bretz2005 and @pinheiro2014. ## For which types of study designs can I use MCP-Mod? MCP-Mod has been developed with having efficacy dose-finding studies in mind, as they are performed in Phase 2 of clinical drug-development. Typically these studies are large scale parallel group randomized studies (e.g. from around 50 to almost 1000 patients in total). It is also possible to use MCP-Mod in crossover designs using generalized MCP-Mod (see below). Titration designs are out of scope, because the administered dose levels depend on observed responses in the same patients, thereby making any naïve dose-response modelling inappropriate. Phase 1 dose escalation safety studies are also out of scope. The major question is dose selection for the next cohort during the trial, and tools have been developed specifically for this purpose. In addition assessment of a dose-response signal over placebo is not so much of interest in these studies. ## What is the difference between the original and generalized MCP-Mod, and what type of response can generalized MCP-Mod handle? The original MCP-Mod approach was derived for a normally distributed response variable assuming homoscedasticity across doses. The generalized MCP-Mod approach [@pinheiro2014] is a flexible extension that allows for example for binary, count, continuous or time-to-event outcomes. In both variants one tests and estimates the dose-response relationship among $K$ doses $x_1,\dots,x_K$ utilizing $M$ candidate models given by functions $f_m(x_k, \theta_m)$. The original MCP-Mod approach assumes normally distributed observations \[ y_{k,j} \sim \mathrm{Normal}(\mu_k, \sigma^2) \] for $k=1,\dots,K$ and $j=1,\dots,n_k$ in each group, where $\mu_k = f_m(x_k, \theta_m)$ under the $m$-th candidate model. In the MCP part the null hypothesis of a flat response profile $c_m^T \mu = 0$ vs $c_m^T \mu > 0$ (or $\neq 0$) is tested with $c_m$ chosen to maximize power under the $m$-th candidate model. Critical values are taken from the multivariate t distribution with $(\sum_{k=1}^K n_k) - k$ degrees of freedom. In the Mod part the dose-response model parameters $\theta$ are estimated by OLS, minimizing $\sum_{k,j} (y_{k,j} - f_m(x_{k,j}, \theta))^2$. In the generalized MCP-Mod approach no specific type of distribution is assumed for the observations, \[ y_{k,j} \sim \mathrm{SomeDistribution}(\mu_k), \] only that $\mu_k$ can be interpreted as a kind of "average response" for dose $k$. The key assumption is that an estimator $\hat\mu=(\hat\mu_1,\dots,\hat\mu_k)$ exists, which has (at least asymptotically) a multivariate normal distribution, \[ \hat\mu \sim \mathrm{MultivariateNormal}(\mu, S), \] and that a first-stage fitting procedure can provide estimates $\hat\mu$ and $\hat S$. The $m$-th candidate model is taken to imply $\mu_k = f_m(x_k, \theta)$ and the null hypothesis $c_m^T \mu = 0$ is tested with optimal contrasts. The estimate $\hat S$ is used in place of the unknown $S$, and critical values are taken from the multivariate normal distribution. Alternatively, degrees of freedom for a multivariate t distribution can be specified. For the Mod part the model parameters $\theta$ are estimated with GLS by minimizing \[ (\hat\mu - f_m(x, \theta))^T\hat{S}^{-1}(\hat\mu - f_m(x, \theta)). \] In generalized MCP-Mod with an ANOVA as the first stage (based on an normality assumption), the multiple contrast test (with appropriate degrees of freedom) will provide the same result as the original MCP-Mod approach. In summary generalized MCP-Mod is a two-stage approach, where in the first stage a model is fitted, that allows to extract (covariate adjusted) estimates at each dose level, as well as an associated covariance matrix. Then in a second stage MCP-Mod is performed on these summary estimates in many ways similar as the original MCP-Mod approach. We discuss the situation when the first stage fit is a logistic regression [in this vignette](binary_data.html), but many other first stage models could be used, as long as the first fit is able to produce adjusted estimates at the doses as long as the associated covariance matrix. See also the help page of the neurodeg data set `?neurodeg`, for a different longitudinal example. ## How many doses do we need to perform MCP-Mod? When using two active doses + placebo it is technically possible to perform the MCP and Mod steps, but in particular for the Mod step only a very limited set of dose-response models can be fitted. In addition limited information on the dose-response curve can be obtained. For both the MCP and the Mod step to make sense, three active doses and placebo should be available, with the general recommendation to use 4-7 active doses. When these doses cover the effective range well (i.e., increasing part and plateau), a large number of active doses is unlikely to produce a benefit, as the simulations in @bornkamp2007 have also shown. Optimal design calculations can also provide useful information on the number of doses (and which doses) to use. From experience with optimal design calculations for different candidate sets, the number of doses from an optimal design calculation often tend to be smaller than 7 (see also `?optDesign`). ## How to determine the doses to be used for a trial using MCP-Mod? To gain most information on the compound, one should evaluate a dose-range that is as large as feasible in terms of lowest and highest dose. As a rule of thumb at minimum a dose-range of > 10-fold should be investigated (i.e., the ratio of highest versus lowest dose should be > 10). Plasma drug exposure values (e.g., steady state AUC values) can be a good predictor of effect. In these situations one can try to select doses to achieve a uniform coverage of the exposure values. These exposure values per patient per dose often follow a log-normal distribution (i.e., positively skewed, with the variance increasing with the mean), so that the spaces between doses should get larger with increasing doses. Often log-spacing of doses (i.e., the ratio of consecutive doses is constant for example equal to 2 or 3) is used. An alternative approach to calculate adequate doses is optimal design theory (see `?optDesign`). The idea is to calculate a design (i.e. the doses and dose allocation weights) under a given fixed sample size so that the variability of the dose-response parameter estimates (or variance of some target dose estimate) is "small" in a specified way [see @bretz2010]. ## How to set up the candidate set of models? Rule of thumb: 3 - 7 dose response shapes through 2 - 4 models are often sufficient. The multiple contrast test is quite robust, even if the model-shapes are mis-specified. What information to utilize? It is possible to use __existing information__: _Similar compounds:_ Information might be available on the dose-response curve for a similar compound in the same indication or the same compound in a different indication. _Other models:_ A dose-exposure-response (PK/PD) model might have been developed based on earlier data (e.g. data from the proof-of-concept (PoC) study). This can be used to predict the dose-response curve at a specific time-point. _Emax model:_ An Emax type model should always be included in the candidate set of models. Meta-analyses of the dose-response curves over the past years showed, that in many situations the monotonic standard Emax model, or the sigmoid Emax model is able to describe the data adequately [see @thomas2014; @thomas2017]. There are also some __statistical considerations__ to be aware of: _Small number of doses and model fitting:_ If only a few active doses are feasible to be used in a trial, it is difficult to fit the more complex models, for example the sigmoid Emax or the beta model with four parameters in a trial with three active doses. Such models would not be included in the candidate set and one would rather use more dose-response models with fewer parameters to obtain an adequate breadth of the candidate set (such as the simple Emax, exponential or quadratic model). Some sigmoid Emax (or beta) model shapes cannot be approximated well by these models. If one still would like to include for example a sigmoid shape this can be achieved by fixing the Hill parameter to a given value (for example 3 and/or 5), and then use different sigmoid Emax candidate models with fixed Hill parameter also for model fitting. Model fitting of these models can be performed with the standard Emax model but utilizing $doses^h$ instead of $doses$ as the dose variable, where $h$ is the assumed fixed Hill parameter (note that the interpretation of ED50 parameter returned by `fitMod` then changes). _Consequence of model misspecification:_ Omission of the “correct†dose-response shape from the set of candidate models might not necessarily have severe consequences, if other models can pick up the omitted shape. This can be evaluated for the MCP part (impact on power) using explicit calculations (see @pinheiro2006 and [the vignette on sample size](sample_size.html)). For the Mod part (impact on estimation precision for dose-response and dose estimation) using simulations see `?planMod`. _Impact on sample size:_ Using a very broad and flexible set of candidate models does not come “for freeâ€. Generally the critical value for the MCP test will increase, if many different (uncorrelated) candidate shapes are included, and consequently also the sample size. The actual impact will have to be investigated on a case-by-case basis. A similar trade-off exists in terms of dose-response model fitting (Mod part), as a broader candidate set will decrease potential bias (in the case of a mis-specified model) but increase the variance of the estimates. _Umbrella-shaped dose-response curve:_ While biological exposure-response relationships are often monotonic, down-turns of the clinical dose-response relationship at higher doses have been observed. For example if, due to tolerability issues, more patients will discontinue treatment with higher doses of the drug. Depending on the estimand strategy of handling this intercurrent event (e.g. for treatment policy or composite) this might lead to a decrease in clinical efficacy at higher doses. It is important to discuss the plausibility of an umbrella-shaped dose-response stage at design stage and make a decision on whether to include such a shape or not. _Caution with linear models:_ Based on simulation studies utilizing the AIC, it has been observed that the linear model (as it has fewest parameters) is often too strongly favored (with the BIC this trend is even stronger), see also results in @schorning2016. The recommendation would be to exclude the linear model usually from the candidate set. The Emax and exponential model (and also the sigmoid Emax model) can approximate a linear shape well in the limiting case. ## Can MCP-Mod be used in trials without placebo control? In some cases the use of a placebo group is not possible due to ethical reasons (e.g., because good treatments exist already or the condition is very severe). In such cases, the MCP part of MCP-Mod focuses on establishing a dose-response trend among the active doses, which would correspond to a very different question rather than a dose-response effect versus placebo, and may not necessarily be of interest. The Mod step would be conducted to model the dose-response relationship among the active doses. Due to non-inclusion of a placebo group, this may be challenging to perform. One aim of such a dose-finding trial could be to estimate the smallest dose of the new compound achieving the same treatment effect as the active control. ## Why are bounds used for the nonlinear parameters in the fitMod function? Most of the common dose-response models are nonlinear in the parameters. This means that iterative algorithms need to be used to calculate the parameter estimates. Given that the number of dose levels is usually relatively small and the noise relatively large in these studies, convergence often fails. This is usually due to the fact that the best fitting model shape corresponds to the case, where one of the model parameters is infinite or 0. When observing these cases more closely, one observes that while on the parameter scale no convergence is obtained, typically convergence towards a fixed model shape is obtained. One approach to overcome this problem is to use bounds on the nonlinear parameters for the model, which thus ensure existence of an estimate. In many situations the assumed bounds can be justified in terms of requiring that the shape-space underlying the corresponding model is covered almost exhaustively (see the `defBnds` function, for the proposed default bounds). When utilizing bounds for model fitting, it bootstrapping/bagging can be used for estimation of the dose-response functions and for the confidence intervals, see @pinheiro2014. Standard asymptotic confidence intervals are not reliable. ## Should model-selection or model-averaging be used for analysis? The Mod step can be performed using either a single model selected from the initial candidate set or a weighted average of the candidate models. Model averaging has two main advantages _Improved estimation performance:_ Simulations in the framework of dose-response analyses in Phase II have shown (over a range of simulation scenarios) that model-averaging leads to a slightly better performance in terms of dose-response estimation and dose-estimation [see @schorning2016]. _Improved coverage probability of confidence intervals:_ Model averaging techniques generally lead to a better performance in terms of confidence interval coverage under model uncertainty (confidence intervals are typically closer to their nominal level). There are two main (non-Bayesian) ways of performing model averaging: _Approximate Bayesian approach:_ The models are weighted according exp(-0.5*IC), where IC is an information criterion (e.g., AIC) corresponding to the model under consideration. All subsequent estimation for quantities of interest would then be based on a weighted mean with the weights above. For numerical stability the minimum IC across all models is typically subtracted from the IC for each model, which does not change the model weights. _Bagging:_ One takes bootstrap samples, performs model selection on each bootstrap re-sample (using, for example AIC) and then uses the mean over all bootstrap predictions as the overall estimate [see @breiman1996]. As the predictions typically come from different models (for each bootstrap resample), this method can be considered to be an “implicit†way of model averaging. Bagging has the advantage that one automatically gets bootstrap confidence intervals for quantities of interest (dose-response curve or target doses) from the performed simulations. ## Which model selection criterion should be used? Whether MCP-Mod is implemented using model selection or model averaging, a suitable model selection criterion needs to be specified. See @schorning2016 for a brief review of the mathematical background of different selection criteria. A simulation in this paper supports a recommendation to utilize the AIC criterion. ## How to deal with intercurrent events and missing data? As in any other trial intercurrent events and handling strategies need to be identified, as well as missing data handling (see [ICH E9(R1) guideline](https://database.ich.org/sites/default/files/E9-R1_Step4_Guideline_2019_1203.pdf)). In many situations (e.g. if multiple imputation is used as part of the analysis) it may be easiest to use generalized MCP-Mod, where the first stage model already accounts for intercurrent events and missing data. This model is then used to produce covariate adjusted estimates at the doses (as well as their covariance matrix), which are then utilized in generalized MCP-Mod. ## Can MCP-Mod be used in trials with multiple treatment regimens? Many of the dose-finding trials study not only multiple doses of one treatment regimen, but include more than one treatment regimen (e.g., once daily (od), twice daily (bid)). MCP-Mod is focused around assessing only one dose-response relationship, but can be extended to handle some of these cases, when one is willing to make additional assumptions. Out of scope are situations, when the primary question of the trial is the regimen and not the dose, e.g., multiple regimen are employed but each with only one or two doses. Out of scope are also situations when the different regimens differ substantially. For example in situations when some treatment groups include a loading dose others do not. In a naïve dose-response modelling approach the dosing regimen cannot be easily reduced to a single dose per patient and is inappropriate. In scope are situations when the primary question focuses around the dose-response curve in the regimen. One possible assumption is to use a dose-response model on a common dose scale (e.g. daily dose) but then to assume that some of the parameters of the dose-response curves within the regimen are shared between regimen, while others are different (e.g. same or different E0, Emax, ED50 parameters between the regimen for an Emax dose-response model). See [the vignette on this topic](mult_regimen.html). To be feasible this approach requires an adequate number of doses per regimen to be able to detect a dose-response signal in each regimen and to estimate the dose-response curve in each regimen. Whether or not simplifying assumptions of parameters shared between regimen are plausible depends on the specifics of every drug. ## What about dose-response estimates, when the MCP part was (or some of the model shapes were) not significant? For practical reasons, the proposal is to perform the Mod step always with all specified models (even if all or only some of the dose-response models are not significant). The obtained dose-response estimate, however, needs to be interpreted very cautiously, when no overall dose-response trend has been established in the MCP step. Using all models is advisible, because non-significance of a particular contrast may only have been due to a particular inadequate choice of guesstimates - nevertheless once the model parameters are estimated from the data in the Mod step, the model may fit the data adequately (if not it will be downweighted automatically by the AIC). ## References DoseFinding/inst/doc/faq.html0000644000176200001440000010405614764012637015642 0ustar liggesusers MCP-Mod FAQ

MCP-Mod FAQ

Preliminaries

The purpose of this FAQ document is to provide answers to some commonly asked questions, based on personal opinions and experiences. For an introduction to MCP-Mod please see Bretz et al. (2005) and Pinheiro et al. (2014).

For which types of study designs can I use MCP-Mod?

MCP-Mod has been developed with having efficacy dose-finding studies in mind, as they are performed in Phase 2 of clinical drug-development. Typically these studies are large scale parallel group randomized studies (e.g. from around 50 to almost 1000 patients in total). It is also possible to use MCP-Mod in crossover designs using generalized MCP-Mod (see below).

Titration designs are out of scope, because the administered dose levels depend on observed responses in the same patients, thereby making any naïve dose-response modelling inappropriate.

Phase 1 dose escalation safety studies are also out of scope. The major question is dose selection for the next cohort during the trial, and tools have been developed specifically for this purpose. In addition assessment of a dose-response signal over placebo is not so much of interest in these studies.

What is the difference between the original and generalized MCP-Mod, and what type of response can generalized MCP-Mod handle?

The original MCP-Mod approach was derived for a normally distributed response variable assuming homoscedasticity across doses. The generalized MCP-Mod approach (Pinheiro et al. 2014) is a flexible extension that allows for example for binary, count, continuous or time-to-event outcomes.

In both variants one tests and estimates the dose-response relationship among \(K\) doses \(x_1,\dots,x_K\) utilizing \(M\) candidate models given by functions \(f_m(x_k, \theta_m)\).

The original MCP-Mod approach assumes normally distributed observations \[ y_{k,j} \sim \mathrm{Normal}(\mu_k, \sigma^2) \] for \(k=1,\dots,K\) and \(j=1,\dots,n_k\) in each group, where \(\mu_k = f_m(x_k, \theta_m)\) under the \(m\)-th candidate model. In the MCP part the null hypothesis of a flat response profile \(c_m^T \mu = 0\) vs \(c_m^T \mu > 0\) (or \(\neq 0\)) is tested with \(c_m\) chosen to maximize power under the \(m\)-th candidate model. Critical values are taken from the multivariate t distribution with \((\sum_{k=1}^K n_k) - k\) degrees of freedom. In the Mod part the dose-response model parameters \(\theta\) are estimated by OLS, minimizing \(\sum_{k,j} (y_{k,j} - f_m(x_{k,j}, \theta))^2\).

In the generalized MCP-Mod approach no specific type of distribution is assumed for the observations, \[ y_{k,j} \sim \mathrm{SomeDistribution}(\mu_k), \] only that \(\mu_k\) can be interpreted as a kind of “average response†for dose \(k\). The key assumption is that an estimator \(\hat\mu=(\hat\mu_1,\dots,\hat\mu_k)\) exists, which has (at least asymptotically) a multivariate normal distribution, \[ \hat\mu \sim \mathrm{MultivariateNormal}(\mu, S), \] and that a first-stage fitting procedure can provide estimates \(\hat\mu\) and \(\hat S\). The \(m\)-th candidate model is taken to imply \(\mu_k = f_m(x_k, \theta)\) and the null hypothesis \(c_m^T \mu = 0\) is tested with optimal contrasts. The estimate \(\hat S\) is used in place of the unknown \(S\), and critical values are taken from the multivariate normal distribution. Alternatively, degrees of freedom for a multivariate t distribution can be specified. For the Mod part the model parameters \(\theta\) are estimated with GLS by minimizing \[ (\hat\mu - f_m(x, \theta))^T\hat{S}^{-1}(\hat\mu - f_m(x, \theta)). \]

In generalized MCP-Mod with an ANOVA as the first stage (based on an normality assumption), the multiple contrast test (with appropriate degrees of freedom) will provide the same result as the original MCP-Mod approach.

In summary generalized MCP-Mod is a two-stage approach, where in the first stage a model is fitted, that allows to extract (covariate adjusted) estimates at each dose level, as well as an associated covariance matrix. Then in a second stage MCP-Mod is performed on these summary estimates in many ways similar as the original MCP-Mod approach.

We discuss the situation when the first stage fit is a logistic regression in this vignette, but many other first stage models could be used, as long as the first fit is able to produce adjusted estimates at the doses as long as the associated covariance matrix. See also the help page of the neurodeg data set ?neurodeg, for a different longitudinal example.

How many doses do we need to perform MCP-Mod?

When using two active doses + placebo it is technically possible to perform the MCP and Mod steps, but in particular for the Mod step only a very limited set of dose-response models can be fitted. In addition limited information on the dose-response curve can be obtained. For both the MCP and the Mod step to make sense, three active doses and placebo should be available, with the general recommendation to use 4-7 active doses. When these doses cover the effective range well (i.e., increasing part and plateau), a large number of active doses is unlikely to produce a benefit, as the simulations in Bornkamp et al. (2007) have also shown. Optimal design calculations can also provide useful information on the number of doses (and which doses) to use. From experience with optimal design calculations for different candidate sets, the number of doses from an optimal design calculation often tend to be smaller than 7 (see also ?optDesign).

How to determine the doses to be used for a trial using MCP-Mod?

To gain most information on the compound, one should evaluate a dose-range that is as large as feasible in terms of lowest and highest dose. As a rule of thumb at minimum a dose-range of > 10-fold should be investigated (i.e., the ratio of highest versus lowest dose should be > 10).

Plasma drug exposure values (e.g., steady state AUC values) can be a good predictor of effect. In these situations one can try to select doses to achieve a uniform coverage of the exposure values. These exposure values per patient per dose often follow a log-normal distribution (i.e., positively skewed, with the variance increasing with the mean), so that the spaces between doses should get larger with increasing doses. Often log-spacing of doses (i.e., the ratio of consecutive doses is constant for example equal to 2 or 3) is used.

An alternative approach to calculate adequate doses is optimal design theory (see ?optDesign). The idea is to calculate a design (i.e. the doses and dose allocation weights) under a given fixed sample size so that the variability of the dose-response parameter estimates (or variance of some target dose estimate) is “small†in a specified way (see Bretz et al. 2010).

How to set up the candidate set of models?

Rule of thumb: 3 - 7 dose response shapes through 2 - 4 models are often sufficient. The multiple contrast test is quite robust, even if the model-shapes are mis-specified. What information to utilize?

It is possible to use existing information:

Similar compounds: Information might be available on the dose-response curve for a similar compound in the same indication or the same compound in a different indication.

Other models: A dose-exposure-response (PK/PD) model might have been developed based on earlier data (e.g. data from the proof-of-concept (PoC) study). This can be used to predict the dose-response curve at a specific time-point.

Emax model: An Emax type model should always be included in the candidate set of models. Meta-analyses of the dose-response curves over the past years showed, that in many situations the monotonic standard Emax model, or the sigmoid Emax model is able to describe the data adequately (see Thomas et al. 2015; Thomas and Roy 2017).

There are also some statistical considerations to be aware of:

Small number of doses and model fitting: If only a few active doses are feasible to be used in a trial, it is difficult to fit the more complex models, for example the sigmoid Emax or the beta model with four parameters in a trial with three active doses. Such models would not be included in the candidate set and one would rather use more dose-response models with fewer parameters to obtain an adequate breadth of the candidate set (such as the simple Emax, exponential or quadratic model).

Some sigmoid Emax (or beta) model shapes cannot be approximated well by these models. If one still would like to include for example a sigmoid shape this can be achieved by fixing the Hill parameter to a given value (for example 3 and/or 5), and then use different sigmoid Emax candidate models with fixed Hill parameter also for model fitting. Model fitting of these models can be performed with the standard Emax model but utilizing \(doses^h\) instead of \(doses\) as the dose variable, where \(h\) is the assumed fixed Hill parameter (note that the interpretation of ED50 parameter returned by fitMod then changes).

Consequence of model misspecification: Omission of the “correct†dose-response shape from the set of candidate models might not necessarily have severe consequences, if other models can pick up the omitted shape. This can be evaluated for the MCP part (impact on power) using explicit calculations (see Pinheiro et al. (2006) and the vignette on sample size). For the Mod part (impact on estimation precision for dose-response and dose estimation) using simulations see ?planMod.

Impact on sample size: Using a very broad and flexible set of candidate models does not come “for freeâ€. Generally the critical value for the MCP test will increase, if many different (uncorrelated) candidate shapes are included, and consequently also the sample size. The actual impact will have to be investigated on a case-by-case basis. A similar trade-off exists in terms of dose-response model fitting (Mod part), as a broader candidate set will decrease potential bias (in the case of a mis-specified model) but increase the variance of the estimates.

Umbrella-shaped dose-response curve: While biological exposure-response relationships are often monotonic, down-turns of the clinical dose-response relationship at higher doses have been observed. For example if, due to tolerability issues, more patients will discontinue treatment with higher doses of the drug. Depending on the estimand strategy of handling this intercurrent event (e.g. for treatment policy or composite) this might lead to a decrease in clinical efficacy at higher doses. It is important to discuss the plausibility of an umbrella-shaped dose-response stage at design stage and make a decision on whether to include such a shape or not.

Caution with linear models: Based on simulation studies utilizing the AIC, it has been observed that the linear model (as it has fewest parameters) is often too strongly favored (with the BIC this trend is even stronger), see also results in Schorning et al. (2016). The recommendation would be to exclude the linear model usually from the candidate set. The Emax and exponential model (and also the sigmoid Emax model) can approximate a linear shape well in the limiting case.

Can MCP-Mod be used in trials without placebo control?

In some cases the use of a placebo group is not possible due to ethical reasons (e.g., because good treatments exist already or the condition is very severe).

In such cases, the MCP part of MCP-Mod focuses on establishing a dose-response trend among the active doses, which would correspond to a very different question rather than a dose-response effect versus placebo, and may not necessarily be of interest.

The Mod step would be conducted to model the dose-response relationship among the active doses. Due to non-inclusion of a placebo group, this may be challenging to perform.

One aim of such a dose-finding trial could be to estimate the smallest dose of the new compound achieving the same treatment effect as the active control.

Why are bounds used for the nonlinear parameters in the fitMod function?

Most of the common dose-response models are nonlinear in the parameters. This means that iterative algorithms need to be used to calculate the parameter estimates. Given that the number of dose levels is usually relatively small and the noise relatively large in these studies, convergence often fails. This is usually due to the fact that the best fitting model shape corresponds to the case, where one of the model parameters is infinite or 0. When observing these cases more closely, one observes that while on the parameter scale no convergence is obtained, typically convergence towards a fixed model shape is obtained.

One approach to overcome this problem is to use bounds on the nonlinear parameters for the model, which thus ensure existence of an estimate. In many situations the assumed bounds can be justified in terms of requiring that the shape-space underlying the corresponding model is covered almost exhaustively (see the defBnds function, for the proposed default bounds).

When utilizing bounds for model fitting, it bootstrapping/bagging can be used for estimation of the dose-response functions and for the confidence intervals, see Pinheiro et al. (2014). Standard asymptotic confidence intervals are not reliable.

Should model-selection or model-averaging be used for analysis?

The Mod step can be performed using either a single model selected from the initial candidate set or a weighted average of the candidate models. Model averaging has two main advantages

Improved estimation performance: Simulations in the framework of dose-response analyses in Phase II have shown (over a range of simulation scenarios) that model-averaging leads to a slightly better performance in terms of dose-response estimation and dose-estimation (see Schorning et al. 2016).

Improved coverage probability of confidence intervals: Model averaging techniques generally lead to a better performance in terms of confidence interval coverage under model uncertainty (confidence intervals are typically closer to their nominal level).

There are two main (non-Bayesian) ways of performing model averaging:

Approximate Bayesian approach: The models are weighted according exp(-0.5*IC), where IC is an information criterion (e.g., AIC) corresponding to the model under consideration. All subsequent estimation for quantities of interest would then be based on a weighted mean with the weights above. For numerical stability the minimum IC across all models is typically subtracted from the IC for each model, which does not change the model weights.

Bagging: One takes bootstrap samples, performs model selection on each bootstrap re-sample (using, for example AIC) and then uses the mean over all bootstrap predictions as the overall estimate (see Breiman 1996). As the predictions typically come from different models (for each bootstrap resample), this method can be considered to be an “implicit†way of model averaging. Bagging has the advantage that one automatically gets bootstrap confidence intervals for quantities of interest (dose-response curve or target doses) from the performed simulations.

Which model selection criterion should be used?

Whether MCP-Mod is implemented using model selection or model averaging, a suitable model selection criterion needs to be specified. See Schorning et al. (2016) for a brief review of the mathematical background of different selection criteria. A simulation in this paper supports a recommendation to utilize the AIC criterion.

How to deal with intercurrent events and missing data?

As in any other trial intercurrent events and handling strategies need to be identified, as well as missing data handling (see ICH E9(R1) guideline). In many situations (e.g. if multiple imputation is used as part of the analysis) it may be easiest to use generalized MCP-Mod, where the first stage model already accounts for intercurrent events and missing data. This model is then used to produce covariate adjusted estimates at the doses (as well as their covariance matrix), which are then utilized in generalized MCP-Mod.

Can MCP-Mod be used in trials with multiple treatment regimens?

Many of the dose-finding trials study not only multiple doses of one treatment regimen, but include more than one treatment regimen (e.g., once daily (od), twice daily (bid)). MCP-Mod is focused around assessing only one dose-response relationship, but can be extended to handle some of these cases, when one is willing to make additional assumptions.

Out of scope are situations, when the primary question of the trial is the regimen and not the dose, e.g., multiple regimen are employed but each with only one or two doses.

Out of scope are also situations when the different regimens differ substantially. For example in situations when some treatment groups include a loading dose others do not. In a naïve dose-response modelling approach the dosing regimen cannot be easily reduced to a single dose per patient and is inappropriate.

In scope are situations when the primary question focuses around the dose-response curve in the regimen. One possible assumption is to use a dose-response model on a common dose scale (e.g. daily dose) but then to assume that some of the parameters of the dose-response curves within the regimen are shared between regimen, while others are different (e.g. same or different E0, Emax, ED50 parameters between the regimen for an Emax dose-response model). See the vignette on this topic.

To be feasible this approach requires an adequate number of doses per regimen to be able to detect a dose-response signal in each regimen and to estimate the dose-response curve in each regimen. Whether or not simplifying assumptions of parameters shared between regimen are plausible depends on the specifics of every drug.

What about dose-response estimates, when the MCP part was (or some of the model shapes were) not significant?

For practical reasons, the proposal is to perform the Mod step always with all specified models (even if all or only some of the dose-response models are not significant). The obtained dose-response estimate, however, needs to be interpreted very cautiously, when no overall dose-response trend has been established in the MCP step.

Using all models is advisible, because non-significance of a particular contrast may only have been due to a particular inadequate choice of guesstimates - nevertheless once the model parameters are estimated from the data in the Mod step, the model may fit the data adequately (if not it will be downweighted automatically by the AIC).

References

Bornkamp, B., Bretz, F., Dmitrienko, A., Enas, G., Gaydos, B., Hsu, C.-H., König, F., Krams, M., Liu, Q., Neuenschwander, B., Parke, T., Pinheiro, J., Roy, A., Sax, R., and Shen, F. (2007), “Innovative approaches for designing and analyzing adaptive dose-ranging trials,†Journal of Biopharmaceutical Statistics, 17, 965–995. https://doi.org/10.1080/10543400701643848.
Breiman, L. (1996), “Baggin predictors,†Machine Learning, 24, 123–140. https://doi.org/10.1007/bf00058655.
Bretz, F., Dette, H., and Pinheiro, J. (2010), “Practical considerations for optimal designs in clinical dose finding studies,†Statistics in Medicine, 29, 731–742. https://doi.org/10.1002/sim.3802.
Bretz, F., Pinheiro, J. C., and Branson, M. (2005), “Combining multiple comparisons and modeling techniques in dose-response studies,†Biometrics, Wiley Online Library, 61, 738–748. https://doi.org/10.1111/j.1541-0420.2005.00344.x.
Pinheiro, J., Bornkamp, B., and Bretz, F. (2006), “Design and analysis of dose finding studies combining multiple comparisons and modeling procedures,†Journal of Biopharmaceutical Statistics, 16, 639–656. https://doi.org/10.1080/10543400600860428.
Pinheiro, J., Bornkamp, B., Glimm, E., and Bretz, F. (2014), “Model-based dose finding under model uncertainty using general parametric models,†Statistics in Medicine, 33, 1646–1661. https://doi.org/10.1002/sim.6052.
Schorning, K., Bornkamp, B., Bretz, F., and Dette, H. (2016), “Model selection versus model averaging in dose finding studies,†Statistics in Medicine, 35, 4021–4040. https://doi.org/10.1002/sim.6991.
Thomas, N., and Roy, D. (2017), “Analysis of clinical dose–response in small-molecule drug development: 2009–2014,†Statistics in Biopharmaceutical Research, 9, 137–146. https://doi.org/10.1080/19466315.2016.1256229.
Thomas, N., Sweeney, K., and Somayaji, V. (2015), “Meta-analysis of clinical dose response in a large drug development portfolio,†Statistics in Biopharmaceutical Research, 6, 302–217. https://doi.org/10.1080/19466315.2014.924876.
DoseFinding/inst/doc/sample_size.html0000644000176200001440000043276514764013014017407 0ustar liggesusers Sample size calculations for MCP-Mod

Sample size calculations for MCP-Mod

In this vignette we will take a closer look at the design stage and see how to perform power and sample size calculations for MCP-Mod with the DoseFinding package.

We will consider the same example study and the same candidate models as in the vignette for analysis of normally distributed data.

library(DoseFinding)
library(ggplot2)
doses <- c(0, 12.5, 25, 50, 100)
guess <- list(emax = c(2.6, 12.5), sigEmax = c(30.5, 3.5), quadratic = -0.00776)
mods <- do.call(Mods, append(guess, list(placEff = 1.25, maxEff = 0.15, doses = doses)))
plotMods(mods)

Power for multiple contrast test versus group sample size

In this section we will investigate at how power varies with sample size. Note that the maximum effect size within the dose-range is fixed through maxEff in the candidate models.

First we calculate the matrix of optimal contrasts (w=1 denotes homoscedastic residuals with equal group sizes, see ?optContr).

In powN we specify the sample sizes for which to calculate the power. We request five equally sized groups with alRatio = rep(1, 5). We fix the residual standard deviation with sigma = 0.34, and calculate the power for a one-sided test at level 0.05.

contMat <- optContr(mods, w=1)
pows <- powN(upperN = 100, lowerN = 10, step = 10, contMat = contMat,
             sigma = 0.34, altModels = mods, alpha = 0.05, alRatio = rep(1, 5))
plot(pows)

This shows the power values of the maximum contrast test assuming each of the different candidate models to be true. The minimum, mean and maximum power over the candidate models are also included in the plot.

There also is a wrapper function that calculates the group sample sizes needed in order to attain a specific power. The powers under each alternative model are combined with sumFct. Here we look at the minimum power, other potential choices are mean or max.

sampSizeMCT(upperN = 150, contMat = contMat, sigma = 0.34, altModels = mods,
            power = 0.9, alRatio = rep(1, 5), alpha = 0.05, sumFct = min)
Sample size calculation

alRatio: 1 1 1 1 1 
Total sample size: 465 
Sample size per arm: 93 93 93 93 93 
targFunc: 0.9026

Power versus treatment effect

In this section we fix the group sample size at 90 and vary the treatment Effect maxEff. Note how power decreases if we assume a higher residual standard deviation.

plot_power_vs_treatment_effect <- function(guess, doses, group_size, placEff, maxEffs,
                                           sigma_low, sigma_mid, sigma_high, alpha) {
  mods_args_fixed <- append(guess, list(placEff = placEff, doses = doses))
  grd <- expand.grid(max_eff = maxEffs, sigma = c(sigma_low, sigma_mid, sigma_high))
  min_power <- mean_power <- NA
  for (i in 1:nrow(grd)) {
    mods <- do.call(Mods, append(mods_args_fixed, list(maxEff = grd$max_eff[i])))
    p <- powMCT(optContr(mods, w = 1), alpha, mods, group_size, grd$sigma[i])
    min_power[i] <- min(p)
    mean_power[i] <- mean(p)
  }
  grd$sigma <- factor(grd$sigma)
  pdat <- cbind(grd, power = c(min_power, mean_power),
                sumFct = rep(factor(1:2, labels = c("min", "mean")), each = nrow(grd)))
  subt <- sprintf("group size = %d, α = %.3f", group_size, alpha)
  gg <- ggplot(pdat) + geom_line(aes(max_eff, power, lty = sigma)) +
    facet_wrap(~sumFct, labeller = label_both)+
    xlab("maximum treatment effect") + ylab("power") +
    labs(title = "Minimum power vs effect size for different residual standard deviations", subtitle = subt) +
    theme(legend.position = "bottom") +
    scale_y_continuous(limits = c(0,1), breaks = seq(0,1,by=.1))
  return(gg)
}

plot_power_vs_treatment_effect(guess, doses, group_size = 90, placEff = 1.25,
                               maxEffs = seq(0.01, 0.3, length.out = 15),
                               sigma_low = 0.3, sigma_mid = 0.34, sigma_high = 0.4, alpha = 0.05)

Power under mis-specification

MCP-Mod depends on the candidate models selected. What if the true model is not among the chosen candidate shapes? Often MCP-Mod is rather robust. To illustrate this, let’s assume an exponential model shape is the true model, which is not among the candidate shapes. Let this exponential model have small responses for all doses but the last (here assuming 20% of the overall treatment effect is achieved at the 50μg dose). All other candidate shapes assume that almost the full effect is achieved for the 50μg dose, so this shape is quite different from all other shapes included in the candidate set.

guess_miss <- list(exponential = guesst(50, 0.2, "exponential", Maxd = max(doses)))
mods_miss <- do.call(Mods, c(guess, guess_miss, list(placEff = 1.25, maxEff = 0.15, doses = doses)))
plot(mods_miss, superpose = TRUE)

Now we compare the power calculation under the exponential model with those based on the original candidate set, in both cases only the contrasts from the original candidate set are used.

plot_power_misspec <- function(guess, guess_miss, placEff, maxEff, doses,
                               upperN, lowerN, step, sigma, alpha) {
  mods_extra_par <- list(placEff = placEff, maxEff = maxEff, doses = doses)
  pown_extra_par <- list(upperN = upperN, lowerN = lowerN, step = step,
                         sigma = sigma, alpha = alpha, alRatio = rep(1, length(doses)))
  mods_miss <- do.call(Mods, c(guess_miss, mods_extra_par))
  mods_ok <- do.call(Mods, c(guess, mods_extra_par))
  cm_ok <- optContr(mods_ok, w = 1)
  p_miss <- do.call(powN, c(pown_extra_par, list(contMat = cm_ok, altModels = mods_miss)))
  p_ok <- do.call(powN, c(pown_extra_par, list(contMat = cm_ok, altModels = mods_ok)))
  pwr <- rbind(data.frame(n = as.numeric(rownames(p_ok)), p_ok[, c("min", "mean")], miss = FALSE),
               data.frame(n = as.numeric(rownames(p_miss)), p_miss[, c("min", "mean")], miss = TRUE))

  gg <- ggplot(pwr, aes(group = miss, color = miss)) +
    geom_line(aes(n, min, linetype = "minimum")) +
    geom_line(aes(n, mean, linetype = "mean")) +
    scale_color_discrete(name = "miss-specified") +
    scale_linetype_discrete(name = "aggregation") +
    labs(title = "Mean and minimum power under mis-specification") +
    xlab("group size") + ylab("power") +
    scale_y_continuous(limits = c(0,1), breaks = seq(0,1,by=.1))
  return(gg)
}

plot_power_misspec(guess, guess_miss, placEff = 1.25, maxEff = 0.15, doses = doses,
                   upperN = 100, lowerN = 10, step = 10, sigma = 0.34, alpha = 0.05)

As expected, the power decreases as the assumed underlying exponential model shape differs substantially from the shapes included in the candidate set. However, the power loss is only in the range of 10-15%.

Sample size based on metrics other than power for the multiple contrast test

The main purpose of a dose-finding study is selection of a dose to take forward into Phase 3. Establishment of a trend over placebo is hence only a minimum requirement before considering dose-selection.

If one considers sample size calculation to allow for adequate dose selection (see ?TD) it turns out that this is a much harder problem than establishing a dose-response effect versus placebo based on the MCP-part: The sample size required for adequate accuracy in estimation of a target dose (e.g. the smallest dose achieving a relevant improvement over placebo) is usually several-fold higher than the sample size needed to have adequate power for the MCP-part. This should not come as a surprise as dose-estimation is primarily a comparison among the investigational doses, while the MCP-part establishes an effect versus placebo. Chapter 12 in O’Quigley, Iasonos, and Bornkamp (2017) illustrates this with simulations, based on the planMod function (see ?planMod for example usage).

Here we only consider a brief example: Consider the sigEmax(30.5, 3.5) model from the first section and assume that it is the “true model†under which we want to investigate the operating characteristics of fitting sigEmax models. Suppose we want to achieve a target improvement of \(\Delta=0.12 L\) over placebo. One can calculate that this needs a target dose TD of 44.4 mg under the true model. Keep this number in mind for later. Now we can ask the question what the variability in TD estimation would be. To answer it, we can run a simulation using the planMod function. If we use the sample size n=93 from the power calculation above, we find:

set.seed(42)
## Note: Warnings related to vcov.DRMod can be ignored if small relative to the total number of simulations
pm <- planMod("sigEmax", Mods(sigEmax=c(30.5, 3.5), placEff=1.25, maxEff=0.15, doses=doses),
              n=93, sigma = 0.34, doses=doses, simulation=TRUE, nSim=5000, showSimProgress = FALSE,
              bnds = defBnds(max(doses)))
Running simulations
summary(pm,  Delta=0.12)
Additional simulation metrics (nSim=5000)
        Eff-vs-ANOVA  cRMSE lengthTDCI P(no TD) lengthEDCI
sigEmax         1.65 0.0392       62.3    0.153         NA

The output shows different outputs (see ?planMod for details) of most interest here is the length of the quantile range for a target dose (lengthTDCI). By default this is calculated by taking the difference of 5% and 95% quantile of the empirical distribution of the dose estimates in the simulation. The metric P(no TD) indicates in how many simulations runs no TD could be identified.

From the output it can be seen that the variation in the TD estimates is quite large and quite unsatisfactory. Experimenting with different values of n, one quickly realizes that we would need for example 1650 patients to get the length of this interval down to 20 mg.

pm <- planMod("sigEmax", Mods(sigEmax=c(30.5, 3.5), placEff=1.25, maxEff=0.15, doses=doses),
              n=1650, sigma = 0.34, doses=doses, simulation=TRUE, nSim=5000, showSimProgress = FALSE,
              bnds = defBnds(max(doses)))
Running simulations
summary(pm, Delta=0.12)
Additional simulation metrics (nSim=5000)
        Eff-vs-ANOVA  cRMSE lengthTDCI P(no TD) lengthEDCI
sigEmax          1.4 0.0102       20.2   0.0034         NA

Note that the variability in TD estimation depends quite strongly on the assumed true dose-response model, see the simulation results in Chapter 12 in O’Quigley, Iasonos, and Bornkamp (2017).

In practice, to keep the size of the study feasible, one needs to find a compromise between dose-response signal detection and estimation precision as the criteria for sample size determination. Irrespective, it is important to properly evaluate the operating characteristics of a given design (including sample size) to understand its strengths and limitations.

In practice of course the dose-response curve of the main efficacy endpoint, is not the only consideration in dose-selection for Phase III: Results for other efficacy/biomarker endpoints, but also the results for tolerability or safety markers, will contribute to that decision.

References

O’Quigley, John, Alexia Iasonos, and Björn Bornkamp. 2017. Handbook of Methods for Designing, Monitoring, and Analyzing Dose-Finding Trials. CRC Press. https://doi.org/10.1201/9781315151984.
DoseFinding/inst/doc/analysis_normal.html0000644000176200001440000037071614764012560020271 0ustar liggesusers Continuous data MCP-Mod

Continuous data MCP-Mod

Background and Data

In this vignette we will illustrate the usage of the DoseFinding package for analyzing continuously distributed data. There is a separate vignette with details on sample size and power calculation.

We will use data from Verkindre et al. (2010), who actually use a cross-over design and utilize MCP-Mod in a supportive analysis. More information can be found at the corresponding clinicaltrials.gov page and on the R help page ?glycobrom.

The main purpose Verkindre et al. (2010) was to provide safety and efficacy data on Glycopyrronium Bromide (NVA237) in patients with stable Chronic Obstructive Pulmonary Disease (COPD). The primary endpoint in this study was the mean of two measurements of forced expiratory volume in 1 second (FEV1) at 23h 15min and 23h 45min post dosing, following 7 days of treatment.

In order to keep this exposition simple, we will ignore the active control and focus on the placebo group and the four dose groups (12.5, 25, 50, and 100μg).

For the purpose here, we recreate a dataset that mimicks a parallel group design, based on the published summary statistics. These can be found in the glycobrom dataset coming with the DoseFinding package. Here fev1 and sdev contain the mean and standard deviation of the mean (standard error) of the primary endpoint for each group, while n denotes the number of participants.

library(DoseFinding)
data(glycobrom)
print(glycobrom)
   dose  fev1   sdev  n
1   0.0 1.243 0.0156 49
2  12.5 1.317 0.0145 55
3  25.0 1.333 0.0151 51
4  50.0 1.374 0.0148 53
5 100.0 1.385 0.0148 53

We want to create a dataset with 60 participants in each of the five groups. Noticing that the standard errors are essentially equal across all groups, we draw five vectors of measurement errors centered at 0 with identical variances 60 * 0.015^2 which we add to the observed means.

Note that here we use MASS::mvrnorm instead of rnorm because it lets us generate random numbers with the specified sample mean and sd.

set.seed(1, kind = "Mersenne-Twister", sample.kind = "Rejection", normal.kind = "Inversion")
rand <- rep(MASS::mvrnorm(60, 0, 60 * 0.015^2, empirical = TRUE), 5)
NVA <- data.frame(dose = rep(glycobrom$dose, each = 60),
                  FEV1 = rep(glycobrom$fev1, each = 60) + rand)
ggplot(NVA) + geom_jitter(aes(dose, FEV1), height = 0, width = 4) +
  labs(title = "Simulated FEV1 by dose (jittered horizontally)") +
  xlab("dose [μg]") + ylab("FEV1 [l]")

Design stage

Now let’s forget we already saw the data and imagine we had to design this trial with MCP-Mod.

First we decide that we want to include two Emax models, one sigmoid Emax model and one quadratic model in the analysis (see ?drmodels for other choices). While the (sigmoid) Emax type covers monotonic dose-response-relationships, the quadratic model is there to accommodate a potentially decreasing effect at high doses.

Next we have to supply guesstimates for the nonlinear parameters:

  • ED50 for an Emax model
  • ED50 and the Hill parameter h for a sigmoid emax model
  • coefficient ratio \(\delta = \beta_2/\lvert\beta_1\rvert\) in the quadratic model \(f(d, \theta) = E_0 + \beta_1 d + \beta_2 d^2\)

The following choices cover a range of plausible relationships:

  • ED50 = 2.6 and ED25 = 12.5 for the Emax models (all doses have substantive effects)
  • ED50 = 30.5 and h = 3.5 for the sigEmax model (first dose has a negligible effect)
  • delta = -0.00776 for the quadratic model (downturn for the fourth dose)

We also fix the effect of placebo at an FEV1 of 1.25 liters and the maximum effect at 0.15 liters above placebo. This implicitly sets the common linear parameters of all the models.

Note the syntax of the arguments to the Mods function: emax = c(2.6, 12.5) specifies two Emax models, but sigEmax = c(30.5, 3.5) only specifies one Sigmoid Emax model.

doses <- c(0, 12.5, 25, 50, 100)
mods <- Mods(emax = c(2.6, 12.5), sigEmax = c(30.5, 3.5), quadratic = -0.00776,
             placEff = 1.25, maxEff = 0.15, doses = doses)

It’s always a good idea to perform a visual sanity check of the functional relationships implied by the guesstimates.

plotMods(mods, ylab = "FEV1")

This concludes the design phase.

We can also take a look at the calculated optimal contrasts. Each contrast has maximum power to detect a non-flat effect profile in the hypothetical world where the particular guesstimate is actually the true value.

optC <- optContr(mods, w=1)
print(optC)
Optimal contrasts
      emax1  emax2 sigEmax quadratic
0    -0.886 -0.813  -0.486    -0.723
12.5  0.116 -0.101  -0.439    -0.240
25    0.211  0.136  -0.120     0.140
50    0.265  0.326   0.448     0.587
100   0.294  0.452   0.597     0.236
plot(optC)

It can be seen that in the balanced sample size case and equal variance assumed for each dose group, the optimal contrasts reflect the underlying assumed mean dose-response shape. This is no surprise, given that the optimal contrasts are given by \[ c^{\textrm{opt}} \propto S^{-1}\biggl(\mu^0_m - \frac{(\mu^0_m)^T S^{-1}1_K}{1_K^T S^{-1} 1_K}\biggr) \] where \(\mu^0_m\) is the standardized mean response, \(K\) is the number doses, and \(1_K\) is an all-ones vector of length \(K\) and \(S\) is the covariance matrix of the estimates at the doses (see Pinheiro et al. 2014 for a detailed account). As we have equal variance in all dose groups in our case and no correlation, the optimal contrasts are all proportional to the shapes of the candidate model mean vectors. As the standardized model is used in the formula, the values of the linear parameters of the models do not impact the optimal contrasts.

Analysis stage

Now fast-forward to the time when we have collected the data.

Multiple comparisons

We run the multiple contrast test with the pre-specified models. Note that the type parameter defaults to type="normal", which means that we assume a homoscedastic ANOVA model for FEV1, i.e. critical values are taken from a multivariate t distribution. Further note that when data is supplied, the first two arguments dose and FEV1 are not evaluated, but symbolically refer to the columns in data=NVA.

test_normal <- MCTtest(dose = dose, resp = FEV1, models = mods, data = NVA)
print(test_normal)
Multiple Contrast Test

Contrasts:
      emax1  emax2 sigEmax quadratic
0    -0.886 -0.813  -0.486    -0.723
12.5  0.116 -0.101  -0.439    -0.240
25    0.211  0.136  -0.120     0.140
50    0.265  0.326   0.448     0.587
100   0.294  0.452   0.597     0.236

Contrast Correlation:
          emax1 emax2 sigEmax quadratic
emax1     1.000 0.957   0.648     0.867
emax2     0.957 1.000   0.839     0.929
sigEmax   0.648 0.839   1.000     0.844
quadratic 0.867 0.929   0.844     1.000

Multiple Contrast Test:
          t-Stat  adj-p
emax2      7.443 <0.001
quadratic  7.016 <0.001
emax1      6.937 <0.001
sigEmax    6.676 <0.001

The test results suggest a clear dose-response trend.

Alternatively we can use generalized MCP-Mod (see the FAQ for the difference). We use R’s builtin lm() function to manually fit the ANOVA model and extract estimates for the model coefficients and their covariance matrix. We also need the model degrees of freedom.

fitlm <- lm(FEV1 ~ factor(dose) - 1, data = NVA)
mu_hat <- coef(fitlm)
S_hat <- vcov(fitlm)
anova_df <- fitlm$df.residual

Next we supply them to the MCTtest function together with type="general". Note that in contrast to the invocation above we here supply the doses and the estimates mu_hat and S_hat directly and not within a data.frame.

test_general <- MCTtest(dose = doses, resp = mu_hat, S = S_hat, df = anova_df,
                        models = mods, type = "general")
print(test_general)
Multiple Contrast Test

Contrasts:
      emax1  emax2 sigEmax quadratic
0    -0.886 -0.813  -0.486    -0.723
12.5  0.116 -0.101  -0.439    -0.240
25    0.211  0.136  -0.120     0.140
50    0.265  0.326   0.448     0.587
100   0.294  0.452   0.597     0.236

Contrast Correlation:
          emax1 emax2 sigEmax quadratic
emax1     1.000 0.957   0.648     0.867
emax2     0.957 1.000   0.839     0.929
sigEmax   0.648 0.839   1.000     0.844
quadratic 0.867 0.929   0.844     1.000

Multiple Contrast Test:
          t-Stat  adj-p
emax2      7.443 <0.001
quadratic  7.016 <0.001
emax1      6.937 <0.001
sigEmax    6.676 <0.001

For the simple ANOVA case at hand the results of the original and the generalized MCP-Mod approaches actually coincide. The p-values differ due to the numerical methods used for obtaining them.

cbind(normal = test_normal$tStat, generalized = test_general$tStat)
            normal generalized
emax1     6.937000    6.937000
emax2     7.442849    7.442849
sigEmax   6.675739    6.675739
quadratic 7.016303    7.016303
cbind(normal = attr(test_normal$tStat, "pVal"), generalized = attr(test_general$tStat, "pVal"))
           normal  generalized
[1,] 1.221279e-11 1.224099e-11
[2,] 5.375700e-13 6.030731e-13
[3,] 5.924716e-11 6.039769e-11
[4,] 8.166245e-12 7.672307e-12

Dose-response estimation

In the simplest case we would now proceed to fit only a single model type, for example the one with the largest t-statistic (or alternatively smallest AIC or BIC):

fit_single <- fitMod(dose, FEV1, NVA, model = "emax")
plot(fit_single)

But actually we want to use a more robust approach that combines bootstrapping with model averaging in the generalized MCP-Mod framework.

First we draw bootstrap samples from the multivariate normal distribution of the estimates originating from the first-stage model. Next, for each bootstrapped data set we fit our candidate models, select the one with lowest AIC and save the corresponding estimated quantities of interest. This selection step implies that the bootstrap samples potentially come from different models. Finally we use these bootstrapped estimates for inference. For example, we can estimate a dose-response curve by using the median over the bootstrapped means at each dose. Similarly we can derive confidence intervals based on bootstrap quantiles. Inference for other quantities of interest can be performed in an analogous way.

As different models contribute to the bootstrap resamples, the approach can be considered more robust than simple model selection (see also Schorning et al. 2016 for simulations on this topic).

Now let’s apply this general idea to the case at hand. Our first-stage model is an ANOVA, and we’re interested in an estimate of the dose-response curve plus confidence intervals. Our set of candidate model types consists of Emax, sigEmax and quadratic.

We us R’s builtin lm() function to fit an ANOVA model without intercept and extract estimates for the model coefficients and their covariance matrix.

fitlm <- lm(FEV1 ~ factor(dose) - 1, data = NVA)
dose <- unique(NVA$dose)
mu_hat <- coef(fitlm)
S_hat <- vcov(fitlm)

The bootstrap procedure described above is implemented in the maFitMod function. Note that for technical reasons we have to supply boundaries to the fitting algorithm via the bnds argument to maFitMod (see ?fitMod and ?defBnds for details).

fit_mod_av <- maFitMod(dose, mu_hat, S = S_hat,
                       models = c("emax", "sigEmax", "quadratic"))

With the predict method we can obtain the predictions from the fitted model on each boostrap sample. The plot method allows to summarize the model fits (some limited customization is possible see ?plot.maFit).

# point estimates (median) and bootstrap quantile intervals can be extracted via
ma_pred <- predict(fit_mod_av, doseSeq = c(0, 12.5, 25, 50, 100))
# individual bootstrap estimates via
indiv_pred <- predict(fit_mod_av, doseSeq = c(0, 12.5, 25, 50, 100),
                      summaryFct = NULL)
# plotting can be done via
plot(fit_mod_av, plotData = "meansCI",
     ylab = "Model averaging estimate with 95% CI")

How to adjust for covariates?

In all practical situations covariates will be used to adjust for in the analysis. The MCP step can then be performed for example by including the covariates in the addCovars argument. Another approach to perform the MCP step is based on the differences to placebo: In a first stage lm(.) is fit with an intercept included. Then the treatment differences and corresponding covariance matrix would be extracted. This could then be fed into the MCTtest function, with the placAdj = TRUE argument, see ?MCTtest for an example. Both approaches will give the same result.

A third alternative is to calculate the adjusted means (and corresponding covariance matrix) and then perform generalized MCP-Mod based on these estimates (following the same steps as in the unadjusted analysis above, but adding the type = "general" argument as well as the estimated covariance matrix via S). The procedure is very similar to the situation explained in detail in the vignette for the analysis of binary data, so not repeated here.

For the case of normally distributed data adjusted means are calculated by predicting the outcome (using the covariate adjusted model) of each patient in the study under every dose, and then averaging over all patients per dose.

References

Pinheiro, J., Bornkamp, B., Glimm, E., and Bretz, F. (2014), “Model-based dose finding under model uncertainty using general parametric models,†Statistics in Medicine, 33, 1646–1661. https://doi.org/10.1002/sim.6052.
Schorning, K., Bornkamp, B., Bretz, F., and Dette, H. (2016), “Model selection versus model averaging in dose finding studies,†Statistics in Medicine, 35, 4021–4040. https://doi.org/10.1002/sim.6991.
Verkindre, C., Fukuchi, Y., Flémale, A., Takeda, A., Overend, T., Prasad, N., and Dolker, M. (2010), “Sustained 24-h efficacy of NVA237, a once-daily long-acting muscarinic antagonist, in COPD patients,†Respiratory Medicine, 104, 1482–1489. https://doi.org/10.1016/j.rmed.2010.04.006.
DoseFinding/inst/doc/overview.Rmd0000644000176200001440000000605514654153534016517 0ustar liggesusers--- title: "Overview DoseFinding package" output: rmarkdown::html_vignette: bibliography: refs.bib link-citations: yes csl: american-statistical-association.csl vignette: > %\VignetteIndexEntry{Overview DoseFinding package} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, child="children/settings.txt"} ``` The DoseFinding package provides functions for the design and analysis of dose-finding experiments (for example pharmaceutical Phase II clinical trials). It provides functions for: multiple contrast tests (`MCTtest` for analysis and `powMCT`, `sampSizeMCT` for sample size calculation), fitting non-linear dose-response models (`fitMod` for ML estimation and `bFitMod` for Bayesian and bootstrap/bagging ML estimation), calculating optimal designs (`optDesign` or `calcCrit` for evaluation of given designs), both for normal and general response variable. In addition the package can be used to implement the MCP-Mod procedure, a combination of testing and dose-response modelling (`MCPMod`) (@bretz2005, @pinheiro2014). A number of vignettes cover practical aspects on how MCP-Mod can be implemented using the DoseFinding package. For example a [FAQ](faq.html) document for MCP-Mod, analysis approaches for [normal](analysis_normal.html) and [binary](binary_data.html) data, [sample size and power calculations](sample_size.html) as well as handling data from more than one dosing [regimen](mult_regimen.html) in certain scenarios. Below a short overview of the main functions. ## Perform multiple contrast test ```{r, overview, fig.asp = .4} library(DoseFinding) data(IBScovars) head(IBScovars) ## perform (model based) multiple contrast test ## define candidate dose-response shapes models <- Mods(linear = NULL, emax = 0.2, quadratic = -0.17, doses = c(0, 1, 2, 3, 4)) ## plot models plotMods(models) ## perform multiple contrast test ## functions powMCT and sampSizeMCT provide tools for sample size ## calculation for multiple contrast tests test <- MCTtest(dose, resp, IBScovars, models=models, addCovars = ~ gender) test ``` ## Fit non-linear dose-response models here illustrated with Emax model ```{r, overview 2} fitemax <- fitMod(dose, resp, data=IBScovars, model="emax", bnds = c(0.01,5)) ## display fitted dose-effect curve plot(fitemax, CI=TRUE, plotData="meansCI") ``` ## Calculate optimal designs, here illustrated for target dose (TD) estimation ```{r, overview 3} ## optimal design for estimation of the smallest dose that gives an ## improvement of 0.2 over placebo, a model-averaged design criterion ## is used (over the models defined in Mods) doses <- c(0, 10, 25, 50, 100, 150) fmodels <- Mods(linear = NULL, emax = 25, exponential = 85, logistic = c(50, 10.8811), doses = doses, placEff=0, maxEff=0.4) plot(fmodels, plotTD = TRUE, Delta = 0.2) weights <- rep(1/4, 4) desTD <- optDesign(fmodels, weights, Delta=0.2, designCrit="TD") desTD plot(desTD, fmodels) ``` ## References DoseFinding/inst/doc/mult_regimen.R0000644000176200001440000002345214764012715017014 0ustar liggesusers## ----settings-knitr, include=FALSE-------------------------------------------- library(ggplot2) knitr::opts_chunk$set(echo = TRUE, message = FALSE, cache = FALSE, comment = NA, dev = "png", dpi = 150, fig.asp = 0.618, fig.width = 7, out.width = "85%", fig.align = "center") options(rmarkdown.html_vignette.check_title = FALSE) theme_set(theme_bw()) ## ----data--------------------------------------------------------------------- library(DoseFinding) library(ggplot2) ## collect estimates and dosage information in one place example_estimates <- function() { ## ANOVA mean estimates and ci bounds extracted from fig. 3 of Bays (2020). ## clinicaltrials.gov page already seems to contain values from the dose-response model fit mn <- c(-0.55, -1.78, -1.95, -3.29, -4.43, -1.14, -2.74, -4.03, -4.47) lb <- c(-1.56, -3.15, -3.36, -4.85, -5.40, -2.49, -4.10, -5.50, -5.50) ub <- c( 0.40, -0.30, -0.54, -1.76, -3.48, 0.24, -1.38, -2.65, -3.44) se <- (ub - lb)/(2*qnorm(0.975)) # approximate standard error return(list(mu_hat = mn, daily_dose = c(0, 2.5, 10, 50, 150, 5, 10, 50, 100), S_hat = diag(se^2), # keep track of which elements correspond to which regimen: index = list(placebo = 1, od = 2:5, bid = 6:9))) } ## restructure estimates for easy plotting with ggplot tidy_estimates <- function(est) { se <- sqrt(diag(est$S_hat)) tidy <- data.frame(daily_dose = est$daily_dose, mu_hat = est$mu_hat, ub = est$mu_hat + qnorm(0.975) * se, lb = est$mu_hat - qnorm(0.975) * se) tidy <- rbind(tidy[1, ], tidy) # duplicate placebo tidy$regimen <- c("od", "bid", rep("od", length(est$index$od)), rep("bid", length(est$index$bid))) return(tidy) } plot_estimates <- function(est) { df <- tidy_estimates(est) ggplot(df, aes(daily_dose, mu_hat)) + geom_point() + geom_errorbar(aes(ymin = lb, ymax = ub)) + facet_wrap(vars(regimen), labeller = label_both) + xlab("daily dose") + ylab("percent body weight cange") + labs(title = "ANOVA estimates with 95% confindence intervals") } est <- example_estimates() plot_estimates(est) ## ----candidate_models--------------------------------------------------------- mods <- list( od = Mods(emax = c(5, 50), sigEmax = rbind(c(75, 3.5), c(25, 0.7)), maxEff = -1, doses = est$daily_dose[c(est$index$placebo, est$index$od)]), bid = Mods(emax = c(5, 50), sigEmax = rbind(c(75, 3.5), c(25, 0.7)), maxEff = -1, doses=est$daily_dose[c(est$index$placebo, est$index$bid)])) plotMods(mods$od, superpose = TRUE, xlab = "daily dose") plotMods(mods$bid, superpose = TRUE, xlab = "daily dose") ## ----contrasts---------------------------------------------------------------- calculate_contrasts <- function(est, mods) { S_hat <- est$S_hat i <- est$index cm_od <- optContr(mods$od, S=S_hat[c(i$placebo, i$od), c(i$placebo, i$od)])$contMat cm_bid <- optContr(mods$bid, S=S_hat[c(i$placebo, i$bid), c(i$placebo, i$bid)])$contMat colnames(cm_od) <- paste0("od_", colnames(cm_od)) rownames(cm_od)[-1] <- paste0("od_", rownames(cm_od)[-1]) colnames(cm_bid) <- paste0("bid_", colnames(cm_bid)) rownames(cm_bid)[-1] <- paste0("bid_", rownames(cm_bid)[-1]) # now build a block matrix (contrasts in columns) like this: # [ row of placebo coefficients od | row of placebo coefficients bid ] # [----------------------------------+-----------------------------------] # [ remaining doses' coefficents od | fill with all zeros ] # [----------------------------------+-----------------------------------] # [ fill with all zeros | remaining doses' coefficients bid ] cm_full <- rbind( "0"=c(cm_od[1,], cm_bid[1,] ), cbind(cm_od[-1,], matrix(0, nrow(cm_od) - 1, ncol(cm_bid))), cbind(matrix(0, nrow(cm_bid) - 1, ncol(cm_od)), cm_bid[-1, ] )) return(cm_full) } cont_mat <- calculate_contrasts(est, mods) print(round(cont_mat, 2)) ## ----test--------------------------------------------------------------------- mct_test <- function(cont_mat, est) { cont_cov <- t(cont_mat) %*% est$S_hat %*% cont_mat t_stat <- drop(est$mu_hat %*% cont_mat) / sqrt(diag(cont_cov)) # FIXME: calling non-exported function p <- MCTpval(contMat = cont_mat, corMat = cov2cor(cont_cov), df=Inf, tStat=t_stat, alternative = "one.sided") ord <- rev(order(t_stat)) return(data.frame(tStat = t_stat[ord], pVals = p[ord])) } mct_test(cont_mat, est) ## ----estimation_1------------------------------------------------------------- ## calculate response under `model` for od/bid with common e0, but separate remaining parameters ## arguments: ## - model: as a string like "emax", ## - i_par: list of vectors named "placebo", "od", "bid", used for indexing `par` ## - par: numeric, model parameter structured as c(e0, pars_od, pars_bid) ## returns: response at placebo, dose_od, dose_bid (in this order) eval_model_shared_e0 <- function(model, dose_od, dose_bid, par, i_par) { resp_placebo <- par[1] # e0 resp_od <- do.call(model, append(list(dose_od, par[1]), as.list(par[i_par$od]))) resp_bid <- do.call(model, append(list(dose_bid, par[1]), as.list(par[i_par$bid]))) resp <- c(resp_placebo, resp_od, resp_bid) return(resp) } ## ----estimation_2------------------------------------------------------------- ## find sensible starting values for `fit_model_shared_e0` by fitting separate models, ## index: list of vectors named "placebo", "od", "bid", used for indexing `dose` ## bounds: passed through to `fitMod` calc_start_values <- function(model, full_mu, full_S, dose, index, bounds) { separate_coefs <- sapply(c("od", "bid"), function(regimen) { inds <- c(index$placebo, index[[regimen]]) coef(fitMod(dose[inds], full_mu[inds], S = full_S[inds, inds], type = "general", model = model, bnds = bounds))[-1] # drop e0 estimate }) ## remove names to prevent error in do.call() in eval_model_shared_e0; ## od, bid coefs are in 1st / second column start <- c(full_mu[1], as.numeric(separate_coefs), use.names=FALSE) return(start) } ## fits 'model' to mu_hat with GLS (using S_hat_inv as weight matrix), using a common e0 for od and bid regimens. ## i_reg: list of vectors named "placebo", "od", "bid", used for indexing `dose` ## i_par: passed through to `eval_model_shared_e0` ## dose: numeric with doses for placebo, od, bid ## lower, upper, start: control parameters fro `nlminb` fit_model_shared_e0 <- function(model, dose, mu_hat, S_hat_inv, lower, upper, start, i_reg, i_par) { opt_fun <- function(par) { # make use of lexical scope resp <- eval_model_shared_e0(model, dose[i_reg$od], dose[i_reg$bid], par, i_par) delta <- resp - mu_hat return(drop(t(delta) %*% S_hat_inv %*% delta)) } fit <- nlminb(start, opt_fun, lower = lower, upper = upper) return(fit) } ## ----estimation_3------------------------------------------------------------- ## predict population response in each regimen for dose_seq_* ## note: both dose_seq_* vectors should contain a 0 if response at placebo is of interest one_bootstrap_sample <- function(est, dose_seq_od, dose_seq_bid) { mu_new <- drop(mvtnorm::rmvnorm(1, est$mu_hat, est$S_hat)) mod_info <- list(list(name = "emax", bounds = rbind(c(0.15, 225)), i_par = list(od = 2:3, bid = 4:5), n_par_gaic = 5), list(name = "sigEmax", bounds = rbind(c(0.15, 225), c(0.5, 5)), i_par = list(od = 2:4, bid = 5:7), n_par_gaic = 7)) fit <- lapply(mod_info, function(m) { start <- calc_start_values(m$name, mu_new, est$S_hat, est$daily_dose, est$index, m$bounds) low <- c(-Inf, -Inf, m$bounds[,1]) # no bounds on e0, eMax up <- c(Inf, Inf, m$bounds[,2]) fit_model_shared_e0(m$name, est$daily_dose, mu_new, solve(est$S_hat), lower = low, upper = up, start = start, i_reg = est$index, i_par = m$i_par) }) ## calculate gAICs gaics <- sapply(fit, `[[`, "objective") + 2 * sapply(mod_info, `[[`, "n_par_gaic") sel <- which.min(gaics) mod <- mod_info[[sel]] ## drop the placebo element pred <- eval_model_shared_e0(mod$name, dose_seq_od, dose_seq_bid, fit[[sel]]$par, mod$i_par)[-1] return(pred) } summarize_bootstrap_samples <- function(samples, probs = c(0.025, 0.25, 0.75, 0.975)) { stopifnot(length(probs) == 4) med <- apply(samples, 1, median) quants <- apply(samples, 1, quantile, probs = probs) bs_df <- as.data.frame(cbind(med, t(quants))) names(bs_df) <- c("median", "low_out", "low_in", "high_in", "high_out") return(bs_df) } dose_seq_od <- seq(0, 150, length.out = 21) # do include placebo! dose_seq_bid <- seq(0, 100, length.out = 21) set.seed(1, kind = "Mersenne-Twister", sample.kind = "Rejection", normal.kind = "Inversion") reps <- replicate(1000, one_bootstrap_sample(est, dose_seq_od, dose_seq_bid)) bs_sum <- summarize_bootstrap_samples(reps) bs_sum$daily_dose <- c(dose_seq_od, dose_seq_bid) bs_sum$regimen <- c(rep("od", length(dose_seq_od)), rep("bid", length(dose_seq_bid))) ggplot(bs_sum) + geom_ribbon(aes(daily_dose, ymin=low_out, ymax=high_out), alpha = 0.2) + geom_ribbon(aes(daily_dose, ymin=low_in, ymax=high_in), alpha = 0.2) + geom_line(aes(daily_dose, median)) + geom_point(aes(daily_dose, mu_hat), tidy_estimates(est)) + facet_wrap(vars(regimen), labeller = label_both) + labs(title = "Bootstrap estimates for population response", subtitle = "Least squares estimates plus 50% and 95% confidence bands") + xlab("daily dose") + ylab("percent body weigh change") + coord_cartesian(ylim = c(-6, 0)) DoseFinding/inst/doc/binary_data.html0000644000176200001440000053514014764012636017351 0ustar liggesusers Binary Data MCP-Mod

Binary Data MCP-Mod

In this vignette we illustrate how to use the DoseFinding package with binary observations by fitting a first-stage GLM and applying the generalized MCP-Mod methodology to the resulting estimates. We also show how to deal with covariates.

For continuously distributed data see the corresponding vignette.

Background and data set

Assume a dose-finding study is planned for an hypothetical investigational treatment in atopic dermatitis, for the binary endpoint Investigator’s Global Assessment (IGA). The treatment is tested with doses 0, 0.5, 1.5, 2.5, 4. It is assumed the response rate for placebo will be around 10%, while the response rate for the top dose may be 35%. This is an example where the generalized MCP-Mod approach can be applied, i.e. dose-response testing and estimation will be performed on the logit scale.

We generate some example data in the setting just described. The 10% placebo effect translates to -2.2 on the logit scale, and the asymptotic effect of 25 percentage points above placebo becomes logit(0.35) - logit(0.1), approximately 1.6.

library(DoseFinding)
library(ggplot2)

logit <- function(p) log(p / (1 - p))
inv_logit <- function(y) 1 / (1 + exp(-y))
doses <- c(0, 0.5, 1.5, 2.5, 4)

## set seed and ensure reproducibility across R versions
set.seed(1, kind = "Mersenne-Twister", sample.kind = "Rejection", normal.kind = "Inversion")
group_size <- 100
dose_vector <- rep(doses, each = group_size)
N <- length(dose_vector)
## generate covariates
x1 <- rnorm(N, 0, 1)
x2 <- factor(sample(c("A", "B"), N, replace = TRUE, prob = c(0.6, 0.4)))
## assume approximately logit(10%) placebo and logit(35%) asymptotic response with ED50=0.5
prob <- inv_logit(emax(dose_vector, -2.2, 1.6, 0.5) + 0.3 * x1 + 0.3 * (x2 == "B"))
dat <- data.frame(y = rbinom(N, 1, prob),
                  dose = dose_vector, x1 = x1, x2 = x2)

Candidate models

We will use the following candidate set of models for the mean response on the logit scale:

mods <- Mods(emax = c(0.25, 1), sigEmax = rbind(c(1, 3), c(2.5, 4)), betaMod = c(1.1, 1.1),
             placEff = logit(0.1), maxEff = logit(0.35)-logit(0.1),
             doses = doses)
plotMods(mods)

## plot candidate models on probability scale
plotMods(mods, trafo = inv_logit)

Analysis without covariates

First assume covariates had not been used in the analysis (not recommended in practice). Let \(\mu_k\) denote the logit response probability at dose \(k\), so that for patient \(j\) in group \(k\) we have

\[ \begin{aligned} Y_{kj} &\sim \mathrm{Bernoulli}(p_{kj}) \\ \mathrm{logit}(p_{kj}) &= \mu_{k} \end{aligned} \]

We perform the MCP-Mod test on the logit scale estimates \(\hat\mu=(\hat\mu_1,\dots,\hat\mu_K)\) and their estimated covariance matrix \(\hat S\). We can extract both from the object returned by the glm() call.

fit_nocov <- glm(y~factor(dose) + 0, data = dat, family = binomial)
mu_hat <- coef(fit_nocov)
S_hat <- vcov(fit_nocov)
MCTtest(doses, mu_hat, S = S_hat, models = mods, type = "general")
Multiple Contrast Test

Contrasts:
     emax1  emax2 sigEmax1 sigEmax2 betaMod
0   -0.817 -0.641   -0.471   -0.280  -0.540
0.5 -0.126 -0.377   -0.589   -0.423  -0.356
1.5  0.202  0.103    0.163   -0.300   0.358
2.5  0.338  0.365    0.418    0.228   0.662
4    0.402  0.550    0.479    0.775  -0.124

Contrast Correlation:
         emax1 emax2 sigEmax1 sigEmax2 betaMod
emax1    1.000 0.945    0.831    0.608   0.789
emax2    0.945 1.000    0.956    0.805   0.762
sigEmax1 0.831 0.956    1.000    0.804   0.788
sigEmax2 0.608 0.805    0.804    1.000   0.327
betaMod  0.789 0.762    0.788    0.327   1.000

Multiple Contrast Test:
         t-Stat   adj-p
emax2     3.378 0.00104
emax1     3.349 0.00103
sigEmax1  3.047 0.00305
sigEmax2  2.668 0.01108
betaMod   2.631 0.01169

Dose-response modeling then can proceed with a combination of bootstrapping and model averaging. For detailed explanations refer to the vignette for analysis of continuous data. Fitting is done on the logit scale, for plotting transfer the fit back to the probability scale.

fit_mod_av <- maFitMod(doses, mu_hat, S = S_hat,
                       models = c("emax", "sigEmax", "betaMod"))
plot(fit_mod_av, plotData = "meansCI",
     title = "Bootstrap estimates for population response probability",
     trafo = function(x) 1/(1+exp(-x)))

Analysis with covariates

In many situations there are important prognostic covariates (main effects) to adjust for in the analysis. Denote the vector of these additional covariates for patient \(j\) with \(x_{kj}\).

\[ \begin{aligned} Y_{kj} &\sim \mathrm{Bernoulli}(p_{kj}) \\ \mathrm{logit}(p_{kj}) &= \mu_k^d + x_{kj}^T\beta \end{aligned} \]

Fitting this model gives us estimated coefficients \(\hat\mu=(\hat\mu^d, \hat\beta)\) and an estimate \(\hat S\) of the covariance matrix of the estimator \(\hat\mu\).

In principle we could perform testing and estimation based on \(\hat\mu^d\) and the corresponding sub-matrix of \(\hat S\), but this would produce estimates for a patient with covariate vector \(\beta=0\), and not reflect the overall population.

To produce adjusted estimates per dose and to accommodate potential systematic differences in the covariates we predict the mean response probability at dose k for all observed values of the covariates and transform back to logit scale:

\[ \mu^*_k := \mathrm{logit}\biggl(\frac{1}{n} \sum_{i=1}^n \mathrm{logit}^{-1}(\hat\mu^d_k + x_{i}^T\hat\beta)\biggr) \]

Note here we index \(x\) with \(i\) that runs from 1 to \(n\) (all patients randomized in the study).

To obtain a variance estimate for \(\mu^*\) we repeat this with draws from \(\mathrm{MultivariateNormal}(\hat\mu, \hat S)\) and calculate the empirical covariance matrix \(S^*\) of theses draws.

Then we use \(\mu^*\) and \(S^*\) in MCTtest().

fit_cov <- glm(y~factor(dose) + 0 + x1 + x2, data = dat, family = binomial)

covariate_adjusted_estimates <- function(mu_hat, S_hat, formula_rhs, doses, other_covariates, n_sim) {
  ## predict every patient under *every* dose
  oc_rep <- as.data.frame(lapply(other_covariates, function(col) rep(col, times = length(doses))))
  d_rep <- rep(doses, each = nrow(other_covariates))
  pdat <- cbind(oc_rep, dose = d_rep)
  X <- model.matrix(formula_rhs, pdat)
  ## average on probability scale then backtransform to logit scale
  mu_star <- logit(tapply(inv_logit(X %*% mu_hat), pdat$dose, mean))
  ## estimate covariance matrix of mu_star
  pred <- replicate(n_sim, logit(tapply(inv_logit(X %*% drop(mvtnorm::rmvnorm(1, mu_hat, S_hat))),
                                        pdat$dose, mean)))
  return(list(mu_star = as.numeric(mu_star), S_star = cov(t(pred))))
}

ca <- covariate_adjusted_estimates(coef(fit_cov), vcov(fit_cov), ~factor(dose)+0+x1+x2,
                                   doses, dat[, c("x1", "x2")], 1000)
MCTtest(doses, ca$mu_star, S = ca$S_star, type = "general", models = mods)
Multiple Contrast Test

Contrasts:
     emax1  emax2 sigEmax1 sigEmax2 betaMod
0   -0.828 -0.659   -0.494   -0.277  -0.551
0.5 -0.067 -0.317   -0.546   -0.369  -0.299
1.5  0.131  0.021    0.090   -0.372   0.315
2.5  0.384  0.412    0.470    0.251   0.694
4    0.381  0.543    0.480    0.766  -0.160

Contrast Correlation:
         emax1 emax2 sigEmax1 sigEmax2 betaMod
emax1    1.000 0.945    0.829    0.598   0.785
emax2    0.945 1.000    0.954    0.799   0.750
sigEmax1 0.829 0.954    1.000    0.797   0.777
sigEmax2 0.598 0.799    0.797    1.000   0.299
betaMod  0.785 0.750    0.777    0.299   1.000

Multiple Contrast Test:
         t-Stat   adj-p
emax2     3.491 < 0.001
emax1     3.471 < 0.001
sigEmax1  3.115 0.00238
sigEmax2  2.749 0.00888
betaMod   2.639 0.01215

In the case at hand the results here are not dramatically different. Adjusting for covariates gives slightly lower variance estimates.

ggplot(data.frame(dose = rep(doses, 4),
                  est = c(inv_logit(mu_hat), diag(S_hat), inv_logit(ca$mu_star), diag(ca$S_star)),
                  name = rep(rep(c("mean", "var"), each = length(doses)), times = 2),
                  a = rep(c(FALSE, TRUE), each = 2*length(doses)))) +
  geom_point(aes(dose, est, color = a)) +
  scale_color_discrete(name = "adjusted") +
  facet_wrap(vars(name), scales = "free_y") + ylab("")

Dose-response modelling proceeds in the same way as before, but now on the adjusted estimates.

fit_cov_adj <- maFitMod(doses, ca$mu_star, S = ca$S_star,
                        models = c("emax", "sigEmax", "betaMod"))
# plotting on probability scale, need to transform predictions on logit scale
plot(fit_cov_adj, plotData = "meansCI",
     title = "Bootstrap estimates for population response probability",
     trafo = function(x) 1/(1+exp(-x)))

Avoiding problems with complete seperation and 0 responders

In a number of situations it makes sense to replace ML estimation for logistic regression via glm(..., family=binomial), with the Firth logistic regression (see Heinze and Schemper 2002), implemented as the logistf function from the logistf package. This is particularly important for small sample size per dose and if small number of responses are expected on some treatment arms. The estimator of Firth regression corresponds to the posterior mode in a Bayesian logistic regression model with Jeffrey’s prior on the parameter vector. This estimator is well defined even in situations where the ML estimate for logistic regression does not exist (e.g. for complete separation).

Considerations around optimal contrasts at design stage and analysis stage

The formula for the optimal contrasts is given by \[ c^{\textrm{opt}} \propto S^{-1}\biggl(\mu^0_m - \frac{(\mu^0_m)^T S^{-1}1_K}{1_K^T S^{-1} 1_K}\biggr) \] where \(\mu^0_m\) is the standardized mean response, \(K\) is the number doses, and \(1_K\) is an all-ones vector of length \(K\) and \(S\) is the covariance matrix of the estimates at the doses (see Pinheiro et al. 2014).

For calculating the optimal contrast for the generalized MCP step the covariance matrix \(S\) of the estimator \(\hat\mu\) can be re-estimated once the trial data are available. With normally distributed data this is possible with decent accuracy even at rather low sample sizes. In the case of binary data, \(\hat\mu\) is on the logit scale and the diagonal elements of \(S\) are approximately \((np(1-p))^{-1}\), where \(n\) is the sample size of the dose group. This can be derived using the delta method. An estimate of this variance depends on the observed response rate and can thus be quite variable in particular for small sample sizes per group (e.g. smaller than 20).

A crude alternative in these situations is to not use the estimated \(S\) but a diagonal matrix with the inverse of the sample size per dose on the diagonal in the formula for calculation of the optimal contrast. The contrast calculated this way will asymptotically not be equal to the “optimal†contrast for the underlying model, but simulations show that they can be closer to the “true†optimal contrast (calculated based on the true variance per dose group) for small sample size, compared to the contrast calculated based on the estimated variance.

To re-run the adjusted analysis above for the contrasts, calculated as outlined above, we need to calculate and hand-over the contrast matrix manually via contMat in the MCTtest() function. In our case (with 100 patients per group) we obtain a result that is only slightly different.

## here we have balanced sample sizes across groups, so we select w = 1
## otherwise would select w proportional to group sample sizes
optCont <- optContr(mods, doses, w = 1)
MCTtest(doses, ca$mu_star, S = ca$S_star, type = "general", contMat = optCont)
Multiple Contrast Test

Contrasts:
     emax1  emax2 sigEmax1 sigEmax2 betaMod
0   -0.861 -0.753   -0.597   -0.391  -0.679
0.5 -0.010 -0.240   -0.479   -0.389  -0.255
1.5  0.233  0.170    0.223   -0.240   0.383
2.5  0.299  0.346    0.402    0.268   0.573
4    0.340  0.477    0.450    0.752  -0.022

Contrast Correlation:
         emax1 emax2 sigEmax1 sigEmax2 betaMod
emax1    1.000 0.965    0.863    0.659   0.884
emax2    0.965 1.000    0.959    0.811   0.882
sigEmax1 0.863 0.959    1.000    0.836   0.879
sigEmax2 0.659 0.811    0.836    1.000   0.522
betaMod  0.884 0.882    0.879    0.522   1.000

Multiple Contrast Test:
         t-Stat   adj-p
emax2     3.427 < 0.001
emax1     3.318 0.00118
sigEmax1  3.166 0.00193
sigEmax2  3.055 0.00255
betaMod   2.907 0.00466

Power and sample size considerations

We can calculate the power under each of the candidate models from the top of this vignette. For example, we assume a Mods(emax = 0.25) and calculate the vector of mean responses lo on the logit scale. When we transform it back to probability scale p, we can calculate the approximate variance of the (logit-scale) estimator mu_hat with the formula \[ \mathrm{Var}(\hat\mu) = \frac{1}{np(1-p)} \] (see the section above). Next we calculate the minimum power across the candidate set using powMCT() and plot it for increasing n.

See also the vignette on sample size calculation.

## for simplicity: contrasts as discussed in the previous section
contMat <- optContr(mods, w=1)

## we need each alternative model as a separate object
alt_model_par <- list(emax = 0.25, emax = 1, sigEmax = c(1, 3),
                      sigEmax = c(2.5, 4), betaMod = c(1.1, 1.1))
alt_common_par <- list(placEff = logit(0.1), maxEff = logit(0.35)-logit(0.1),
                       doses = doses)
## this is a bit hackish because we need to pass named arguments to Mods()
alt_mods <- lapply(seq_along(alt_model_par), function(i) {
  do.call(Mods, append(alt_model_par[i], alt_common_par))
})

prop_true_var_mu_hat <- lapply(seq_along(alt_model_par), function(i) {
  ## mean responses on logit scale
  lo <- getResp(do.call(Mods, append(alt_model_par[i], alt_common_par)))
  p <- inv_logit(lo) # mean responses on probability scale
  v <- 1 / (p * (1-p)) # element-wise variance of mu_hat up to a factor of 1/n
  return(as.numeric(v)) # drop unnecessary attributes
})

min_power_at_group_size <- function(n) {
  pwr <- mapply(function(m, v) powMCT(contMat, alpha=0.025, altModels=m, S=diag(v/n), df=Inf),
                alt_mods, prop_true_var_mu_hat)
  return(min(pwr))
}

n <- seq(5, 80, by=5)
pwrs <- sapply(n, min_power_at_group_size)
qplot(n, pwrs, geom="line", ylab="Min. Power over candidate set")+
  scale_y_continuous(breaks = seq(0,1,by=0.1), limits = c(0,1))
Warning: `qplot()` was deprecated in ggplot2 3.4.0.
This warning is displayed once every 8 hours.
Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
generated.

References

Heinze, G., and Schemper, M. (2002), “A solution to the problem of separation in logistic regression,†Statistics in Medicine, 21, 2409–2419. https://doi.org/10.1002/sim.1047.
Pinheiro, J., Bornkamp, B., Glimm, E., and Bretz, F. (2014), “Model-based dose finding under model uncertainty using general parametric models,†Statistics in Medicine, 33, 1646–1661. https://doi.org/10.1002/sim.6052.
DoseFinding/inst/doc/binary_data.Rmd0000644000176200001440000003141414762603270017120 0ustar liggesusers--- title: "Binary Data MCP-Mod" output: rmarkdown::html_vignette bibliography: refs.bib link-citations: yes csl: american-statistical-association.csl vignette: > %\VignetteIndexEntry{Design and analysis template MCP-Mod for binary data} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, child = "children/settings.txt"} ``` In this vignette we illustrate how to use the DoseFinding package with binary observations by fitting a first-stage GLM and applying the generalized MCP-Mod methodology to the resulting estimates. We also show how to deal with covariates. For continuously distributed data see [the corresponding vignette][v2]. [v2]: analysis_normal.html ## Background and data set Assume a dose-finding study is planned for an hypothetical investigational treatment in atopic dermatitis, for the binary endpoint Investigator's Global Assessment (IGA). The treatment is tested with doses 0, 0.5, 1.5, 2.5, 4. It is assumed the response rate for placebo will be around 10%, while the response rate for the top dose may be 35%. This is an example where the generalized MCP-Mod approach can be applied, i.e. dose-response testing and estimation will be performed on the logit scale. We generate some example data in the setting just described. The 10% placebo effect translates to -2.2 on the logit scale, and the asymptotic effect of 25 percentage points above placebo becomes `logit(0.35) - logit(0.1)`, approximately 1.6. ```{r, example_data} library(DoseFinding) library(ggplot2) logit <- function(p) log(p / (1 - p)) inv_logit <- function(y) 1 / (1 + exp(-y)) doses <- c(0, 0.5, 1.5, 2.5, 4) ## set seed and ensure reproducibility across R versions set.seed(1, kind = "Mersenne-Twister", sample.kind = "Rejection", normal.kind = "Inversion") group_size <- 100 dose_vector <- rep(doses, each = group_size) N <- length(dose_vector) ## generate covariates x1 <- rnorm(N, 0, 1) x2 <- factor(sample(c("A", "B"), N, replace = TRUE, prob = c(0.6, 0.4))) ## assume approximately logit(10%) placebo and logit(35%) asymptotic response with ED50=0.5 prob <- inv_logit(emax(dose_vector, -2.2, 1.6, 0.5) + 0.3 * x1 + 0.3 * (x2 == "B")) dat <- data.frame(y = rbinom(N, 1, prob), dose = dose_vector, x1 = x1, x2 = x2) ``` ## Candidate models We will use the following candidate set of models for the mean response on the logit scale: ```{r, setup, fig.width = 8, out.width = '100%'} mods <- Mods(emax = c(0.25, 1), sigEmax = rbind(c(1, 3), c(2.5, 4)), betaMod = c(1.1, 1.1), placEff = logit(0.1), maxEff = logit(0.35)-logit(0.1), doses = doses) plotMods(mods) ## plot candidate models on probability scale plotMods(mods, trafo = inv_logit) ``` ## Analysis without covariates First assume covariates had not been used in the analysis (not recommended in practice). Let $\mu_k$ denote the logit response probability at dose $k$, so that for patient $j$ in group $k$ we have \[ \begin{aligned} Y_{kj} &\sim \mathrm{Bernoulli}(p_{kj}) \\ \mathrm{logit}(p_{kj}) &= \mu_{k} \end{aligned} \] We perform the MCP-Mod test on the logit scale estimates $\hat\mu=(\hat\mu_1,\dots,\hat\mu_K)$ and their estimated covariance matrix $\hat S$. We can extract both from the object returned by the `glm()` call. ```{r, test_no_covariates} fit_nocov <- glm(y~factor(dose) + 0, data = dat, family = binomial) mu_hat <- coef(fit_nocov) S_hat <- vcov(fit_nocov) MCTtest(doses, mu_hat, S = S_hat, models = mods, type = "general") ``` Dose-response modeling then can proceed with a combination of bootstrapping and model averaging. For detailed explanations refer to the [vignette for analysis of continuous data][v2]. Fitting is done on the logit scale, for plotting transfer the fit back to the probability scale. ```{r, estimate_no_covariates} fit_mod_av <- maFitMod(doses, mu_hat, S = S_hat, models = c("emax", "sigEmax", "betaMod")) plot(fit_mod_av, plotData = "meansCI", title = "Bootstrap estimates for population response probability", trafo = function(x) 1/(1+exp(-x))) ``` ## Analysis with covariates In many situations there are important prognostic covariates (main effects) to adjust for in the analysis. Denote the vector of these additional covariates for patient $j$ with $x_{kj}$. \[ \begin{aligned} Y_{kj} &\sim \mathrm{Bernoulli}(p_{kj}) \\ \mathrm{logit}(p_{kj}) &= \mu_k^d + x_{kj}^T\beta \end{aligned} \] Fitting this model gives us estimated coefficients $\hat\mu=(\hat\mu^d, \hat\beta)$ and an estimate $\hat S$ of the covariance matrix of the estimator $\hat\mu$. In principle we could perform testing and estimation based on $\hat\mu^d$ and the corresponding sub-matrix of $\hat S$, but this would produce estimates for a patient with covariate vector $\beta=0$, and not reflect the overall population. To produce adjusted estimates per dose and to accommodate potential systematic differences in the covariates we predict the mean response probability at dose k for all observed values of the covariates and transform back to logit scale: \[ \mu^*_k := \mathrm{logit}\biggl(\frac{1}{n} \sum_{i=1}^n \mathrm{logit}^{-1}(\hat\mu^d_k + x_{i}^T\hat\beta)\biggr) \] Note here we index $x$ with $i$ that runs from 1 to $n$ (all patients randomized in the study). To obtain a variance estimate for $\mu^*$ we repeat this with draws from $\mathrm{MultivariateNormal}(\hat\mu, \hat S)$ and calculate the empirical covariance matrix $S^*$ of theses draws. Then we use $\mu^*$ and $S^*$ in `MCTtest()`. ```{r, test_covariates} fit_cov <- glm(y~factor(dose) + 0 + x1 + x2, data = dat, family = binomial) covariate_adjusted_estimates <- function(mu_hat, S_hat, formula_rhs, doses, other_covariates, n_sim) { ## predict every patient under *every* dose oc_rep <- as.data.frame(lapply(other_covariates, function(col) rep(col, times = length(doses)))) d_rep <- rep(doses, each = nrow(other_covariates)) pdat <- cbind(oc_rep, dose = d_rep) X <- model.matrix(formula_rhs, pdat) ## average on probability scale then backtransform to logit scale mu_star <- logit(tapply(inv_logit(X %*% mu_hat), pdat$dose, mean)) ## estimate covariance matrix of mu_star pred <- replicate(n_sim, logit(tapply(inv_logit(X %*% drop(mvtnorm::rmvnorm(1, mu_hat, S_hat))), pdat$dose, mean))) return(list(mu_star = as.numeric(mu_star), S_star = cov(t(pred)))) } ca <- covariate_adjusted_estimates(coef(fit_cov), vcov(fit_cov), ~factor(dose)+0+x1+x2, doses, dat[, c("x1", "x2")], 1000) MCTtest(doses, ca$mu_star, S = ca$S_star, type = "general", models = mods) ``` In the case at hand the results here are not dramatically different. Adjusting for covariates gives slightly lower variance estimates. ```{r, compare} ggplot(data.frame(dose = rep(doses, 4), est = c(inv_logit(mu_hat), diag(S_hat), inv_logit(ca$mu_star), diag(ca$S_star)), name = rep(rep(c("mean", "var"), each = length(doses)), times = 2), a = rep(c(FALSE, TRUE), each = 2*length(doses)))) + geom_point(aes(dose, est, color = a)) + scale_color_discrete(name = "adjusted") + facet_wrap(vars(name), scales = "free_y") + ylab("") ``` Dose-response modelling proceeds in the same way as before, but now on the adjusted estimates. ```{r, estimate_covariates} fit_cov_adj <- maFitMod(doses, ca$mu_star, S = ca$S_star, models = c("emax", "sigEmax", "betaMod")) # plotting on probability scale, need to transform predictions on logit scale plot(fit_cov_adj, plotData = "meansCI", title = "Bootstrap estimates for population response probability", trafo = function(x) 1/(1+exp(-x))) ``` ## Avoiding problems with complete seperation and 0 responders In a number of situations it makes sense to replace ML estimation for logistic regression via `glm(..., family=binomial)`, with the Firth logistic regression [see @heinze2002], implemented as the `logistf` function from the `logistf` package. This is particularly important for small sample size per dose and if small number of responses are expected on some treatment arms. The estimator of Firth regression corresponds to the posterior mode in a Bayesian logistic regression model with Jeffrey's prior on the parameter vector. This estimator is well defined even in situations where the ML estimate for logistic regression does not exist (e.g. for complete separation). ## Considerations around optimal contrasts at design stage and analysis stage The formula for the optimal contrasts is given by \[ c^{\textrm{opt}} \propto S^{-1}\biggl(\mu^0_m - \frac{(\mu^0_m)^T S^{-1}1_K}{1_K^T S^{-1} 1_K}\biggr) \] where $\mu^0_m$ is the standardized mean response, $K$ is the number doses, and $1_K$ is an all-ones vector of length $K$ and $S$ is the covariance matrix of the estimates at the doses [see @pinheiro2014]. For calculating the optimal contrast for the generalized MCP step the covariance matrix $S$ of the estimator $\hat\mu$ can be re-estimated once the trial data are available. With normally distributed data this is possible with decent accuracy even at rather low sample sizes. In the case of binary data, $\hat\mu$ is on the logit scale and the diagonal elements of $S$ are approximately $(np(1-p))^{-1}$, where $n$ is the sample size of the dose group. This can be derived using the delta method. An estimate of this variance depends on the observed response rate and can thus be quite variable in particular for small sample sizes per group (e.g. smaller than 20). A crude alternative in these situations is to not use the estimated $S$ but a diagonal matrix with the inverse of the sample size per dose on the diagonal in the formula for calculation of the optimal contrast. The contrast calculated this way will asymptotically not be equal to the "optimal" contrast for the underlying model, but simulations show that they can be closer to the "true" optimal contrast (calculated based on the true variance per dose group) for small sample size, compared to the contrast calculated based on the estimated variance. To re-run the adjusted analysis above for the contrasts, calculated as outlined above, we need to calculate and hand-over the contrast matrix manually via `contMat` in the `MCTtest()` function. In our case (with 100 patients per group) we obtain a result that is only slightly different. ```{r} ## here we have balanced sample sizes across groups, so we select w = 1 ## otherwise would select w proportional to group sample sizes optCont <- optContr(mods, doses, w = 1) MCTtest(doses, ca$mu_star, S = ca$S_star, type = "general", contMat = optCont) ``` ## Power and sample size considerations We can calculate the power under each of the candidate models from the top of this vignette. For example, we assume a `Mods(emax = 0.25)` and calculate the vector of mean responses `lo` on the logit scale. When we transform it back to probability scale `p`, we can calculate the approximate variance of the (logit-scale) estimator `mu_hat` with the formula \[ \mathrm{Var}(\hat\mu) = \frac{1}{np(1-p)} \] (see the section above). Next we calculate the minimum power across the candidate set using `powMCT()` and plot it for increasing `n`. See also the [vignette on sample size calculation](sample_size.html). ```{r, sample_size} ## for simplicity: contrasts as discussed in the previous section contMat <- optContr(mods, w=1) ## we need each alternative model as a separate object alt_model_par <- list(emax = 0.25, emax = 1, sigEmax = c(1, 3), sigEmax = c(2.5, 4), betaMod = c(1.1, 1.1)) alt_common_par <- list(placEff = logit(0.1), maxEff = logit(0.35)-logit(0.1), doses = doses) ## this is a bit hackish because we need to pass named arguments to Mods() alt_mods <- lapply(seq_along(alt_model_par), function(i) { do.call(Mods, append(alt_model_par[i], alt_common_par)) }) prop_true_var_mu_hat <- lapply(seq_along(alt_model_par), function(i) { ## mean responses on logit scale lo <- getResp(do.call(Mods, append(alt_model_par[i], alt_common_par))) p <- inv_logit(lo) # mean responses on probability scale v <- 1 / (p * (1-p)) # element-wise variance of mu_hat up to a factor of 1/n return(as.numeric(v)) # drop unnecessary attributes }) min_power_at_group_size <- function(n) { pwr <- mapply(function(m, v) powMCT(contMat, alpha=0.025, altModels=m, S=diag(v/n), df=Inf), alt_mods, prop_true_var_mu_hat) return(min(pwr)) } n <- seq(5, 80, by=5) pwrs <- sapply(n, min_power_at_group_size) qplot(n, pwrs, geom="line", ylab="Min. Power over candidate set")+ scale_y_continuous(breaks = seq(0,1,by=0.1), limits = c(0,1)) ``` ## References DoseFinding/inst/doc/sample_size.R0000644000176200001440000001302214764013014016621 0ustar liggesusers## ----settings-knitr, include=FALSE-------------------------------------------- library(ggplot2) knitr::opts_chunk$set(echo = TRUE, message = FALSE, cache = FALSE, comment = NA, dev = "png", dpi = 150, fig.asp = 0.618, fig.width = 7, out.width = "85%", fig.align = "center") options(rmarkdown.html_vignette.check_title = FALSE) theme_set(theme_bw()) ## ----setup, fig.asp = 1, out.width = "50%", fig.width = 5--------------------- library(DoseFinding) library(ggplot2) doses <- c(0, 12.5, 25, 50, 100) guess <- list(emax = c(2.6, 12.5), sigEmax = c(30.5, 3.5), quadratic = -0.00776) mods <- do.call(Mods, append(guess, list(placEff = 1.25, maxEff = 0.15, doses = doses))) plotMods(mods) ## ----power_sample_size_1------------------------------------------------------ contMat <- optContr(mods, w=1) pows <- powN(upperN = 100, lowerN = 10, step = 10, contMat = contMat, sigma = 0.34, altModels = mods, alpha = 0.05, alRatio = rep(1, 5)) plot(pows) ## ----power_sample_size_2------------------------------------------------------ sampSizeMCT(upperN = 150, contMat = contMat, sigma = 0.34, altModels = mods, power = 0.9, alRatio = rep(1, 5), alpha = 0.05, sumFct = min) ## ----power_effect_size-------------------------------------------------------- plot_power_vs_treatment_effect <- function(guess, doses, group_size, placEff, maxEffs, sigma_low, sigma_mid, sigma_high, alpha) { mods_args_fixed <- append(guess, list(placEff = placEff, doses = doses)) grd <- expand.grid(max_eff = maxEffs, sigma = c(sigma_low, sigma_mid, sigma_high)) min_power <- mean_power <- NA for (i in 1:nrow(grd)) { mods <- do.call(Mods, append(mods_args_fixed, list(maxEff = grd$max_eff[i]))) p <- powMCT(optContr(mods, w = 1), alpha, mods, group_size, grd$sigma[i]) min_power[i] <- min(p) mean_power[i] <- mean(p) } grd$sigma <- factor(grd$sigma) pdat <- cbind(grd, power = c(min_power, mean_power), sumFct = rep(factor(1:2, labels = c("min", "mean")), each = nrow(grd))) subt <- sprintf("group size = %d, α = %.3f", group_size, alpha) gg <- ggplot(pdat) + geom_line(aes(max_eff, power, lty = sigma)) + facet_wrap(~sumFct, labeller = label_both)+ xlab("maximum treatment effect") + ylab("power") + labs(title = "Minimum power vs effect size for different residual standard deviations", subtitle = subt) + theme(legend.position = "bottom") + scale_y_continuous(limits = c(0,1), breaks = seq(0,1,by=.1)) return(gg) } plot_power_vs_treatment_effect(guess, doses, group_size = 90, placEff = 1.25, maxEffs = seq(0.01, 0.3, length.out = 15), sigma_low = 0.3, sigma_mid = 0.34, sigma_high = 0.4, alpha = 0.05) ## ----power_miss_1------------------------------------------------------------- guess_miss <- list(exponential = guesst(50, 0.2, "exponential", Maxd = max(doses))) mods_miss <- do.call(Mods, c(guess, guess_miss, list(placEff = 1.25, maxEff = 0.15, doses = doses))) plot(mods_miss, superpose = TRUE) ## ----power_miss_2------------------------------------------------------------- plot_power_misspec <- function(guess, guess_miss, placEff, maxEff, doses, upperN, lowerN, step, sigma, alpha) { mods_extra_par <- list(placEff = placEff, maxEff = maxEff, doses = doses) pown_extra_par <- list(upperN = upperN, lowerN = lowerN, step = step, sigma = sigma, alpha = alpha, alRatio = rep(1, length(doses))) mods_miss <- do.call(Mods, c(guess_miss, mods_extra_par)) mods_ok <- do.call(Mods, c(guess, mods_extra_par)) cm_ok <- optContr(mods_ok, w = 1) p_miss <- do.call(powN, c(pown_extra_par, list(contMat = cm_ok, altModels = mods_miss))) p_ok <- do.call(powN, c(pown_extra_par, list(contMat = cm_ok, altModels = mods_ok))) pwr <- rbind(data.frame(n = as.numeric(rownames(p_ok)), p_ok[, c("min", "mean")], miss = FALSE), data.frame(n = as.numeric(rownames(p_miss)), p_miss[, c("min", "mean")], miss = TRUE)) gg <- ggplot(pwr, aes(group = miss, color = miss)) + geom_line(aes(n, min, linetype = "minimum")) + geom_line(aes(n, mean, linetype = "mean")) + scale_color_discrete(name = "miss-specified") + scale_linetype_discrete(name = "aggregation") + labs(title = "Mean and minimum power under mis-specification") + xlab("group size") + ylab("power") + scale_y_continuous(limits = c(0,1), breaks = seq(0,1,by=.1)) return(gg) } plot_power_misspec(guess, guess_miss, placEff = 1.25, maxEff = 0.15, doses = doses, upperN = 100, lowerN = 10, step = 10, sigma = 0.34, alpha = 0.05) ## ----tdci93, warning = FALSE-------------------------------------------------- set.seed(42) ## Note: Warnings related to vcov.DRMod can be ignored if small relative to the total number of simulations pm <- planMod("sigEmax", Mods(sigEmax=c(30.5, 3.5), placEff=1.25, maxEff=0.15, doses=doses), n=93, sigma = 0.34, doses=doses, simulation=TRUE, nSim=5000, showSimProgress = FALSE, bnds = defBnds(max(doses))) summary(pm, Delta=0.12) ## ----tdci1650----------------------------------------------------------------- pm <- planMod("sigEmax", Mods(sigEmax=c(30.5, 3.5), placEff=1.25, maxEff=0.15, doses=doses), n=1650, sigma = 0.34, doses=doses, simulation=TRUE, nSim=5000, showSimProgress = FALSE, bnds = defBnds(max(doses))) summary(pm, Delta=0.12) DoseFinding/inst/doc/analysis_normal.Rmd0000644000176200001440000003017014762603270020034 0ustar liggesusers--- title: "Continuous data MCP-Mod" output: rmarkdown::html_vignette bibliography: refs.bib csl: american-statistical-association.csl link-citations: yes vignette: > %\VignetteIndexEntry{Analysis template MCP-Mod for continuous data} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, child="children/settings.txt"} ``` ## Background and Data In this vignette we will illustrate the usage of the DoseFinding package for analyzing continuously distributed data. There is a separate vignette with details on [sample size and power calculation](sample_size.html). We will use data from @verkindre2010, who actually use a cross-over design and utilize MCP-Mod in a supportive analysis. More information can be found at the corresponding [clinicaltrials.gov page](https://www.clinicaltrials.gov/study/NCT00501852) and on the R help page `?glycobrom`. The main purpose @verkindre2010 was to provide safety and efficacy data on Glycopyrronium Bromide (NVA237) in patients with stable Chronic Obstructive Pulmonary Disease ([COPD](https://en.wikipedia.org/wiki/Chronic_obstructive_pulmonary_disease)). The primary endpoint in this study was the mean of two measurements of forced expiratory volume in 1 second ([FEV1](https://en.wikipedia.org/wiki/FEV1#Forced_expiratory_volume_in_1_second_(FEV1))) at 23h 15min and 23h 45min post dosing, following 7 days of treatment. In order to keep this exposition simple, we will ignore the active control and focus on the placebo group and the four dose groups (12.5, 25, 50, and 100μg). For the purpose here, we recreate a dataset that mimicks a parallel group design, based on the published summary statistics. These can be found in the `glycobrom` dataset coming with the `DoseFinding` package. Here `fev1` and `sdev` contain the mean and standard deviation of the mean (standard error) of the primary endpoint for each group, while `n` denotes the number of participants. ```{r, load_data} library(DoseFinding) data(glycobrom) print(glycobrom) ``` We want to create a dataset with 60 participants in each of the five groups. Noticing that the standard errors are essentially equal across all groups, we draw five vectors of measurement errors centered at `0` with identical variances `60 * 0.015^2` which we add to the observed means. Note that here we use `MASS::mvrnorm` instead of `rnorm` because it lets us generate random numbers with the specified _sample_ mean and sd. ```{r, simulate_dataset} set.seed(1, kind = "Mersenne-Twister", sample.kind = "Rejection", normal.kind = "Inversion") rand <- rep(MASS::mvrnorm(60, 0, 60 * 0.015^2, empirical = TRUE), 5) NVA <- data.frame(dose = rep(glycobrom$dose, each = 60), FEV1 = rep(glycobrom$fev1, each = 60) + rand) ggplot(NVA) + geom_jitter(aes(dose, FEV1), height = 0, width = 4) + labs(title = "Simulated FEV1 by dose (jittered horizontally)") + xlab("dose [μg]") + ylab("FEV1 [l]") ``` ## Design stage Now let's forget we already saw the data and imagine we had to design this trial with MCP-Mod. First we decide that we want to include two Emax models, one sigmoid Emax model and one quadratic model in the analysis (see `?drmodels` for other choices). While the (sigmoid) Emax type covers monotonic dose-response-relationships, the quadratic model is there to accommodate a potentially decreasing effect at high doses. Next we have to supply guesstimates for the nonlinear parameters: - ED50 for an Emax model - ED50 and the Hill parameter h for a sigmoid emax model - coefficient ratio $\delta = \beta_2/\lvert\beta_1\rvert$ in the quadratic model $f(d, \theta) = E_0 + \beta_1 d + \beta_2 d^2$ The following choices cover a range of plausible relationships: - ED50 = 2.6 and ED25 = 12.5 for the Emax models (all doses have substantive effects) - ED50 = 30.5 and h = 3.5 for the sigEmax model (first dose has a negligible effect) - delta = -0.00776 for the quadratic model (downturn for the fourth dose) We also fix the effect of placebo at an FEV1 of `1.25` liters and the maximum effect at `0.15` liters above placebo. This implicitly sets the common linear parameters of all the models. Note the syntax of the arguments to the `Mods` function: `emax = c(2.6, 12.5)` specifies *two* Emax models, but `sigEmax = c(30.5, 3.5)` only specifies *one* Sigmoid Emax model. ```{r, models} doses <- c(0, 12.5, 25, 50, 100) mods <- Mods(emax = c(2.6, 12.5), sigEmax = c(30.5, 3.5), quadratic = -0.00776, placEff = 1.25, maxEff = 0.15, doses = doses) ``` It's always a good idea to perform a visual sanity check of the functional relationships implied by the guesstimates. ```{r, plot_models} plotMods(mods, ylab = "FEV1") ``` This concludes the design phase. We can also take a look at the calculated optimal contrasts. Each contrast has maximum power to detect a non-flat effect profile in the hypothetical world where the particular guesstimate is actually the true value. ```{r, contrasts} optC <- optContr(mods, w=1) print(optC) plot(optC) ``` It can be seen that in the balanced sample size case and equal variance assumed for each dose group, the optimal contrasts reflect the underlying assumed mean dose-response shape. This is no surprise, given that the optimal contrasts are given by \[ c^{\textrm{opt}} \propto S^{-1}\biggl(\mu^0_m - \frac{(\mu^0_m)^T S^{-1}1_K}{1_K^T S^{-1} 1_K}\biggr) \] where $\mu^0_m$ is the standardized mean response, $K$ is the number doses, and $1_K$ is an all-ones vector of length $K$ and $S$ is the covariance matrix of the estimates at the doses [see @pinheiro2014 for a detailed account]. As we have equal variance in all dose groups in our case and no correlation, the optimal contrasts are all proportional to the shapes of the candidate model mean vectors. As the standardized model is used in the formula, the values of the linear parameters of the models do not impact the optimal contrasts. ## Analysis stage Now fast-forward to the time when we have collected the data. ### Multiple comparisons We run the multiple contrast test with the pre-specified models. Note that the `type` parameter defaults to `type="normal"`, which means that we assume a homoscedastic ANOVA model for `FEV1`, i.e. critical values are taken from a multivariate t distribution. Further note that when `data` is supplied, the first two arguments `dose` and `FEV1` are _not evaluated_, but symbolically refer to the columns in `data=NVA`. ```{r, mctest_normal} test_normal <- MCTtest(dose = dose, resp = FEV1, models = mods, data = NVA) print(test_normal) ``` The test results suggest a clear dose-response trend. Alternatively we can use generalized MCP-Mod (see the FAQ for the [difference](faq.html)). We use R's builtin `lm()` function to manually fit the ANOVA model and extract estimates for the model coefficients and their covariance matrix. We also need the model degrees of freedom. ```{r, fit_lm_1} fitlm <- lm(FEV1 ~ factor(dose) - 1, data = NVA) mu_hat <- coef(fitlm) S_hat <- vcov(fitlm) anova_df <- fitlm$df.residual ``` Next we supply them to the `MCTtest` function together with `type="general"`. Note that in contrast to the invocation above we here supply the `doses` and the estimates `mu_hat` and `S_hat` directly and not within a `data.frame`. ```{r, mctest_generalizes} test_general <- MCTtest(dose = doses, resp = mu_hat, S = S_hat, df = anova_df, models = mods, type = "general") print(test_general) ``` For the simple ANOVA case at hand the results of the original and the generalized MCP-Mod approaches actually coincide. The p-values differ due to the numerical methods used for obtaining them. ```{r, compare_normal_generalized} cbind(normal = test_normal$tStat, generalized = test_general$tStat) cbind(normal = attr(test_normal$tStat, "pVal"), generalized = attr(test_general$tStat, "pVal")) ``` ## Dose-response estimation In the simplest case we would now proceed to fit only a single model type, for example the one with the largest t-statistic (or alternatively smallest AIC or BIC): ```{r, fit_single} fit_single <- fitMod(dose, FEV1, NVA, model = "emax") plot(fit_single) ``` But actually we want to use a more robust approach that combines bootstrapping with model averaging in the generalized MCP-Mod framework. First we draw bootstrap samples from the multivariate normal distribution of the estimates originating from the first-stage model. Next, for each bootstrapped data set we fit our candidate models, select the one with lowest AIC and save the corresponding estimated quantities of interest. This selection step implies that the bootstrap samples potentially come from different models. Finally we use these bootstrapped estimates for inference. For example, we can estimate a dose-response curve by using the median over the bootstrapped means at each dose. Similarly we can derive confidence intervals based on bootstrap quantiles. Inference for other quantities of interest can be performed in an analogous way. As different models contribute to the bootstrap resamples, the approach can be considered more robust than simple model selection [see also @schorning2016 for simulations on this topic]. Now let's apply this general idea to the case at hand. Our first-stage model is an ANOVA, and we're interested in an estimate of the dose-response curve plus confidence intervals. Our set of candidate model types consists of Emax, sigEmax and quadratic. We us R's builtin `lm()` function to fit an ANOVA model without intercept and extract estimates for the model coefficients and their covariance matrix. ```{r, fit_lm_2} fitlm <- lm(FEV1 ~ factor(dose) - 1, data = NVA) dose <- unique(NVA$dose) mu_hat <- coef(fitlm) S_hat <- vcov(fitlm) ``` The bootstrap procedure described above is implemented in the `maFitMod` function. Note that for technical reasons we have to supply boundaries to the fitting algorithm via the `bnds` argument to `maFitMod` (see `?fitMod` and `?defBnds` for details). ```{r, bootstrap_draw} fit_mod_av <- maFitMod(dose, mu_hat, S = S_hat, models = c("emax", "sigEmax", "quadratic")) ``` With the `predict` method we can obtain the predictions from the fitted model on each boostrap sample. The `plot` method allows to summarize the model fits (some limited customization is possible see `?plot.maFit`). ```{r, bootstrap_summarize} # point estimates (median) and bootstrap quantile intervals can be extracted via ma_pred <- predict(fit_mod_av, doseSeq = c(0, 12.5, 25, 50, 100)) # individual bootstrap estimates via indiv_pred <- predict(fit_mod_av, doseSeq = c(0, 12.5, 25, 50, 100), summaryFct = NULL) # plotting can be done via plot(fit_mod_av, plotData = "meansCI", ylab = "Model averaging estimate with 95% CI") ``` ## How to adjust for covariates? In all practical situations covariates will be used to adjust for in the analysis. The MCP step can then be performed for example by including the covariates in the `addCovars` argument. Another approach to perform the MCP step is based on the differences to placebo: In a first stage `lm(.)` is fit _with_ an intercept included. Then the treatment differences and corresponding covariance matrix would be extracted. This could then be fed into the `MCTtest` function, with the `placAdj = TRUE` argument, see `?MCTtest` for an example. Both approaches will give the same result. A third alternative is to calculate the adjusted means (and corresponding covariance matrix) and then perform generalized MCP-Mod based on these estimates (following the same steps as in the unadjusted analysis above, but adding the `type = "general"` argument as well as the estimated covariance matrix via `S`). The procedure is very similar to the situation explained in detail in the vignette for the [analysis of binary data](binary_data.html), so not repeated here. For the case of normally distributed data adjusted means are calculated by predicting the outcome (using the covariate adjusted model) of each patient in the study under every dose, and then averaging over all patients per dose. ## References DoseFinding/inst/doc/mult_regimen.html0000644000176200001440000044005614764012716017563 0ustar liggesusers Multiple Regimen MCP-Mod

Multiple Regimen MCP-Mod

Background

Often more than one regimen is studied in dose-finding studies. If there are enough doses within each regimen, one may still utilize MCP-Mod. But specific assumptions are needed, and it depends on the situation, whether or not these are appropriate (and thus usage of MCP-Mod).

The first idea is to bring the doses for each regimen on a common scale (total dose per time unit). For example if once daily (od) dosing and twice daily (bid) dosing are used in a study, one might utilize the total daily dose.

It is usually not appropriate to then perform MCP-Mod on the total daily dose (ignoring from which regimen the doses originate): The study investigated more than one regimen, so assessing the difference between regimen (for example for the same total daily dose) is of interest. This would not be possible with a modelling approach that ignores the regimen.

The most general approach would be to perform MCP-Mod separately by regimen, and for example to adjust p-values originating from the MCP-part using a Bonferroni correction. This approach assumes that the regimen don’t share any similarity. Due to the double-blind nature of trials, all patients would receive two administrations per day (patients in the od group receive one placebo per day), so that there is no real od group and in particular no separate placebo od group. So it often makes more sense to assume that the placebo group is common to both the od and bid dose-response curve. For the MCP-step contrasts for both od and bid are taken with respect to the same placebo group and in the modelling step one would assume the intercept to be the same across regimen, but all other parameters separate.

One could also assume further parameters to be common across regimen (for example the Emax or the ED50 parameter for the Emax model), but in the following example no such assumption is made.

The motivation for the simulated data below is taken from a recently completed dose-finding study, where the dose-response of the drug Licogliflozin was assessed for the od and bid regimen (Bays et al. 2020), see also the corresponding page at clinicaltrials.gov.

Note that this study used MCP-Mod, but the analysis presented here has been modified and simplified (in terms of candidate models and dose-response modelling strategy).

For most of the following code it is useful to structure the first-stage estimates like this: \[ \hat\mu=(\hat\mu_{\mathrm{placebo}}, \hat\mu_{\mathrm{od}}, \hat\mu_{\mathrm{bid}}) \] The length of the sub-vectors \(\hat\mu_{\mathrm{od}}\) and \(\hat\mu_{\mathrm{bid}}\) correspond to the number of different doses in the two regimens. They can be different, but in our example both have 4 elements.

Also as discussed above everything is modeled on the total daily dose scale.

library(DoseFinding)
library(ggplot2)
## collect estimates and dosage information in one place
example_estimates <- function() {
  ## ANOVA mean estimates and ci bounds extracted from fig. 3 of Bays (2020).
  ## clinicaltrials.gov page already seems to contain values from the dose-response model fit
  mn <- c(-0.55, -1.78, -1.95, -3.29, -4.43, -1.14, -2.74, -4.03, -4.47)
  lb <- c(-1.56, -3.15, -3.36, -4.85, -5.40, -2.49, -4.10, -5.50, -5.50)
  ub <- c( 0.40, -0.30, -0.54, -1.76, -3.48, 0.24, -1.38, -2.65, -3.44)
  se <- (ub - lb)/(2*qnorm(0.975)) # approximate standard error
  return(list(mu_hat = mn,
              daily_dose = c(0, 2.5, 10, 50, 150, 5, 10, 50, 100),
              S_hat = diag(se^2),
              # keep track of which elements correspond to which regimen:
              index = list(placebo = 1, od = 2:5, bid = 6:9)))
}

## restructure estimates for easy plotting with ggplot
tidy_estimates <- function(est) {
  se <- sqrt(diag(est$S_hat))
  tidy <- data.frame(daily_dose = est$daily_dose, mu_hat = est$mu_hat,
                     ub = est$mu_hat + qnorm(0.975) * se, lb = est$mu_hat - qnorm(0.975) * se)
  tidy <- rbind(tidy[1, ], tidy) # duplicate placebo
  tidy$regimen <- c("od", "bid", rep("od", length(est$index$od)), rep("bid", length(est$index$bid)))
  return(tidy)
}

plot_estimates <- function(est) {
  df <- tidy_estimates(est)
  ggplot(df, aes(daily_dose, mu_hat)) + geom_point() +
    geom_errorbar(aes(ymin = lb, ymax = ub)) +
    facet_wrap(vars(regimen), labeller = label_both) +
    xlab("daily dose") + ylab("percent body weight cange") +
    labs(title = "ANOVA estimates with 95% confindence intervals")
}

est <- example_estimates()
plot_estimates(est)

Candidate models

Even though not necessary and not always desired we will use the same candidate models for both regimen here.

mods <- list(
  od = Mods(emax = c(5, 50),
            sigEmax = rbind(c(75, 3.5), c(25, 0.7)),
            maxEff = -1,
            doses = est$daily_dose[c(est$index$placebo, est$index$od)]),
  bid = Mods(emax = c(5, 50),
             sigEmax = rbind(c(75, 3.5), c(25, 0.7)),
             maxEff = -1,
             doses=est$daily_dose[c(est$index$placebo, est$index$bid)]))

plotMods(mods$od, superpose = TRUE, xlab = "daily dose")

plotMods(mods$bid, superpose = TRUE, xlab = "daily dose")

Multiple contrast test

The matrix of contrasts is built up from a separate matrix for each regimen. We stick them together in such a way that we compare \(\hat\mu_{\mathrm{od}}\) and \(\hat\mu_{\mathrm{bid}}\) with the common placebo response estimate \(\hat\mu_{\mathrm{placebo}}\).

calculate_contrasts <- function(est, mods) {
  S_hat <- est$S_hat
  i <- est$index
  cm_od <- optContr(mods$od, S=S_hat[c(i$placebo, i$od), c(i$placebo, i$od)])$contMat
  cm_bid <- optContr(mods$bid, S=S_hat[c(i$placebo, i$bid), c(i$placebo, i$bid)])$contMat
  colnames(cm_od) <- paste0("od_", colnames(cm_od))
  rownames(cm_od)[-1] <- paste0("od_", rownames(cm_od)[-1])
  colnames(cm_bid) <- paste0("bid_", colnames(cm_bid))
  rownames(cm_bid)[-1] <- paste0("bid_", rownames(cm_bid)[-1])
  # now build a block matrix (contrasts in columns) like this:
  # [ row of placebo coefficients od   | row of placebo coefficients bid   ]
  # [----------------------------------+-----------------------------------]
  # [ remaining doses' coefficents od  | fill with all zeros               ]
  # [----------------------------------+-----------------------------------]
  # [ fill with all zeros              | remaining doses' coefficients bid ]
  cm_full <- rbind(
    "0"=c(cm_od[1,],                                cm_bid[1,]                              ),
    cbind(cm_od[-1,],                               matrix(0, nrow(cm_od) - 1, ncol(cm_bid))),
    cbind(matrix(0, nrow(cm_bid) - 1, ncol(cm_od)), cm_bid[-1, ]                            ))
  return(cm_full)
}

cont_mat <- calculate_contrasts(est, mods)
print(round(cont_mat, 2))
        od_emax1 od_emax2 od_sigEmax1 od_sigEmax2 bid_emax1 bid_emax2
0           0.75     0.56        0.41        0.66      0.81      0.60
od_2.5      0.14     0.22        0.19        0.18      0.00      0.00
od_10      -0.08     0.13        0.20        0.03      0.00      0.00
od_50      -0.20    -0.13        0.06       -0.16      0.00      0.00
od_150     -0.61    -0.78       -0.87       -0.71      0.00      0.00
bid_5       0.00     0.00        0.00        0.00      0.04      0.21
bid_10      0.00     0.00        0.00        0.00     -0.08      0.13
bid_50      0.00     0.00        0.00        0.00     -0.24     -0.21
bid_100     0.00     0.00        0.00        0.00     -0.52     -0.73
        bid_sigEmax1 bid_sigEmax2
0               0.41         0.72
od_2.5          0.00         0.00
od_10           0.00         0.00
od_50           0.00         0.00
od_150          0.00         0.00
bid_5           0.21         0.12
bid_10          0.21         0.02
bid_50          0.02        -0.23
bid_100        -0.86        -0.64

We also need to calculate the test statistics by hand.

mct_test <- function(cont_mat, est) {
  cont_cov <- t(cont_mat) %*% est$S_hat %*% cont_mat
  t_stat <- drop(est$mu_hat %*% cont_mat) / sqrt(diag(cont_cov))
  # FIXME: calling non-exported function
  p <- MCTpval(contMat = cont_mat, corMat = cov2cor(cont_cov),
               df=Inf, tStat=t_stat, alternative = "one.sided")
  ord <- rev(order(t_stat))
  return(data.frame(tStat = t_stat[ord], pVals = p[ord]))
}
mct_test(cont_mat, est)
                tStat        pVals
bid_sigEmax2 6.027666 1.656982e-09
bid_emax2    5.916858 3.407547e-09
bid_emax1    5.832739 6.095019e-09
od_sigEmax2  5.710927 2.000246e-08
od_emax2     5.640589 1.967013e-08
od_emax1     5.504042 6.639540e-08
od_sigEmax1  5.200171 1.075474e-06
bid_sigEmax1 5.006107 6.517094e-07

A clear dose-response trend can be established for both regimen.

Dose-response modelling

Dose-response estimation needs a handful of auxiliary functions. The model for \(\hat\mu\) has a common intercept parameter for both regimen together and two sets of the remaining parameters of the family in question. For example, a model based on the Emax family has 5 parameters: one common e0, (eMax, ed50) for the od regimen, and (eMax, ed50) for the bid regimen.

The following function calculates the responses given dose values and a model family.

## calculate response under `model` for od/bid with common e0, but separate remaining parameters
## arguments:
## - model: as a string like "emax",
## - i_par: list of vectors named "placebo", "od", "bid", used for indexing `par`
## - par: numeric, model parameter structured as c(e0, pars_od, pars_bid)
## returns: response at placebo, dose_od, dose_bid (in this order)
eval_model_shared_e0 <- function(model, dose_od, dose_bid, par, i_par) {
  resp_placebo <- par[1] # e0
  resp_od <- do.call(model, append(list(dose_od, par[1]), as.list(par[i_par$od])))
  resp_bid <- do.call(model, append(list(dose_bid, par[1]), as.list(par[i_par$bid])))
  resp <- c(resp_placebo, resp_od, resp_bid)
  return(resp)
}

Next, we need to be able to fit a model family to the observed \(\hat\mu\). For this we employ the usual generalized MCP-Mod approach, i.e. generalized least squares with the estimated covariance matrix \(\hat S\) (Pinheiro et al. 2014).

## find sensible starting values for `fit_model_shared_e0` by fitting separate models,
## index:  list of vectors named "placebo", "od", "bid", used for indexing `dose`
## bounds: passed through to `fitMod`
calc_start_values <- function(model, full_mu, full_S, dose, index, bounds) {
  separate_coefs <- sapply(c("od", "bid"), function(regimen) {
    inds <- c(index$placebo, index[[regimen]])
    coef(fitMod(dose[inds], full_mu[inds], S = full_S[inds, inds],
                type = "general",  model = model, bnds = bounds))[-1] # drop e0 estimate
  })
  ## remove names to prevent error in do.call() in eval_model_shared_e0;
  ## od, bid coefs are in 1st / second column
  start <- c(full_mu[1], as.numeric(separate_coefs), use.names=FALSE)
  return(start)
}

## fits 'model' to mu_hat with GLS (using S_hat_inv as weight matrix), using a common e0 for od and bid regimens.
## i_reg:  list of vectors named "placebo", "od", "bid", used for indexing `dose`
## i_par: passed through to `eval_model_shared_e0`
## dose: numeric with doses for placebo, od, bid
## lower, upper, start: control parameters fro `nlminb`
fit_model_shared_e0 <- function(model, dose, mu_hat, S_hat_inv, lower, upper, start, i_reg, i_par) {
  opt_fun <- function(par) { # make use of lexical scope
    resp <- eval_model_shared_e0(model, dose[i_reg$od], dose[i_reg$bid], par, i_par)
    delta <- resp - mu_hat
    return(drop(t(delta) %*% S_hat_inv %*% delta))
  }
  fit <- nlminb(start, opt_fun, lower = lower, upper = upper)
  return(fit)
}

Finally, instead of only fitting a single model, we use the same bootstrap-plus-averaging approach that is detailed in the vignette for analysis of continuous data.

## predict population response in each regimen for dose_seq_*
## note: both dose_seq_* vectors should contain a 0 if response at placebo is of interest
one_bootstrap_sample <- function(est, dose_seq_od, dose_seq_bid) {
  mu_new <- drop(mvtnorm::rmvnorm(1, est$mu_hat, est$S_hat))
  mod_info <- list(list(name = "emax", bounds = rbind(c(0.15, 225)),
                        i_par = list(od = 2:3, bid = 4:5), n_par_gaic = 5),
                   list(name = "sigEmax", bounds = rbind(c(0.15, 225), c(0.5, 5)),
                        i_par = list(od = 2:4, bid = 5:7), n_par_gaic = 7))
  fit <- lapply(mod_info, function(m) {
    start <- calc_start_values(m$name, mu_new, est$S_hat, est$daily_dose, est$index, m$bounds)
    low <- c(-Inf, -Inf, m$bounds[,1]) # no bounds on e0, eMax
    up <- c(Inf, Inf, m$bounds[,2])
    fit_model_shared_e0(m$name, est$daily_dose, mu_new, solve(est$S_hat), lower = low,  upper = up,
                        start = start, i_reg = est$index, i_par = m$i_par)
  })
  ## calculate gAICs
  gaics <- sapply(fit, `[[`, "objective") + 2 * sapply(mod_info, `[[`, "n_par_gaic")
  sel <- which.min(gaics)
  mod <- mod_info[[sel]]
  ## drop the placebo element
  pred <- eval_model_shared_e0(mod$name, dose_seq_od, dose_seq_bid, fit[[sel]]$par, mod$i_par)[-1]
  return(pred)
}

summarize_bootstrap_samples <- function(samples, probs = c(0.025, 0.25, 0.75, 0.975)) {
  stopifnot(length(probs) == 4)
  med <- apply(samples, 1, median)
  quants <- apply(samples, 1, quantile, probs = probs)
  bs_df <- as.data.frame(cbind(med, t(quants)))
  names(bs_df) <- c("median", "low_out", "low_in", "high_in", "high_out")
  return(bs_df)
}

dose_seq_od <- seq(0, 150, length.out = 21) # do include placebo!
dose_seq_bid <- seq(0, 100, length.out = 21)
set.seed(1, kind = "Mersenne-Twister", sample.kind = "Rejection", normal.kind = "Inversion")
reps <- replicate(1000, one_bootstrap_sample(est, dose_seq_od, dose_seq_bid))
bs_sum <- summarize_bootstrap_samples(reps)
bs_sum$daily_dose <- c(dose_seq_od, dose_seq_bid)
bs_sum$regimen <- c(rep("od", length(dose_seq_od)), rep("bid", length(dose_seq_bid)))

ggplot(bs_sum) + geom_ribbon(aes(daily_dose, ymin=low_out, ymax=high_out), alpha = 0.2) +
  geom_ribbon(aes(daily_dose, ymin=low_in, ymax=high_in), alpha = 0.2) +
  geom_line(aes(daily_dose, median)) +
  geom_point(aes(daily_dose, mu_hat), tidy_estimates(est)) +
  facet_wrap(vars(regimen), labeller = label_both) +
  labs(title = "Bootstrap estimates for population response",
       subtitle = "Least squares estimates plus 50% and 95% confidence bands") +
  xlab("daily dose") + ylab("percent body weigh change") +
  coord_cartesian(ylim = c(-6, 0))

References

Bays, H. E., Kozlovski, P., Shao, Q., Proot, P., and Keefe, D. (2020), “Licogliflozin, a novel SGLT1 and 2 inhibitor: Body weight effects in a randomized trial in adults with overweight or obesity,†Obesity, 28, 870–881. https://doi.org/10.1002/oby.22764.
Pinheiro, J., Bornkamp, B., Glimm, E., and Bretz, F. (2014), “Model-based dose finding under model uncertainty using general parametric models,†Statistics in Medicine, 33, 1646–1661. https://doi.org/10.1002/sim.6052.
DoseFinding/inst/doc/faq.R0000644000176200001440000000014014764012637015064 0ustar liggesusers## h2 { ## font-size: 20px; ## line-height: 1.35; ## } ## #TOC { ## width: 100%; ## } DoseFinding/inst/doc/mult_regimen.Rmd0000644000176200001440000003330414654153534017335 0ustar liggesusers--- title: "Multiple Regimen MCP-Mod" output: rmarkdown::html_vignette bibliography: refs.bib link-citations: yes csl: american-statistical-association.csl vignette: > %\VignetteIndexEntry{Analysis template: MCP-Mod with multiple regimen} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, child="children/settings.txt"} ``` ## Background Often more than one regimen is studied in dose-finding studies. If there are enough doses within each regimen, one may still utilize MCP-Mod. But specific assumptions are needed, and it depends on the situation, whether or not these are appropriate (and thus usage of MCP-Mod). The first idea is to bring the doses for each regimen on a common scale (total dose per time unit). For example if once daily (od) dosing and twice daily (bid) dosing are used in a study, one might utilize the total daily dose. It is usually not appropriate to then perform MCP-Mod on the total daily dose (ignoring from which regimen the doses originate): The study investigated more than one regimen, so assessing the difference between regimen (for example for the same total daily dose) is of interest. This would not be possible with a modelling approach that ignores the regimen. The most general approach would be to perform MCP-Mod separately by regimen, and for example to adjust p-values originating from the MCP-part using a Bonferroni correction. This approach assumes that the regimen don't share any similarity. Due to the double-blind nature of trials, all patients would receive two administrations per day (patients in the od group receive one placebo per day), so that there is no real od group and in particular no separate placebo od group. So it often makes more sense to assume that the placebo group is common to both the od and bid dose-response curve. For the MCP-step contrasts for both od and bid are taken with respect to the same placebo group and in the modelling step one would assume the intercept to be the same across regimen, but all other parameters separate. One could also assume further parameters to be common across regimen (for example the Emax or the ED50 parameter for the Emax model), but in the following example no such assumption is made. The motivation for the simulated data below is taken from a recently completed dose-finding study, where the dose-response of the drug Licogliflozin was assessed for the od and bid regimen [@bays2020], see also the [corresponding page at clinicaltrials.gov](https://clinicaltrials.gov/ct2/show/results/NCT03100058). Note that this study used MCP-Mod, but the analysis presented here has been modified and simplified (in terms of candidate models and dose-response modelling strategy). For most of the following code it is useful to structure the first-stage estimates like this: \[ \hat\mu=(\hat\mu_{\mathrm{placebo}}, \hat\mu_{\mathrm{od}}, \hat\mu_{\mathrm{bid}}) \] The length of the sub-vectors $\hat\mu_{\mathrm{od}}$ and $\hat\mu_{\mathrm{bid}}$ correspond to the number of different doses in the two regimens. They can be different, but in our example both have 4 elements. Also as discussed above everything is modeled on the total daily dose scale. ```{r, data} library(DoseFinding) library(ggplot2) ## collect estimates and dosage information in one place example_estimates <- function() { ## ANOVA mean estimates and ci bounds extracted from fig. 3 of Bays (2020). ## clinicaltrials.gov page already seems to contain values from the dose-response model fit mn <- c(-0.55, -1.78, -1.95, -3.29, -4.43, -1.14, -2.74, -4.03, -4.47) lb <- c(-1.56, -3.15, -3.36, -4.85, -5.40, -2.49, -4.10, -5.50, -5.50) ub <- c( 0.40, -0.30, -0.54, -1.76, -3.48, 0.24, -1.38, -2.65, -3.44) se <- (ub - lb)/(2*qnorm(0.975)) # approximate standard error return(list(mu_hat = mn, daily_dose = c(0, 2.5, 10, 50, 150, 5, 10, 50, 100), S_hat = diag(se^2), # keep track of which elements correspond to which regimen: index = list(placebo = 1, od = 2:5, bid = 6:9))) } ## restructure estimates for easy plotting with ggplot tidy_estimates <- function(est) { se <- sqrt(diag(est$S_hat)) tidy <- data.frame(daily_dose = est$daily_dose, mu_hat = est$mu_hat, ub = est$mu_hat + qnorm(0.975) * se, lb = est$mu_hat - qnorm(0.975) * se) tidy <- rbind(tidy[1, ], tidy) # duplicate placebo tidy$regimen <- c("od", "bid", rep("od", length(est$index$od)), rep("bid", length(est$index$bid))) return(tidy) } plot_estimates <- function(est) { df <- tidy_estimates(est) ggplot(df, aes(daily_dose, mu_hat)) + geom_point() + geom_errorbar(aes(ymin = lb, ymax = ub)) + facet_wrap(vars(regimen), labeller = label_both) + xlab("daily dose") + ylab("percent body weight cange") + labs(title = "ANOVA estimates with 95% confindence intervals") } est <- example_estimates() plot_estimates(est) ``` ## Candidate models Even though not necessary and not always desired we will use the same candidate models for both regimen here. ```{r, candidate_models} mods <- list( od = Mods(emax = c(5, 50), sigEmax = rbind(c(75, 3.5), c(25, 0.7)), maxEff = -1, doses = est$daily_dose[c(est$index$placebo, est$index$od)]), bid = Mods(emax = c(5, 50), sigEmax = rbind(c(75, 3.5), c(25, 0.7)), maxEff = -1, doses=est$daily_dose[c(est$index$placebo, est$index$bid)])) plotMods(mods$od, superpose = TRUE, xlab = "daily dose") plotMods(mods$bid, superpose = TRUE, xlab = "daily dose") ``` ## Multiple contrast test The matrix of contrasts is built up from a separate matrix for each regimen. We stick them together in such a way that we compare $\hat\mu_{\mathrm{od}}$ and $\hat\mu_{\mathrm{bid}}$ with the common placebo response estimate $\hat\mu_{\mathrm{placebo}}$. ```{r, contrasts} calculate_contrasts <- function(est, mods) { S_hat <- est$S_hat i <- est$index cm_od <- optContr(mods$od, S=S_hat[c(i$placebo, i$od), c(i$placebo, i$od)])$contMat cm_bid <- optContr(mods$bid, S=S_hat[c(i$placebo, i$bid), c(i$placebo, i$bid)])$contMat colnames(cm_od) <- paste0("od_", colnames(cm_od)) rownames(cm_od)[-1] <- paste0("od_", rownames(cm_od)[-1]) colnames(cm_bid) <- paste0("bid_", colnames(cm_bid)) rownames(cm_bid)[-1] <- paste0("bid_", rownames(cm_bid)[-1]) # now build a block matrix (contrasts in columns) like this: # [ row of placebo coefficients od | row of placebo coefficients bid ] # [----------------------------------+-----------------------------------] # [ remaining doses' coefficents od | fill with all zeros ] # [----------------------------------+-----------------------------------] # [ fill with all zeros | remaining doses' coefficients bid ] cm_full <- rbind( "0"=c(cm_od[1,], cm_bid[1,] ), cbind(cm_od[-1,], matrix(0, nrow(cm_od) - 1, ncol(cm_bid))), cbind(matrix(0, nrow(cm_bid) - 1, ncol(cm_od)), cm_bid[-1, ] )) return(cm_full) } cont_mat <- calculate_contrasts(est, mods) print(round(cont_mat, 2)) ``` We also need to calculate the test statistics by hand. ```{r, test} mct_test <- function(cont_mat, est) { cont_cov <- t(cont_mat) %*% est$S_hat %*% cont_mat t_stat <- drop(est$mu_hat %*% cont_mat) / sqrt(diag(cont_cov)) # FIXME: calling non-exported function p <- MCTpval(contMat = cont_mat, corMat = cov2cor(cont_cov), df=Inf, tStat=t_stat, alternative = "one.sided") ord <- rev(order(t_stat)) return(data.frame(tStat = t_stat[ord], pVals = p[ord])) } mct_test(cont_mat, est) ``` A clear dose-response trend can be established for both regimen. ## Dose-response modelling Dose-response estimation needs a handful of auxiliary functions. The model for $\hat\mu$ has a common intercept parameter for both regimen together and two sets of the remaining parameters of the family in question. For example, a model based on the Emax family has 5 parameters: one common `e0`, `(eMax, ed50)` for the od regimen, and `(eMax, ed50)` for the bid regimen. The following function calculates the responses given dose values and a model family. ```{r, estimation_1} ## calculate response under `model` for od/bid with common e0, but separate remaining parameters ## arguments: ## - model: as a string like "emax", ## - i_par: list of vectors named "placebo", "od", "bid", used for indexing `par` ## - par: numeric, model parameter structured as c(e0, pars_od, pars_bid) ## returns: response at placebo, dose_od, dose_bid (in this order) eval_model_shared_e0 <- function(model, dose_od, dose_bid, par, i_par) { resp_placebo <- par[1] # e0 resp_od <- do.call(model, append(list(dose_od, par[1]), as.list(par[i_par$od]))) resp_bid <- do.call(model, append(list(dose_bid, par[1]), as.list(par[i_par$bid]))) resp <- c(resp_placebo, resp_od, resp_bid) return(resp) } ``` Next, we need to be able to fit a model family to the observed $\hat\mu$. For this we employ the usual generalized MCP-Mod approach, i.e. generalized least squares with the estimated covariance matrix $\hat S$ [@pinheiro2014]. ```{r, estimation_2} ## find sensible starting values for `fit_model_shared_e0` by fitting separate models, ## index: list of vectors named "placebo", "od", "bid", used for indexing `dose` ## bounds: passed through to `fitMod` calc_start_values <- function(model, full_mu, full_S, dose, index, bounds) { separate_coefs <- sapply(c("od", "bid"), function(regimen) { inds <- c(index$placebo, index[[regimen]]) coef(fitMod(dose[inds], full_mu[inds], S = full_S[inds, inds], type = "general", model = model, bnds = bounds))[-1] # drop e0 estimate }) ## remove names to prevent error in do.call() in eval_model_shared_e0; ## od, bid coefs are in 1st / second column start <- c(full_mu[1], as.numeric(separate_coefs), use.names=FALSE) return(start) } ## fits 'model' to mu_hat with GLS (using S_hat_inv as weight matrix), using a common e0 for od and bid regimens. ## i_reg: list of vectors named "placebo", "od", "bid", used for indexing `dose` ## i_par: passed through to `eval_model_shared_e0` ## dose: numeric with doses for placebo, od, bid ## lower, upper, start: control parameters fro `nlminb` fit_model_shared_e0 <- function(model, dose, mu_hat, S_hat_inv, lower, upper, start, i_reg, i_par) { opt_fun <- function(par) { # make use of lexical scope resp <- eval_model_shared_e0(model, dose[i_reg$od], dose[i_reg$bid], par, i_par) delta <- resp - mu_hat return(drop(t(delta) %*% S_hat_inv %*% delta)) } fit <- nlminb(start, opt_fun, lower = lower, upper = upper) return(fit) } ``` Finally, instead of only fitting a single model, we use the same bootstrap-plus-averaging approach that is detailed in the [vignette for analysis of continuous data](analysis_normal.html#dose-response-estimation). ```{r, estimation_3} ## predict population response in each regimen for dose_seq_* ## note: both dose_seq_* vectors should contain a 0 if response at placebo is of interest one_bootstrap_sample <- function(est, dose_seq_od, dose_seq_bid) { mu_new <- drop(mvtnorm::rmvnorm(1, est$mu_hat, est$S_hat)) mod_info <- list(list(name = "emax", bounds = rbind(c(0.15, 225)), i_par = list(od = 2:3, bid = 4:5), n_par_gaic = 5), list(name = "sigEmax", bounds = rbind(c(0.15, 225), c(0.5, 5)), i_par = list(od = 2:4, bid = 5:7), n_par_gaic = 7)) fit <- lapply(mod_info, function(m) { start <- calc_start_values(m$name, mu_new, est$S_hat, est$daily_dose, est$index, m$bounds) low <- c(-Inf, -Inf, m$bounds[,1]) # no bounds on e0, eMax up <- c(Inf, Inf, m$bounds[,2]) fit_model_shared_e0(m$name, est$daily_dose, mu_new, solve(est$S_hat), lower = low, upper = up, start = start, i_reg = est$index, i_par = m$i_par) }) ## calculate gAICs gaics <- sapply(fit, `[[`, "objective") + 2 * sapply(mod_info, `[[`, "n_par_gaic") sel <- which.min(gaics) mod <- mod_info[[sel]] ## drop the placebo element pred <- eval_model_shared_e0(mod$name, dose_seq_od, dose_seq_bid, fit[[sel]]$par, mod$i_par)[-1] return(pred) } summarize_bootstrap_samples <- function(samples, probs = c(0.025, 0.25, 0.75, 0.975)) { stopifnot(length(probs) == 4) med <- apply(samples, 1, median) quants <- apply(samples, 1, quantile, probs = probs) bs_df <- as.data.frame(cbind(med, t(quants))) names(bs_df) <- c("median", "low_out", "low_in", "high_in", "high_out") return(bs_df) } dose_seq_od <- seq(0, 150, length.out = 21) # do include placebo! dose_seq_bid <- seq(0, 100, length.out = 21) set.seed(1, kind = "Mersenne-Twister", sample.kind = "Rejection", normal.kind = "Inversion") reps <- replicate(1000, one_bootstrap_sample(est, dose_seq_od, dose_seq_bid)) bs_sum <- summarize_bootstrap_samples(reps) bs_sum$daily_dose <- c(dose_seq_od, dose_seq_bid) bs_sum$regimen <- c(rep("od", length(dose_seq_od)), rep("bid", length(dose_seq_bid))) ggplot(bs_sum) + geom_ribbon(aes(daily_dose, ymin=low_out, ymax=high_out), alpha = 0.2) + geom_ribbon(aes(daily_dose, ymin=low_in, ymax=high_in), alpha = 0.2) + geom_line(aes(daily_dose, median)) + geom_point(aes(daily_dose, mu_hat), tidy_estimates(est)) + facet_wrap(vars(regimen), labeller = label_both) + labs(title = "Bootstrap estimates for population response", subtitle = "Least squares estimates plus 50% and 95% confidence bands") + xlab("daily dose") + ylab("percent body weigh change") + coord_cartesian(ylim = c(-6, 0)) ``` ## References DoseFinding/inst/doc/analysis_normal.R0000644000176200001440000000674514764012556017531 0ustar liggesusers## ----settings-knitr, include=FALSE-------------------------------------------- library(ggplot2) knitr::opts_chunk$set(echo = TRUE, message = FALSE, cache = FALSE, comment = NA, dev = "png", dpi = 150, fig.asp = 0.618, fig.width = 7, out.width = "85%", fig.align = "center") options(rmarkdown.html_vignette.check_title = FALSE) theme_set(theme_bw()) ## ----load_data---------------------------------------------------------------- library(DoseFinding) data(glycobrom) print(glycobrom) ## ----simulate_dataset--------------------------------------------------------- set.seed(1, kind = "Mersenne-Twister", sample.kind = "Rejection", normal.kind = "Inversion") rand <- rep(MASS::mvrnorm(60, 0, 60 * 0.015^2, empirical = TRUE), 5) NVA <- data.frame(dose = rep(glycobrom$dose, each = 60), FEV1 = rep(glycobrom$fev1, each = 60) + rand) ggplot(NVA) + geom_jitter(aes(dose, FEV1), height = 0, width = 4) + labs(title = "Simulated FEV1 by dose (jittered horizontally)") + xlab("dose [μg]") + ylab("FEV1 [l]") ## ----models------------------------------------------------------------------- doses <- c(0, 12.5, 25, 50, 100) mods <- Mods(emax = c(2.6, 12.5), sigEmax = c(30.5, 3.5), quadratic = -0.00776, placEff = 1.25, maxEff = 0.15, doses = doses) ## ----plot_models-------------------------------------------------------------- plotMods(mods, ylab = "FEV1") ## ----contrasts---------------------------------------------------------------- optC <- optContr(mods, w=1) print(optC) plot(optC) ## ----mctest_normal------------------------------------------------------------ test_normal <- MCTtest(dose = dose, resp = FEV1, models = mods, data = NVA) print(test_normal) ## ----fit_lm_1----------------------------------------------------------------- fitlm <- lm(FEV1 ~ factor(dose) - 1, data = NVA) mu_hat <- coef(fitlm) S_hat <- vcov(fitlm) anova_df <- fitlm$df.residual ## ----mctest_generalizes------------------------------------------------------- test_general <- MCTtest(dose = doses, resp = mu_hat, S = S_hat, df = anova_df, models = mods, type = "general") print(test_general) ## ----compare_normal_generalized----------------------------------------------- cbind(normal = test_normal$tStat, generalized = test_general$tStat) cbind(normal = attr(test_normal$tStat, "pVal"), generalized = attr(test_general$tStat, "pVal")) ## ----fit_single--------------------------------------------------------------- fit_single <- fitMod(dose, FEV1, NVA, model = "emax") plot(fit_single) ## ----fit_lm_2----------------------------------------------------------------- fitlm <- lm(FEV1 ~ factor(dose) - 1, data = NVA) dose <- unique(NVA$dose) mu_hat <- coef(fitlm) S_hat <- vcov(fitlm) ## ----bootstrap_draw----------------------------------------------------------- fit_mod_av <- maFitMod(dose, mu_hat, S = S_hat, models = c("emax", "sigEmax", "quadratic")) ## ----bootstrap_summarize------------------------------------------------------ # point estimates (median) and bootstrap quantile intervals can be extracted via ma_pred <- predict(fit_mod_av, doseSeq = c(0, 12.5, 25, 50, 100)) # individual bootstrap estimates via indiv_pred <- predict(fit_mod_av, doseSeq = c(0, 12.5, 25, 50, 100), summaryFct = NULL) # plotting can be done via plot(fit_mod_av, plotData = "meansCI", ylab = "Model averaging estimate with 95% CI") DoseFinding/README.md0000644000176200001440000000576014762613063013742 0ustar liggesusers # DoseFinding [![CRAN status](https://www.r-pkg.org/badges/version/DoseFinding)](https://CRAN.R-project.org/package=DoseFinding) The DoseFinding package provides functions for the design and analysis of dose-finding experiments (for example pharmaceutical Phase II clinical trials). It provides functions for: multiple contrast tests, fitting non-linear dose-response models, a combination of testing and dose-response modelling and calculating optimal designs, both for normal and general response variable. ## Installation You can install the development version of DoseFinding from [GitHub](https://github.com/) with: ``` r # install.packages("devtools") devtools::install_github("bbnkmp/DoseFinding") ``` ## Examples ### Performing multiple contrast tests ``` r library(DoseFinding) data(IBScovars) ## set random seed to ensure reproducible adj. p-values for multiple contrast test set.seed(12) ## perform (model based) multiple contrast test ## define candidate dose-response shapes models <- Mods(linear = NULL, emax = 0.2, quadratic = -0.17, doses = c(0, 1, 2, 3, 4)) ## plot models plot(models) ``` ``` r ## perform multiple contrast test MCTtest(dose, resp, IBScovars, models=models, addCovars = ~ gender) #> Multiple Contrast Test #> #> Contrasts: #> linear emax quadratic #> 0 -0.616 -0.889 -0.815 #> 1 -0.338 0.135 -0.140 #> 2 0.002 0.226 0.294 #> 3 0.315 0.252 0.407 #> 4 0.638 0.276 0.254 #> #> Contrast Correlation: #> linear emax quadratic #> linear 1.000 0.768 0.843 #> emax 0.768 1.000 0.948 #> quadratic 0.843 0.948 1.000 #> #> Multiple Contrast Test: #> t-Stat adj-p #> emax 3.208 0.00128 #> quadratic 3.083 0.00228 #> linear 2.640 0.00848 ``` ### Fitting non-linear dose-response model ``` r ## fit non-linear emax dose-response model fitemax <- fitMod(dose, resp, data=IBScovars, model="emax", bnds = c(0.01,5)) ## display fitted dose-effect curve plot(fitemax, CI=TRUE, plotData="meansCI") ``` ### Optimal designs for dose estimation ``` r ## Calculate optimal designs for target dose (TD) estimation doses <- c(0, 10, 25, 50, 100, 150) fmodels <- Mods(linear = NULL, emax = 25, exponential = 85, logistic = c(50, 10.8811), doses = doses, placEff=0, maxEff=0.4) plot(fmodels, plotTD = TRUE, Delta = 0.2) ``` ``` r weights <- rep(1/4, 4) optDesign(fmodels, weights, Delta=0.2, designCrit="TD") #> Calculated TD - optimal design: #> 0 10 25 50 100 150 #> 0.34960 0.09252 0.00366 0.26760 0.13342 0.15319 ``` DoseFinding/build/0000755000176200001440000000000014764013015013543 5ustar liggesusersDoseFinding/build/vignette.rds0000644000176200001440000000067014764013015016105 0ustar liggesusers‹R¿O1>!¢:¹AœLˆäCă)Üãh¸k¡íApòïv{¥…$&:\Û÷®ßë÷¾ï½×<Ïó½R±àùEu,¶Ôr¢¾†ÞK^Uí-Lq¼D )ã Ž;/Ih~]ŒÅ|= ±ÄNº2Á 'l$i,‡"’uògl |I`åV8™Ç0ät:Ï¥Ý5\uK@ý‡A»ÏB4a•„¦,(£d@·=$¢Óá_ñÛv\ìuÀa‘•ñuÅ Bôœ‚„Q¡mnßÑ»ÛÕ_9E™Dõ‡Œwõd”@=& 4$4Bs<žáÌûW­ ʔٳw8èóÖ"E6$Br2J¥¢¬ûÉ yyhêT&±õËuÕÉŸf¶:q3ç«ó£¾3Ö­ê:«óyFÍ£1³ÕrCf’e=b&8ϘÉÖöãe+å†+mgܽ?ìÿÄ•|µl' D($¶†—߈ÜÅA/0Ç‚m§Òƒ9ÐPX{a½b\Åù‡ªœ­:ö±ºúüOµl6›¯CFã ËÈ&kZö Wx}ÿ ÷²@2DoseFinding/man/0000755000176200001440000000000014762603270013225 5ustar liggesusersDoseFinding/man/glycobrom.Rd0000644000176200001440000000423014654153534015513 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/DoseFinding-package.R \docType{data} \name{glycobrom} \alias{glycobrom} \title{Glycopyrronium Bromide dose-response data} \format{ A data frame with 5 summary estimates (one per dose). Variables: A data frame with 5 summary estimates (one per dose). Variables: \describe{ \item{\code{dose}}{a numeric vector containing the dose values} \item{\code{fev1}}{a numeric vector containing the least square mean per dose} \item{\code{sdev}}{a numeric vector containing the standard errors of the least square means per dose} \item{\code{n}}{Number of participants analyzed per treatment group} } } \source{ http://clinicaltrials.gov/ct2/show/results/NCT00501852 } \usage{ data(glycobrom) } \description{ Data from a clinical study evaluating Efficacy and Safety of Four Doses of Glycopyrronium Bromide in Patients With Stable Chronic Obstructive Pulmonary Disease (COPD). This data set was obtained from clinicaltrials.gov (NCT00501852). The study design was a 4 period incomplete cross-over design. The primary endpoint is the trough forced expiratory volume in 1 second (FEV1) following 7 days of Treatment. } \details{ The data given here are summary estimates (least-square means) for each dose. } \examples{ ## simulate a full data set with given means and sdv (here we ignore ## the original study was a cross-over design, and simulate a parallel ## group design) simData <- function(mn, sd, n, doses, fixed = TRUE){ ## simulate data with means (mns) and standard deviations (sd), for ## fixed = TRUE, the data set will have observed means and standard ## deviations as given in mns and sd resp <- numeric(sum(n)) uppind <- cumsum(n) lowind <- c(0,uppind)+1 for(i in 1:length(n)){ rv <- rnorm(n[i]) if(fixed) rv <- scale(rv) resp[lowind[i]:uppind[i]] <- mn[i] + sd[i]*rv } data.frame(doses=rep(doses, n), resp=resp) } data(glycobrom) fullDat <- simData(glycobrom$fev1, glycobrom$sdev, glycobrom$n, glycobrom$dose) } \keyword{datasets} DoseFinding/man/IBScovars.Rd0000644000176200001440000000234114654153534015352 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/DoseFinding-package.R \docType{data} \name{IBScovars} \alias{IBScovars} \title{Irritable Bowel Syndrome Dose Response data with covariates} \format{ A data frame with 369 observations on the following 2 variables. \describe{ \item{\code{gender}}{a factor specifying the gender} \item{\code{dose}}{a numeric vector} \item{\code{resp}}{a numeric vector} } } \source{ Biesheuvel, E. and Hothorn, L. A. (2002). Many-to-one comparisons in stratified designs, \emph{Biometrical Journal}, \bold{44}, 101--116 } \usage{ data(IBScovars) } \description{ A subset of the data used by (Biesheuvel and Hothorn, 2002). The data are part of a dose ranging trial on a compound for the treatment of the irritable bowel syndrome with four active treatment arms, corresponding to doses 1,2,3,4 and placebo. Note that the original dose levels have been blinded in this data set for confidentiality. The primary endpoint was a baseline adjusted abdominal pain score with larger values corresponding to a better treatment effect. In total 369 patients completed the study, with nearly balanced allocation across the doses. } \keyword{datasets} DoseFinding/man/defBnds.Rd0000644000176200001440000000255014654153534015066 0ustar liggesusers\name{defBnds} \alias{defBnds} \title{ Calculates default bounds for non-linear parameters in dose-response models } \description{ Calculates reasonable bounds for non-linear parameters for the built-in non-linear regression model based on the dose range under investigation. For the logistic model the first row corresponds to the ED50 parameter and the second row to the delta parameter. For the sigmoid Emax model the first row corresponds to the ED50 parameter and the second row to the h parameter, while for the beta model first and second row correspond to the delta1 and delta2 parameters. See \code{\link{logistic}}, \code{\link{sigEmax}} and \code{\link{betaMod}} for details. } \usage{ defBnds(mD, emax = c(0.001, 1.5)*mD, exponential = c(0.1, 2)*mD, logistic = matrix(c(0.001, 0.01, 1.5, 1/2)*mD, 2), sigEmax = matrix(c(0.001*mD, 0.5, 1.5*mD, 10), 2), betaMod = matrix(c(0.05,0.05,4,4), 2)) } \arguments{ \item{mD}{ Maximum dose in the study. } \item{emax, exponential, logistic, sigEmax, betaMod}{ values for the nonlinear parameters for these model-functions } } \value{ List containing bounds for the model parameters. } \author{ Bjoern Bornkamp } \seealso{ \code{\link{fitMod}} } \examples{ defBnds(mD = 1) defBnds(mD = 200) } DoseFinding/man/biom.Rd0000644000176200001440000000144114654153534014445 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/DoseFinding-package.R \docType{data} \name{biom} \alias{biom} \title{Biometrics Dose Response data} \format{ A data frame with 100 observations on the following 2 variables. \describe{ \item{\code{resp}}{a numeric vector containing the response values} \item{\code{dose}}{a numeric vector containing the dose values} } } \source{ Bretz, F., Pinheiro, J. C., and Branson, M. (2005), Combining multiple comparisons and modeling techniques in dose-response studies, \emph{Biometrics}, \bold{61}, 738--748 } \usage{ data(biom) } \description{ An example data set for dose response studies. This data set was used in Bretz et al. (2005) to illustrate the MCPMod methodology. } \keyword{datasets} DoseFinding/man/optDesign.Rd0000644000176200001440000003166114654153534015462 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/optDesign.R \name{optDesign} \alias{optDesign} \alias{plot.DRdesign} \alias{calcCrit} \alias{rndDesign} \title{Function to calculate optimal designs} \usage{ optDesign( models, probs, doses, designCrit = c("Dopt", "TD", "Dopt&TD", "userCrit"), Delta, standDopt = TRUE, weights, nold = rep(0, length(doses)), n, control = list(), optimizer = c("solnp", "Nelder-Mead", "nlminb", "exact"), lowbnd = rep(0, length(doses)), uppbnd = rep(1, length(doses)), userCrit, ... ) calcCrit( design, models, probs, doses, designCrit = c("Dopt", "TD", "Dopt&TD"), Delta, standDopt = TRUE, weights, nold = rep(0, length(doses)), n ) rndDesign(design, n, eps = 1e-04) \method{plot}{DRdesign}(x, models, lwdDes = 10, colDes = rgb(0, 0, 0, 0.3), ...) } \arguments{ \item{models}{An object of class \samp{c(Mods, fullMod)}, see the \code{\link{Mods}} function for details. When an TD optimal design should be calculated, the TD needs to exist for all models. If a D-optimal design should be calculated, you need at least as many doses as there are parameters in the specified models.} \item{probs}{Vector of model probabilities for the models specified in \samp{models}, assumed in the same order as specified in models} \item{doses}{Optional argument. If this argument is missing the doses attribute in the \samp{c(Mods, fullMod)} object specified in \samp{models} is used.} \item{designCrit}{Determines which type of design to calculate. "TD&Dopt" uses both optimality criteria with equal weight.} \item{Delta}{Target effect needed for calculating "TD" and "TD&Dopt" type designs.} \item{standDopt}{Logical determining, whether the D-optimality criterion (specifically the log-determinant) should be standardized by the number of parameters in the model or not (only of interest if type = "Dopt" or type = "TD&Dopt"). This is of interest, when there is more than one model class in the candidate model set (traditionally standardization this is done in the optimal design literature).} \item{weights}{Vector of weights associated with the response at the doses. Needs to be of the same length as the \samp{doses}. This can be used to calculate designs for heteroscedastic or for generalized linear model situations.} \item{nold, n}{When calculating an optimal design at an interim analysis, \samp{nold} specifies the vector of sample sizes already allocated to the different doses, and \samp{n} gives sample size for the next cohort. For \samp{optimizer = "exact"} one always needs to specify the total sample size via \samp{n}.} \item{control}{List containing control parameters passed down to numerical optimization algorithms (\code{\link{optim}}, \code{\link{nlminb}} or solnp function).\cr For \samp{type = "exact"} this should be a list with possible entries \samp{maxvls1} and \samp{maxvls2}, determining the maximum number of designs allowed for passing to the criterion function (default \samp{maxvls2=1e5}) and for creating the initial unrestricted matrix of designs (default \samp{maxvls1=1e6}). In addition there can be an entry \samp{groupSize} in case the patients are allocated a minimum group size is required.} \item{optimizer}{Algorithm used for calculating the optimal design. Options "Nelder-Mead" and "nlminb" use the \code{\link{optim}} and \code{\link{nlminb}} function and use a trigonometric transformation to turn the constrained optimization problem into an unconstrained one (see Atkinson, Donev and Tobias, 2007, pages 130,131). Option "solnp" uses the solnp function from the Rsolnp package, which implements an optimizer for non-linear optimization under general constraints. Option "exact" tries all given combinations of \samp{n} patients to the given dose groups (subject to the bounds specified via \samp{lowbnd} and \samp{uppbnd}) and reports the best design. When patients are only allowed to be allocated in groups of a certain \samp{groupSize}, this can be adjusted via the control argument. \samp{n/groupSize} and \samp{length(doses)} should be rather small for this approach to be feasible. When the number of doses is small (<8) usually \samp{"Nelder-Mead"} and \samp{"nlminb"} are best suited (\samp{"nlminb"} is usually a bit faster but less stable than \samp{"Nelder-Mead"}). For a larger number of doses \samp{"solnp"} is the most reliable option (but also slowest) (\samp{"Nelder-Mead"} and \samp{"nlminb"} often fail). When the sample size is small \samp{"exact"} provides the optimal solution rather quickly.} \item{lowbnd, uppbnd}{Vectors of the same length as dose vector specifying upper and lower limits for the allocation weights. This option is only available when using the "solnp" and "exact" optimizers.} \item{userCrit}{User defined design criterion, should be a function that given a vector of allocation weights and the doses returns the criterion function. When specified \samp{models} does not need to be handed over. The first argument of \samp{userCrit} should be the vector of design weights, while the second argument should be the \samp{doses} argument (see example below). Additional arguments to \samp{userCrit} can be passed via ...} \item{...}{For function \samp{optDesign} these are additional arguments passed to \samp{userCrit}.\cr \cr For function \samp{plot.design} these are additional parameters passed to \code{\link{plot.Mods}}.\cr} \item{design}{Argument for \samp{rndDesign} and \samp{calcCrit} functions: Numeric vector (or matrix) of allocation weights for the different doses. The rows of the matrices need to sum to 1. Alternatively also an object of class "DRdesign" can be used for \samp{rndDesign}. Note that there should be at least as many design points available as there are parameters in the dose-response models selected in \code{models} (otherwise the code returns an NA).} \item{eps}{Argument for \samp{rndDesign} function: Value under which elements of w will be regarded as 0.} \item{x}{Object of class \samp{DRdesign} (for \samp{plot.design})} \item{lwdDes, colDes}{Line width and color of the lines plotted for the design (in \samp{plot.design})} } \description{ Given a set of models (with full parameter values and model probabilities) the \samp{optDesign} function calculates the optimal design for estimating the dose-response model parameters (D-optimal) or the design for estimating the target dose (TD-optimal design) (see Dette, Bretz, Pepelyshev and Pinheiro (2008)), or a mixture of these two criteria. The design can be plotted (together with the candidate models) using \samp{plot.design}. \samp{calcCrit} calculates the design criterion for a discrete set of design(s). \samp{rndDesign} provides efficient rounding for the calculated continous design to a finite sample size. } \details{ Let \eqn{M_m}{M_m} denote the Fisher information matrix under model m (up to proportionality). \eqn{M_m}{M_m} is given by \eqn{\sum a_i w_i }{\sum a_i w_i g_i^Tg_i}\eqn{ g_i^Tg_i}{\sum a_i w_i g_i^Tg_i}, where \eqn{a_i}{a_i} is the allocation weight to dose i, \eqn{w_i}{w_i} the weight for dose i specified via \samp{weights} and \eqn{g_i}{g_i} the gradient vector of model m evaluated at dose i. For \samp{designCrit = "Dopt"} the code minimizes the design criterion \deqn{-\sum_{m}p_m/k_m \log(\det(M_m))}{-sum_m p_m/k_m log(det(M_m))} where \eqn{p_m}{p_m} is the probability for model m and \eqn{k_m}{k_m} is the number of parameters for model m. When \samp{standDopt = FALSE} the \eqn{k_m}{k_m} are all assumed to be equal to one. For \samp{designCrit = "TD"} the code minimizes the design criterion \deqn{\sum_{m}p_m \log(v_m)}{sum_m p_m log(v_m)} where \eqn{p_m}{p_m} is the probability for model m and \eqn{v_m}{v_m} is proportional to the asymptotic variance of the TD estimate and given by \eqn{b_m'M_m^{-}b_m}{b_m'Minv_m b_m} (see Dette et al. (2008), p. 1227 for details). For \samp{designCrit = "Dopt&TD"} the code minimizes the design criterion \deqn{\sum_{m}p_m(-0.5\log(\det(M_m))/k_m+0.5\log(v_m))}{sum_m p_m(-0.5log(det(M_m))/k_m+0.5log(v_m))} Again, for \samp{standDopt = FALSE} the \eqn{k_m}{k_m} are all assumed to be equal to one. For details on the \samp{rndDesign} function, see Pukelsheim (1993), Chapter 12. } \note{ In some cases (particularly when the number of doses is large, e.g. 7 or larger) it might be necessary to allow a larger number of iterations in the algorithm (via the argument \samp{control}), particularly for the Nelder-Mead algorithm. Alternatively one can use the solnp optimizer that is usually the most reliable, but not fastest option. } \examples{ ## calculate designs for Emax model doses <- c(0, 10, 100) emodel <- Mods(emax = 15, doses=doses, placEff = 0, maxEff = 1) optDesign(emodel, probs = 1) ## TD-optimal design optDesign(emodel, probs = 1, designCrit = "TD", Delta=0.5) ## 50-50 mixture of Dopt and TD optDesign(emodel, probs = 1, designCrit = "Dopt&TD", Delta=0.5) ## use dose levels different from the ones specified in emodel object des <- optDesign(emodel, probs = 1, doses = c(0, 5, 20, 100)) ## plot models overlaid by design plot(des, emodel) ## round des to a sample size of exactly 90 patients rndDesign(des, n=90) ## using the round function would lead to 91 patients ## illustrating different optimizers (see Note above for more comparison) optDesign(emodel, probs=1, optimizer="Nelder-Mead") optDesign(emodel, probs=1, optimizer="nlminb") ## optimizer solnp (the default) can deal with lower and upper bounds: optDesign(emodel, probs=1, designCrit = "TD", Delta=0.5, optimizer="solnp", lowbnd = rep(0.2,3)) ## exact design using enumeration of all possibilites optDesign(emodel, probs=1, optimizer="exact", n = 30) ## also allows to fix minimum groupSize optDesign(emodel, probs=1, designCrit = "TD", Delta=0.5, optimizer="exact", n = 30, control = list(groupSize=5)) ## optimal design at interim analysis ## assume there are already 10 patients on each dose and there are 30 ## left to randomize, this calculates the optimal increment design optDesign(emodel, 1, designCrit = "TD", Delta=0.5, nold = c(10, 10, 10), n=30) ## use a larger candidate model set doses <- c(0, 10, 25, 50, 100, 150) fmods <- Mods(linear = NULL, emax = 25, exponential = 85, linlog = NULL, logistic = c(50, 10.8811), doses = doses, addArgs=list(off=1), placEff=0, maxEff=0.4) probs <- rep(1/5, 5) # assume uniform prior desDopt <- optDesign(fmods, probs, optimizer = "nlminb") desTD <- optDesign(fmods, probs, designCrit = "TD", Delta = 0.2, optimizer = "nlminb") desMix <- optDesign(fmods, probs, designCrit = "Dopt&TD", Delta = 0.2) ## plot design and truth plot(desMix, fmods) ## illustrate calcCrit function ## calculate optimal design for beta model doses <- c(0, 0.49, 25.2, 108.07, 150) models <- Mods(betaMod = c(0.33, 2.31), doses=doses, addArgs=list(scal=200), placEff=0, maxEff=0.4) probs <- 1 deswgts <- optDesign(models, probs, designCrit = "Dopt", control=list(maxit=1000)) ## now compare this design to equal allocations on ## 0, 10, 25, 50, 100, 150 doses2 <- c(0, 10, 25, 50, 100, 150) design2 <- c(1/6, 1/6, 1/6, 1/6, 1/6, 1/6) crit2 <- calcCrit(design2, models, probs, doses2, designCrit = "Dopt") ## ratio of determinants (returned criterion value is on log scale) exp(deswgts$crit-crit2) ## example for calculating an optimal design for logistic regression doses <- c(0, 0.35, 0.5, 0.65, 1) fMod <- Mods(linear = NULL, doses=doses, placEff=-5, maxEff = 10) ## now calculate weights to use in the covariance matrix mu <- as.numeric(getResp(fMod, doses=doses)) mu <- 1/(1+exp(-mu)) weights <- mu*(1-mu) des <- optDesign(fMod, 1, doses, weights = weights) ## one can also specify a user defined criterion function ## here D-optimality for cubic polynomial CubeCrit <- function(w, doses){ X <- cbind(1, doses, doses^2, doses^3) CVinv <- crossprod(X*w) -log(det(CVinv)) } optDesign(doses = c(0,0.05,0.2,0.6,1), designCrit = "userCrit", userCrit = CubeCrit, optimizer = "nlminb") } \references{ Atkinson, A.C., Donev, A.N. and Tobias, R.D. (2007). Optimum Experimental Designs, with SAS, Oxford University Press Dette, H., Bretz, F., Pepelyshev, A. and Pinheiro, J. C. (2008). Optimal Designs for Dose Finding Studies, \emph{Journal of the American Statisical Association}, \bold{103}, 1225--1237 Pinheiro, J.C., Bornkamp, B. (2017) Designing Phase II Dose-Finding Studies: Sample Size, Doses and Dose Allocation Weights, in O'Quigley, J., Iasonos, A. and Bornkamp, B. (eds) Handbook of methods for designing, monitoring, and analyzing dose-finding trials, CRC press Pukelsheim, F. (1993). Optimal Design of Experiments, Wiley } \seealso{ \code{\link{Mods}}, \code{\link{drmodels}} } \author{ Bjoern Bornkamp } DoseFinding/man/sampSize.Rd0000644000176200001440000001541014654153534015313 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sampSize.R \name{sampSize} \alias{sampSize} \alias{sampSizeMCT} \alias{targN} \alias{plot.targN} \alias{powN} \title{Sample size calculations} \usage{ sampSize( upperN, lowerN = floor(upperN/2), targFunc, target, tol = 0.001, alRatio, Ntype = c("arm", "total"), verbose = FALSE ) sampSizeMCT( upperN, lowerN = floor(upperN/2), ..., power, sumFct = mean, tol = 0.001, alRatio, Ntype = c("arm", "total"), verbose = FALSE ) targN( upperN, lowerN, step, targFunc, alRatio, Ntype = c("arm", "total"), sumFct = c("min", "mean", "max") ) powN( upperN, lowerN, step, ..., alRatio, Ntype = c("arm", "total"), sumFct = c("min", "mean", "max") ) \method{plot}{targN}(x, superpose = TRUE, line.at = NULL, xlab = NULL, ylab = NULL, ...) } \arguments{ \item{upperN, lowerN}{Upper and lower bound for the target sample size. \code{lowerN} defaults to \code{floor(upperN/2)}.} \item{targFunc, target}{The target function needs to take as an input the vector of sample sizes in the different dose groups. For \samp{sampSize} it needs to return a univariate number. For function \samp{targN} it should return a numerical vector.\cr \cr Example: \samp{targFunc} could be a function that calculates the power of a test, and \samp{target} the desired target power value. \cr For function \samp{sampSize} the bisection search iterates the sample size so that a specific target value is achieved (the implicit assumption is that targFunc is monotonically increasing in the sample size).\cr \cr Function \samp{targN} simply calculates \samp{targFunc} for a given set of sample sizes.} \item{tol}{A positive numeric value specifying the tolerance level for the bisection search algorithm. Bisection is stopped if the \samp{targFunc} value is within \samp{tol} of \samp{target}.} \item{alRatio}{Vector describing the relative patient allocations to the dose groups up to proportionality, e.g. \samp{rep(1, length(doses))} corresponds to balanced allocations.} \item{Ntype}{One of "arm" or "total". Determines, whether the sample size in the smallest arm or the total sample size is iterated in bisection search algorithm.} \item{verbose}{Logical value indicating if a trace of the iteration progress of the bisection search algorithm should be displayed.} \item{...}{Arguments directly passed to the \code{\link{powMCT}} function in the \samp{sampSizeMCT} and \samp{powN} function.} \item{power, sumFct}{power is a numeric defining the desired summary power to achieve (in \samp{sampSizeMCT}).} \item{step}{Only needed for functions \samp{targN} and \samp{powN}. Stepsize for the sample size at which the target function is calculated. The steps are calculated via \code{seq(lowerN,upperN,by=step)}.} \item{x, superpose, line.at, xlab, ylab}{arguments for the plot method of \samp{targN} and \samp{powN}, additional arguments are passed down to the low-level lattice plotting routines.} } \description{ The \samp{sampSize} function implements a bisection search algorithm for sample size calculation. The user can hand over a general target function (via \samp{targFunc}) that is then iterated so that a certain \samp{target} is achieved. The \samp{sampSizeMCT} is a convenience wrapper of \samp{sampSize} for multiple contrast tests using the power as target function. } \details{ The \samp{targN} functions calculates a general target function for different given sample sizes. The \samp{powN} function is a convenience wrapper of \samp{targN} for multiple contrast tests using the power as target function. } \examples{ ## sampSize examples ## first define the target function ## first calculate the power to detect all of the models in the candidate set fmodels <- Mods(linear = NULL, emax = c(25), logistic = c(50, 10.88111), exponential=c(85), betaMod=matrix(c(0.33,2.31,1.39,1.39), byrow=TRUE, nrow=2), doses = c(0,10,25,50,100,150), placEff=0, maxEff=0.4, addArgs = list(scal=200)) ## contrast matrix to use contMat <- optContr(fmodels, w=1) ## this function calculates the power under each model and then returns ## the average power under all models tFunc <- function(n){ powVals <- powMCT(contMat, altModels=fmodels, n=n, sigma = 1, alpha=0.05) mean(powVals) } ## assume we want to achieve 80\% average power over the selected shapes ## and want to use a balanced allocations \dontrun{ sSize <- sampSize(upperN = 80, targFunc = tFunc, target=0.8, alRatio = rep(1,6), verbose = TRUE) sSize ## Now the same using the convenience sampSizeMCT function sampSizeMCT(upperN=80, contMat = contMat, sigma = 1, altModels=fmodels, power = 0.8, alRatio = rep(1, 6), alpha = 0.05) ## Alternatively one can also specify an S matrix ## covariance matrix in one observation (6 total observation result in a ## variance of 1 in each group) S <- 6*diag(6) ## this uses df = Inf, hence a slightly smaller sample size results sampSizeMCT(upperN=500, contMat = contMat, S=S, altModels=fmodels, power = 0.8, alRatio = rep(1, 6), alpha = 0.05, Ntype = "total") ## targN examples ## first calculate the power to detect all of the models in the candidate set fmodels <- Mods(linear = NULL, emax = c(25), logistic = c(50, 10.88111), exponential=c(85), betaMod=matrix(c(0.33,2.31,1.39,1.39), byrow=TRUE, nrow=2), doses = c(0,10,25,50,100,150), placEff=0, maxEff=0.4, addArgs = list(scal=200)) ## corresponding contrast matrix contMat <- optContr(fmodels, w=1) ## define target function tFunc <- function(n){ powMCT(contMat, altModels=fmodels, n=n, sigma = 1, alpha=0.05) } powVsN <- targN(upperN = 100, lowerN = 10, step = 10, tFunc, alRatio = rep(1, 6)) plot(powVsN) ## the same can be achieved using the convenience powN function ## without the need to specify a target function powN(upperN = 100, lowerN=10, step = 10, contMat = contMat, sigma = 1, altModels = fmodels, alpha = 0.05, alRatio = rep(1, 6)) } } \references{ Pinheiro, J. C., Bornkamp, B., and Bretz, F. (2006). Design and analysis of dose finding studies combining multiple comparisons and modeling procedures, \emph{Journal of Biopharmaceutical Statistics}, \bold{16}, 639--656 Pinheiro, J.C., Bornkamp, B. (2017) Designing Phase II Dose-Finding Studies: Sample Size, Doses and Dose Allocation Weights, in O'Quigley, J., Iasonos, A. and Bornkamp, B. (eds) Handbook of methods for designing, monitoring, and analyzing dose-finding trials, CRC press } \seealso{ \code{\link{powMCT}} } \author{ Jose Pinheiro, Bjoern Bornkamp } DoseFinding/man/bMCTtest.Rd0000644000176200001440000002324214762603270015204 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bMCTtest.R \name{bMCTtest} \alias{bMCTtest} \title{Performs Bayesian multiple contrast test} \usage{ bMCTtest( dose, resp, data = NULL, models, S = NULL, type = c("normal", "general"), prior, alpha = 0.025, na.action = na.fail, mvtcontrol = mvtnorm.control(), contMat = NULL, critV = NULL ) } \arguments{ \item{dose, resp}{Either vectors of equal length specifying dose and response values, or names of variables in the data frame specified in \samp{data}.} \item{data}{Data frame containing the variables referenced in dose and resp if \samp{data} is not specified it is assumed that \samp{dose} and \samp{resp} are variables referenced from data (and no vectors)} \item{models}{An object of class \samp{Mods}, see \code{\link{Mods}} for details} \item{S}{The covariance matrix of \samp{resp} when \samp{type = "general"}, see Description.} \item{type}{Determines whether inference is based on an ANCOVA model under a homoscedastic normality assumption (when \samp{type = "normal"}), or estimates at the doses and their covariance matrix and degrees of freedom are specified directly in \samp{resp}, \samp{S} and \samp{df}. See also \code{\link{fitMod}} and Pinheiro et al. (2014).} \item{prior}{List of length equal to the number of doses with the prior for each arm. Each element needs to be of class \samp{normMix} (See \samp{RBesT} package documentation). It is assumed that the i-th component of the prior list corresponds to the i-th largest dose. For example the first entry in the list is the prior for the placebo group, the second entry the prior for the second lowest dose and so on. Internally the priors across the different arms are combined (densities multiplied) assuming independence. The resulting multivariate normal mixture prior will have as many components as the product of the number of components of the individual mixture priors. The posterior mixture is part of the result object under "posterior".} \item{alpha}{Significance level for the frequentist multiple contrast test. If no critical values are supplied via \samp{critV} this is used to derive critical values for Bayesian decision rule.} \item{na.action}{A function which indicates what should happen when the data contain NAs.} \item{mvtcontrol}{A list specifying additional control parameters for the \samp{qmvt} and \samp{pmvt} calls in the code, see also \code{\link{mvtnorm.control}} for details.} \item{contMat}{Contrast matrix to apply to the posterior dose-response estimates. The contrasts need to be in the columns of the matrix (i.e. the column sums need to be 0). If not specified optimal contrasts are calculated using \code{\link{optContr}}.} \item{critV}{Supply a critical value for the maximum posterior probability of the contrasts being greater than zero that needs to be surpassed to establish a non-flat dose-response. If this argument is NULL, this will be derived from critical values for frequentist MCP-Mod using the provided \samp{alpha}.} } \value{ An object of class bMCTtest, a list containing the output. } \description{ This function performs a Bayesian multiple contrast test using normal mixture priors for the response on each dose, as proposed in Fleischer et al. (2022). For a general description of the multiple contrast test see \code{\link{MCTtest}}. } \details{ If \samp{type = "normal"}, an ANCOVA model based on a homoscedastic normality assumption is fitted and posteriors for dose-response and contrast vectors are obtained assuming a known variance. For \samp{type = "general"} it is assumed multivariate normally distributed estimates are specified in \samp{resp} with covariance given by \samp{S}, which define the likelihood. Posteriors for dose-response and contrast vectors are then obtained assuming a known covariance matrix S The multiple contrast test decision is based on the maximum posterior probability of a contrast being greater than zero. Thresholds for the posterior probability can either be supplied or will be derived from frequentist critical values. In the latter case the Bayesian test will give approximately the same results as the frequentist multiple contrast test if uninformative priors are used. For the default calculation of optimal contrasts the prior information is ignored (i.e. contrasts are calculated in the same way as in \code{\link{MCTtest}}). Fleischer et al. (2022) discuss using contrasts that take the prior effective sample sizes into account, which can be slightly more favourable for the Bayesian MCT test. Such alternative contrasts can be directly handed over via the \samp{contMat} argument. For analysis with covariate adjustment, covariate-adjusted \samp{resp} and \samp{S} can be supplied together with using \samp{type = "general"}. See `vignette("binary_data")` vignette "Design and analysis template MCP-Mod for binary data" for an example on how to obtain covariate adjusted estimates. } \examples{ if (require("RBesT")) { ############################### ## Normal outcome ############################### data(biom) ## define shapes for which to calculate optimal contrasts doses <- c(0, 0.05, 0.2, 0.6, 1) modlist <- Mods(emax = 0.05, linear = NULL, logistic = c(0.5, 0.1), linInt = c(0, 1, 1, 1), doses = doses) ## specify an informative prior for placebo, weakly informative for other arms plc_prior <- mixnorm(inf = c(0.8, 0.4, 0.1), rob = c(0.2, 0.4, 10)) vague_prior <- mixnorm(c(1, 0, 10)) ## i-th component of the prior list corresponds to the i-th largest dose ## (e.g. 1st component -> placebo prior; last component prior for top dose) prior <- list(plc_prior, vague_prior, vague_prior, vague_prior, vague_prior) m1 <- bMCTtest(dose, resp, biom, models=modlist, prior = prior) ## now supply a critical value (= threshold for maxmimum posterior probability) m2 <- bMCTtest(dose, resp, biom, models=modlist, prior = prior, critV = 0.99) #################################### ## Binary outcome with covariates #################################### \dontrun{ ## generate data logit <- function(p) log(p / (1 - p)) inv_logit <- function(y) 1 / (1 + exp(-y)) doses <- c(0, 0.5, 1.5, 2.5, 4) ## set seed and ensure reproducibility across R versions set.seed(1, kind = "Mersenne-Twister", sample.kind = "Rejection", normal.kind = "Inversion") group_size <- 100 dose_vector <- rep(doses, each = group_size) N <- length(dose_vector) ## generate covariates x1 <- rnorm(N, 0, 1) x2 <- factor(sample(c("A", "B"), N, replace = TRUE, prob = c(0.6, 0.4))) ## assume approximately logit(10\%) placebo and logit(35\%) asymptotic response with ED50=0.5 prob <- inv_logit(emax(dose_vector, -2.2, 1.6, 0.5) + 0.3 * x1 + 0.3 * (x2 == "B")) dat <- data.frame(y = rbinom(N, 1, prob), dose = dose_vector, x1 = x1, x2 = x2) ## specify an informative prior for placebo (on logit scale), weakly informative for other arms plc_prior <- mixnorm(inf = c(0.8, -2, 0.5), rob = c(0.2, -2, 10)) vague_prior <- mixnorm(c(1, 0, 10)) prior <- list(plc_prior, vague_prior, vague_prior, vague_prior, vague_prior) ## candidate models mods <- Mods(emax = c(0.25, 1), sigEmax = rbind(c(1, 3), c(2.5, 4)), betaMod = c(1.1, 1.1), placEff = logit(0.1), maxEff = logit(0.35)-logit(0.1), doses = doses) fit_cov <- glm(y~factor(dose) + 0 + x1 + x2, data = dat, family = binomial) covariate_adjusted_estimates <- function(mu_hat, S_hat, formula_rhs, doses, other_covariates, n_sim) { ## predict every patient under *every* dose oc_rep <- as.data.frame(lapply(other_covariates, function(col) rep(col, times = length(doses)))) d_rep <- rep(doses, each = nrow(other_covariates)) pdat <- cbind(oc_rep, dose = d_rep) X <- model.matrix(formula_rhs, pdat) ## average on probability scale then backtransform to logit scale mu_star <- logit(tapply(inv_logit(X \%*\% mu_hat), pdat$dose, mean)) ## estimate covariance matrix of mu_star pred <- replicate(n_sim, logit(tapply(inv_logit(X \%*\% drop(mvtnorm::rmvnorm(1, mu_hat, S_hat))), pdat$dose, mean))) return(list(mu_star = as.numeric(mu_star), S_star = cov(t(pred)))) } ca <- covariate_adjusted_estimates(coef(fit_cov), vcov(fit_cov), ~factor(dose)+0+x1+x2, doses, dat[, c("x1", "x2")], 1000) bMCTtest(doses, ca$mu_star, S = ca$S_star, type = "general", models = mods, prior = prior) } ################################################ ## example with contrasts handed over ################################################ data(biom) ## define shapes for which to calculate optimal contrasts doses <- c(0, 0.05, 0.2, 0.6, 1) modlist <- Mods(emax = 0.05, linear = NULL, sigEmax = c(0.5, 5), linInt = c(0, 1, 1, 1), doses = doses) ## specify an informative prior for placebo, weakly informative for other arms plc_prior <- mixnorm(inf = c(0.8, 0.4, 0.1), rob = c(0.2, 0.4, 10), sigma = 0.7) vague_prior <- mixnorm(c(1, 0, 10), sigma = 0.7) prior <- list(plc_prior, vague_prior, vague_prior, vague_prior, vague_prior) ## use prior effective sample sizes to calculate optimal contrasts prior_ess <- unlist(lapply(prior, ess)) n_grp <- as.numeric(table(biom$dose)) weights <- n_grp + prior_ess cmat <- optContr(modlist, w = weights) bMCTtest(dose, resp, biom, models=modlist, prior = prior, contMat = cmat) } } \references{ Fleischer, F., Bossert, S., Deng, Q., Loley, C. and Gierse, J. (2022). Bayesian MCP-Mod, \emph{Pharmaceutical Statistics}, \bold{21}, 654--670 } \seealso{ \code{\link{MCTtest}}, \code{\link{optContr}} } \author{ Marius Thomas } DoseFinding/man/MCPMod.Rd0000644000176200001440000002461314654153534014604 0ustar liggesusers\name{MCPMod} \alias{MCPMod} \alias{predict.MCPMod} \alias{plot.MCPMod} \title{ MCPMod - Multiple Comparisons and Modeling } \description{ Tests for a dose-response effect using a model-based multiple contrast test (see \code{\link{MCTtest}}), selects one (or several) model(s) from the significant shapes, fits them using \code{\link{fitMod}}. For details on the method see Bretz et al. (2005). } \usage{ MCPMod(dose, resp, data, models, S = NULL, type = c("normal", "general"), addCovars = ~1, placAdj = FALSE, selModel = c("AIC", "maxT", "aveAIC"), alpha = 0.025, df = NULL, critV = NULL, doseType = c("TD", "ED"), Delta, p, pVal = TRUE, alternative = c("one.sided", "two.sided"), na.action = na.fail, mvtcontrol = mvtnorm.control(), bnds, control = NULL) \method{predict}{MCPMod}(object, predType = c("full-model", "ls-means", "effect-curve"), newdata = NULL, doseSeq = NULL, se.fit = FALSE, ...) \method{plot}{MCPMod}(x, CI = FALSE, level = 0.95, plotData = c("means", "meansCI", "raw", "none"), plotGrid = TRUE, colMn = 1, colFit = 1, ...) } \arguments{ \item{dose, resp}{ Either vectors of equal length specifying dose and response values, or names of variables in the data frame specified in \samp{data}. } \item{data}{ Data frame containing the variables referenced in dose and resp if \samp{data} is not specified it is assumed that \samp{dose} and \samp{resp} are variables referenced from data (and no vectors) } \item{models}{ An object of class \samp{"Mods"}, see \code{\link{Mods}} for details } \item{S}{ The covariance matrix of \samp{resp} when \samp{type = "general"}, see Description. } \item{type}{ Determines whether inference is based on an ANCOVA model under a homoscedastic normality assumption (when \samp{type = "normal"}), or estimates at the doses and their covariance matrix and degrees of freedom are specified directly in \samp{resp}, \samp{S} and \samp{df}. See also \code{\link{fitMod}} and Pinheiro et al. (2014). } \item{addCovars}{ Formula specifying additive linear covariates (for \samp{type = "normal"}) } \item{placAdj}{ Logical, if true, it is assumed that placebo-adjusted estimates are specified in \samp{resp} (only possible for \samp{type = "general"}). } \item{selModel}{ Optional character vector specifying the model selection criterion for dose estimation. Possible values are \itemize{ \item \code{AIC}: Selects model with smallest AIC (this is the default) \item \code{maxT}: Selects the model corresponding to the largest t-statistic. \item \code{aveAIC}: Uses a weighted average of the models corresponding to the significant contrasts. The model weights are chosen by the formula: \eqn{w_i = \exp(-0.5AIC_i)/\sum_i(\exp(-0.5AIC_i))}{w_i = exp(-0.5AIC_i)/sum(exp(-0.5AIC_i))} See Buckland et al. (1997) for details. } For \samp{type = "general"} the "gAIC" is used. } \item{alpha}{ Significance level for the multiple contrast test } \item{df}{ Specify the degrees of freedom to use in case \samp{type = "general"}, for the call to \code{\link{MCTtest}} and \code{\link{fitMod}}. Infinite degrees of (\samp{df=Inf}) correspond to the multivariate normal distribution. For type = "normal" the degrees of freedom deduced from the AN(C)OVA fit are used and this argument is ignored. } \item{critV}{ Supply a pre-calculated critical value. If this argument is NULL, no critical value will be calculated and the test decision is based on the p-values. If \samp{critV = TRUE} the critical value will be calculated. } \item{doseType, Delta, p}{ \samp{doseType} determines the dose to estimate, ED or TD (see also \code{\link{Mods}}), and \samp{Delta} and \samp{p} need to be specified depending on whether TD or ED is to be estimated. See \code{\link{TD}} and \code{\link{ED}} for details. } \item{pVal}{ Logical determining, whether p-values should be calculated. } \item{alternative}{ Character determining the alternative for the multiple contrast trend test. } \item{na.action}{ A function which indicates what should happen when the data contain NAs. } \item{mvtcontrol}{ A list specifying additional control parameters for the \samp{qmvt} and \samp{pmvt} calls in the code, see also \code{\link{mvtnorm.control}} for details. } \item{bnds}{ Bounds for non-linear parameters. This needs to be a list with list entries corresponding to the selected bounds. The names of the list entries need to correspond to the model names. The \code{\link{defBnds}} function provides the default selection. } \item{control}{ Control list for the optimization.\cr A list with entries: "nlminbcontrol", "optimizetol" and "gridSize". The entry nlminbcontrol needs to be a list and is passed directly to control argument in the nlminb function, that is used internally for models with 2 nonlinear parameters (e.g. sigmoid Emax or beta model). The entry optimizetol is passed directly to the tol argument of the optimize function, which is used for models with 1 nonlinear parameters (e.g. Emax or exponential model). The entry gridSize needs to be a list with entries dim1 and dim2 giving the size of the grid for the gridsearch in 1d or 2d models. } \item{object, x}{ MCPMod object } \item{predType, newdata, doseSeq, se.fit, ...}{ predType determines whether predictions are returned for the full model (including potential covariates), the ls-means (SAS type) or the effect curve (difference to placebo). newdata gives the covariates to use in producing the predictions (for \samp{predType = "full-model"}), if missing the covariates used for fitting are used. doseSeq dose-sequence on where to produce predictions (for \samp{predType = "effect-curve"} and \samp{predType = "ls-means"}). If missing the doses used for fitting are used. se.fit: logical determining, whether the standard error should be calculated. \ldots: Additional arguments, for plot.MCPMod these are passed to plot.DRMod. } \item{CI, level, plotData, plotGrid, colMn, colFit}{ Arguments for plot method: \samp{CI} determines whether confidence intervals should be plotted. \samp{level} determines the level of the confidence intervals. \samp{plotData} determines how the data are plotted: Either as means or as means with CI, raw data or none. In case of \samp{type = "normal"} and covariates the ls-means are displayed, when \samp{type = "general"} the option "raw" is not available. \samp{colMn} and \samp{colFit} determine the colors of fitted model and the raw means. } } \value{ An object of class \samp{MCPMod}, which contains the fitted \samp{MCTtest} object as well as the \samp{DRMod} objects and additional information (model selection criteria, dose estimates, selected models). } \references{ Bretz, F., Pinheiro, J. C., and Branson, M. (2005), Combining multiple comparisons and modeling techniques in dose-response studies, \emph{Biometrics}, \bold{61}, 738--748 Pinheiro, J. C., Bornkamp, B., and Bretz, F. (2006). Design and analysis of dose finding studies combining multiple comparisons and modeling procedures, \emph{Journal of Biopharmaceutical Statistics}, \bold{16}, 639--656 Pinheiro, J. C., Bretz, F., and Branson, M. (2006). Analysis of dose-response studies - modeling approaches, \emph{in} N. Ting (ed.). \emph{Dose Finding in Drug Development}, Springer, New York, pp. 146--171 Pinheiro, J. C., Bornkamp, B., Glimm, E. and Bretz, F. (2014) Model-based dose finding under model uncertainty using general parametric models, \emph{Statistics in Medicine}, \bold{33}, 1646--1661 Schorning, K., Bornkamp, B., Bretz, F., & Dette, H. (2016). Model selection versus model averaging in dose finding studies. \emph{Statistics in Medicine}, \bold{35}, 4021--4040 Xun, X. and Bretz, F. (2017) The MCP-Mod methodology: Practical Considerations and The DoseFinding R package, in O'Quigley, J., Iasonos, A. and Bornkamp, B. (eds) Handbook of methods for designing, monitoring, and analyzing dose-finding trials, CRC press Buckland, S. T., Burnham, K. P. and Augustin, N. H. (1997). Model selection an integral part of inference, \emph{Biometrics}, \bold{53}, 603--618 Seber, G.A.F. and Wild, C.J. (2003). Nonlinear Regression, Wiley. } \author{ Bjoern Bornkamp } \seealso{ \code{\link{MCTtest}}, \code{\link{fitMod}}, \code{\link{drmodels}} } \examples{ data(biom) ## first define candidate model set (only need "standardized" models) models <- Mods(linear = NULL, emax=c(0.05,0.2), linInt=c(1, 1, 1, 1), doses=c(0,0.05,0.2,0.6,1)) plot(models) ## perform MCPMod procedure MM <- MCPMod(dose, resp, biom, models, Delta=0.5) ## a number of things can be done with an MCPMod object MM # print method provides basic information summary(MM) # more information ## predict all significant dose-response models predict(MM, se.fit=TRUE, doseSeq=c(0,0.2,0.4, 0.9, 1), predType="ls-means") ## display all model functions plot(MM, plotData="meansCI", CI=TRUE) ## now perform model-averaging MM2 <- MCPMod(dose, resp, biom, models, Delta=0.5, selModel = "aveAIC") sq <- seq(0,1,length=11) pred <- predict(MM, doseSeq=sq, predType="ls-means") modWeights <- MM2$selMod ## model averaged predictions pred <- do.call("cbind", pred)\%*\%modWeights ## model averaged dose-estimate TDEst <- MM2$doseEst\%*\%modWeights ## now an example using a general fit and fitting based on placebo ## adjusted first-stage estimates data(IBScovars) ## ANCOVA fit model including covariates anovaMod <- lm(resp~factor(dose)+gender, data=IBScovars) drFit <- coef(anovaMod)[2:5] # placebo adjusted estimates at doses vCov <- vcov(anovaMod)[2:5,2:5] dose <- sort(unique(IBScovars$dose))[-1] # no estimate for placebo ## candidate models models <- Mods(emax = c(0.5, 1), betaMod=c(1,1), doses=c(0,4)) plot(models) ## hand over placebo-adjusted estimates drFit to MCPMod MM3 <- MCPMod(dose, drFit, S=vCov, models = models, type = "general", placAdj = TRUE, Delta=0.2) plot(MM3, plotData="meansCI") ## The first example, but with critical value handed over ## this is useful, e.g. in simulation studies MM4 <- MCPMod(dose, resp, biom, models, Delta=0.5, critV = 2.31) } DoseFinding/man/migraine.Rd0000644000176200001440000000154614654153534015320 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/DoseFinding-package.R \docType{data} \name{migraine} \alias{migraine} \title{Migraine Dose Response data} \format{ A data frame with 517 columns corresponding to the patients that completed the trial \describe{ \item{\code{dose}}{a numeric vector containing the dose values} \item{\code{painfree}}{number of treatment responders} \item{\code{ntrt}}{number of subject per treatment group} } } \source{ http://clinicaltrials.gov/ct2/show/results/NCT00712725 } \usage{ data(migraine) } \description{ Data set obtained from clinicaltrials.gov (NCT00712725). This was randomized placebo controlled dose-response trial for treatment of acute migraine. The primary endpoint was "pain freedom at 2 hours postdose" (a binary measurement). } \keyword{datasets} DoseFinding/man/targdose.Rd0000644000176200001440000000744714762603270015340 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/Mods.R \name{Target doses} \alias{Target doses} \alias{TD} \alias{ED} \title{Calculate dose estimates for a fitted dose-response model (via \code{\link{fitMod}}, \code{\link{bFitMod}}) or \code{\link{maFitMod}}) or a \code{\link{Mods}} object} \usage{ TD( object, Delta, TDtype = c("continuous", "discrete"), direction = c("increasing", "decreasing"), doses = NULL ) ED( object, p, EDtype = c("continuous", "discrete"), direction = c("increasing", "decreasing"), doses = NULL ) } \arguments{ \item{object}{An object of class c(Mods, fullMod), DRMod, bFitMod or maFit} \item{Delta, p}{Delta: The target effect size use for the target dose (TD) (Delta should be > 0). p: The percentage of the dose to use for the effective dose.} \item{TDtype, EDtype}{character that determines, whether the dose should be treated as a continuous variable when calculating the TD/ED or whether the TD/ED should be calculated based on a grid of doses specified in \samp{doses}} \item{direction}{Direction to be used in defining the TD. This depends on whether an increasing or decreasing of the response variable is beneficial. In case of ED calculation only needed for maFit objects.} \item{doses}{Dose levels to be used if \samp{TDtype} or \samp{EDtype} are equal to \samp{"discrete"}. Needs to include placebo, and may not exceed the dose range of the model(s) provided in \samp{object}.} } \value{ Returns the dose estimate } \description{ The TD (target dose) is defined as the dose that achieves a target effect of Delta over placebo (if there are multiple such doses, the smallest is chosen): \deqn{TD_\Delta = \min \{x|f(x) > f(0)+\Delta\}}{TD = min {x|f(x) > f(0)+Delta}} If a decreasing trend is beneficial the definition of the TD is \deqn{TD_\Delta = \min \{x|f(x) < f(0)-\Delta\}}{TD = min {x|f(x) < f(0)-Delta}} When \eqn{\Delta}{Delta} is the clinical relevance threshold, then the TD is similar to the usual definition of the minimum effective dose (MED). The ED (effective dose) is defined as the dose that achieves a certain percentage p of the full effect size (within the observed dose-range!) over placebo (if there are multiple such doses, the smallest is chosen). \deqn{ED_p=\min\{x|f(x) > f(0) + p(f(dmax)-f(0))}{ EDp=min{x|f(x) > f(0) + p(f(dmax)-f(0))}} Note that this definition of the EDp is different from traditional definition based on the Emax model, where the EDp is defined relative to the \emph{asymptotic} maximum effect (rather than the maximum effect in the observed dose-range). ED or TD calculation for bootstrap model averaging (maFit) objects is based on first calculating the pointwise median dose-response curve estimate. Then calculating the dose estimate based on this curve. } \examples{ ## example for creating a "full-model" candidate set placebo response ## and maxEff already fixed in Mods call doses <- c(0, 10, 25, 50, 100, 150) fmodels <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), exponential = 85, betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), linInt = rbind(c(0, 1, 1, 1, 1), c(0, 0, 1, 1, 0.8)), doses=doses, placEff = 0, maxEff = 0.4, addArgs=list(scal=200)) ## calculate doses giving an improvement of 0.3 over placebo TD(fmodels, Delta=0.3) ## discrete version TD(fmodels, Delta=0.3, TDtype = "discrete", doses=doses) ## doses giving 50\% of the maximum effect ED(fmodels, p=0.5) ED(fmodels, p=0.5, EDtype = "discrete", doses=doses) plot(fmodels, plotTD = TRUE, Delta = 0.3) } \seealso{ \code{\link{Mods}}, \code{\link{drmodels}}, \code{\link{fitMod}}, \code{\link{bFitMod}} } \author{ Bjoern Bornkamp } DoseFinding/man/optContr.Rd0000644000176200001440000001315314654153534015332 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/optContr.R \name{optContr} \alias{optContr} \alias{plot.optContr} \alias{plotContr} \title{Calculate optimal contrasts} \usage{ optContr( models, doses, w, S, placAdj = FALSE, type = c("unconstrained", "constrained") ) \method{plot}{optContr}( x, superpose = TRUE, xlab = "Dose", ylab = NULL, plotType = c("contrasts", "means"), ... ) plotContr(optContrObj, xlab = "Dose", ylab = "Contrast coefficients") } \arguments{ \item{models}{An object of class \samp{Mods} defining the dose-response shapes for which to calculate optimal contrasts.} \item{doses}{Optional argument. If this argument is missing the doses attribute in the \samp{Mods} object specified in \samp{models} is used.} \item{w, S}{Arguments determining the matrix S used in the formula for the optimal contrasts. Exactly one of \samp{w} and \samp{S} has to be specified. Note that \samp{w} and \samp{S} only have to be specified up to proportionality \cr \describe{ \item{w}{ Vector specifying weights for the different doses, in the formula for calculation of the optimal contrasts. Specifying a weights vector is equivalent to specifying S=diag(1/w) (e.g. in a homoscedastic case with unequal sample sizes, \samp{w} should be proportional to the group sample sizes). } \item{S}{ Directly specify a matrix proportional to the covariance matrix to use. } }} \item{placAdj}{Logical determining, whether the contrasts should be applied to placebo-adjusted estimates. If yes the returned coefficients are no longer contrasts (i.e. do not sum to 0). However, the result of multiplying of this "contrast" matrix with the placebo adjusted estimates, will give the same results as multiplying the original contrast matrix to the unadjusted estimates.} \item{type}{For \samp{type = "constrained"} the contrast coefficients of the zero dose group are constrained to be different from the coefficients of the active treatment groups. So that a weighted sum of the active treatments is compared against the zero dose group. For an increasing trend the coefficient of the zero dose group is negative and all other coefficients have to be positive (for a decreasing trend the other way round).} \item{x, superpose, xlab, ylab, plotType}{Arguments for the plot method for optContr objects. plotType determines, whether the contrasts or the underlying (standardized) mean matrix should be plotted.} \item{...}{Additional arguments for plot method} \item{optContrObj}{For function \samp{plotContr} the \samp{optContrObj} should contain an object of class \samp{optContr}.} } \value{ Object of class \samp{optContr}. A list containing entries contMat and muMat (i.e. contrast, mean and correlation matrix). } \description{ This function calculates a contrast vectors that are optimal for detecting certain alternatives. The contrast is optimal in the sense of maximizing the non-centrality parameter of the underlying contrast test statistic: \deqn{\frac{c'\mu}{\sqrt{c'Sc}}}{c'mu/sqrt(c'Sc).} Here \eqn{\mu}{mu} is the mean vector under the alternative and \eqn{S}{S} the covariance matrix associated with the estimate of \eqn{\mu}{mu}. The optimal contrast is given by \deqn{c^{opt} \propto S^{-1}\left(\mu - \frac{\mu^{\prime}S^{-1}1} {1^\prime S^{-1} 1}\right),}{c propto S^(-1) (mu - mu'S^(-1)1)/(1'S^(-1)1),} see Pinheiro et al. (2014). } \details{ Note that the directionality (i.e. whether in "increase" in the response variable is beneficial or a "decrease", is inferred from the specified \samp{models} object, see \code{\link{Mods}} for details). Constrained contrasts (type = "constrained") add the additional constraint in the optimization that the sign of the contrast coefficient for control and active treatments need to be different. The quadratic programming algorithm from the quadprog package is used to calculate the contrasts. } \examples{ doses <- c(0,10,25,50,100,150) models <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), exponential= 85, betaMod=rbind(c(0.33,2.31), c(1.39,1.39)), doses = doses, addArgs = list(scal = 200)) contMat <- optContr(models, w = rep(50,6)) plot(contMat) plotContr(contMat) # display contrasts using ggplot2 ## now we would like the "contrasts" for placebo adjusted estimates dosPlac <- doses[-1] ## matrix proportional to cov-matrix of plac. adj. estimates for balanced data S <- diag(5)+matrix(1, 5,5) ## note that we explicitly hand over the doses here contMat0 <- optContr(models, doses=dosPlac, S = S, placAdj = TRUE) ## -> contMat0 is no longer a contrast matrix (columns do not sum to 0) colSums(contMat0$contMat) ## calculate contrast matrix for unadjusted estimates from this matrix ## (should be same as above) aux <- rbind(-colSums(contMat0$contMat), contMat0$contMat) t(t(aux)/sqrt(colSums(aux^2))) ## compare to contMat$contMat ## now calculate constrained contrasts if(requireNamespace("quadprog", quietly = TRUE)){ optContr(models, w = rep(50,6), type = "constrained") optContr(models, doses=dosPlac, S = S, placAdj = TRUE, type = "constrained") } } \references{ Bretz, F., Pinheiro, J. C., and Branson, M. (2005), Combining multiple comparisons and modeling techniques in dose-response studies, \emph{Biometrics}, \bold{61}, 738--748 Pinheiro, J. C., Bornkamp, B., Glimm, E. and Bretz, F. (2014) Model-based dose finding under model uncertainty using general parametric models, \emph{Statistics in Medicine}, \bold{33}, 1646--1661 } \seealso{ \code{\link{MCTtest}} } \author{ Bjoern Bornkamp } DoseFinding/man/fitMod.Rd0000644000176200001440000002647114762603270014750 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fitMod.R \name{fitMod} \alias{fitMod} \alias{coef.DRMod} \alias{vcov.DRMod} \alias{predict.DRMod} \alias{plot.DRMod} \alias{logLik.DRMod} \alias{AIC.DRMod} \alias{gAIC} \alias{gAIC.DRMod} \title{Fit non-linear dose-response model} \usage{ fitMod( dose, resp, data = NULL, model = NULL, S = NULL, type = c("normal", "general"), addCovars = ~1, placAdj = FALSE, bnds, df = NULL, start = NULL, na.action = na.fail, control = NULL, addArgs = NULL ) \method{coef}{DRMod}(object, sep = FALSE, ...) \method{vcov}{DRMod}(object, ...) \method{predict}{DRMod}( object, predType = c("full-model", "ls-means", "effect-curve"), newdata = NULL, doseSeq = NULL, se.fit = FALSE, ... ) \method{plot}{DRMod}( x, CI = FALSE, level = 0.95, plotData = c("means", "meansCI", "raw", "none"), plotGrid = TRUE, colMn = 1, colFit = 1, ... ) \method{logLik}{DRMod}(object, ...) \method{AIC}{DRMod}(object, ..., k = 2) \method{gAIC}{DRMod}(object, ..., k = 2) } \arguments{ \item{dose, resp}{Either vectors of equal length specifying dose and response values, or names of variables in the data frame specified in \samp{data}.} \item{data}{Data frame containing the variables referenced in dose and resp if \samp{data} is not specified it is assumed that \samp{dose} and \samp{resp} are variables referenced from data (and no vectors)} \item{model}{The dose-response model to be used for fitting the data. Built-in models are "linlog", "linear", "quadratic", "emax", "exponential", "sigEmax", "betaMod" and "logistic" (see \link{drmodels}).} \item{S}{The inverse weighting matrix used in case, when \samp{type = "general"}, see Description. For later inference statements (vcov or predict methods) it is assumed this is the estimated covariance of the estimates in the first stage fit.} \item{type}{Determines whether inference is based on an ANCOVA model under a homoscedastic normality assumption (when \samp{type = "normal"}), or estimates at the doses and their covariance matrix and degrees of freedom are specified directly in \samp{resp}, \samp{S} and \samp{df}. See also the Description above and Pinheiro et al. (2014).} \item{addCovars}{Formula specifying additional additive linear covariates (only for \samp{type = "normal"})} \item{placAdj}{Logical, if true, it is assumed that placebo-adjusted estimates are specified in \samp{resp} (only possible for \samp{type = "general"}).} \item{bnds}{Bounds for non-linear parameters. If missing the the default bounds from \code{\link{defBnds}} is used. When the dose-response model has only one non-linear parameter (for example Emax or exponential model), \samp{bnds} needs to be a vector containing upper and lower bound. For models with two non-linear parameters \samp{bnds} needs to be a matrix containing the bounds in the rows, see the Description section of \code{\link{defBnds}} for details on the formatting of the bounds for the individual models.} \item{df}{Degrees of freedom to use in case of \samp{type = "general"}. If this argument is missing \samp{df = Inf} is used. For \samp{type = "normal"} this argument is ignored as the exact degrees of freedom can be deduced from the model.} \item{start}{Vector of starting values for the nonlinear parameters (ignored for linear models). When equal to NULL, a grid optimization is performed and the best value is used as starting value for the local optimizer.} \item{na.action}{A function which indicates what should happen when the data contain NAs.} \item{control}{A list with entries: "nlminbcontrol", "optimizetol" and "gridSize". The entry nlminbcontrol needs to be a list and it is passed directly to control argument in the nlminb function, that is used internally for models with 2 nonlinear parameters. The entry optimizetol is passed directly to the tol argument of the optimize function, which is used for models with 1 nonlinear parameters. The entry gridSize needs to be a list with entries dim1 and dim2 giving the size of the grid for the gridsearch in 1d or 2d models.} \item{addArgs}{List containing two entries named "scal" and "off" for the "betaMod" and "linlog" model. When addArgs is NULL the following defaults is used \samp{list(scal = 1.2*max(doses), off = 0.01*max(doses))}.} \item{object, x}{DRMod object} \item{sep}{Logical determining whether all coefficients should be returned in one numeric or separated in a list.} \item{...}{Additional arguments for plotting for the plot method. For all other cases additional arguments are ignored.} \item{predType, newdata, doseSeq, se.fit}{predType determines whether predictions are returned for the full model (including potential covariates), the ls-means (SAS type) or the effect curve (difference to placebo). newdata gives the covariates to use in producing the predictions (for predType = "full-model"), if missing the covariates used for fitting are used. doseSeq dose-sequence on where to produce predictions (for predType = "effect-curve" and predType = "ls-means"). If missing the doses used for fitting are used. se.fit: logical determining, whether the standard error should be calculated.} \item{CI, level, plotData, plotGrid, colMn, colFit}{Arguments for plot method: \samp{CI} determines whether confidence intervals should be plotted. \samp{level} determines the level of the confidence intervals. \samp{plotData} determines how the data are plotted: Either as means or as means with CI, raw data or none. In case of \samp{type = "normal"} and covariates the ls-means are displayed, when \samp{type = "general"} the option "raw" is not available. \samp{colMn} and \samp{colFit} determine the colors of fitted model and the raw means.} \item{k}{Penalty to use for model-selection criterion (AIC uses 2, BIC uses log(n)).} } \value{ An object of class DRMod. Essentially a list containing information about the fitted model coefficients, the residual sum of squares (or generalized residual sum of squares), } \description{ Fits a dose-response model. Built-in dose-response models are "linlog", "linear", "quadratic", "emax", "exponential", "sigEmax", "betaMod" and "logistic" (see \code{\link{drmodels}}). } \details{ When \samp{type = "normal"} ordinary least squares is used and additional additive covariates can be specified in \samp{addCovars}. The underlying assumption is hence normally distributed data and homoscedastic variance. For \samp{type = "general"} a generalized least squares criterion is used \deqn{}{(f(dose,theta)-resp)'S^{-1}(f(dose,theta)-resp)}\deqn{ (f(dose,\theta)-resp)'S^{-1}(f(dose,\theta)-resp)}{(f(dose,theta)-resp)'S^{-1}(f(dose,theta)-resp)} and an inverse weighting matrix is specified in \samp{S}, \samp{type = "general"} is primarily of interest, when fitting a model to AN(C)OVA type estimates obtained in a first stage fit, then \samp{resp} contains the estimates and \samp{S} is the estimated covariance matrix for the estimates in \samp{resp}. Statistical inference (e.g. confidence intervals) rely on asymptotic normality of the first stage estimates, which makes this method of interest only for sufficiently large sample size for the first stage fit. A modified model-selection criterion can be applied to these model fits (see also Pinheiro et al. 2014 for details). For details on the implemented numerical optimizer see the Details section below. Details on numerical optimizer for model-fitting:\cr For linear models fitting is done using numerical linear algebra based on the QR decomposition. For nonlinear models numerical optimization is performed only in the nonlinear parameters in the model and optimizing over the linear parameters in each iteration (similar as the Golub-Pereyra implemented in \code{\link{nls}}). For models with 1 nonlinear parameter the \code{\link{optimize}} function is used for 2 nonlinear parameters the \code{\link{nlminb}} function is used. The starting value is generated using a grid-search (with the grid size specified via \samp{control$gridSize}), or can directly be handed over via \samp{start}. For details on the asymptotic approximation used for \samp{type = "normal"}, see Seber and Wild (2003, chapter 5). For details on the asymptotic approximation used for \samp{type = "general"}, and the gAIC, see Pinheiro et al. (2014). } \examples{ ## Fit the emax model to the IBScovars data set data(IBScovars) fitemax <- fitMod(dose, resp, data=IBScovars, model="emax", bnds = c(0.01, 4)) ## methods for DRMod objects summary(fitemax) ## extracting coefficients coef(fitemax) ## (asymptotic) covariance matrix of estimates vcov(fitemax) ## predicting newdat <- data.frame(dose = c(0,0.5,1), gender=factor(1)) predict(fitemax, newdata=newdat, predType = "full-model", se.fit = TRUE) ## plotting plot(fitemax, plotData = "meansCI", CI=TRUE) ## now include (additive) covariate gender fitemax2 <- fitMod(dose, resp, data=IBScovars, model="emax", addCovars = ~gender, bnds = c(0.01, 4)) vcov(fitemax2) plot(fitemax2) ## fitted log-likelihood logLik(fitemax2) ## extracting AIC (or BIC) AIC(fitemax2) ## Illustrating the "general" approach for a binary regression ## produce first stage fit (using dose as factor) data(migraine) PFrate <- migraine$painfree/migraine$ntrt doseVec <- migraine$dose doseVecFac <- as.factor(migraine$dose) ## fit logistic regression with dose as factor fitBin <- glm(PFrate~doseVecFac-1, family = binomial, weights = migraine$ntrt) drEst <- coef(fitBin) vCov <- vcov(fitBin) ## now fit an Emax model (on logit scale) gfit <- fitMod(doseVec, drEst, S=vCov, model = "emax", bnds = c(0,100), type = "general") ## model fit on logit scale plot(gfit, plotData = "meansCI", CI = TRUE) ## model on probability scale logitPred <- predict(gfit, predType ="ls-means", doseSeq = 0:200, se.fit=TRUE) plot(0:200, 1/(1+exp(-logitPred$fit)), type = "l", ylim = c(0, 0.5), ylab = "Probability of being painfree", xlab = "Dose") LB <- logitPred$fit-qnorm(0.975)*logitPred$se.fit UB <- logitPred$fit+qnorm(0.975)*logitPred$se.fit lines(0:200, 1/(1+exp(-LB))) lines(0:200, 1/(1+exp(-UB))) ## now illustrate "general" approach for placebo-adjusted data (on ## IBScovars) note that the estimates are identical to fitemax2 above) anovaMod <- lm(resp~factor(dose)+gender, data=IBScovars) drFit <- coef(anovaMod)[2:5] # placebo adjusted estimates at doses vCov <- vcov(anovaMod)[2:5,2:5] dose <- sort(unique(IBScovars$dose))[-1] ## now fit an emax model to these estimates gfit2 <- fitMod(dose, drFit, S=vCov, model = "emax", type = "general", placAdj = TRUE, bnds = c(0.01, 2)) ## some outputs summary(gfit2) coef(gfit2) vcov(gfit2) predict(gfit2, se.fit = TRUE, doseSeq = c(1,2,3,4), predType = "effect-curve") plot(gfit2, CI=TRUE, plotData = "meansCI") gAIC(gfit2) } \references{ Pinheiro, J. C., Bornkamp, B., Glimm, E. and Bretz, F. (2014) Model-based dose finding under model uncertainty using general parametric models, \emph{Statistics in Medicine}, \bold{33}, 1646--1661 Seber, G.A.F. and Wild, C.J. (2003). Nonlinear Regression, Wiley. } \seealso{ \code{\link{defBnds}}, \code{\link{drmodels}} } \author{ Bjoern Bornkamp } DoseFinding/man/guesst.Rd0000644000176200001440000001260214654153534015032 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/guesst.R \name{guesst} \alias{guesst} \title{Calculate guesstimates based on prior knowledge} \usage{ guesst( d, p, model = c("emax", "exponential", "logistic", "quadratic", "betaMod", "sigEmax"), less = TRUE, local = FALSE, dMax, Maxd, scal ) } \arguments{ \item{d}{Vector containing dose value(s).} \item{p}{Vector of expected percentages of the maximum effect achieved at d.} \item{model}{Character string. Should be one of "emax", "exponential", "quadratic", "betaMod", "sigEmax", "logistic".} \item{less}{Logical, only needed in case of quadratic model. Determines if d is smaller (\samp{less=TRUE}) or larger (\samp{less=FALSE}) than dopt (see Pinheiro et al. (2006) for details).} \item{local}{Logical indicating whether local or asymptotic version of guesstimate should be derived (defaults to \samp{FALSE}). Only needed for emax, logistic and sigEmax model. When \samp{local=TRUE} the maximum dose must be provided via \samp{Maxd}.} \item{dMax}{Dose at which maximum effect occurs, only needed for the beta model} \item{Maxd}{Maximum dose to be administered in the trial} \item{scal}{Scale parameter, only needed for the beta model} } \value{ Returns a numeric vector containing the guesstimates. } \description{ Calculates guesstimates for standardized model parameter(s) using the general approach described in Pinheiro et al. (2006). } \details{ Calculates guesstimates for the parameters \eqn{\theta_2}{theta2} of the standardized model function based on the prior expected percentage of the maximum effect at certain dose levels. Note that this function should be used together with the \code{\link{plot.Mods}} function to ensure that the guesstimates are reflecting the prior beliefs. For the logistic and sigmoid emax models at least two pairs (d,p) need to be specified. For the beta model the dose at which the maximum effect occurs (dMax) has to be specified in addition to the (d,p) pair. For the exponential model the maximum dose administered (Maxd) needs to be specified in addition to the (d,p) pair. For the quadratic model one (d,p) pair is needed. It is advisable to specify the location of the maximum within the dose range with this pair. For the emax, sigmoid Emax and logistic model one can choose between a local and an asymptotic version. In the local version one explicitly forces the standardized model function to pass through the specified points (d,p). For the asymptotic version it assumed that the standardized model function is equal to 1 at the largest dose (this is the approach described in Pinheiro et al. (2006)). If the local version is used, convergence problems with the underlying nonlinear optimization can occur. } \examples{ ## Emax model ## Expected percentage of maximum effect: 0.8 is associated with ## dose 0.3 (d,p)=(0.3, 0.8), dose range [0,1] emx1 <- guesst(d=0.3, p=0.8, model="emax") emax(0.3,0,1,emx1) ## local approach emx2 <- guesst(d=0.3, p=0.8, model="emax", local = TRUE, Maxd = 1) emax(0.3,0,1,emx2)/emax(1,0,1,emx2) ## plot models models <- Mods(emax=c(emx1, emx2), doses=c(0,1)) plot(models) ## Logistic model ## Select two (d,p) pairs (0.2, 0.6) and (0.2, 0.95) lgc1 <- guesst(d = c(0.2, 0.6), p = c(0.2, 0.95), "logistic") logistic(c(0.2,0.6), 0, 1, lgc1[1], lgc1[2]) ## local approach lgc2 <- guesst(d = c(0.2, 0.6), p = c(0.2, 0.95), "logistic", local = TRUE, Maxd = 1) r0 <- logistic(0, 0, 1, lgc2[1], lgc2[2]) r1 <- logistic(1, 0, 1, lgc2[1], lgc2[2]) (logistic(c(0.2,0.6), 0, 1, lgc2[1], lgc2[2])-r0)/(r1-r0) ## plot models models <- Mods(logistic = rbind(lgc1, lgc2), doses=c(0,1)) plot(models) ## Beta Model ## Select one pair (d,p): (0.4,0.8) ## dose, where maximum occurs: 0.8 bta <- guesst(d=0.4, p=0.8, model="betaMod", dMax=0.8, scal=1.2, Maxd=1) ## plot models <- Mods(betaMod = bta, doses=c(0,1), addArgs = list(scal = 1.2)) plot(models) ## Sigmoid Emax model ## Select two (d,p) pairs (0.2, 0.6) and (0.2, 0.95) sgE1 <- guesst(d = c(0.2, 0.6), p = c(0.2, 0.95), "sigEmax") sigEmax(c(0.2,0.6), 0, 1, sgE1[1], sgE1[2]) ## local approach sgE2 <- guesst(d = c(0.2, 0.6), p = c(0.2, 0.95), "sigEmax", local = TRUE, Maxd = 1) sigEmax(c(0.2,0.6), 0, 1, sgE2[1], sgE2[2])/sigEmax(1, 0, 1, sgE2[1], sgE2[2]) models <- Mods(sigEmax = rbind(sgE1, sgE2), doses=c(0,1)) plot(models) ## Quadratic model ## For the quadratic model it is assumed that the maximum effect occurs at ## dose 0.7 quad <- guesst(d = 0.7, p = 1, "quadratic") models <- Mods(quadratic = quad, doses=c(0,1)) plot(models) ## exponential model ## (d,p) = (0.8,0.5) expo <- guesst(d = 0.8, p = 0.5, "exponential", Maxd=1) models <- Mods(exponential = expo, doses=c(0,1)) plot(models) } \references{ Bornkamp B., Pinheiro J. C., and Bretz, F. (2009). MCPMod: An R Package for the Design and Analysis of Dose-Finding Studies, \emph{Journal of Statistical Software}, \bold{29}(7), 1--23 Pinheiro, J. C., Bretz, F., and Branson, M. (2006). Analysis of dose-response studies - modeling approaches, \emph{in} N. Ting (ed.), \emph{Dose Finding in Drug Development}, Springer, New York, pp. 146--171 } \seealso{ \code{\link{emax}}, \code{\link{logistic}}, \code{\link{betaMod}}, \code{\link{sigEmax}}, \code{\link{quadratic}}, \code{\link{exponential}}, \code{\link{plot.Mods}} } DoseFinding/man/planMod.Rd0000644000176200001440000001640614654153534015120 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/planMod.R \name{planMod} \alias{planMod} \alias{plot.planMod} \alias{summary.planMod} \title{Evaluate performance metrics for fitting dose-response models} \usage{ planMod( model, altModels, n, sigma, S, doses, asyApprox = TRUE, simulation = FALSE, alpha = 0.025, tau = 0, p = 0.5, pLB = 0.25, pUB = 0.75, nSim = 100, cores = 1, showSimProgress = TRUE, bnds, addArgs = NULL ) \method{summary}{planMod}( object, digits = 3, len = 101, Delta = NULL, p = NULL, dLB = 0.05, dUB = 0.95, ... ) \method{plot}{planMod}( x, type = c("dose-response", "ED", "TD"), p, Delta, placAdj = FALSE, xlab = "Dose", ylab = "", ... ) } \arguments{ \item{model}{Character vector determining the dose-response model(s) to be used for fitting the data. When more than one dose-response model is provided the best fitting model is chosen using the AIC. Built-in models are "linlog", "linear", "quadratic", "emax", "exponential", "sigEmax", "betaMod" and "logistic" (see \link{drmodels}).} \item{altModels}{An object of class \samp{Mods}, defining the true mean vectors under which operating characteristics should be calculated.} \item{n, sigma, S}{Either a vector \samp{n} and \samp{sigma} or \samp{S} need to be specified. When \samp{n} and \samp{sigma} are specified it is assumed computations are made for a normal homoscedastic ANOVA model with group sample sizes given by \samp{n} and residual standard deviation \samp{sigma}, i.e. the covariance matrix used for the estimates is thus \code{sigma^2*diag(1/n)} and the degrees of freedom are calculated as \code{sum(n)-nrow(contMat)}. When a single number is specified for \samp{n} it is assumed this is the sample size per group and balanced allocations are used.\cr When \samp{S} is specified this will be used as covariance matrix for the estimates.} \item{doses}{Doses to use} \item{asyApprox, simulation}{Logicals determining, whether asymptotic approximations or simulations should be calculated. If multiple models are specified in \samp{model} asymptotic approximations are not available.} \item{alpha, tau}{Significance level for the one-sided confidence interval for model-based contrast of best dose vs placebo. Tau is the threshold to compare the confidence interval limit to. CI(MaxDCont) gives the percentage that the bound of the confidence interval was larger than tau.} \item{p, pLB, pUB}{p determines the type of EDp to estimate. pLB and pUB define the bounds for the EDp estimate. The performance metric Pr(Id-ED) gives the percentage that the estimated EDp was within the true EDpLB and EDpUB.} \item{nSim}{Number of simulations} \item{cores}{Number of cores to use for simulations. By default 1 cores is used, note that cores > 1 will have no effect Windows, as the mclapply function is used internally.} \item{showSimProgress}{In case of simulations show the progress using a progress-bar.} \item{bnds}{Bounds for non-linear parameters. This needs to be a list with list entries corresponding to the selected bounds. The names of the list entries need to correspond to the model names. The \code{\link{defBnds}} function provides the default selection.} \item{addArgs}{See the corresponding argument in function \code{\link{fitMod}}. This argument is directly passed to fitMod.} \item{object, digits}{object: A planMod object. digits: Digits in summary output} \item{len}{Number of equally spaced points to determine the mean-squared error on a grid (cRMSE).} \item{Delta}{Additional arguments determining what dose estimate to plot, when \samp{type = "ED"} or \samp{type = "TD"}} \item{dLB, dUB}{Which quantiles to use for calculation of \code{lengthTDCI} and \code{lengthEDpCI}. By default dLB = 0.05 and dUB = 0.95, so that this corresponds to a 90\% interval.} \item{...}{Additional arguments (currently ignored)} \item{x}{An object of class planMod} \item{type}{Type of plot to produce} \item{placAdj}{When \samp{type = "dose-response"}, this determines whether dose-response estimates are shown on placebo-adjusted or original scale} \item{xlab, ylab}{Labels for the plot (ylab only applies for \samp{type = "dose-response"})} } \description{ This function evaluates, the performance metrics for fitting dose-response models (using asymptotic approximations or simulations). Note that some metrics are available via the print method and others only via the summary method applied to planMod objects. The implemented metrics are \itemize{ \item Root of the mean-squared error to estimate the placebo-adjusted dose-response averaged over the used dose-levels, i.e. a rather discrete set (\code{dRMSE}). Available via the print method of planMod objects. \item Root of the mean-squared error to estimate the placebo-adjusted dose-response (\code{cRMSE}) averaged over fine (almost continuous) grid at 101 equally spaced values between placebo and the maximum dose. NOTE: Available via the summary method applied to planMod objects. \item Ratio of the placebo-adjusted mean-squared error (at the observed doses) of model-based vs ANOVA approach (\code{Eff-vs-ANOVA}). This can be interpreted on the sample size scale. NOTE: Available via the summary method applied to planMod objects. \item Power that the (unadjusted) one-sided \samp{1-alpha} confidence interval comparing the dose with maximum effect vs placebo is larger than \samp{tau}. By default \samp{alpha = 0.025} and \samp{tau = 0} (\code{Pow(maxDose)}). Available via the print method of planMod objects. \item Probability that the EDp estimate is within the true [EDpLB, EDpUB] (by default \samp{p=0.5}, \samp{pLB=0.25} and \samp{pUB=0.75}). This metric gives an idea on the ability to characterize the increasing part of the dose-response curve (\code{P(EDp)}). Available via the print method of planMod objects. \item Length of the quantile range for a target dose (TD or EDp). This is calculated by taking the difference of the dUB and dLB quantile of the empirical distribution of the dose estimates. (\code{lengthTDCI} and \code{lengthEDpCI}). It is NOT calculated by calculating confidence interval lengths in each simulated data-set and taking the mean. NOTE: Available via the summary method of planMod objects. } } \details{ A plot method exists to summarize dose-response and dose estimations graphically. } \examples{ \dontrun{ doses <- c(0,10,25,50,100,150) fmodels <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), exponential= 85, betaMod=rbind(c(0.33,2.31),c(1.39,1.39)), doses = doses, addArgs=list(scal = 200), placEff = 0, maxEff = 0.4) sigma <- 1 n <- rep(62, 6)*2 model <- "quadratic" pObj <- planMod(model, fmodels, n, sigma, doses=doses, simulation = TRUE, alpha = 0.025, nSim = 200, p = 0.5, pLB = 0.25, pUB = 0.75) print(pObj) ## to get additional metrics (e.g. Eff-vs-ANOVA, cRMSE, lengthTDCI, ...) summary(pObj, p = 0.5, Delta = 0.3) plot(pObj) plot(pObj, type = "TD", Delta=0.3) plot(pObj, type = "ED", p = 0.5) } } \references{ TBD } \seealso{ \code{\link{fitMod}} } \author{ Bjoern Bornkamp } DoseFinding/man/figures/0000755000176200001440000000000014654153534014674 5ustar liggesusersDoseFinding/man/figures/README-example-1.png0000644000176200001440000001654314654153534020137 0ustar liggesusers‰PNG  IHDR àMR/½PLTE6:af6ˆ:::a¬f¶r²6666ˆÏ::::f:::ff:Ûaa6aaaaˆˆa¬¬a¬òff:f:f¶ÿˆ6ˆˆaˆ¬ˆˆÏò::fÛÿ¬a¬Ïˆ¬ò¬¬òò¶f¶:¶Û¶ÿÿψ6Ïò¬ÏòÏÏòòÓÓÓÛ:Û¶¶Ûÿÿò¬aòψòò¬òòÏòòòÿ¶fÿÛÿÿ¶ÿÿÛÿÿÿD“ pHYsÃÃÇo¨dLIDATxœí Û6²Å™ôák¦q²uºw£ÔÙëÜ]m“½µê¼$Yßÿc-AQ 9À€<ç—V~ŒÀƒÑßà¢ÀìA‚•Å6Ac hPH´($Z- ‰…D €B¢@!Ñ hPH´($Z- ‰…D €B¢@!Ñ hPH´($Z- ‰…D €B¢@!Ñ hPH´($Z- ‰…D €B¢@Ûz¼Í¾ÿ@ŠÜ½$Åí®²ì†¸Í²§wœGž‡h[ëKõ ýŠò~usØRÀÛ½¸;likâŸÐ,@[Ú¿¹£ P›ìgÒ8¶½x(FeÒz<:¡É1‚.V N&>ÐO´j%iSÐ<©Çß~ ‹P“JĪVI5èæ5èråÐ ¹d¤Ô û_ ÆäÐ qn~ Õ ëÌâ,ò$‰ (}ü$º_eJÄ¢v m‘—™ˆ€ªÕ#’Ôé}÷Z±Št¹*F(Ö…ú5yÀÛdÌoÌC- ‰…D €B¢@!Ñ hPH´üJm™ì TƒÑŒ»Y\&ítz sËâÒ @ã7èôæ–Å¥€ÆoÐé)Ì-‹K+ß ÓS˜[—V¿A§§0·,.­4~ƒNOanY\Zhüž2ÖQÐo‰*Yãé: &JÖxºÎ¨‰’5ž®sj¢d§ëùÇOïJðÊÿU6¿ùû“wUš?V}ùá?%¤ª“ÿãf|&€Ä«ÿ>?+^Ø÷EZÔ7_^ýðÛÑ8=9ýüLÙV¯®‚òdûëÛçß>Šqþ¾pö){rôd³ñeöœôª=~ãôw6@˱èõ1Ÿ¾û×—_Þ•?à†­–NÕÿ^׶‹ßüó—îÔÃE.ÎKC ¶ µÍãoÞ«ß7Oñ•Íão>UèÖ?>½$Uœ43@«÷o_«âç»ÿ{&ГÓ6 'Û*à5ÛÁ¾¹9ÿØôdócÐfÒK@r? Ì ÐÓ|²~ÅÅÚsÚN¿¾ý+ßÜî›ãzíÏ€Ö6Û#h+éAKu=ŸiTæ> >Å×¾Z€Ö¶‹Òÿ¿•R=WÃcUi6m¶«ÓVÒQƒ–êZM-Ÿ¼;þgÏÅÚrÚAkÛŸ8‡P'çLJ'ï¾¾ýá¯o³³Íò7õü¾áþùyÿõ­S1=3@Ë…7õªõ¹wïÕ;‹¸×A §½´´ýþ‡?\_ٶܜ«ŠùRKFYö·Wg›çuÐS züñ{¬ƒÆQ²ÆœsÌx,@M”¬qj(QÐÆ×÷ÄçPã¼6(¸Ց3ýÙÃÞ 5 a€j@K‰0@5 ¥D ÐR"ŒPüš”’5ž®sj¢d§ë€š(Yãé:¨ˆB‡(Â8jPh)ƨF´”ãT#ZJ„qª-%Â8Õ³øRÉO×95Q²ÆÓu@M”¬ñt{t÷òÃñ‹ÇÛìûc­‰(tÆ”çç¯E§6‹¨A[†¨ út¿:Q¹¾TÿFZ“h~¸?çU„qb`˸@Û†¨ zt“ý\ û7wçÑTÛšp@sXçU„qZ`Û¸@;†¨ zôχ”êQAzj¦ýY/÷¬qyV$5oþ<ºñâõ#ϻƽ9'<楎†Œ3Q}=&Û´¨¦5á#h‘Ù”NñyCRNñG3ÇS|õ¥Aƒž'IÓ€Š×Ð$)š4/ñÊ¡¸XΛžŽ_Ò­@'ÔJ¦ãùÙ“–K½â8²f@¨g@§'IÒ% Ðzò2±jÄ Ý¼ïuÐ9,3¿‰nœ>dK¹P™ì›lŽt"T º¾V+¢i/ÔçR.©Ét^N “IíÀ¨€Ò[“ h~ˆhwÌt}C&H&µ;ƒ Ô¸¼Ú¸þtžÀåvzôzˆPj\D@GJMù€’'¨dõÒçÓxkÁÐh†NQÈ”›˜ŸŒ ÃêçΣñÓò¦8•¦ÜÐþD8VH@}©$Љøè€ ®Aó^ ?ã¹Áâµèt¬úÇgtP§Ä…TÔåMÑ€ŽöahE¿û$JŠ èqž|j èxì< €Râê¤y´>³{ía@'þƆl?€âÎ)ó h³î\2 ígŠT¨ô©f6îmÎÞW”;tgð©T/ÿ€ú[RÒ)DÊú3ôdª—w@CÒy’rÇ <=: 2kÐf¶<Ô ÚÑ3ñÔð³F}é«qª•_@‰×ú´8— ÚuªÕÐœ’ŸëEJ2¥œà(Sƒƒ«r Ƈ§FIJ*@(Sƒ5~§Ú!0  æ’ÒIóÞ]|@j8ۮƃ®,µäóBÁœmIBÓíË ñðô|¡ _¿¬¯p\ #évÔéÙnò–òrS„FT^ :rñ—‹ñÉW1Í”ûBÖÎçhhO½d³Jx ÓTmþÇy!+ˆ½¾ÛÚ8Ã*¡å‘+yœÅó^È @'â¨a`ÎÜ`@ÇâÆß#·0N¿X€êŒ¨,ñ|¶Ý`ÌÕ¥Z^gñÜM6Û -qʼc¯„m/üЖ<öÂä!ùJ¹>Ë…úÛ耊ªAµévªA öbH²íNº #q“×iZJô“$ 9wƒe›w-el<÷`\ 9wƒÇVEM’:}!1mË ²–™ä:t.v”¿B3 ôhà'Æ´„Y<¡X44.aú^ÉGʃt€ÖbTŸÔÇAÊ’n#ã’ø ÖSƒR>Ìfb\÷#CΞkPígÜ\ÔÆÐJÃÃÕ €¶äPÚ§-èYá·åÓÜ+§ìõ7¾È´‘1j'Pã Õhæ³xê|”l\Ô ^‰;åÁ:@•¨©hPq*ŽOj}P 5èx¶-jÐÝɆx=Ö CÛÿY78çÐÇÛú&ñ»«ìéÝXk h_‰º¾Tÿ”ö«›Ã櫶µ9ê÷åèàö¶ Çùtÿæî°{YR©ԷíÅÔ`KšqÏ/_|@;KЕ·7‡íÅCÝL¥ûBʈÇ{ø|*þþü=Íxî×xÓ9Ž5å“)cziÊ”Wš`ÎPUŽžù´jÍ·Læ£$ãò¦ðÞ”í çt¿ºž¨A£ €šjN€N× ±e”mŠq‘|r¦I"dÛl’4¶{#ù8<ž&Iþ{p™éñvê@½Ð!íWåBýúZüB½á¶ˆtbJ›Çã–ýV§é¶ˆ€ €zt|U‹'â¢SÆóÑiã2çðŒ)ÝAj"¼‹´ÜšÛôI“Æ¥ò @­©U{ü“mRƒ†¨ÐbÖ S¨78·P@ÕåÕµ@hw_jƒÔÅ5´»?uñ@M­¶æž0æå‹èäÔ¦ NÇE4–¬¦£ÆÅÎá¹R¡ƒÔD 4Fÿ– ¨]®hpE4Þ2“EƒË®A ›ø›5H‰ & Ž4… Í PÛ»o,PÊÔF ’â ¨õýѨ‹J ´¿ýÔ¨ñéû€‘ÃÈ (it“iqÑ ûÉè¨qÁsxŽ”Gê5 ®êé1ã¢ù Ö _ƒæö Ž¶§¥ÝÅ AbÜòu¹= uñ@)N·‡1n&  Ä۠ФÆP“¨‹Jt»Ñb!ÍÐÀr›‹Ž—=‰wMy¼Þ- PÇDÎ'õqP VŠØ»è€­A]o3l<à;ÕjPò¤è†¨q‹Ôùö0ÔÅ  –ÇIÐò ™æ.&­ÔýþE ”~§3ž@.@×»«z·oÐ KTÝæp›ÿõö ·i-€Üç¢ËœÅGí›# ëÎþM˜Ê,†<—Îç"-ÎíûÕÅÃ~åtŠ&Ž4Ðàr›$eOïoùŒRƒ²ì?h<äÅh¡kÐI>¥Ö ö A¨­"Êsó”!ãA/F èô ^, ·Ç;%;M’ÂÊ´57uñ~Ô˜LMkÔ[àÒUo$Ù)ü,ži":d\ü$Þ!å‘ûæ¸êõ |âJ2 .@m˜ŒÊ'Ï€ÊçÓ>å±ûæRƒª÷9¢eÛ·sÀxØOì„­A €Ê­A³4fñ|»Î-PÊ*Ða=ÞÖЪ¥¨Þ\*, Œ»ÎP?r]Ÿ¯ÁS—佸i €z \< §s|÷¿swؽüpúr¼µøzó€’¦Hb-FÇÍåawÕ*)8+2+Nëf*ÝRFB<æŒíéça:âôh™ò<ºó2Z,di~¦ê·‡M÷3 @·ÿÎúsý ËLœë$zã±Wb(²K¹€ž9.Ô+;£dÐb†´}:VƒúkŽhp9-Ô_7ËͳZ#èC×BÖ ¼ŸZZ JTl ª>ë±¾îŸâÔªj|ž@g@‰¨X@ÕZR1“ï¯Ó7—™®5ª (ó…ÄÔÅœuЊÚÎr¡~t’äPîË਋9€š´@½:šçÉZŒ”kó«BƒÍâ¹g¡KšÅç2:æt5ÓÓ»úر1¡¡eOð‚-ùÐ3Çe&5ƒ»qzhp9.Ô+@ݶ¾ñXƒò׆Zã¡w. TƒæyꓤÓº6ÞÞ.  ÀY êI, U º1¿®> Sé Ê=¿‡B‹sÅgYïv³Ö¨·@ÇS¼ï7ùhqó] ÔV!fñ^& Z㦺Ӳ™Å‹+ê¹ê"?ù Áå4‹7ßÞè . ¨”Wr\K”gg?…Ž§OsëŒû¨uyjÐÜ÷…fÄ8ÇuP;yÔ×g¨‹Ÿà“¤þ牉 Aè•ÐE¼}Xv9€æ–Ça d;Åsl@½.P¹Û/z›.f/§SÑ'Iä/»ãr^ÊQ-PžI·ÈT° .§S¼ÀísòUbL5hø›´¨Asëã°Šz/ž7 ×Ðaг¸Í¨.€šÈç)Þëhn–À9ê÷ƒ ÔÅOš€2Ëïôs!³xI}š žS» @Eu €š¨o\Ô‹9¢ÅZ/‚ŠZõýrßøô‹™^ zêjP%Î,äÜ v¨‹ŸÅêõ€ºø (ÇîvÔ[ % u—’”ew;ê-pé€JÛÝ.Àäs³xY]r¼`Ù}w;>ÐÑS.¬G #¨Ûîvl ‘X\î5¨Ýí‚TN=ãž>ÏhWƒž»”z *kw;:G´Ñ£ôµ•@ÃüÝP?”³Am uñPaïÅJëümv(i@•Ô­Œš›Ûµæ¤@SÏžqaSÞaQS.®CNËLÇEz7“å:(]¡Ò @ƒËq¡^)þB}°¬Ðàr\¨WŠšVVQƒêâZƒª!tãVƒ2d¡M ÕÅ-ÐãTÞbp^@;P]Ð`ç"rœ—uÐÇÛÆÒÓîe¯D AèÖ—êßé›þ €  åËýtÿæî C*NU—·t𠨎ª‹ &bk-ô¬sÞ³x‘±ôñ–éŠzÏh׸ȗT+BÊevÆzݯ,>ÎivÐ)…Ï( .§e¦ÌòVs<5è@BCÖ ”×4™´×™Ô kóÓ{·5ê-€Ô*¨ùÆ"4L -µ»Šó±ã!8¨.n©€ªÉ¼ùY€ 44ìU ä8'@·š·1í[3S”9çœgñBûâè:Ë.5?æ;è˜â¤€—5 » ¼ÉAÇ@Í4™r©]‰þN’]¡3’NÔ º¸É4ðe7ä¸èïÅ[ea ª‹ & A¨­æ(©nKÐÐ.’ã’t ª‹ &rl-Þ„³c\êÌW£©”‹í 5Ñl•Û“˜L\Ñ5®K¦r‰T7Qƒj{‚T €z  ¶ A¨­\„€ê⨉h@: úŽP ÅnÎu/¸#‰9“4¸Ò4v"g ¨ä~DÔ¨.á¼z5h­Ÿ%Ç%(+´i €z  ¶š  ´ÒM> 1>ÀMŽK P^ èI”§5sͶq†ÈK¹è~¤hžKÈã,•ÝDÍeä€Wt@IuIÉ'1‘¨Auq#5è`7Pƒ*Po4@‡{@•h¦sU„Ò@uqÔDËLd>¨6€šÈfõšj u‰KPš„Ì4ç8‹Þ‹4•’D\I*&‡4¸¢J©Krb¹A“¸™× ‘vZ%Ç¥hNŒ#7h@¹üPjƒFq”Ë@oëmÁÕ-å{714'Æ‘4‹ \~亾Tÿ”ö«›Ã¶w×Y$h¬­€Éq>Ý¿¹;ì^–Cèöâ¡O»C¨Qk’f™-ã’ŒMj(åâ;áP§‚´’Eí[•A\ݣ詙J÷…Šoï 91.ÈcËx.Àùq åy|g'd&˜stÓ¿’A Zÿ…Ë«A™/ÿ‹RƒFÛíŸç}Ýô¦H4P Pc’¤?h @:¤ó2ÓîEü4ôœ@j8 èxæ è~U.Ô¯¯Õ‘5·ì&ÚH 5 ¶¢¶&n dnËL t€š€—d@奀Wt@‡ë’vöPƒ¢µ @m@ƒN:Ѫ4hº“=j@m@ƒP[QZ9Áœ×,>‰HTfòhp ThîhpET_—ôs‡Ô8pªêjP%ê-pÐIÿTIkZ“;j@m@ƒP[MªK5tÚ>ÜÙåœfñ‰Ø & Á%PÁ™ ÁÐ~]¢ÏjPã@Ô ¶t qÔ8€Ú €  ¶t(oÔ8€ÚjÐÁ´PãÀQ@ î¨F²ç–3šÅ§â^ ÂÓ@ƒK Ò³6@“1ÐV]°£?jPm\·¥˜G ª@½P[ ÊqË ª &”e7UªëJò@•¨·@j+}k L,g3‹OÇ»@SÈ .j¢¹šõè€ÖõÓFA¨Aµqí”f5¨ÒÉ ×.T@M@ƒP[ieûv0@©uœ@@™ÿ´–(ßÕ³T@M4‹k¿Rñ|T²ëÔD4¸DšLÂhpE”úÎ0jPã@Ô ¶ A¨­:€²^Z@µqM@¹ÏPÞUcª M=Þ–÷‹ï|©o €z  CZ_ªÝ/µ­åy¢Sʤ|7§•q/€îßÜv/?t¾Ô¶–§õB'küìµáýg~­‹½ŽŸþi¿³½Öe{„" ¨ ï74m ÓÏÿÕ‹ú¾×Ô†õ z·;y>™NÿüéïmI jćï7äAßwRösç»/þû‹ø;5£[«ß½ùìç½ôÃ÷ÍËÞß÷L¡wjG·Ú*¸Wƒ~ös«í›/~o¯ò,“ÄAPÆFPWLÚÌi¤ô&jž$k%#(ÉÒÉJ²t2‚’,Œ $K'‹ °AAiDU®ŠHΙŒ $K'#(ÉÒÉJ²t2‚’,,*(Ài¤T¹*š_²Ý„Ql Z£&5 z:AIFPÿÞjÔAÃZø4sAµ’4ioP. …ƒ  ¨ 5V‚5Ö ìƒzSc2‹$ïÞjÔAÃZø4sAµ’Ô»·5Aа>Íak AAQAk¬k¬AÙõ¦ÆdIÞ½ùVÀ_†ˆ”  káÓÌ‘Ø‚î99ÁRÍ–ê4Hå zð^†IŠ ©Ãv/sÅ «¯©|ˆÄòkö‚:ÙWˆ£E¤/“We êÜQ 3©úñùc¹ºé)j³h¡nõ˜çQ9®J*Á$ÉþÛ(óÞõ?(‡3‡ !„N—ÅÖ š„]>NžHuÿ±éò :刎Rå‡ýRá{ŸcÕ—stê<½z°U¼•G²¨ º8pªç´–ŽDt-wºŽÐ§™#Ù6N÷³wÞ‹«Ó 9ˆ¨Íâ†&ì`·/1DŽ#Å•|¢‚ž¨Ç"Înwê•`ºd -gºý$îŒL…‚N˜ÅÖ ™]÷Ú‘õ<–5qc¦ò}.QÐtçÓ´ôÊ7w‹LõîíØ`¥=Ùª)ƒ .æµ·Ô‚–ñÜ'?”Öå»ÌQÐÄgùÓu/÷p¦È“Ú1 A$åÚ˜ –/æQA×c©Ïù09ß8Çx8ÌKåç ¨KrK'>?kÂ!²Hòîí  †š¤¶4¨ï(—rõîMQÐõ·ÓYê÷Rë˜E&‚z÷vh°ÒŸJ—„4–ºšf탠ÑzÓtÝ0ß:Yì F™› È{ÍœaóÕÒC›š®`D¯ÇrŒÙäGćžPͱYØõî­`AG‘qä®Ô(h±5¨ ÊƒUcrI‚æY1ç¥Âçò#¨?ª•,*h†ƒ° ª"–¬LA.›ço?~ؼšÖÛ´Ÿ*‡¹ß¿0’zý¢ûoýáÙíý·WÞ½ÕcyJ0'6û «×W÷ß½Ý~Ò‚’ìÚ§ٚNΙO?v³á¦¥ýôÆç¶ñlxÛ$îÿðmc”Û‹Qn{¶O‡ÛÃl¡‚.ÏþÓ4þ½Ìc™~Í•/w©¨x]¶+¤å³(5(‚&£fAÏnÛ…üp 9!¹N"kéœØº³HênT=Y™äÛLí%þùÛÁ÷•µcþ÷0„$‚®ÎûúVÎ~£>Æ")ÛèQ æd>ÏEÐJ“Ô*ˆd§dµ Úƒ¹;¬…O3GüÍw T+YTдùI2H¿\AÍ’T’ _Pꌠ2ÝG×<»‹ jWƒVW Ú óiJÆ‚f<Õ jw‰GÐê«Aó-’ÜÞÀbð3Ž]O=6ÏÞj´ô¹{L¿2–»HBÐœ¸ÞgOý¢$‹ š2]'K’È ž‹Ð§™#*œÏÂI ¨ )量ˆ‡ôi=–ódêW‚'ûñ¶Q¹î.AЬç¯8A#LÊe ‚P¬M»è—jåûŒ /wökéT ¨7‚f^Ï è¤Þòž>Ë[aOA½1Û¬d3Í5al®œãýœŽ¨ »5hÞK¹Ítü®\ ¦bû ¥ ª¿]®œ¬/hî¢0bW~+eMì’t@„¸ÀµxqaeIFÐSâ&mI¿ø×.YTÐdÑiâ"l_VµýùõÆïØ¢m¬W¶AW(=€¨ v5èÉ¥J¢‡#-ýdÔ»·Ožûä;eIg9I-|š9",èAMÒÏpÊšØ%#èF5ÌT²Ö§™#²‚î?#ciˆ a-|š9âÓ›™ ,«3€ žl¥´p“߆1tטmø 袂~¬ÇrZ•»‘ìƒz÷f!èºèd©¢•Œ Û íÚ(WàþÔ§™#b‚>Y¯+_îR Þ½etPt"¨V²¨ ‰‚÷»ß[±–Î ‚éy|;Iy6©qAçøÜ¡Cè‘¢‚në±4ƒvl³“J0'Å8uÇ'OÕJ®MPÞ>¡°äº÷wyÀÜÖ§™#F‚:-ŒT+YTÐø±®Ïa-Ývdñ;á ¿cT!¨à¦çEdvD½‰ëÕ •`NJßë9}Ê ÚL&49ÅÖ 7‘RýŸ /0Xžzîø”»÷yB ŸfŽd4 ³ÁŠ©d@hÜß çü-|š9’KПÏ/èÖ â"Ÿ¶Å #5ì”æÔ`ÂœD gë4øìåñelt‹1õ&Ú™ *<ØGQø˜}ˆì¬¨ 7“B§œ’ä'éðw&'uòቶì}ÐÐÐI›HP‡™d¾‚Žf:N®3tâÒjÒOöèx•«KP×äÙ :µJ^ä;w¨³Í¤”<3A§/"#ÞSÏ‚†µðiæˆ[o6ź§mp’XÐÕy; g·>Gäê?ÀQž[¡°™¡Ç˜"èòÙUûï¢ÿ7A¨÷Ó‡äzcågð£Ó+`¶™ÂZlÖ¯á7ø]å£ só2è‡b‚†µði¶áárÇØûïöäuêÍ=2êò=`sKfû <Œ½~Ñý·ýdv+¨Åƒ;íªß93EÐÕù«¶Ýß©ï–÷çÍå—a3¨‘ŸžDý“ññºšS½>»½ÿfw²ÜÐɹ݃zøå·A·%ëMKûéÍ‘ÛæÄ÷?Þ6ŽíRÜ61ûkÌî‡ËxXÝ:>éy|‘tÑ/ä÷öAw]¼ ªAoÌ&P¥JäÚSy©b—Í6<ÙfJ8ƒ ʾg4Œm'ή.½~Õ}ºQû bušLO´c’ ­ˆg·k S„féÅ74]*‚Ž1éÉ"Ï®Ý"ÉÛP·g3Mî$ˆ£ÉI/îv‚ÚU¿IŸúpùªªÝÞ6S„Ðhµ‰7ÇNYZ…tŒ‰û  )ž°|ºôŒtæpÇ©×F:F„4ÅK>BÙŠÃÁž“û£¬‰]òô4É–O´H(Ë®3l-)kb—Í0yLqjo¹×Òyôä—`Œ‰5hÒÐd?ï™–)Aǘ¸ŠOz|720Ö‰½älÞ°ŠcÒ"É{É9ôX‹´9õt¿6Éáçxr.HCTÐýé]'(VÉ¥šk•¬“t ŠÌŽ•«Æd ¤tRU4é`•ë±“E’7íX•«Æd ¥ ŠŸ• *èÉÚ$™ ÊõXÉ¢‚žj‘nU¬“Ë4á^y°jLFÐʃUcr‘‚¦\!)VÉÊ‚6ãí|f‰¨ ›Vc.¢gUh :Ò?ëBTЛm“û©\Õ˜,*hó©Ñnã å§ò`Õ˜,+è§6­Ì²:R¬“ tcf¦Å»ò`Õ˜\„ ¹GʃUcr!‚B­ˆ ŠŸ°AAQAoÌU®ÇjLÔîñvåÁª1YUШy>(VÉ:@y°jLFÐʃUc2‚‚4¢‚¬APFTP媈äœÉJ²t2‚’,Œ $K'#(ÉÒÉ¢‚¬APAAQA•«"’s&#(ÉÒÉJ²t2‚’,l#(€+‚êå‘\x2‚’,Œ $K'#(ÉÒÉJ²t2‚’,Œ $K'óôAAi¤APAAi¤AP&« —Íó·9w¸ÿÎ&ùþ›¦¹0I^6ͳ+“ä˜g;« ×/ºÿLXÛüj¬Î/—&žÜ{õ¸´š®£çtõúÊj"[4µ ^žÝ¶›)t}Æ-X~Yä ÚÉitÊþwku‰\Ï¢6,Ú_~ù ACÂ0Ò¤-jÐÅ«2kÐJ]˜- jÐÕ¯Wšš…ÙRÚª½¾(to¸H²Ôpþ4tuÞ¿ì=RÝ]Ë6“• Ýf Ýåýþ/6Õo¡3h÷»UÛFýuÌÙÄE3‡³ÍC ‚‚4 Ò (Hƒ  ‚‚4 Ò (Hƒ  ‚‚4 Ò (Hƒ  ‚‚4 Ò (Hƒ i°y³†‚ i@ÐH h4ŸEÓ<ûg'è²išWë7ë_—´Ø|œAÐètoœµìÞXnÙJ¹:ÑúyñØÒ½Dþþ õAcÓëøxýìêá²S±½ÖoßßcuÞÁò…òå ±Y Øz¹6µýwûÖëºtýepAc³x*h÷Öv—} ºl»WÉ— ‚Æfí¿Ü^óYÙ€ ±Y¹Ø©Aû/·3©Ýû„ ‚FgÑ/àwVñ½£Ý?ýÝ]3ú€ ñÙÛín{-»}Pñ^ (Hƒ  ‚‚4 Ò (Hƒ  ‚‚4 Ò (Hƒ  ‚‚4 Ò (Hƒ  ‚‚4 Ò (Hƒ  ‚‚4 Ò (Hƒ  ‚‚4 Òügoï©VyMIEND®B`‚DoseFinding/man/figures/README-example-3.png0000644000176200001440000001727214654153534020141 0ustar liggesusers‰PNG  IHDR àMR/ÉPLTE6:af6ˆ:::a¬f¶r²6666ˆÏ::::f:::::ff:Ûaa6aaaaˆˆa¬¬a¬òff:fff:f¶ÿˆ6ˆˆaˆ¬ˆˆÏò::::fÛÿ¬a¬¬a¬Ïˆ¬ò¬¬òò¶f¶Û¶ÿÿψ6Ïò¬ÏòÏÏòòÓÓÓÛ:Û¶¶ÛÿÿßSkò¬aòψòò¬òòÏòòòÿ¶fÿÛÿÿ¶ÿÿÛÿÿÿC¶p pHYsÃÃÇo¨d—IDATxœí cÔ¸µ† ,L·»°mɶ¡Ú䶛’vg6l&Éüÿu-ìñ‡>Ž¤sì÷iav&ñ|ôD–d[Îö0&K]¦€ €5°‚Ö@PÀ XAk (` ¬ €5°‚Ö@PÀ XAk (` ¬ €5°‚Ö@PÀ XAk (` ¬ €5°‚Ö@PÀ XAk (` Äãçì»/4¡îßdÙ‹k¢ˆ÷ÿó¥-œÄ2iù h$._©ÿ“°{EñáTIT‡òŽXE£,ÄÃOçUóBÀå;²ˆÛì‡"DÊ;b²|4÷µ<þýœ,â¯×*LÊ;b²|4„‚>üô‡ìé9UDJA›Ý¤,¡ ÷oÏ÷ùÂVPÚòAÐ8 ª ÑIA/(mù h(IU8¢ˆGƒ¤Ž $É‚nši÷]Ñæ}M±tˆjš©ŒF[>‰‡S²‰úmV†¢‰X Z‡òXF#-¬ €5°‚Ö@PÀ XAk Jž¸°± ‡d$!¼ð:A2’FŠ^x I#E/¼NŒ¤‘"„^'HFÒH ¯$#i¤á…× ’‘4R €aœ•¢ôsŸÝ$C‚òÉЀ ü@24 (?  zûþCñÿž‚j¬[Ð[5‚j@P~@Pu ª½}ÿç÷Y¦\½Ê²ìDýä"+?¸ýñoÙ³Ÿã,‰ õÎ{­²qòíu•’:WEnߟ¤(½}ÿäÓÝUýçÛë¢.^Þ•onß?ÿ%A¹’Úìü·×*ê÷RIÙdâ·'wW‰’ᬥŸi-ŽU ñõÙÏ·?~*?HÕf¤´Ýùò7´þëC›‰â'ÿRÿZvE‹¿¾>Q5PVGQ!êÈ–ª“š íΗûø«Î„:Ö¿Œ_*m­Ïý~Pݱgÿ|½.A›ï ÚdB}!ш‚v[Ð;­zÖ$èÑÎw›Óß>þ1Åpñ‚muüªªâëºñí®vm3QŒþû1Q‡ÜY)J?9ZWï.ž|ªÏìdM‚vv¾Ó‚¶™øš¦ … ­ åT ª…âõɧ¢²Ö$h³óG}Ð2Ï)ŽòI†I+”-H†å’¡ÁEP†qVŠÒÏãhÒð´ÑBÉÐà*èšA24 (? Ê$Cƒ« èvÅÛ§p©ú gÔhïœÁê^ó¬8ªåÝÏ“*ÁkÞ0˜ŒÌá„’« ½6$­†|ßo3Ö“Œü@ýa2\½<3ůÕbÐ dз²û³þ'±I§eƒ}6mÝ®ª:Ö1Í4¥åT´ÓL˜-iªjÙ‚i9-’ õ3ê/ß©7TÑVÙ"5k/ ¢áTg’pzÍÉ´¯ ›—-”E¸Ný‰ô0µîifA—Ì\- J†Ú3Ç€ Ñ™­J1Éh§ÖAc3_’Ñ6šSë´p”q·Ë'ÜСPV´<'>¶‹éƒrªºpƒ•)GÐÁ®æ2®µŽÆ¥N(Ã46"AP8:z,ä.èÌ‚^Љ*f,¨ÉüÑJ]V# &É7·i mM3HFÀ™wK hp¬k:q2øÈ©à*èbú ó•Í©Jqý‘bú KÔ ºùêÔrBP jÖñÔùÀA Ht—ƒc´èÉðêuBPRJx—CØdx‰V*¨xh}]ã¹Ò>¨\A­+>ª Õú\”'% š .U[Pâžç2ÕVXÞeÙÓóÙh2uªùȇxê‘Ñ2=,}sÿö|¿;Zby‚RŠ ˜ŒÁÅÊüX„ –÷íR¡Åà]ÅK†Œq{—èË/*¶/®Û05›‚âíFêkžÓÅ ” UDɲJFìl‹7o ú Â mš‚$Cbë©HÒ‚.­êWùQú Z Ó\9ã-‰ }PA‚ú¶MáíÜ!è1öƒ$1‚ú:ƒ Ú+!à0ͤï÷ß_÷~.VP‚ž]`A~ƒ èÚ ËÛ,[Ê“æhæ¼Ã z­š…7Z$Ø-‰y„„ëéf€ öTµ®îÉ’!ÞÎ=u ½*&U2–à'[AùöAóò¼QÈëÕˆ’a¼X™+탲”vÕë@‚Ž‚RDã+¨:§ö‚J‚dL5ñ”"_AÉ/X èd!(E4®‚–rÆ®ÛíY>Ó• Ê“8ÓŠ¾ÉXÄ轂Z©æ=“±(?!¨1ñÎÊx%Cþ¹£.\e× wÁiÔe¹G?VÚe&h·]â+¨Ór~@P¼¯ø¥ 7Í1¦OÍ„ Ñ zÜùd)¨ñõ”"Aj£ Õ‚KNÛóc¥‚r!Å Ø)¹ñ!^t’$5î–ŒàÆN'Õõèî-èá*(ƒ>h¬ëHú r¢J-¹ œð;¿=›Æ‚RDK,èôá‚ AM˜ëͱÔª÷ Aа½“eg³ÑR jÿtM/üµAÐ+‹<œžíwGËÛ1ŧ Û&#}‰}m¦Ý‹ë¢=í7¡låPÙ–É`P․YÝ ô´M‹"‡#‰ +,ß(È^7fßËoÌÿÝ^TØ*7¶ÙÐ:t2⯰¼ß²\{%ƒ÷.бFA¹×-ÕXŸ SÍ'9E“dv‚G™ƒÁUÐP=›é£»˜A’¶$ #SЙ£AõÝ€ ÃHtvpAí þÔbÎ+Dš{^?A)¢Qîv¾ßä¤Õ%Ô{;šÑ‚NmÏŵ Aé|.EP{ù'¶ç5gtè.¼N&õߧp‰ÕIᦙ–23žŒ¥ì¡ ¦™Â*zæ³Ëh2³‡Ð úpún¿Í²ÃSf?hVXÞ‡”¦îxÌ)Ú Ê£ÌÁ ôòÅõý½±tŽf׳¡zú+óA +ÏáÌŠ?Cò°‹f¶Û¦·k.CÐáÝ„ ÃŒ zYÈ9ø¤»hF»]ÝŸcÐù„ SÛóC’ Å±ýáôÅõÃiœC¼ùíštj{~ˆ´ ==ülí§³ †cwáuR}ƒj /<¦p¸ÔüvMQŒ$c‰»:`Aóþ ¸Ka8‹ÜÕyh}ü\]zâ?Hš'D…ñ˜S´”G™ƒAÄgGñ º¨nœ¡d¬`·‡‘5ºŽj‚ 2­ÚÍð­'9E;Ay”9äçâ‰ñ¾H~¼l«âI”[qT]°¼}µ¿c=TšTÕNœ§¿BP{$ ª&êw/®÷Ûã{>l£õõ¼*‚NmÏY‚ž•7 Ütd­{ˆ÷½j ‚NmÏI‚>~~×»ÃØ9šVP‚«–„×Ɇtt(<¦ þCu¯Çå;ŠC|Ë&>{'c}9h!žfº|ÕÜaLTŒ5V Õˆ4ª-`ÛYËv:ZôóF<æíåQæ`Ä_Yärè¾ù~´ÒÌø×ä9Hšþ=Å i˜áXß_\_]ªœ†Q½hêñ¯”­§hAgƈt˜á«™žžoÕmÇ}CµÕíº Ý GËÕÀ•òè.YйY`:ÌØ4“Á-Ü0.h¦Ñ¼-ª#Ë‹ÿµï½_7†ß»1ûÞ†ª\ïvɸ • Ã×ÉȈVXVõJУ¥o,[Ðê n4 '¦ZÐËþ<¨­ kœý<€dh„èƒn®«·$­$Cƒ~ŸeOûí£ý4ÓªA24"̓j Øžiš¾XÄáÝ.$ÃÚ_sÔ‰’¡A+h +ê½^'H†ãxë˘Ƣ¡NâmS8¶+‹0 ¥ jÔ1ÚhA24hû ÷og˜ ¨-H†± oªfÙ~”:œ@24ˆñ΋‡¥Î' .ƒ¤Ôyç뇻Û÷ï;o‚7ƒûÓù°Ÿ¨`4ÃQÕ¬BP«/ƒ¤ è‚õX~1ô~^¥:)^žý\$üäÛïÿ÷uù¾8~U?¸}ÿç÷YöáðÍúƒoÅ÷žÿ§¬¢‹¬üÂ"­³Pîä“¿=ùT~¨ö½“•š—Q GÝ‚:ºN®ž|*ò}r÷ÛÇ“»«ç¿IÿPTJY3ªƒõ²øS|ãªþ£¾Ù| ªª¬®‹—U˜% Údáî¢øþšU{ýíu•Ÿ6ÕÞŸD-ÝJ­ÒúUeÿÙ¿~¬ ¼S¦*a‹¨9QMƇö›‡ªê¹-þYYg ´ÍBéäÝE%¨JWý…úOd7KÖ!h‘û»J¯âö²þ¯CÔªjh¿Ù|жwåp‘‚¶Y¨œüÚ7*C› TߊÍJ­ûÆõ1ýîÛ­ µ‡¥ Í7-:`Ïþ¹Ì´Í•.hÑÊšßÈRÐ2i±Y‰ OšÜþöñE%ô=jAï걃&hùÍ…â‡[Ð’‹C/-h8R]=ÿoÑáªú >èÁÇÃ?Ñ-ëîë2ñ½>è•&¨–ôA¢ ZçÿÛëâ}o_Ï é߬ªç¤m?nßg'Ktx_Lêñc;Šÿícäy&:AÛIP¶ó Eò‹FSåøÛë?½®f=ó ÍgýÍöƒ‹z°øüɧ ­q FâyÐgÿ§æ0êË_W̃Æ>“”¦;eJêÓjÍü (?Ò Zæ%M_s úûâ‡V·›À0¤‚Ž­ng ÷‰ÅÛ§p‰V·sŠ¶Z ò –W· WŒ%‚dhÄYÝ.\1–’¡gu;ûhèvÅÛ§p֨φV·³Ž†:‰·=Náf“ÑyHÌÔã°xÇËÓ"ýdtV＜ì@Pø• ÒåŸç“ÑYÿx÷;›Ôï\|ÿÎuB.xT¬¤d. o }ùÇüÛö¿ËÔý΢Ú;g°º×<ËÔCf:Ÿ'/”ùkùô‘\ýƒÉÈÚJº Ûw¶}ÐfeʇÉ.GKIFÇ+šˆÇoAþzm+h³²&êͨ\öÉФPÊ/rÿ“qA/ϬGñÍÊ"õŒ»]ô}ÐŒ“qÜ\?#g.‡AR=ær郪ïoí'B×IØp‚9’GžíL3Ùσ–Z;¬δN‚‡Ë‡¢qLÆx73² Úób0Q<\>]2&A²Nu’EK]'QÂå"éeÊ´\b™â\ü«xVÉHý P⫙ʉzŠ«™VÀhÍóIÙ§;ä׃*0QoÀxÕ³IFr;÷®¨WLÔ/¿ÚÖ>Û>¨™Ÿ’ú „-èâ=Ô>SAMî’%ìƒ.]P­öY jÞù%(Ý(~á‚êÕÏQP‹Þ§,AÉ¢-[ÐNý3Ôft´RAÍLý'O‡Ñ{ ŸW—âr»)æê?u28ùIÙ‚>œ:t>}‹!ÙúOœ V~RO3eöë† G[nô¨þyõA­Ï ëƒ^ÚÞ£APªí1;ù&¨šµŸ]  'AïâU“¡8Õ9‚Ñ%éTƒ\P5˜·?ʯDÐÁúg$¨ËøH– »©Û˜¬£- ÃúO– ^ã÷ RA/³ìÕÀÇ!‹! æ‚rô“RЭÛÞ¯’0 Q2Ò_œ<×3IË냚ß™&®zÊꃒE[œ ãõÏCPçæ‚^P›ûv!¨nªúYêÞÿŒ,¨¶Âò.›ºô‚ÚÀ]PñQdAKßÜ¿=Ÿºû ׃Z`Wÿ ’Ár_2ºxXûÖì:o¿fSP¼Ý,ñµ¿[}?~2òôIMÆø¶ûÉÛ3Ñ‚šbÝ:ÅOßtb}PuÑú þáf+?}ÔËϸ}Ð^ š®ºAç+?¹ ~ígRAÃ÷AÇ¢-EPƒÊO-¨çñ=® ÑIcÑ"¨Iå'Ô·ÿ™lšIÞï¿O5HZ† F•A§¢õ“¡­°¼¼è£øyë>j2àK¸žê\®uA5 h0œ«>f2¸ûÉVPù}P÷åáb&Ã_ÐÈ}Pc è4æ5ŸRP‚‚]P›Û' èT4"œU½'”¢ A ˆ,¨]½§”d„´RA%ã[ïÑ’Á~¿‡ ð®öXÉà'%Ç¿Ú!¨WA¥öAV?HÕ%òs¥}P¡‚’¬¾A5 (e8§:O$(Õ‚IP·:‡ SÑ (]8Ç*O#(Ùi¥‚ʃnq¸(É1„ßCP*(×.Œ‘ )~BPHë‚jpTV”öÆòÉ ôs¥}PQ‚ßX>”í'% ¨ ¾ÝO: ‚ú†ó®ìø‚’v@!( pSÕè'C[ÀöþÍÔ30Š/ 1›Œ¢G"f¿ŸZYäáôl¿_Þ‚ªºRÕA“‘ šbRŒ¯Í´{q]´§£M( VÑ!“¡ÊÌóH#̬nwZб–od¯Úx›Ãû ‹ ‡MÆZP™®Ð›u®°ÌyTµ@ùþ†&\ÜARQlÚ4î ©+è6ÝâaŒÍ÷›ª#'RÐ}NT솄‚n'V_¯ …™ÒÑQlAãÝÿBm|4Ù~®[PÚ‰šØ‡xÑ‚öž“4ÁzGñÁ'CO3‰¢ŸŒÃ¶—åà ÓLG´ÇwâÎ\Kài¦PÅ×S\Ñ{ŸU…‡ јöAs=œÀQ|Aq±TÑòN8y‚–几Ñ8 ÚÝ!¨%€"šÖùŒ]'´‚Êžf2fm‚êÓ3Ríô ©X© ÌˆzP°dH›U@P†kVÚ4SàéÛ0@ÐYFO¼CÐp”OtÀN™£øfG0Š§ˆÆEÐÁÖS¤ íŽ@PŠhL>¸K4ØZJ€[´ÑΧÄi¦P³¸”§hã“2Õv‚&FAÂ[C$Câh ÄHOAÓLúî`š)y4_ [O®‚¦ìƒÎê)nßÙ#Œâ)¢¥Ô ù„ ”ãhf÷K´»O”"ZA Ǻ¦™z{…i&Šh)5žY’%h¯ hòh.ZJÑâd°Ù/'úÉаݷkŒ˜üCÚbÄÆÉNÓLG{&{šé°²ˆZÄ!Ýâaqqkd h¦ÖfÊ~HׂFìƒÚÜ%â÷Mô(^_Ýî×ë‡ø±li_7ã?Ïsûxõš­Ñ°õyÍ>¿¡-tÊlöA#µ n##A-èÀþ-¦]¼ ÎwAÓLã7¬PA Šæ1­$GЉV¨ˆ› }´äi&F³žÇÐ%ƒó^25Í´XA‰êý4SÜÛùÃÐOÆaÛýR%kV¸ ùvþ0p=ÕªgCrl2Š#èJÏÅ“îv+%Qã)Cб}… Ñ(w»z°á±]„ £; A)¢î¶:—¢ít#ZÓL£»+zšÉQ‚Ï* tb‡!hòh]raOH§H†¨ýdñ‚æy°ùj¾ÓL“û‹i¦äÑH;žÇ@Ðp” gì©ìGñÓ¿•ÅSDóÜí^Û¹.AgŽ”"š×nØW%è\¯‚RDó¸Âl ß)|fÅf{ó½náÉ0…§ #£"áub¶½r× …“a ÃQ<ë‹<-pK†šN[ÐügƒlAFžQ„Õ4SÞþ5¦™¢EË›zIÓtrÔ0 ”"šIϦ‘Óx½D*XŽâ!ÅSD347­”šŸÐ… Ñæw»’Ó¬R/¨M‚RD›Þí¦å4­á3+3Û³ì‚ O†)QÕkÀe¼.¼Nf~[}·çÇJíÐÊSL&Åg&µ,>!mGëÌê"Í4“Öñv˦™¢u[ ¦-g,A{ɨÿrN‰lAµ–;‹-ÏþCÒb4÷aîÛ–ÓÏOÑ£x-ûfBÞçVö(^[ú¦³ Î!­îÃÔŽê¾í§dAëdTÿ{Ê©-¨¶xXw±#ˆÍ4š·Eudu5t?w~ÝÅ©_7Õë Yùº¯ƒÉ()?/_<6r$ÔIè¹Ñè¦-¿Ø]‰ñØ, g™<ªù#zfÉÐ`"(õ}˜¢ëÉÐà"èªA24 (? Ôƒ¤ Ñ„ƒdh°œfÚïÙp jùEãíq 7› m…åú?G€ Á¢!LOu¢N"nS8Ê/ŠÆEP†qVŠÒÏÐበ»pHFÒH ¯$#i¤á…× ’‘4R„ðÂëÉH)Bxáu‚d$!¼ð:A2’FŠ^x I# XAk (` ¬ €5°‚Ö@PÀš‚N/[fÅý›,{qM±¼Éµå±ŒFZ> RÐéûI­Ø½¢‹øpZÞOX…òŽXE£,Ð (èÌùV¨ÛS‰"n³êµ,ŠPÞ«h”å :³¦‰ 7Y%ÅŒ_¯U˜:”wÄ*eù@‚>üô‡ìé9UDJA›Ý¤,Ð!èýÛóýÃ_¾°”¶|@C†  ô‚Ò–h$Uáˆ"6Q ’:‚bDŒi¦ÝwE›÷ý5QÄÒ!ªi¦2mù€FHA§—-³b›•¡h"–‚Ö¡ü#–ÑHË4pª°‚Ö@PÀ XAk (` ¬ €5°‚Ö@PÀ XAk (` ¬ €5”ˆËê‰g©Ë±4 (—/®÷j ÜñA %¢t¿{Š›:I DÔ‚>~VMè®8Ø«ÅpÔšbåQ[l DÔ‚–¯»BʇÓW…ŸgûòÍV-;ò†:A‰hÝ~÷åñ³R±8Øïê[<NËpç”MвáTÍgµ4cÓ1­>v@P"´C|eâÃé™ZÐVõAwæ \ Dhƒ¤¶­~Pê1´w‚¡M3µ}ÐòEKªSà%¢™¨/ݬGñ¥£ê/5ŠWMiêB ‚Ñ9ÕÙ̃ª×RK5ŠA¼ °‚Ö@PÀ XAk (` ¬ €5°‚Ö@PÀ XAk (` ¬ €5°‚Ö@PÀ XAk (` ¬ €5ÿ)ÏlPüÍùIEND®B`‚DoseFinding/man/figures/README-example3-1.png0000644000176200001440000001727214762613063020220 0ustar liggesusers‰PNG  IHDR àMR/ÉPLTE6:af6ˆ:::a¬f¶r²6666ˆÏ::::f:::::ff:Ûaa6aaaaˆˆa¬¬a¬òff:fff:f¶ÿˆ6ˆˆaˆ¬ˆˆÏò::::fÛÿ¬a¬¬a¬Ïˆ¬ò¬¬òò¶f¶Û¶ÿÿψ6Ïò¬ÏòÏÏòòÓÓÓÛ:Û¶¶ÛÿÿßSkò¬aòψòò¬òòÏòòòÿ¶fÿÛÿÿ¶ÿÿÛÿÿÿC¶p pHYsÃÃÇo¨d—IDATxœí cÔ¸µ† ,L·»°mɶ¡Ú䶛’vg6l&Éüÿu-ìñ‡>Ž¤sì÷iav&ñ|ôD–d[Îö0&K]¦€ €5°‚Ö@PÀ XAk (` ¬ €5°‚Ö@PÀ XAk (` ¬ €5°‚Ö@PÀ XAk (` ¬ €5°‚Ö@PÀ XAk (` Äãçì»/4¡îßdÙ‹k¢ˆ÷ÿó¥-œÄ2iù h$._©ÿ“°{EñáTIT‡òŽXE£,ÄÃOçUóBÀå;²ˆÛì‡"DÊ;b²|4÷µ<þýœ,â¯×*LÊ;b²|4„‚>üô‡ìé9UDJA›Ý¤,¡ ÷oÏ÷ùÂVPÚòAÐ8 ª ÑIA/(mù h(IU8¢ˆGƒ¤Ž $É‚nši÷]Ñæ}M±tˆjš©ŒF[>‰‡S²‰úmV†¢‰X Z‡òXF#-¬ €5°‚Ö@PÀ XAk Jž¸°± ‡d$!¼ð:A2’FŠ^x I#E/¼NŒ¤‘"„^'HFÒH ¯$#i¤á…× ’‘4R €aœ•¢ôsŸÝ$C‚òÉЀ ü@24 (?  zûþCñÿž‚j¬[Ð[5‚j@P~@Pu ª½}ÿç÷Y¦\½Ê²ìDýä"+?¸ýñoÙ³Ÿã,‰ õÎ{­²qòíu•’:WEnߟ¤(½}ÿäÓÝUýçÛë¢.^Þ•onß?ÿ%A¹’Úìü·×*ê÷RIÙdâ·'wW‰’ᬥŸi-ŽU ñõÙÏ·?~*?HÕf¤´Ýùò7´þëC›‰â'ÿRÿZvE‹¿¾>Q5PVGQ!êÈ–ª“š íΗûø«Î„:Ö¿Œ_*m­Ïý~Pݱgÿ|½.A›ï ÚdB}!ш‚v[Ð;­zÖ$èÑÎw›Óß>þ1Åpñ‚muüªªâëºñí®vm3QŒþû1Q‡ÜY)J?9ZWï.ž|ªÏìdM‚vv¾Ó‚¶™øš¦ … ­ åT ª…âõɧ¢²Ö$h³óG}Ð2Ï)ŽòI†I+”-H†å’¡ÁEP†qVŠÒÏãhÒð´ÑBÉÐà*èšA24 (? Ê$Cƒ« èvÅÛ§p©ú gÔhïœÁê^ó¬8ªåÝÏ“*ÁkÞ0˜ŒÌá„’« ½6$­†|ßo3Ö“Œü@ýa2\½<3ůÕbÐ dз²û³þ'±I§eƒ}6mÝ®ª:Ö1Í4¥åT´ÓL˜-iªjÙ‚i9-’ õ3ê/ß©7TÑVÙ"5k/ ¢áTg’pzÍÉ´¯ ›—-”E¸Ný‰ô0µîifA—Ì\- J†Ú3Ç€ Ñ™­J1Éh§ÖAc3_’Ñ6šSë´p”q·Ë'ÜСPV´<'>¶‹éƒrªºpƒ•)GÐÁ®æ2®µŽÆ¥N(Ã46"AP8:z,ä.èÌ‚^Љ*f,¨ÉüÑJ]V# &É7·i mM3HFÀ™wK hp¬k:q2øÈ©à*èbú ó•Í©Jqý‘bú KÔ ºùêÔrBP jÖñÔùÀA Ht—ƒc´èÉðêuBPRJx—CØdx‰V*¨xh}]ã¹Ò>¨\A­+>ª Õú\”'% š .U[Pâžç2ÕVXÞeÙÓóÙh2uªùȇxê‘Ñ2=,}sÿö|¿;Zby‚RŠ ˜ŒÁÅÊüX„ –÷íR¡Åà]ÅK†Œq{—èË/*¶/®Û05›‚âíFêkžÓÅ ” UDɲJFìl‹7o ú Â mš‚$Cbë©HÒ‚.­êWùQú Z Ó\9ã-‰ }PA‚ú¶MáíÜ!è1öƒ$1‚ú:ƒ Ú+!à0ͤï÷ß_÷~.VP‚ž]`A~ƒ èÚ ËÛ,[Ê“æhæ¼Ã z­š…7Z$Ø-‰y„„ëéf€ öTµ®îÉ’!ÞÎ=u ½*&U2–à'[AùöAóò¼QÈëÕˆ’a¼X™+탲”vÕë@‚Ž‚RDã+¨:§ö‚J‚dL5ñ”"_AÉ/X èd!(E4®‚–rÆ®ÛíY>Ó• Ê“8ÓŠ¾ÉXÄ轂Z©æ=“±(?!¨1ñÎÊx%Cþ¹£.\e× wÁiÔe¹G?VÚe&h·]â+¨Ór~@P¼¯ø¥ 7Í1¦OÍ„ Ñ zÜùd)¨ñõ”"Aj£ Õ‚KNÛóc¥‚r!Å Ø)¹ñ!^t’$5î–ŒàÆN'Õõèî-èá*(ƒ>h¬ëHú r¢J-¹ œð;¿=›Æ‚RDK,èôá‚ AM˜ëͱÔª÷ Aа½“eg³ÑR jÿtM/üµAÐ+‹<œžíwGËÛ1ŧ Û&#}‰}m¦Ý‹ë¢=í7¡låPÙ–É`P․YÝ ô´M‹"‡#‰ +,ß(È^7fßËoÌÿÝ^TØ*7¶ÙÐ:t2⯰¼ß²\{%ƒ÷.бFA¹×-ÕXŸ SÍ'9E“dv‚G™ƒÁUÐP=›é£»˜A’¶$ #SЙ£AõÝ€ ÃHtvpAí þÔbÎ+Dš{^?A)¢Qîv¾ßä¤Õ%Ô{;šÑ‚NmÏŵ Aé|.EP{ù'¶ç5gtè.¼N&õߧp‰ÕIᦙ–23žŒ¥ì¡ ¦™Â*zæ³Ëh2³‡Ð úpún¿Í²ÃSf?hVXÞ‡”¦îxÌ)Ú Ê£ÌÁ ôòÅõý½±tŽf׳¡zú+óA +ÏáÌŠ?Cò°‹f¶Û¦·k.CÐáÝ„ ÃŒ zYÈ9ø¤»hF»]ÝŸcÐù„ SÛóC’ Å±ýáôÅõÃiœC¼ùíštj{~ˆ´ ==ülí§³ †cwáuR}ƒj /<¦p¸ÔüvMQŒ$c‰»:`Aóþ ¸Ka8‹ÜÕyh}ü\]zâ?Hš'D…ñ˜S´”G™ƒAÄgGñ º¨nœ¡d¬`·‡‘5ºŽj‚ 2­ÚÍð­'9E;Ay”9äçâ‰ñ¾H~¼l«âI”[qT]°¼}µ¿c=TšTÕNœ§¿BP{$ ª&êw/®÷Ûã{>l£õõ¼*‚NmÏY‚ž•7 Ütd­{ˆ÷½j ‚NmÏI‚>~~×»ÃØ9šVP‚«–„×Ɇtt(<¦ þCu¯Çå;ŠC|Ë&>{'c}9h!žfº|ÕÜaLTŒ5V Õˆ4ª-`ÛYËv:ZôóF<æíåQæ`Ä_Yärè¾ù~´ÒÌø×ä9Hšþ=Å i˜áXß_\_]ªœ†Q½hêñ¯”­§hAgƈt˜á«™žžoÕmÇ}CµÕíº Ý GËÕÀ•òè.YйY`:ÌØ4“Á-Ü0.h¦Ñ¼-ª#Ë‹ÿµï½_7†ß»1ûÞ†ª\ïvɸ • Ã×ÉȈVXVõJУ¥o,[Ðê n4 '¦ZÐËþ<¨­ kœý<€dh„èƒn®«·$­$Cƒ~ŸeOûí£ý4ÓªA24"̓j Øžiš¾XÄáÝ.$ÃÚ_sÔ‰’¡A+h +ê½^'H†ãxë˘Ƣ¡NâmS8¶+‹0 ¥ jÔ1ÚhA24hû ÷og˜ ¨-H†± oªfÙ~”:œ@24ˆñ΋‡¥Î' .ƒ¤Ôyç뇻Û÷ï;o‚7ƒûÓù°Ÿ¨`4ÃQÕ¬BP«/ƒ¤ è‚õX~1ô~^¥:)^žý\$üäÛïÿ÷uù¾8~U?¸}ÿç÷YöáðÍúƒoÅ÷žÿ§¬¢‹¬üÂ"­³Pîä“¿=ùT~¨ö½“•š—Q GÝ‚:ºN®ž|*ò}r÷ÛÇ“»«ç¿IÿPTJY3ªƒõ²øS|ãªþ£¾Ù| ªª¬®‹—U˜% Údáî¢øþšU{ýíu•Ÿ6ÕÞŸD-ÝJ­ÒúUeÿÙ¿~¬ ¼S¦*a‹¨9QMƇö›‡ªê¹-þYYg ´ÍBéäÝE%¨JWý…úOd7KÖ!h‘û»J¯âö²þ¯CÔªjh¿Ù|жwåp‘‚¶Y¨œüÚ7*C› TߊÍJ­ûÆõ1ýîÛ­ µ‡¥ Í7-:`Ïþ¹Ì´Í•.hÑÊšßÈRÐ2i±Y‰ OšÜþöñE%ô=jAï걃&hùÍ…â‡[Ð’‹C/-h8R]=ÿoÑáªú >èÁÇÃ?Ñ-ëîë2ñ½>è•&¨–ôA¢ ZçÿÛëâ}o_Ï é߬ªç¤m?nßg'Ktx_Lêñc;Šÿícäy&:AÛIP¶ó Eò‹FSåøÛë?½®f=ó ÍgýÍöƒ‹z°øüɧ ­q FâyÐgÿ§æ0êË_W̃Æ>“”¦;eJêÓjÍü (?Ò Zæ%M_s úûâ‡V·›À0¤‚Ž­ng ÷‰ÅÛ§p‰V·sŠ¶Z ò –W· WŒ%‚dhÄYÝ.\1–’¡gu;ûhèvÅÛ§p֨φV·³Ž†:‰·=Náf“ÑyHÌÔã°xÇËÓ"ýdtV＜ì@Pø• ÒåŸç“ÑYÿx÷;›Ôï\|ÿÎuB.xT¬¤d. o }ùÇüÛö¿ËÔý΢Ú;g°º×<ËÔCf:Ÿ'/”ùkùô‘\ýƒÉÈÚJº Ûw¶}ÐfeʇÉ.GKIFÇ+šˆÇoAþzm+h³²&êͨ\öÉФPÊ/rÿ“qA/ϬGñÍÊ"õŒ»]ô}ÐŒ“qÜ\?#g.‡AR=ær郪ïoí'B×IØp‚9’GžíL3Ùσ–Z;¬δN‚‡Ë‡¢qLÆx73² Úób0Q<\>]2&A²Nu’EK]'QÂå"éeÊ´\b™â\ü«xVÉHý P⫙ʉzŠ«™VÀhÍóIÙ§;ä׃*0QoÀxÕ³IFr;÷®¨WLÔ/¿ÚÖ>Û>¨™Ÿ’ú „-èâ=Ô>SAMî’%ìƒ.]P­öY jÞù%(Ý(~á‚êÕÏQP‹Þ§,AÉ¢-[ÐNý3Ôft´RAÍLý'O‡Ñ{ ŸW—âr»)æê?u28ùIÙ‚>œ:t>}‹!ÙúOœ V~RO3eöë† G[nô¨þyõA­Ï ëƒ^ÚÞ£APªí1;ù&¨šµŸ]  'AïâU“¡8Õ9‚Ñ%éTƒ\P5˜·?ʯDÐÁúg$¨ËøH– »©Û˜¬£- ÃúO– ^ã÷ RA/³ìÕÀÇ!‹! æ‚rô“RЭÛÞ¯’0 Q2Ò_œ<×3IË냚ß™&®zÊꃒE[œ ãõÏCPçæ‚^P›ûv!¨nªúYêÞÿŒ,¨¶Âò.›ºô‚ÚÀ]PñQdAKßÜ¿=Ÿºû ׃Z`Wÿ ’Ár_2ºxXûÖì:o¿fSP¼Ý,ñµ¿[}?~2òôIMÆø¶ûÉÛ3Ñ‚šbÝ:ÅOßtb}PuÑú þáf+?}ÔËϸ}Ð^ š®ºAç+?¹ ~ígRAÃ÷AÇ¢-EPƒÊO-¨çñ=® ÑIcÑ"¨Iå'Ô·ÿ™lšIÞï¿O5HZ† F•A§¢õ“¡­°¼¼è£øyë>j2àK¸žê\®uA5 h0œ«>f2¸ûÉVPù}P÷åáb&Ã_ÐÈ}Pc è4æ5ŸRP‚‚]P›Û' èT4"œU½'”¢ A ˆ,¨]½§”d„´RA%ã[ïÑ’Á~¿‡ ð®öXÉà'%Ç¿Ú!¨WA¥öAV?HÕ%òs¥}P¡‚’¬¾A5 (e8§:O$(Õ‚IP·:‡ SÑ (]8Ç*O#(Ùi¥‚ʃnq¸(É1„ßCP*(×.Œ‘ )~BPHë‚jpTV”öÆòÉ ôs¥}PQ‚ßX>”í'% ¨ ¾ÝO: ‚ú†ó®ìø‚’v@!( pSÕè'C[ÀöþÍÔ30Š/ 1›Œ¢G"f¿ŸZYäáôl¿_Þ‚ªºRÕA“‘ šbRŒ¯Í´{q]´§£M( VÑ!“¡ÊÌóH#̬nwZб–od¯Úx›Ãû ‹ ‡MÆZP™®Ð›u®°ÌyTµ@ùþ†&\ÜARQlÚ4î ©+è6ÝâaŒÍ÷›ª#'RÐ}NT솄‚n'V_¯ …™ÒÑQlAãÝÿBm|4Ù~®[PÚ‰šØ‡xÑ‚öž“4ÁzGñÁ'CO3‰¢ŸŒÃ¶—åà ÓLG´ÇwâÎ\Kài¦PÅ×S\Ñ{ŸU…‡ јöAs=œÀQ|Aq±TÑòN8y‚–几Ñ8 ÚÝ!¨%€"šÖùŒ]'´‚Êžf2fm‚êÓ3Ríô ©X© ÌˆzP°dH›U@P†kVÚ4SàéÛ0@ÐYFO¼CÐp”OtÀN™£øfG0Š§ˆÆEÐÁÖS¤ íŽ@PŠhL>¸K4ØZJ€[´ÑΧÄi¦P³¸”§hã“2Õv‚&FAÂ[C$Câh ÄHOAÓLúî`š)y4_ [O®‚¦ìƒÎê)nßÙ#Œâ)¢¥Ô ù„ ”ãhf÷K´»O”"ZA Ǻ¦™z{…i&Šh)5žY’%h¯ hòh.ZJÑâd°Ù/'úÉаݷkŒ˜üCÚbÄÆÉNÓLG{&{šé°²ˆZÄ!Ýâaqqkd h¦ÖfÊ~HׂFìƒÚÜ%â÷Mô(^_Ýî×ë‡ø±li_7ã?Ïsûxõš­Ñ°õyÍ>¿¡-tÊlöA#µ n##A-èÀþ-¦]¼ ÎwAÓLã7¬PA Šæ1­$GЉV¨ˆ› }´äi&F³žÇÐ%ƒó^25Í´XA‰êý4SÜÛùÃÐOÆaÛýR%kV¸ ùvþ0p=ÕªgCrl2Š#èJÏÅ“îv+%Qã)Cб}… Ñ(w»z°á±]„ £; A)¢î¶:—¢ít#ZÓL£»+zšÉQ‚Ï* tb‡!hòh]raOH§H†¨ýdñ‚æy°ùj¾ÓL“û‹i¦äÑH;žÇ@Ðp” gì©ìGñÓ¿•ÅSDóÜí^Û¹.AgŽ”"š×nØW%è\¯‚RDó¸Âl ß)|fÅf{ó½náÉ0…§ #£"áub¶½r× …“a ÃQ<ë‹<-pK†šN[ÐügƒlAFžQ„Õ4SÞþ5¦™¢EË›zIÓtrÔ0 ”"šIϦ‘Óx½D*XŽâ!ÅSD347­”šŸÐ… Ñæw»’Ó¬R/¨M‚RD›Þí¦å4­á3+3Û³ì‚ O†)QÕkÀe¼.¼Nf~[}·çÇJíÐÊSL&Åg&µ,>!mGëÌê"Í4“Öñv˦™¢u[ ¦-g,A{ɨÿrN‰lAµ–;‹-ÏþCÒb4÷aîÛ–ÓÏOÑ£x-ûfBÞçVö(^[ú¦³ Î!­îÃÔŽê¾í§dAëdTÿ{Ê©-¨¶xXw±#ˆÍ4š·Eudu5t?w~ÝÅ©_7Õë Yùº¯ƒÉ()?/_<6r$ÔIè¹Ñè¦-¿Ø]‰ñØ, g™<ªù#zfÉÐ`"(õ}˜¢ëÉÐà"èªA24 (? Ôƒ¤ Ñ„ƒdh°œfÚïÙp jùEãíq 7› m…åú?G€ Á¢!LOu¢N"nS8Ê/ŠÆEP†qVŠÒÏÐበ»pHFÒH ¯$#i¤á…× ’‘4R„ðÂëÉH)Bxáu‚d$!¼ð:A2’FŠ^x I# XAk (` ¬ €5°‚Ö@PÀš‚N/[fÅý›,{qM±¼Éµå±ŒFZ> RÐéûI­Ø½¢‹øpZÞOX…òŽXE£,Ð (èÌùV¨ÛS‰"n³êµ,ŠPÞ«h”å :³¦‰ 7Y%ÅŒ_¯U˜:”wÄ*eù@‚>üô‡ìé9UDJA›Ý¤,Ð!èýÛóýÃ_¾°”¶|@C†  ô‚Ò–h$Uáˆ"6Q ’:‚bDŒi¦ÝwE›÷ý5QÄÒ!ªi¦2mù€FHA§—-³b›•¡h"–‚Ö¡ü#–ÑHË4pª°‚Ö@PÀ XAk (` ¬ €5°‚Ö@PÀ XAk (` ¬ €5”ˆËê‰g©Ë±4 (—/®÷j ÜñA %¢t¿{Š›:I DÔ‚>~VMè®8Ø«ÅpÔšbåQ[l DÔ‚–¯»BʇÓW…ŸgûòÍV-;ò†:A‰hÝ~÷åñ³R±8Øïê[<NËpç”MвáTÍgµ4cÓ1­>v@P"´C|eâÃé™ZÐVõAwæ \ Dhƒ¤¶­~Pê1´w‚¡M3µ}ÐòEKªSà%¢™¨/ݬGñ¥£ê/5ŠWMiêB ‚Ñ9ÕÙ̃ª×RK5ŠA¼ °‚Ö@PÀ XAk (` ¬ €5°‚Ö@PÀ XAk (` ¬ €5°‚Ö@PÀ XAk (` ¬ €5ÿ)ÏlPüÍùIEND®B`‚DoseFinding/man/figures/README-example2-1.png0000644000176200001440000001261614762613063020214 0ustar liggesusers‰PNG  IHDR àMR/®PLTE6:af6ˆ:::a¬f¶66ˆÏ::::f:::ff:Ûaa6aaaa¬¬a¬òff:f:f¶ÿˆ6ˆÏò::ffÛÿ¬a¬Ïˆ¬ò¬¬òò¶f¶:¶Û¶ÿÿψ6ÏòÏÏòòÓÓÓÛ:Û¶¶Ûÿÿò¬aòψòò¬òòÏòòòÿ¶fÿÛÿÿ¶ÿÿÛÿÿÿYW¡ pHYsÃÃÇo¨d†IDATxœí {Û¶FÙ4­›¦í–n«S·îœ­^“ÕšÓÔ²ìÿÿÇFRR"S”€î ✧ü㥈cðúpó Lc}Ç@PAAi¤APAAi¤APAAi¤APAAi¤APAAi¤APAAi¤APAAi¤APAAi¤APAAi¤AP&· v¿$™Œ $K'#(ÉÒÉJ²t2‚’,Œ $K'#(ÉÒÉqïBàŠ‰ wn (Hƒ  ‚‚4 Ò (Hƒ  ‚Zñ®iš—ww|ýïÛþøºi~h¿ú¦éoß}þë݇ï_Z£jÄ»Ï~nå|Ùþß~ð®i…ì¤|óÕú;þôòîÝ¿[¤jÃzz|ÿù¯¤w›~øð·ŸûÛî;ÿî>µáýg~­‹½ŽŸþi¿³½Öe{„" ¨ ï74m ÓÏÿÕ‹ú¾×Ô†õ z·;y>™NÿüéïmI jćï7äAßwRösç»/þû‹ø;5£[«ß½ùìç½ôÃ÷ÍËÞß÷L¡wjG·Ú*¸Wƒ~ös«í›/~o¯ò,“ÄAPÆFPWLÚÌi¤ô&jž$k%#(ÉÒÉJ²t2‚’,Œ $K'‹ °AAiDU®ŠHΙŒ $K'#(ÉÒÉJ²t2‚’,,*(Ài¤T¹*š_²Ý„Ql Z£&5 z:AIFPÿÞjÔAÃZø4sAµ’4ioP. …ƒ  ¨ 5V‚5Ö ìƒzSc2‹$ïÞjÔAÃZø4sAµ’Ô»·5Aа>Íak AAQAk¬k¬AÙõ¦ÆdIÞ½ùVÀ_†ˆ”  káÓÌ‘Ø‚î99ÁRÍ–ê4Hå zð^†IŠ ©Ãv/sÅ «¯©|ˆÄòkö‚:ÙWˆ£E¤/“We êÜQ 3©úñùc¹ºé)j³h¡nõ˜çQ9®J*Á$ÉþÛ(óÞõ?(‡3‡ !„N—ÅÖ š„]>NžHuÿ±éò :刎Rå‡ýRá{ŸcÕ—stê<½z°U¼•G²¨ º8pªç´–ŽDt-wºŽÐ§™#Ù6N÷³wÞ‹«Ó 9ˆ¨Íâ†&ì`·/1DŽ#Å•|¢‚ž¨Ç"Înwê•`ºd -gºý$îŒL…‚N˜ÅÖ ™]÷Ú‘õ<–5qc¦ò}.QÐtçÓ´ôÊ7w‹LõîíØ`¥=Ùª)ƒ .æµ·Ô‚–ñÜ'?”Öå»ÌQÐÄgùÓu/÷p¦È“Ú1 A$åÚ˜ –/æQA×c©Ïù09ß8Çx8ÌKåç ¨KrK'>?kÂ!²Hòîí  †š¤¶4¨ï(—rõîMQÐõ·ÓYê÷Rë˜E&‚z÷vh°ÒŸJ—„4–ºšf탠ÑzÓtÝ0ß:Yì F™› È{ÍœaóÕÒC›š®`D¯ÇrŒÙäGćžPͱYØõî­`AG‘qä®Ô(h±5¨ ÊƒUcrI‚æY1ç¥Âçò#¨?ª•,*h†ƒ° ª"–¬LA.›ço?~ؼšÖÛ´Ÿ*‡¹ß¿0’zý¢ûoýáÙíý·WÞ½ÕcyJ0'6û «×W÷ß½Ý~Ò‚’ìÚ§ٚNΙO?v³á¦¥ýôÆç¶ñlxÛ$îÿðmc”Û‹Qn{¶O‡ÛÃl¡‚.ÏþÓ4þ½Ìc™~Í•/w©¨x]¶+¤å³(5(‚&£fAÏnÛ…üp 9!¹N"kéœØº³HênT=Y™äÛLí%þùÛÁ÷•µcþ÷0„$‚®ÎûúVÎ~£>Æ")ÛèQ æd>ÏEÐJ“Ô*ˆd§dµ Úƒ¹;¬…O3GüÍw T+YTдùI2H¿\AÍ’T’ _Pꌠ2ÝG×<»‹ jWƒVW Ú óiJÆ‚f<Õ jw‰GÐê«Aó-’ÜÞÀbð3Ž]O=6ÏÞj´ô¹{L¿2–»HBÐœ¸ÞgOý¢$‹ š2]'K’È ž‹Ð§™#*œÏÂI ¨ )量ˆ‡ôi=–ódêW‚'ûñ¶Q¹î.AЬç¯8A#LÊe ‚P¬M»è—jåûŒ /wökéT ¨7‚f^Ï è¤Þòž>Ë[aOA½1Û¬d3Í5al®œãýœŽ¨ »5hÞK¹Ítü®\ ¦bû ¥ ª¿]®œ¬/hî¢0bW~+eMì’t@„¸ÀµxqaeIFÐSâ&mI¿ø×.YTÐdÑiâ"l_VµýùõÆïØ¢m¬W¶AW(=€¨ v5èÉ¥J¢‡#-ýdÔ»·Ožûä;eIg9I-|š9",èAMÒÏpÊšØ%#èF5ÌT²Ö§™#²‚î?#ciˆ a-|š9âÓ›™ ,«3€ žl¥´p“߆1tטmø 袂~¬ÇrZ•»‘ìƒz÷f!èºèd©¢•Œ Û íÚ(WàþÔ§™#b‚>Y¯+_îR Þ½etPt"¨V²¨ ‰‚÷»ß[±–Î ‚éy|;Iy6©qAçøÜ¡Cè‘¢‚në±4ƒvl³“J0'Å8uÇ'OÕJ®MPÞ>¡°äº÷wyÀÜÖ§™#F‚:-ŒT+YTÐø±®Ïa-Ývdñ;á ¿cT!¨à¦çEdvD½‰ëÕ •`NJßë9}Ê ÚL&49ÅÖ 7‘RýŸ /0Xžzîø”»÷yB ŸfŽd4 ³ÁŠ©d@hÜß çü-|š9’KПÏ/èÖ â"Ÿ¶Å #5ì”æÔ`ÂœD gë4øìåñelt‹1õ&Ú™ *<ØGQø˜}ˆì¬¨ 7“B§œ’ä'éðw&'uòቶì}ÐÐÐI›HP‡™d¾‚Žf:N®3tâÒjÒOöèx•«KP×äÙ :µJ^ä;w¨³Í¤”<3A§/"#ÞSÏ‚†µðiæˆ[o6ź§mp’XÐÕy; g·>Gäê?ÀQž[¡°™¡Ç˜"èòÙUûï¢ÿ7A¨÷Ó‡äzcågð£Ó+`¶™ÂZlÖ¯á7ø]å£ só2è‡b‚†µði¶áárÇØûïöäuêÍ=2êò=`sKfû <Œ½~Ñý·ýdv+¨Åƒ;íªß93EÐÕù«¶Ýß©ï–÷çÍå—a3¨‘ŸžDý“ññºšS½>»½ÿfw²ÜÐɹ݃zøå·A·%ëMKûéÍ‘ÛæÄ÷?Þ6ŽíRÜ61ûkÌî‡ËxXÝ:>éy|‘tÑ/ä÷öAw]¼ ªAoÌ&P¥JäÚSy©b—Í6<ÙfJ8ƒ ʾg4Œm'ή.½~Õ}ºQû bušLO´c’ ­ˆg·k S„féÅ74]*‚Ž1éÉ"Ï®Ý"ÉÛP·g3Mî$ˆ£ÉI/îv‚ÚU¿IŸúpùªªÝÞ6S„Ðhµ‰7ÇNYZ…tŒ‰û  )ž°|ºôŒtæpÇ©×F:F„4ÅK>BÙŠÃÁž“û£¬‰]òô4É–O´H(Ë®3l-)kb—Í0yLqjo¹×Òyôä—`Œ‰5hÒÐd?ï™–)Aǘ¸ŠOz|720Ö‰½älÞ°ŠcÒ"É{É9ôX‹´9õt¿6Éáçxr.HCTÐýé]'(VÉ¥šk•¬“t ŠÌŽ•«Æd ¤tRU4é`•ë±“E’7íX•«Æd ¥ ŠŸ• *èÉÚ$™ ÊõXÉ¢‚žj‘nU¬“Ë4á^y°jLFÐʃUcr‘‚¦\!)VÉÊ‚6ãí|f‰¨ ›Vc.¢gUh :Ò?ëBTЛm“û©\Õ˜,*hó©Ñnã å§ò`Õ˜,+è§6­Ì²:R¬“ tcf¦Å»ò`Õ˜\„ ¹GʃUcr!‚B­ˆ ŠŸ°AAQAoÌU®ÇjLÔîñvåÁª1YUШy>(VÉ:@y°jLFÐʃUc2‚‚4¢‚¬APFTP媈äœÉJ²t2‚’,Œ $K'#(ÉÒÉ¢‚¬APAAQA•«"’s&#(ÉÒÉJ²t2‚’,l#(€+‚êå‘\x2‚’,Œ $K'#(ÉÒÉJ²t2‚’,Œ $K'óôAAi¤APAAi¤AP&« —Íó·9w¸ÿÎ&ùþ›¦¹0I^6ͳ+“ä˜g;« ×/ºÿLXÛüj¬Î/—&žÜ{õ¸´š®£çtõúÊj"[4µ ^žÝ¶›)t}Æ-X~Yä ÚÉitÊþwku‰\Ï¢6,Ú_~ù ACÂ0Ò¤-jÐÅ«2kÐJ]˜- jÐÕ¯Wšš…ÙRÚª½¾(to¸H²Ôpþ4tuÞ¿ì=RÝ]Ë6“• Ýf Ýåýþ/6Õo¡3h÷»UÛFýuÌÙÄE3‡³ÍC ‚‚4 Ò (Hƒ  ‚‚4 Ò (Hƒ  ‚‚4 Ò (Hƒ  ‚‚4 Ò (Hƒ i°y³†‚ i@ÐH h4ŸEÓ<ûg'è²išWë7ë_—´Ø|œAÐètoœµìÞXnÙJ¹:ÑúyñØÒ½Dþþ õAcÓëøxýìêá²S±½ÖoßßcuÞÁò…òå ±Y Øz¹6µýwûÖëºtýepAc³x*h÷Öv—} ºl»WÉ— ‚Æfí¿Ü^óYÙ€ ±Y¹Ø©Aû/·3©Ýû„ ‚FgÑ/àwVñ½£Ý?ýÝ]3ú€ ñÙÛín{-»}Pñ^ (Hƒ  ‚‚4 Ò (Hƒ  ‚‚4 Ò (Hƒ  ‚‚4 Ò (Hƒ  ‚‚4 Ò (Hƒ  ‚‚4 Ò (Hƒ  ‚‚4 Òügoï©VyMIEND®B`‚DoseFinding/man/figures/README-example1-1.png0000644000176200001440000001654314762613063020216 0ustar liggesusers‰PNG  IHDR àMR/½PLTE6:af6ˆ:::a¬f¶r²6666ˆÏ::::f:::ff:Ûaa6aaaaˆˆa¬¬a¬òff:f:f¶ÿˆ6ˆˆaˆ¬ˆˆÏò::fÛÿ¬a¬Ïˆ¬ò¬¬òò¶f¶:¶Û¶ÿÿψ6Ïò¬ÏòÏÏòòÓÓÓÛ:Û¶¶Ûÿÿò¬aòψòò¬òòÏòòòÿ¶fÿÛÿÿ¶ÿÿÛÿÿÿD“ pHYsÃÃÇo¨dLIDATxœí Û6²Å™ôák¦q²uºw£ÔÙëÜ]m“½µê¼$Yßÿc-AQ 9À€<ç—V~ŒÀƒÑßà¢ÀìA‚•Å6Ac hPH´($Z- ‰…D €B¢@!Ñ hPH´($Z- ‰…D €B¢@!Ñ hPH´($Z- ‰…D €B¢@!Ñ hPH´($Z- ‰…D €B¢@Ûz¼Í¾ÿ@ŠÜ½$Åí®²ì†¸Í²§wœGž‡h[ëKõ ýŠò~usØRÀÛ½¸;likâŸÐ,@[Ú¿¹£ P›ìgÒ8¶½x(FeÒz<:¡É1‚.V N&>ÐO´j%iSÐ<©Çß~ ‹P“JĪVI5èæ5èråÐ ¹d¤Ô û_ ÆäÐ qn~ Õ ëÌâ,ò$‰ (}ü$º_eJÄ¢v m‘—™ˆ€ªÕ#’Ôé}÷Z±Št¹*F(Ö…ú5yÀÛdÌoÌC- ‰…D €B¢@!Ñ hPH´üJm™ì TƒÑŒ»Y\&ítz sËâÒ @ã7èôæ–Å¥€ÆoÐé)Ì-‹K+ß ÓS˜[—V¿A§§0·,.­4~ƒNOanY\Zhüž2ÖQÐo‰*Yãé: &JÖxºÎ¨‰’5ž®sj¢d§ëùÇOïJðÊÿU6¿ùû“wUš?V}ùá?%¤ª“ÿãf|&€Ä«ÿ>?+^Ø÷EZÔ7_^ýðÛÑ8=9ýüLÙV¯®‚òdûëÛçß>Šqþ¾pö){rôd³ñeöœôª=~ãôw6@˱èõ1Ÿ¾û×—_Þ•?à†­–NÕÿ^׶‹ßüó—îÔÃE.ÎKC ¶ µÍãoÞ«ß7Oñ•Íão>UèÖ?>½$Uœ43@«÷o_«âç»ÿ{&ГÓ6 'Û*à5ÛÁ¾¹9ÿØôdócÐfÒK@r? Ì ÐÓ|²~ÅÅÚsÚN¿¾ý+ßÜî›ãzíÏ€Ö6Û#h+éAKu=ŸiTæ> >Å×¾Z€Ö¶‹Òÿ¿•R=WÃcUi6m¶«ÓVÒQƒ–êZM-Ÿ¼;þgÏÅÚrÚAkÛŸ8‡P'çLJ'ï¾¾ýá¯o³³Íò7õü¾áþùyÿõ­S1=3@Ë…7õªõ¹wïÕ;‹¸×A §½´´ýþ‡?\_ٶܜ«ŠùRKFYö·Wg›çuÐS züñ{¬ƒÆQ²ÆœsÌx,@M”¬qj(QÐÆ×÷ÄçPã¼6(¸Ց3ýÙÃÞ 5 a€j@K‰0@5 ¥D ÐR"ŒPüš”’5ž®sj¢d§ë€š(Yãé:¨ˆB‡(Â8jPh)ƨF´”ãT#ZJ„qª-%Â8Õ³øRÉO×95Q²ÆÓu@M”¬ñt{t÷òÃñ‹ÇÛìûc­‰(tÆ”çç¯E§6‹¨A[†¨ út¿:Q¹¾TÿFZ“h~¸?çU„qb`˸@Û†¨ zt“ý\ û7wçÑTÛšp@sXçU„qZ`Û¸@;†¨ zôχ”êQAzj¦ýY/÷¬qyV$5oþ<ºñâõ#ϻƽ9'<楎†Œ3Q}=&Û´¨¦5á#h‘Ù”NñyCRNñG3ÇS|õ¥Aƒž'IÓ€Š×Ð$)š4/ñÊ¡¸XΛžŽ_Ò­@'ÔJ¦ãùÙ“–K½â8²f@¨g@§'IÒ% Ðzò2±jÄ Ý¼ïuÐ9,3¿‰nœ>dK¹P™ì›lŽt"T º¾V+¢i/ÔçR.©Ét^N “IíÀ¨€Ò[“ h~ˆhwÌt}C&H&µ;ƒ Ô¸¼Ú¸þtžÀåvzôzˆPj\D@GJMù€’'¨dõÒçÓxkÁÐh†NQÈ”›˜ŸŒ ÃêçΣñÓò¦8•¦ÜÐþD8VH@}©$Љøè€ ®Aó^ ?ã¹Áâµèt¬úÇgtP§Ä…TÔåMÑ€ŽöahE¿û$JŠ èqž|j èxì< €Râê¤y´>³{ía@'þƆl?€âÎ)ó h³î\2 ígŠT¨ô©f6îmÎÞW”;tgð©T/ÿ€ú[RÒ)DÊú3ôdª—w@CÒy’rÇ <=: 2kÐf¶<Ô ÚÑ3ñÔð³F}é«qª•_@‰×ú´8— ÚuªÕÐœ’ŸëEJ2¥œà(Sƒƒ«r Ƈ§FIJ*@(Sƒ5~§Ú!0  æ’ÒIóÞ]|@j8ۮƃ®,µäóBÁœmIBÓíË ñðô|¡ _¿¬¯p\ #évÔéÙnò–òrS„FT^ :rñ—‹ñÉW1Í”ûBÖÎçhhO½d³Jx ÓTmþÇy!+ˆ½¾ÛÚ8Ã*¡å‘+yœÅó^È @'â¨a`ÎÜ`@ÇâÆß#·0N¿X€êŒ¨,ñ|¶Ý`ÌÕ¥Z^gñÜM6Û -qʼc¯„m/üЖ<öÂä!ùJ¹>Ë…úÛ耊ªAµévªA öbH²íNº #q“×iZJô“$ 9wƒe›w-el<÷`\ 9wƒÇVEM’:}!1mË ²–™ä:t.v”¿B3 ôhà'Æ´„Y<¡X44.aú^ÉGʃt€ÖbTŸÔÇAÊ’n#ã’ø ÖSƒR>Ìfb\÷#CΞkPígÜ\ÔÆÐJÃÃÕ €¶äPÚ§-èYá·åÓÜ+§ìõ7¾È´‘1j'Pã Õhæ³xê|”l\Ô ^‰;åÁ:@•¨©hPq*ŽOj}P 5èx¶-jÐÝɆx=Ö CÛÿY78çÐÇÛú&ñ»«ìéÝXk h_‰º¾Tÿ”ö«›Ã櫶µ9ê÷åèàö¶ Çùtÿæî°{YR©ԷíÅÔ`KšqÏ/_|@;KЕ·7‡íÅCÝL¥ûBʈÇ{ø|*þþü=Íxî×xÓ9Ž5å“)cziÊ”Wš`ÎPUŽžù´jÍ·Læ£$ãò¦ðÞ”í çt¿ºž¨A£ €šjN€N× ±e”mŠq‘|r¦I"dÛl’4¶{#ù8<ž&Iþ{p™éñvê@½Ð!íWåBýúZüB½á¶ˆtbJ›Çã–ýV§é¶ˆ€ €zt|U‹'â¢SÆóÑiã2çðŒ)ÝAj"¼‹´ÜšÛôI“Æ¥ò @­©U{ü“mRƒ†¨ÐbÖ S¨78·P@ÕåÕµ@hw_jƒÔÅ5´»?uñ@M­¶æž0æå‹èäÔ¦ NÇE4–¬¦£ÆÅÎá¹R¡ƒÔD 4Fÿ– ¨]®hpE4Þ2“EƒË®A ›ø›5H‰ & Ž4… Í PÛ»o,PÊÔF ’â ¨õýѨ‹J ´¿ýÔ¨ñéû€‘ÃÈ (it“iqÑ ûÉè¨qÁsxŽ”Gê5 ®êé1ã¢ù Ö _ƒæö Ž¶§¥ÝÅ AbÜòu¹= uñ@)N·‡1n&  Ä۠ФÆP“¨‹Jt»Ñb!ÍÐÀr›‹Ž—=‰wMy¼Þ- PÇDÎ'õqP VŠØ»è€­A]o3l<à;ÕjPò¤è†¨q‹Ôùö0ÔÅ  –ÇIÐò ™æ.&­ÔýþE ”~§3ž@.@×»«z·oÐ KTÝæp›ÿõö ·i-€Üç¢ËœÅGí›# ëÎþM˜Ê,†<—Îç"-ÎíûÕÅÃ~åtŠ&Ž4Ðàr›$eOïoùŒRƒ²ì?h<äÅh¡kÐI>¥Ö ö A¨­"Êsó”!ãA/F èô ^, ·Ç;%;M’ÂÊ´57uñ~Ô˜LMkÔ[àÒUo$Ù)ü,ži":d\ü$Þ!å‘ûæ¸êõ |âJ2 .@m˜ŒÊ'Ï€ÊçÓ>å±ûæRƒª÷9¢eÛ·sÀxØOì„­A €Ê­A³4fñ|»Î-PÊ*Ða=ÞÖЪ¥¨Þ\*, Œ»ÎP?r]Ÿ¯ÁS—佸i €z \< §s|÷¿swؽüpúr¼µøzó€’¦Hb-FÇÍåawÕ*)8+2+Nëf*ÝRFB<æŒíéça:âôh™ò<ºó2Z,di~¦ê·‡M÷3 @·ÿÎúsý ËLœë$zã±Wb(²K¹€ž9.Ô+;£dÐb†´}:VƒúkŽhp9-Ô_7ËͳZ#èC×BÖ ¼ŸZZ JTl ª>ë±¾îŸâÔªj|ž@g@‰¨X@ÕZR1“ï¯Ó7—™®5ª (ó…ÄÔÅœuЊÚÎr¡~t’äPîË਋9€š´@½:šçÉZŒ”kó«BƒÍâ¹g¡KšÅç2:æt5ÓÓ»úر1¡¡eOð‚-ùÐ3Çe&5ƒ»qzhp9.Ô+@ݶ¾ñXƒò׆Zã¡w. TƒæyꓤÓº6ÞÞ.  ÀY êI, U º1¿®> Sé Ê=¿‡B‹sÅgYïv³Ö¨·@ÇS¼ï7ùhqó] ÔV!fñ^& Z㦺Ӳ™Å‹+ê¹ê"?ù Áå4‹7ßÞè . ¨”Wr\K”gg?…Ž§OsëŒû¨uyjÐÜ÷…fÄ8ÇuP;yÔ×g¨‹Ÿà“¤þ牉 Aè•ÐE¼}Xv9€æ–Ça d;Åsl@½.P¹Û/z›.f/§SÑ'Iä/»ãr^ÊQ-PžI·ÈT° .§S¼ÀísòUbL5hø›´¨Asëã°Šz/ž7 ×Ðaг¸Í¨.€šÈç)Þëhn–À9ê÷ƒ ÔÅOš€2Ëïôs!³xI}š žS» @Eu €š¨o\Ô‹9¢ÅZ/‚ŠZõýrßøô‹™^ zêjP%Î,äÜ v¨‹ŸÅêõ€ºø (ÇîvÔ[ % u—’”ew;ê-pé€JÛÝ.Àäs³xY]r¼`Ù}w;>ÐÑS.¬G #¨Ûîvl ‘X\î5¨Ýí‚TN=ãž>ÏhWƒž»”z *kw;:G´Ñ£ôµ•@ÃüÝP?”³Am uñPaïÅJëümv(i@•Ô­Œš›Ûµæ¤@SÏžqaSÞaQS.®CNËLÇEz7“å:(]¡Ò @ƒËq¡^)þB}°¬Ðàr\¨WŠšVVQƒêâZƒª!tãVƒ2d¡M ÕÅ-ÐãTÞbp^@;P]Ð`ç"rœ—uÐÇÛÆÒÓîe¯D AèÖ—êßé›þ €  åËýtÿæî C*NU—·t𠨎ª‹ &bk-ô¬sÞ³x‘±ôñ–éŠzÏh׸ȗT+BÊevÆzݯ,>ÎivÐ)…Ï( .§e¦ÌòVs<5è@BCÖ ”×4™´×™Ô kóÓ{·5ê-€Ô*¨ùÆ"4L -µ»Šó±ã!8¨.n©€ªÉ¼ùY€ 44ìU ä8'@·š·1í[3S”9çœgñBûâè:Ë.5?æ;è˜â¤€—5 » ¼ÉAÇ@Í4™r©]‰þN’]¡3’NÔ º¸É4ðe7ä¸èïÅ[ea ª‹ & A¨­æ(©nKÐÐ.’ã’t ª‹ &rl-Þ„³c\êÌW£©”‹í 5Ñl•Û“˜L\Ñ5®K¦r‰T7Qƒj{‚T €z  ¶ A¨­\„€ê⨉h@: úŽP ÅnÎu/¸#‰9“4¸Ò4v"g ¨ä~DÔ¨.á¼z5h­Ÿ%Ç%(+´i €z  ¶š  ´ÒM> 1>ÀMŽK P^ èI”§5sͶq†ÈK¹è~¤hžKÈã,•ÝDÍeä€Wt@IuIÉ'1‘¨Auq#5è`7Pƒ*Po4@‡{@•h¦sU„Ò@uqÔDËLd>¨6€šÈfõšj u‰KPš„Ì4ç8‹Þ‹4•’D\I*&‡4¸¢J©Krb¹A“¸™× ‘vZ%Ç¥hNŒ#7h@¹üPjƒFq”Ë@oëmÁÕ-å{714'Æ‘4‹ \~亾Tÿ”ö«›Ã¶w×Y$h¬­€Éq>Ý¿¹;ì^–Cèöâ¡O»C¨Qk’f™-ã’ŒMj(åâ;áP§‚´’Eí[•A\ݣ詙J÷…Šoï 91.ÈcËx.Àùq åy|g'd&˜stÓ¿’A Zÿ…Ë«A™/ÿ‹RƒFÛíŸç}Ýô¦H4P Pc’¤?h @:¤ó2ÓîEü4ôœ@j8 èxæ è~U.Ô¯¯Õ‘5·ì&ÚH 5 ¶¢¶&n dnËL t€š€—d@奀Wt@‡ë’vöPƒ¢µ @m@ƒN:Ѫ4hº“=j@m@ƒP[QZ9Áœ×,>‰HTfòhp ThîhpET_—ôs‡Ô8pªêjP%ê-pÐIÿTIkZ“;j@m@ƒP[MªK5tÚ>ÜÙåœfñ‰Ø & Á%PÁ™ ÁÐ~]¢ÏjPã@Ô ¶t qÔ8€Ú €  ¶t(oÔ8€ÚjÐÁ´PãÀQ@ î¨F²ç–3šÅ§â^ ÂÓ@ƒK Ò³6@“1ÐV]°£?jPm\·¥˜G ª@½P[ ÊqË ª &”e7UªëJò@•¨·@j+}k L,g3‹OÇ»@SÈ .j¢¹šõè€ÖõÓFA¨Aµqí”f5¨ÒÉ ×.T@M@ƒP[ieûv0@©uœ@@™ÿ´–(ßÕ³T@M4‹k¿Rñ|T²ëÔD4¸DšLÂhpE”úÎ0jPã@Ô ¶ A¨­:€²^Z@µqM@¹ÏPÞUcª M=Þ–÷‹ï|©o €z  CZ_ªÝ/µ­åy¢Sʤ|7§•q/€îßÜv/?t¾Ô¶–§õB'küì 0).} } \value{ Returns an object of class \samp{"Mods"}. The object contains the specified model parameter values and the derived linear parameters (based on \samp{"placEff"} and \samp{"maxEff"}) in a list. } \description{ The Mods functions allows to define a set of dose-response models. The function is used as input object for a number of other different functions. } \details{ The dose-response models used in this package (see \code{\link{drmodels}} for details) are of form \deqn{f(d) = \theta_0+\theta_1 f^0(d,\theta_2)}{f(d) = theta0+theta1 f0(d,theta2)} where the parameter \eqn{\theta_2}{theta2} is the only non-linear parameter and can be one- or two-dimensional, depending on the used model. One needs to hand over the effect at placebo and the maximum effect in the dose range, from which \eqn{\theta_0,\theta_1}{theta0,theta1} are then back-calculated, the output object is of class \samp{"Mods"}. This object can form the input for other functions to extract the mean response (\samp{getResp}) or target doses (\code{\link{TD}} and \code{\link{ED}}) corresponding to the models. It is also needed as input to the functions \code{\link{powMCT}}, \code{\link{optDesign}} Some models, for example the beta model (\samp{scal}) and the linlog model (\samp{off}) have parameters that are not estimated from the data, they need to be specified via the \samp{addArgs} argument. The default plot method for \samp{Mods} objects is based on a plot using the \samp{lattice} package for backward compatibility. The function \samp{plotMods} function implements a plot using the \samp{ggplot2} package. NOTE: If a decreasing effect is beneficial for the considered response variable it needs to specified here, either by using \samp{direction = "decreasing"} or by specifying a negative "maxEff" argument. } \examples{ ## Example on how to specify candidate models ## Suppose one would like to use the following models with the specified ## guesstimates for theta2, in a situation where the doses to be used are ## 0, 0.05, 0.2, 0.6, 1 ## Model guesstimate(s) for theta2 parameter(s) (name) ## linear - ## linear in log - ## Emax 0.05 (ED50) ## Emax 0.3 (ED50) ## exponential 0.7 (delta) ## quadratic -0.85 (delta) ## logistic 0.4 0.09 (ED50, delta) ## logistic 0.3 0.1 (ED50, delta) ## betaMod 0.3 1.3 (delta1, delta2) ## sigmoid Emax 0.5 2 (ED50, h) ## linInt 0.5 0.75 1 1 (perc of max-effect at doses) ## linInt 0.5 1 0.7 0.5 (perc of max-effect at doses) ## for the linInt model one specifies the effect over placebo for ## each active dose. ## The fixed "scal" parameter of the betaMod is set to 1.2 ## The fixed "off" parameter of the linlog is set to 0.1 ## These (standardized) candidate models can be specified as follows models <- Mods(linear = NULL, linlog = NULL, emax = c(0.05, 0.3), exponential = 0.7, quadratic = -0.85, logistic = rbind(c(0.4, 0.09), c(0.3, 0.1)), betaMod = c(0.3, 1.3), sigEmax = c(0.5, 2), linInt = rbind(c(0.5, 0.75, 1, 1), c(0.5, 1, 0.7, 0.5)), doses = c(0, 0.05, 0.2, 0.6, 1), addArgs = list(scal=1.2, off=0.1)) ## "models" now contains the candidate model set, as placEff, maxEff and ## direction were not specified a placebo effect of 0 and an effect of 1 ## is assumed ## display of specified candidate set using default plot (based on lattice) plot(models) ## display using ggplot2 plotMods(models) ## example for creating a candidate set with decreasing response doses <- c(0, 10, 25, 50, 100, 150) fmodels <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), exponential = 85, betaMod = rbind(c(0.33, 2.31), c(1.39, 1.39)), linInt = rbind(c(0, 1, 1, 1, 1), c(0, 0, 1, 1, 0.8)), doses=doses, placEff = 0.5, maxEff = -0.4, addArgs=list(scal=200)) plot(fmodels) plotMods(fmodels) ## some customizations (different model names, symbols, line-width) plot(fmodels, lwd = 3, pch = 3, cex=1.2, col="red", modNams = paste("mod", 1:8, sep="-")) ## for a full-model object one can calculate the responses ## in a matrix getResp(fmodels, doses=c(0, 20, 100, 150)) ## calculate doses giving an improvement of 0.3 over placebo TD(fmodels, Delta=0.3, direction = "decreasing") ## discrete version TD(fmodels, Delta=0.3, TDtype = "discrete", doses=doses, direction = "decreasing") ## doses giving 50\% of the maximum effect ED(fmodels, p=0.5) ED(fmodels, p=0.5, EDtype = "discrete", doses=doses) plot(fmodels, plotTD = TRUE, Delta = 0.3) ## example for specifying all model parameters (fullMod=TRUE) fmods <- Mods(emax = c(0, 1, 0.1), linear = cbind(c(-0.4,0), c(0.2,0.1)), sigEmax = c(0, 1.1, 0.5, 3), doses = 0:4, fullMod = TRUE) getResp(fmods, doses=seq(0,4,length=11)) ## calculate doses giving an improvement of 0.3 over placebo TD(fmods, Delta=0.3) ## discrete version TD(fmods, Delta=0.3, TDtype = "discrete", doses=0:4) ## doses giving 50\% of the maximum effect ED(fmods, p=0.5) ED(fmods, p=0.5, EDtype = "discrete", doses=0:4) plot(fmods) } \references{ Pinheiro, J. C., Bornkamp, B., and Bretz, F. (2006). Design and analysis of dose finding studies combining multiple comparisons and modeling procedures, \emph{Journal of Biopharmaceutical Statistics}, \bold{16}, 639--656 } \seealso{ \code{\link{Mods}}, \code{\link{drmodels}}, \code{\link{optDesign}}, \code{\link{powMCT}} } \author{ Bjoern Bornkamp } DoseFinding/man/powMCT.Rd0000644000176200001440000001122314654153534014667 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/powMCT.R \name{powMCT} \alias{powMCT} \title{Calculate power for multiple contrast test} \usage{ powMCT( contMat, alpha = 0.025, altModels, n, sigma, S, placAdj = FALSE, alternative = c("one.sided", "two.sided"), df, critV = TRUE, control = mvtnorm.control() ) } \arguments{ \item{contMat}{Contrast matrix to use. The individual contrasts should be saved in the columns of the matrix} \item{alpha}{Significance level to use} \item{altModels}{An object of class \samp{Mods}, defining the mean vectors under which the power should be calculated} \item{n, sigma, S}{Either a vector \samp{n} and \samp{sigma} or \samp{S} need to be specified. When \samp{n} and \samp{sigma} are specified it is assumed computations are made for a normal homoscedastic ANOVA model with group sample sizes given by \samp{n} and residual standard deviation \samp{sigma}, i.e. the covariance matrix used for the estimates is thus \code{sigma^2*diag(1/n)} and the degrees of freedom are calculated as \code{sum(n)-nrow(contMat)}. When a single number is specified for \samp{n} it is assumed this is the sample size per group and balanced allocations are used.\cr When \samp{S} is specified this will be used as covariance matrix for the estimates.} \item{placAdj}{Logical, if true, it is assumed that the standard deviation or variance matrix of the placebo-adjusted estimates are specified in \samp{sigma} or \samp{S}, respectively. The contrast matrix has to be produced on placebo-adjusted scale, see \code{\link{optContr}}, so that the coefficients are no longer contrasts (i.e. do not sum to 0).} \item{alternative}{Character determining the alternative for the multiple contrast trend test.} \item{df}{Degrees of freedom to assume in case \samp{S} (a general covariance matrix) is specified. When \samp{n} and \samp{sigma} are specified the ones from the corresponding ANOVA model are calculated.} \item{critV}{Critical value, if equal to \samp{TRUE} the critical value will be calculated. Otherwise one can directly specify the critical value here.} \item{control}{A list specifying additional control parameters for the \samp{qmvt} and \samp{pmvt} calls in the code, see also \samp{mvtnorm.control} for details.} } \value{ Numeric containing the calculated power values } \description{ Calculate power for a multiple contrast test for a set of specified alternatives. } \examples{ ## look at power under some dose-response alternatives ## first the candidate models used for the contrasts doses <- c(0,10,25,50,100,150) ## define models to use as alternative fmodels <- Mods(linear = NULL, emax = 25, logistic = c(50, 10.88111), exponential= 85, betaMod=rbind(c(0.33,2.31),c(1.39,1.39)), doses = doses, addArgs=list(scal = 200), placEff = 0, maxEff = 0.4) ## plot alternatives plot(fmodels) ## power for to detect a trend contMat <- optContr(fmodels, w = 1) powMCT(contMat, altModels = fmodels, n = 50, alpha = 0.05, sigma = 1) \dontrun{ ## power under the Dunnett test ## contrast matrix for Dunnett test with informative names contMatD <- rbind(-1, diag(5)) rownames(contMatD) <- doses colnames(contMatD) <- paste("D", doses[-1], sep="") powMCT(contMatD, altModels = fmodels, n = 50, alpha = 0.05, sigma = 1) ## now investigate power of the contrasts in contMat under "general" alternatives altFmods <- Mods(linInt = rbind(c(0, 1, 1, 1, 1), c(0.5, 1, 1, 1, 0.5)), doses=doses, placEff=0, maxEff=0.5) plot(altFmods) powMCT(contMat, altModels = altFmods, n = 50, alpha = 0.05, sigma = 1) ## now the first example but assume information only on the ## placebo-adjusted scale ## for balanced allocations and 50 patients with sigma = 1 one obtains ## the following covariance matrix S <- 1^2/50*diag(6) ## now calculate variance of placebo adjusted estimates CC <- cbind(-1,diag(5)) V <- (CC)\%*\%S\%*\%t(CC) linMat <- optContr(fmodels, doses = c(10,25,50,100,150), S = V, placAdj = TRUE) powMCT(linMat, altModels = fmodels, placAdj=TRUE, alpha = 0.05, S = V, df=6*50-6) # match df with the df above } } \references{ Pinheiro, J. C., Bornkamp, B., and Bretz, F. (2006). Design and analysis of dose finding studies combining multiple comparisons and modeling procedures, \emph{Journal of Biopharmaceutical Statistics}, \bold{16}, 639--656 } \seealso{ \code{\link{powN}}, \code{\link{sampSizeMCT}}, \code{\link{MCTtest}}, \code{\link{optContr}}, \code{\link{Mods}} } \author{ Bjoern Bornkamp } DoseFinding/man/maFitMod.Rd0000644000176200001440000000756114762603270015225 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/maFitMod.R \name{maFitMod} \alias{maFitMod} \alias{predict.maFit} \alias{plot.maFit} \alias{print.maFit} \title{Fit dose-response models via bootstrap model averaging (bagging)} \usage{ maFitMod(dose, resp, S, models, nSim = 1000, control, bnds, addArgs = NULL) \method{predict}{maFit}( object, summaryFct = function(x) quantile(x, probs = c(0.025, 0.25, 0.5, 0.75, 0.975)), doseSeq = NULL, ... ) \method{plot}{maFit}( x, plotData = c("means", "meansCI", "none"), xlab = "Dose", ylab = "Response", title = NULL, level = 0.95, trafo = function(x) x, lenDose = 201, ... ) } \arguments{ \item{dose}{Numeric specifying the dose variable.} \item{resp}{Numeric specifying the response estimate corresponding to the doses in \code{dose}} \item{S}{Covariance matrix associated with the dose-response estimate specified via \code{resp}} \item{models}{dose-response models to fit} \item{nSim}{Number of bootstrap simulations} \item{control}{Same as the control argument in \code{\link{fitMod}}.} \item{bnds}{Bounds for non-linear parameters. This needs to be a list with list entries corresponding to the selected bounds. The names of the list entries need to correspond to the model names. The \code{\link{defBnds}} function provides the default selection.} \item{addArgs}{List containing two entries named "scal" and "off" for the "betaMod" and "linlog" model. When addArgs is NULL the following defaults are used \samp{list(scal = 1.2*max(doses), off = 0.01*max(doses))}} \item{object}{Object of class maFit} \item{summaryFct}{If equal to NULL predictions are calculated for each sampled parameter value. Otherwise a summary function is applied to the dose-response predictions for each parameter value. The default is to calculate 0.025, 0.25, 0.5, 0.75, 0.975 quantiles of the predictions for each dose.} \item{doseSeq}{Where to calculate predictions.} \item{...}{Additional parametes (unused)} \item{x}{object of class maFit} \item{plotData}{Determines how the original data are plotted: Either as means or as means with CI or not at all. The level of the CI is determined by the argument \samp{level}.} \item{xlab}{x-axis label} \item{ylab}{y-axis label} \item{title}{plot title} \item{level}{Level for CI, when plotData is equal to \samp{meansCI}.} \item{trafo}{Plot the fitted models on a transformed scale (e.g. probability scale if models have been fitted on log-odds scale). The default for \samp{trafo} is the identity function.} \item{lenDose}{Number of grid values to use for display.} } \value{ An object of class \samp{maFit}, which contains the fitted dose-response models \samp{DRMod} objects, information on which model was selected in each bootstrap and basic input parameters. } \description{ This function fits dose-response models in a bootstrap model averaging approach motivated by the bagging procedure (Breiman 1996). Given summary estimates for the outcome at each dose, the function samples summary data from the multivariate normal distribution. For each sample dose-response models are fit to these summary estimates and the best model according to the gAIC is selected. } \examples{ data(biom) ## produce first stage fit (using dose as factor) anMod <- lm(resp~factor(dose)-1, data=biom) drFit <- coef(anMod) S <- vcov(anMod) dose <- sort(unique(biom$dose)) ## fit an emax and sigEmax model (increase nSim for real use) mFit <- maFitMod(dose, drFit, S, model = c("emax", "sigEmax"), nSim = 10) mFit plot(mFit, plotData = "meansCI") ED(mFit, direction = "increasing", p = 0.9) } \references{ Breiman, L. (1996). Bagging predictors. Machine learning, 24, 123-140. } \seealso{ \code{\link{fitMod}}, \code{\link{bFitMod}}, \code{\link{drmodels}} } \author{ Bjoern Bornkamp } DoseFinding/man/mvpostmix.Rd0000644000176200001440000000165614654153534015575 0ustar liggesusers\name{mvpostmix} \alias{mvpostmix} \title{Prior to posterior updating for a multivariate normal mixture} \description{ Calculate conjugate posterior mixture of multivariate normals with known covariance matrix } \usage{ mvpostmix(priormix, mu_hat, S_hat) } \arguments{ \item{priormix}{ Prior multivariate normal mixture given as a list of length 3. The first list entry contains the mixture weights, the second component the mean vectors and the third component of the list the covariance matrices. } \item{mu_hat}{ estimated mean response for each dose } \item{S_hat}{ estimated covariance matrix } } \value{ Returns a posterior multivariate normal mixture as a list of length 3, containing mixture weights, mean vectors and covariance matrices. } \references{ Bernardo, J. M., and Smith, A. F. (1994). Bayesian theory. John Wiley & Sons. } \author{ Marius Thomas } DoseFinding/man/mvtnorm-control.Rd0000644000176200001440000000153714654153534016705 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/powMCT.R \name{mvtnorm-control} \alias{mvtnorm-control} \alias{mvtnorm.control} \title{Control options for pmvt and qmvt functions} \usage{ mvtnorm.control(maxpts = 30000, abseps = 0.001, releps = 0, interval = NULL) } \arguments{ \item{maxpts}{Maximum number of function values as integer.} \item{abseps}{Absolute error tolerance as double.} \item{releps}{Relative error tolerance as double.} \item{interval}{Interval to be searched, when the quantile is calculated.} } \description{ Returns a list (an object of class "GenzBretz") with control parameters for the \samp{pmvt} and \samp{qmvt} functions from the \samp{mvtnorm} package. Note that the DoseFinding package always uses "GenzBretz" algorithm. See the mvtnorm documentation for more information. } DoseFinding/man/DoseFinding-package.Rd0000644000176200001440000001016714762603270017303 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/DoseFinding-package.R \docType{package} \name{DoseFinding-package} \alias{DoseFinding} \alias{DoseFinding-package} \title{DoseFinding: Planning and Analyzing Dose Finding Experiments} \description{ The DoseFinding package provides functions for the design and analysis of dose-finding experiments (for example pharmaceutical Phase II clinical trials). It provides functions for: multiple contrast tests (MCTtest), fitting non-linear dose-response models (fitMod), a combination of testing and dose-response modelling (MCPMod), and calculating optimal designs (optDesign), both for normal and general response variable. } \details{ The main functions are:\cr \bold{MCTtest}: Implements a multiple contrast tests\cr \bold{powMCT}: Power calculations for multiple contrast tests\cr \bold{fitMod}: Fits non-linear dose-response models\cr \bold{optDesign}: Calculates optimal designs for dose-response models\cr \bold{MCPMod}: Performs MCPMod methodology\cr \bold{sampSize}: General function for sample size calculation\cr } \examples{ data(IBScovars) ## perform (model based) multiple contrast test ## define candidate dose-response shapes models <- Mods(linear = NULL, emax = 0.2, quadratic = -0.17, doses = c(0, 1, 2, 3, 4)) ## plot models plot(models) ## perform multiple contrast test test <- MCTtest(dose, resp, IBScovars, models=models, addCovars = ~ gender) ## fit non-linear emax dose-response model fitemax <- fitMod(dose, resp, data=IBScovars, model="emax", bnds = c(0.01,5)) ## display fitted dose-effect curve plot(fitemax, CI=TRUE, plotData="meansCI") ## Calculate optimal designs for target dose (TD) estimation doses <- c(0, 10, 25, 50, 100, 150) fmodels <- Mods(linear = NULL, emax = 25, exponential = 85, logistic = c(50, 10.8811), doses = doses, placEff=0, maxEff=0.4) plot(fmodels, plotTD = TRUE, Delta = 0.2) weights <- rep(1/4, 4) desTD <- optDesign(fmodels, weights, Delta=0.2, designCrit="TD") } \references{ Bornkamp, B., Bretz, F., Dette, H. and Pinheiro, J. C. (2011). Response-Adaptive Dose-Finding under model uncertainty, \emph{Annals of Applied Statistics}, \bold{5}, 1611--1631 Bornkamp B., Pinheiro J. C., and Bretz, F. (2009). MCPMod: An R Package for the Design and Analysis of Dose-Finding Studies, \emph{Journal of Statistical Software}, \bold{29}(7), 1--23 Bretz, F., Pinheiro, J. C., and Branson, M. (2005), Combining multiple comparisons and modeling techniques in dose-response studies, \emph{Biometrics}, \bold{61}, 738--748 Dette, H., Bretz, F., Pepelyshev, A. and Pinheiro, J. C. (2008). Optimal Designs for Dose Finding Studies, \emph{Journal of the American Statisical Association}, \bold{103}, 1225--1237 O'Quigley, J., Iasonos, A. and Bornkamp, B. (2017) Handbook of methods for designing, monitoring, and analyzing dose-finding trials, CRC press, Part 3: Dose-Finding Studies in Phase II Pinheiro, J. C., Bornkamp, B., and Bretz, F. (2006). Design and analysis of dose finding studies combining multiple comparisons and modeling procedures, \emph{Journal of Biopharmaceutical Statistics}, \bold{16}, 639--656 Pinheiro, J. C., Bornkamp, B., Glimm, E. and Bretz, F. (2014) Model-based dose finding under model uncertainty using general parametric models, \emph{Statistics in Medicine}, \bold{33}, 1646--1661 Seber, G.A.F. and Wild, C.J. (2003). Nonlinear Regression, Wiley } \seealso{ Useful links: \itemize{ \item \url{https://github.com/openpharma/DoseFinding} \item \url{https://openpharma.github.io/DoseFinding/} \item Report bugs at \url{https://github.com/openpharma/DoseFinding/issues} } } \author{ \strong{Maintainer}: Marius Thomas \email{marius.thomas@novartis.com} Authors: \itemize{ \item Bjoern Bornkamp \email{bjoern.bornkamp@novartis.com} (\href{https://orcid.org/0000-0002-6294-8185}{ORCID}) \item Jose Pinheiro \item Frank Bretz \item Ludger Sandig } Other contributors: \itemize{ \item Novartis Pharma AG [copyright holder, funder] } } \keyword{internal} DoseFinding/man/critVal.Rd0000644000176200001440000000262214654153534015125 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/MCTtest.R \name{critVal} \alias{critVal} \title{Calculate critical value for multiple contrast test} \usage{ critVal( corMat, alpha = 0.025, df = NULL, alternative = c("one.sided", "two.sided"), control = mvtnorm.control() ) } \arguments{ \item{corMat}{Correlation matrix of contrasts} \item{alpha}{Significance level for the multiple contrast test} \item{df}{Specify the degrees of freedom to use, if this argument is missing \samp{df = Inf} is used (which corresponds to the multivariate normal distribution).} \item{alternative}{Character determining the alternative for the multiple contrast trend test.} \item{control}{A list specifying additional control parameters for the \samp{qmvt} and \samp{pmvt} calls in the code, see also \code{\link{mvtnorm.control}} for details.} } \description{ Calculation of the critical value for a maximum contrast test. This is based on the equicoordinate quantile function of the multivariate normal or t distribution as implemented in the \code{qmvt} function from the mvtnorm package. } \examples{ R <- matrix(c(1,0.5,0.5,1), nrow=2) critVal(R, alpha = 0.05, df = 1) critVal(R, alpha = 0.05, df = 20) critVal(R, alpha = 0.05, df = Inf) } \seealso{ \code{\link{powMCT}}, \code{\link{optContr}}, \code{\link{MCTtest}} } \author{ Bjoern Bornkamp } DoseFinding/man/neurodeg.Rd0000644000176200001440000000563014654153534015333 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/DoseFinding-package.R \docType{data} \name{neurodeg} \alias{neurodeg} \title{Neurodegenerative disease simulated longitudinal dose-finding data set} \format{ A data frame with 100 observations on the following 2 variables. \describe{ \item{\code{resp}}{a numeric vector containing the response values} \item{\code{dose}}{a numeric vector containing the dose values} \item{\code{id}}{Patient ID} \item{\code{time}}{time of measurement} } } \source{ Pinheiro, J. C., Bornkamp, B., Glimm, E. and Bretz, F. (2014) Model-based dose finding under model uncertainty using general parametric models, \emph{Statistics in Medicine}, \bold{33}, 1646--1661 } \usage{ data(neurodeg) } \description{ This simulated data set is motivated by a real Phase 2 clinical study of a new drug for a neurodegenerative disease. The state of the disease is measured through a functional scale, with smaller values corresponding to more severe neurodeterioration. The goal of the drug is to reduce the rate of disease progression, which is measured by the linear slope of the functional scale over time. } \details{ The trial design includes placebo and four doses: 1, 3, 10, and 30 mg, with balanced allocation of 50 patients per arm. Patients are followed up for one year, with measurements of the functional scale being taken at baseline and then every three months. The functional scale response is assumed to be normally distributed and, based on historical data, it is believed that the longitudinal progression of the functional scale over the one year of follow up can be modeled a simple linear trend. See the example below on how to analyse this type of data. This data set was used in Pinheiro et al. (2014) to illustrate the generalized MCPMod methodology. } \examples{ \dontrun{ ## reproduce analysis from Pinheiro et al. (2014) data(neurodeg) ## first fit the linear mixed effect model library(nlme) fm <- lme(resp ~ as.factor(dose):time, neurodeg, ~time|id, method = "ML") muH <- fixef(fm)[-1] # extract estimates covH <- vcov(fm)[-1,-1] ## derive optimal contrasts for candidate shapes doses <- c(0, 1, 3, 10, 30) mod <- Mods(emax = 1.11, quadratic= -0.022, exponential = 8.867, linear = NULL, doses = doses) # contMat <- optContr(mod, S=covH) # calculate optimal contrasts ## multiple contrast test MCTtest(doses, muH, S=covH, type = "general", critV = TRUE, contMat=contMat) ## fit the emax model fitMod(doses, muH, S=covH, model="emax", type = "general", bnds=c(0.1, 10)) ## alternatively one can also fit the model using nlme nlme(resp ~ b0 + (e0 + eM * dose/(ed50 + dose))*time, neurodeg, fixed = b0 + e0 + eM + ed50 ~ 1, random = b0 + e0 ~ 1 | id, start = c(200, -4.6, 1.6, 3.2)) ## both approaches lead to rather similar results } } \keyword{datasets} DoseFinding/DESCRIPTION0000644000176200001440000000341214764054522014162 0ustar liggesusersPackage: DoseFinding Type: Package Title: Planning and Analyzing Dose Finding Experiments Version: 1.3-1 Date: 2025-03-07 Authors@R: c( person("Bjoern", "Bornkamp", email = "bjoern.bornkamp@novartis.com", comment = c(ORCID = "0000-0002-6294-8185"), role = c("aut")), person("Jose", "Pinheiro", role = "aut"), person("Frank", "Bretz", role = "aut"), person("Ludger", "Sandig", role = "aut"), person("Marius", "Thomas", role = c("aut", "cre"), email = "marius.thomas@novartis.com"), person(given = "Novartis Pharma AG", role = c("cph", "fnd"))) Imports: ggplot2, lattice, mvtnorm Suggests: numDeriv, Rsolnp, quadprog, parallel, multcomp, knitr, rmarkdown, MASS, testthat, RBesT, nlme Maintainer: Marius Thomas Description: The DoseFinding package provides functions for the design and analysis of dose-finding experiments (with focus on pharmaceutical Phase II clinical trials). It provides functions for: multiple contrast tests, fitting non-linear dose-response models (using Bayesian and non-Bayesian estimation), calculating optimal designs and an implementation of the MCPMod methodology (Pinheiro et al. (2014) ). VignetteBuilder: knitr License: GPL-3 LazyLoad: yes RoxygenNote: 7.3.1 Encoding: UTF-8 URL: https://github.com/openpharma/DoseFinding, https://openpharma.github.io/DoseFinding/ BugReports: https://github.com/openpharma/DoseFinding/issues NeedsCompilation: yes Packaged: 2025-03-11 10:53:03 UTC; THOMAM1D Author: Bjoern Bornkamp [aut] (), Jose Pinheiro [aut], Frank Bretz [aut], Ludger Sandig [aut], Marius Thomas [aut, cre], Novartis Pharma AG [cph, fnd] Repository: CRAN Date/Publication: 2025-03-11 15:40:02 UTC