vrsn <- "20120817" Dirname <- "GSDesign" FileName <- "RCTvalidateGSDesign" library(gsDesign) RCTvalidateOutputDirname <- paste(RCTdirnameV,Dirname,sep="") if(!file.exists(RCTvalidateOutputDirname)) dir.create(RCTvalidateOutputDirname) RCTvalidateOutputDirname <- paste(RCTvalidateOutputDirname,"/",sep="") cat("#####", FileName, "-", vrsn, "\n") #################### TestName <- "Wang & Tsiatis " #################### f <- function (alpha, P, J, r) { Nj <- ((1:J)/J)^r gs <- gsDesign(k= J, test.type=2, timing= Nj, sfu= "WT", sfupar= 1-P, alpha= alpha, tol=1e-8, r=80) rct <- seqDesign(arms=1,test.type="two.sided", sample.size=Nj, P=P, alpha=alpha, display.scale="Z") c(alpha,P,J,r,max(abs(gs$upper$bound - rct$boundary[,4])), max(abs(cumsum(gs$upper$spend) - rct$error.spend[,4]*alpha))) } P <- c(.5,.75,1) J <- c(2,4,6) accrual <- c(0.75,1,1.2) alpha <- c(0.005,0.01,0.025) #strt <- proc.time() rslt <- NULL for (a in alpha) { for (p in P) { for (j in J) { for (r in accrual) { rslt <- rbind(rslt, f(a, p, j, r)) } } } } #print(proc.time() - strt) #apply(rslt,2,range) rslt <- as.vector(t(rslt[,-(1:4)] < 1e-6)) if (all(rslt)) {cat(" ",TestName,": All",length(rslt),"tests PASS\n") } else cat(" ",TestName,": failing test numbers ", (1:length(rslt))[!rslt],"\n") #################### TestName <- "Single Boundary " #################### f <- function (alpha, P, J, r) { Nj <- ((1:J)/J)^r gs <- gsDesign(k= J, test.type=1, timing= Nj, sfu= "WT", sfupar= 1-P, alpha= alpha, tol=1e-8, r=80) rct <- seqDesign(arms=1,test.type="greater", sample.size=Nj, P=c(Inf,P), alpha=alpha, display.scale="Z") c(alpha,P,J,r,max(abs(gs$upper$bound - rct$boundary[,4])), max(abs(cumsum(gs$upper$spend) - rct$error.spend[,4]*alpha))) } P <- c(.5,1) J <- 4 accrual <- 1 alpha <- c(0.01,0.025) #strt <- proc.time() rslt <- NULL for (a in alpha) { for (p in P) { for (j in J) { for (r in accrual) { rslt <- rbind(rslt, f(a, p, j, r)) } } } } #print(proc.time() - strt) rslt <- as.vector(t(rslt[,-(1:4)] < 1e-6)) if (all(rslt)) {cat(" ",TestName,": All",length(rslt),"tests PASS\n") } else cat(" ",TestName,": failing test numbers ", (1:length(rslt))[!rslt],"\n") #################### TestName <- "Hwang Shih DeCani " #################### f <- function (alpha, P, J, r) { Nj <- ((1:J)/J)^r gs <- gsDesign(k= J, test.type=2, timing= Nj, sfupar= P, alpha= alpha, tol=1e-6, r=50) rct <- seqDesign(arms=1,test.type="two.sided", sample.size=Nj, design.family="E", A=1, P=P, alpha=alpha, display.scale="Z", EPSILON=1e-9) c(alpha,P,J,r,max(abs(gs$upper$bound - rct$boundary[,4])), max(abs(cumsum(gs$upper$spend) - rct$error.spend[,4]*alpha))) } P <- c(-1,-4) J <- 4 accrual <- 1 alpha <- c(0.01,0.025) #strt <- proc.time() rslt <- NULL for (a in alpha) { for (p in P) { for (j in J) { for (r in accrual) { rslt <- rbind(rslt, f(a, p, j, r)) } } } } #print(proc.time() - strt) rslt <- as.vector(t(rslt[,-(1:4)] < 1e-6)) if (all(rslt)) {cat(" ",TestName,": All",length(rslt),"tests PASS\n") } else cat(" ",TestName,": failing test numbers ", (1:length(rslt))[!rslt],"\n") #################### TestName <- "Power Error Spend " #################### f <- function (alpha, P, J, r) { Nj <- ((1:J)/J)^r gs <- gsDesign(k= J, test.type=2, timing= Nj, sfu=sfPower, sfupar= -P, alpha= alpha, tol=1e-6, r=50) rct <- seqDesign(arms=1,test.type="two.sided", sample.size=Nj, design.family="E", A=0, P=P, alpha=alpha, display.scale="Z", EPSILON=1e-9) c(alpha,P,J,r,max(abs(gs$upper$bound - rct$boundary[,4])), max(abs(cumsum(gs$upper$spend) - rct$error.spend[,4]*alpha))) } P <- c(-1,-3.25) J <- 4 accrual <- 1 alpha <- c(0.01,0.025) #strt <- proc.time() rslt <- NULL for (a in alpha) { for (p in P) { for (j in J) { for (r in accrual) { rslt <- rbind(rslt, f(a, p, j, r)) } } } } #print(proc.time() - strt) rslt <- as.vector(t(rslt[,-(1:4)] < 1e-6)) if (all(rslt)) {cat(" ",TestName,": All",length(rslt),"tests PASS\n") } else cat(" ",TestName,": failing test numbers ", (1:length(rslt))[!rslt],"\n")