pn.mtc.fast <- function(j, k, p.true, cohort, ceiling, floor) { #This function finds the probability that combination (j,k) #is identified as the mtc at the end of a Phase I study #using a three-stage algorithm, as well as the mean number #of patients enrolled to get that answer. #Assumes fast escalation method is used #j = dose of first agent #k = dose of second agent #p.true = matrix of DLT probabilities for every combination #cohort = three-element vector of cohort sizes #ceiling = three-element vector of ceilings for escalation #floor = three element vector of floors for stopping #Get probabilities of escalation and stopping for each combo zz <- get.oc.all(p.true, cohort, ceiling, floor) #Add dummy rows and columns of 1's to p matrices and 0's to n matrices in zz for (i in c(1,3)) zz[[i]] <- rbind(cbind(zz[[i]], 1), 1) for (i in c(2,4)) zz[[i]] <- rbind(cbind(zz[[i]], 0), 0) #Compute results for combo where j and k are equal (on diagonal) if (j==k) { p.mtcr <- prod(diag(zz\$p.esc)[1:j]) * zz\$p.stop[j+1,k+1] * zz\$p.stop[j,k+1] p.mtcc <- prod(diag(zz\$p.esc)[1:j]) * zz\$p.stop[j+1,k+1] * zz\$p.stop[j+1,k] n.mtcr <- sum(diag(zz\$n.esc)[1:j]) + zz\$n.stop[j+1,k+1] + zz\$n.stop[j,k+1] n.mtcc <- sum(diag(zz\$n.esc)[1:j]) + zz\$n.stop[j+1,k+1] + zz\$n.stop[j+1,k] } #Compute results for combo where j and k differ (above diagonal) if (j>k) { p.mtcr <- prod(diag(zz\$p.esc)[1:k]) * zz\$p.stop[k+1,k+1] * prod(zz\$p.esc[k,(k+1):j]) * zz\$p.stop[k,j+1] p.mtcc <- NA n.mtcr <- sum(diag(zz\$n.esc)[1:k]) + zz\$n.stop[k+1,k+1] + sum(zz\$n.esc[k,(k+1):j]) + zz\$n.stop[k,j+1] n.mtcc <- NA } #Compute results for combo where j and k differ (below diagonal) if (j0]) * zz\$p.stop[j,k+1] p.mtcc <- prod(pp[pp>0]) * zz\$p.stop[j+1,k] n.mtcr <- sum(nn[nn>0]) + zz\$n.stop[j,k+1] n.mtcc <- sum(nn[nn>0]) + zz\$n.stop[j+1,k] } #Compute results for combo where j and k differ (above diagonal) if (j>k) { pp <- pp[1:k,1:k] nn <- nn[1:k,1:k] p1 <- prod(pp[pp>0]) * zz\$p.esc[k+1,k] * zz\$p.stop[k+1,k+1] * prod(zz\$p.esc[k,(k+1):j]) * zz\$p.stop[k,j+1] p2 <- prod(pp[pp>0]) * zz\$p.stop[k+1,k] * prod(zz\$p.esc[k,(k+1):j]) * zz\$p.stop[k,j+1] p.mtcr <- p1 + p2 p.mtcc <- NA n1 <- sum(nn[nn>0]) + zz\$n.esc[k+1,k] + zz\$n.stop[k+1,k+1] + sum(zz\$n.esc[k,(k+1):j]) + zz\$n.stop[k,j+1] n2 <- sum(nn[nn>0]) + zz\$n.stop[k+1,k] + sum(zz\$n.esc[k,(k+1):j]) + zz\$n.stop[k,j+1] n.mtcr <- (p1*n1+p2*n2)/(p1+p2) n.mtcc <- NA } #Compute results for combo where j and k differ (below diagonal) if (j0]) * zz\$p.esc[j,j+1] * zz\$p.stop[j+1,j+1] * prod(zz\$p.esc[(j+1):k,j]) * zz\$p.stop[k+1,j] p2 <- prod(pp[pp>0]) * zz\$p.stop[j,j+1] * prod(zz\$p.esc[(j+1):k,j]) * zz\$p.stop[k+1,j] p.mtcc <- p1+p2 n.mtcr <- NA n1 <- sum(nn[nn>0]) + zz\$n.esc[j,j+1] + zz\$n.stop[j+1,j+1] + sum(zz\$n.esc[(j+1):k,j]) + zz\$n.stop[k+1,j] n2 <- sum(nn[nn>0]) + zz\$n.stop[j,j+1] + sum(zz\$n.esc[(j+1):k,j]) + zz\$n.stop[k+1,j] n.mtcc <- (p1*n1+p2*n2)/(p1+p2) } c(p.mtcr, p.mtcc, n.mtcr, n.mtcc) } ############################################################################################################# sampsize.fast <- function(j, k, p.true, cohort, ceiling, floor) { #This function computes how many subjects are assigned to #each combination when combination (j,k) is identified as the #mtc at the end of a Phase I study using a three-stage algorithm. #Assumes fast escalation method is used #j = dose of first agent #k = dose of second agent #p.true = matrix of DLT probabilities for every combination #cohort = three-element vector of cohort sizes #ceiling = three-element vector of ceilings for escalation #floor = three element vector of floors for stopping #Get probabilities of escalation and stopping for each combo zz <- get.oc.all(p.true, cohort, ceiling, floor) #Add dummy rows and columns of 0's to n matrices in zz for (i in c(2,4)) zz[[i]] <- rbind(cbind(zz[[i]], 0), 0) #Create holder for sample sizes nr <- zz[[2]]; nr[,] <- 0; nc <- nr #Compute results for combo where j and k are equal (on diagonal) if (j==k) { diag(nr)[1:j] <- diag(zz\$n.esc)[1:j] nr[j+1,k+1] <- zz\$n.stop[j+1,k+1] nr[j,k+1] <- zz\$n.stop[j,k+1] diag(nc)[1:j] <- diag(zz\$n.esc)[1:j] nc[j+1,k+1] <- zz\$n.stop[j+1,k+1] nc[j+1,k] <- zz\$n.stop[j+1,k] } #Compute results for combo where j and k differ (above diagonal) if (j>k) { diag(nr)[1:k] <- diag(zz\$n.esc)[1:k] nr[k+1,k+1] <- zz\$n.stop[k+1,k+1] nr[k,(k+1):j] <- zz\$n.esc[k,(k+1):j] nr[k,j+1] <- zz\$n.stop[k,j+1] } #Compute results for combo where j and k differ (below diagonal) if (jk) { pp <- pp[1:k,1:k] nr[1:k,1:k] <- nn[1:k,1:k] p1 <- prod(pp[pp>0]) * zz\$p.esc[k+1,k] * zz\$p.stop[k+1,k+1] * prod(zz\$p.esc[k,(k+1):j]) * zz\$p.stop[k,j+1] p2 <- prod(pp[pp>0]) * zz\$p.stop[k+1,k] * prod(zz\$p.esc[k,(k+1):j]) * zz\$p.stop[k,j+1] nr1 <- nr nr1[k+1,k] <- zz\$n.esc[k+1,k] nr1[k+1,k+1] <- zz\$n.stop[k+1,k+1] nr1[k,(k+1):j] <- zz\$n.esc[k,(k+1):j] nr1[k,j+1] <- zz\$n.stop[k,j+1] nr2 <- nr nr2[k+1,k] <- zz\$n.stop[k+1,k] nr2[k,(k+1):j] <- zz\$n.esc[k,(k+1):j] nr2[k,j+1] <- zz\$n.stop[k,j+1] nr <- (p1*nr1+p2*nr2)/(p1+p2) } #Compute results for combo where j and k differ (below diagonal) if (j0]) * zz\$p.esc[j,j+1] * zz\$p.stop[j+1,j+1] * prod(zz\$p.esc[(j+1):k,j]) * zz\$p.stop[k+1,j] p2 <- prod(pp[pp>0]) * zz\$p.stop[j,j+1] * prod(zz\$p.esc[(j+1):k,j]) * zz\$p.stop[k+1,j] nc1 <- nc nc1[j,j+1] <- zz\$n.esc[j,j+1] nc1[j+1,j+1] <- zz\$n.stop[j+1,j+1] nc1[(j+1):k,j] <- zz\$n.esc[(j+1):k,j] nc1[k+1,j] <- zz\$n.stop[k+1,j] nc2 <- nc nc2[j,j+1] <- zz\$n.stop[j,j+1] nc2[(j+1):k,j] <- zz\$n.esc[(j+1):k,j] nc2[k+1,j] <- zz\$n.stop[k+1,j] nc <- (p1*nc1+p2*nc2)/(p1+p2) } list(nr=nr[1:nrow(p.true), 1:ncol(p.true)], nc=nc[1:nrow(p.true), 1:ncol(p.true)]) } ############################################################################################################# get.oc1 <- function(p, cohort, ceiling, floor) { #This function computes the operating characteristics for an three-stage #Phase I algorithm for a combination with true DLT probability p. #cohort = three-element vector of cohort sizes #ceiling = three-element vector of ceilings for escalation #floor = three element vector of floors for stopping pmat <- matrix(nrow=3, ncol=3) rownames(pmat) <- 1:3 colnames(pmat) <- c("Esc", "Stay", "Stop") for (i in 1:3) { pmat[i,] <- c(sum(dbinom(0:(ceiling[i]-1), cohort[i], p)), sum(dbinom(ceiling[i]:floor[i], cohort[i], p)), sum(dbinom((floor[i]+1):cohort[i], cohort[i], p))) if(ceiling[i]==0) pmat[i,1] <- 0 } p.esc <- pmat[1,1] + pmat[1,2]*pmat[2,1] + pmat[1,2]*pmat[2,2]*(pmat[3,1]+pmat[3,2]) n.esc <- cohort[1]*pmat[1,1] + sum(cohort[1:2])*pmat[1,2]*pmat[2,1] + sum(cohort)*pmat[1,2]*pmat[2,2]*(pmat[3,1]+pmat[3,2]) p.stop <- pmat[1,3] + pmat[1,2]*pmat[2,3] + pmat[1,2]*pmat[2,2]*pmat[3,3] n.stop <- cohort[1]*pmat[1,3] + sum(cohort[1:2])*pmat[1,2]*pmat[2,3] + sum(cohort)*pmat[1,2]*pmat[2,2]*pmat[3,3] c(p.esc, p.stop, n.esc, n.stop) } ############################################################################################################# get.oc.all <- function(p.true, cohort, ceiling, floor) { #This function computes the operating characteristics for an three-stage #Phase I algorithm for all combinations whose true DLT probabilities #are in a matrix p.true #cohort = three-element vector of cohort sizes #ceiling = three-element vector of ceilings for escalation #floor = three element vector of floors for stopping p.esc <- p.stop <- n.esc <- n.stop <- p.true J <- nrow(p.true) K <- ncol(p.true) for (k in 1:K) { for (j in 1:J) { oc <- get.oc1(p.true[k,j], cohort, ceiling, floor) p.esc[k,j] <- oc[1] n.esc[k,j] <- oc[3] p.stop[k,j] <- oc[2] n.stop[k,j] <- oc[4] } } list(p.esc=p.esc, n.esc=n.esc, p.stop=p.stop, n.stop=n.stop) }