Nothing
R/PSO_design_TE.gbop2.R
In GBOP2: Generalized Bayesian Optimal Phase II Design (G-BOP2)
Defines functions
PSO_design_TE
PSO_design_TE <- function(design = "optimal",
unified.u = 1,
method = "quantum",
nlooks = 4,
skip_efficacy = NULL, # Default: NULL no skipping.
## Input a vector as the same length as total stages, 1 is skip.
## Ex: skip for the first stage of a two stage design input c(1,0).
skip_toxicity = NULL , ## Default:NULL, 1 is skip.
maxPatients = 50, ## maximum number of patients
Nmin_cohort1 = 10,
Nmin_increase = 5,
e1n = 0.3, # H0 for Eff
e2n = 0.4, # H0 for Tox
e3n = 0.2, # H0 for Eff and Tox
e1a = 0.6, # Ha for Eff
e2a = 0.2, # Ha for Tox
e3a = 0.15, # Ha for Eff and Tox
err_eff = 0.1, # Type I error rate: Efficacious but toxic
err_tox = 0.1, # Type I error rate: Safe but futile
err_all = 0.05, # Type I error rate: Futile and toxic
power_eff = 0.8,
power_tox = 0.8,
power_all = 0.8,
seed = 1024,
nSwarm = 32,
maxIter = 100){
if((!is.null(skip_efficacy) && (length(skip_efficacy) != (nlooks +1) ) )| (!is.null(skip_toxicity) && (length(skip_toxicity) != (nlooks +1)))){
stop("skip_efficacy and skip_toxicity must be the length of (nlooks +1)")
}
if(!is.null(skip_efficacy) && !is.null(skip_toxicity)){
for(i in 1: (nlooks+1)){
if (skip_efficacy[i] == 1 && skip_toxicity[i] ==1){
stop("Error: Cannot skip both efficacy and toxicity at the same stage")
}
}
}
boundary_tox <- rep(NA, nlooks + 1) # Ensure it exists before modification
boundary_eff <- rep(NA, nlooks + 1)
# library(globpso)
# library(R6)
# library(Rcpp)
# library(RcppArmadillo)
# source("BOP2_functions_EffTox.R")
# source("BOP2_TE_function.R")
# source("boundcode.R")
# Rcpp::sourceCpp(file="Calculation2_original.cpp")
# Rcpp::sourceCpp(file="Calculation_minimizeN.cpp",cacheDir="cache")
# numOfSimForTiralSetting = 10000 # Number of simulations
## Fixed parameters
input <- list(
skip_efficacy = skip_efficacy, # if FALSE then skip tox
skip_toxicity = skip_toxicity,
e1n = e1n, # H0 for Eff
e2n = e2n, # H0 for Tox
e3n = e3n, # H0 for Eff and Tox
e1a = e1a, # Ha for Eff
e2a = e2a, # Ha for Tox
e3a = e3a, # Ha for Eff and Tox
err_eff = err_eff, # Type I error rate: Efficacious but toxic
err_tox = err_tox, # Type I error rate: Safe but futile
err_all = err_all, # Type I error rate: Futile and toxic
power_eff = power_eff,
power_tox = power_tox,
power_all = power_all,
seed = seed
)
miniPatients <- Nmin_cohort1 + nlooks*Nmin_increase
if(maxPatients < miniPatients){
stop(paste0("Error: Please increase maxPatients to more than ", miniPatients ))
}
cohortSize = function(N, R, w, n_min_cohort1 = Nmin_cohort1, n_min_incre = Nmin_increase){
Nrest = N - R*n_min_incre - n_min_cohort1
nobs = c()
extra = 0
for ( i in 1:(R+1)){
if (i == 1){
tmp = Nrest * w[i] + n_min_cohort1
} else {
tmp = Nrest * w[i] + n_min_incre + nobs[i-1]
}
extra = extra + round(Nrest * w[i])
nobs = c(nobs, tmp)
}
extra = extra - Nrest
w2 = w[-length(w)]
nobs[which.max(w)] = nobs[which.max(w)] - extra
return(nobs)
}
r0 = input$e1n # H0 for Eff
t0 = input$e2n # H0 for Tox
t00 = input$e3n # H0 for Eff and Tox
r1 = input$e1a
t1 = input$e2a
t11 = input$e3a
# interm.eff = input$nobs.seq
# interm.tox = input$nobs.seqTX
## toxicity and efficacy independent or correlated
if(r0*t0 != t00 | r1*t1 != t11){ ## correlated
scen = hypotheses_corr(r0,r1,t0,t1,PA_ET=input$e3a, PN_ET = input$e3n)
} else{## independent
scen = hypotheses_ind(r0, r1, t0, t1)
}
input$scenario = scen
inputlist = input
## Build the utility function -----
objf <- function(x, inputlist) {
if (nlooks ==1){
le = x[1]
lt = x[2]
g = x[3]
n = x[4]
le2 = x[5]
w1 = x[6]
lt2 = x[7]
w_list = c(w1, 1-w1)
}else{
le = x[1]
lt = x[2]
g = x[3]
n = x[4]
le2 = x[5]
lt2 = x[length(x)]
n_cohort <- nlooks +1 ## n_cohort is number of cohort
theta <- x[6: (length(x)-1)] ## number of thetas
w_list <- c()
w_list[1] <- (cos(theta[1]))^2
for( ii in 2: (n_cohort-1)){
w_list[ii] <- (prod(sin(theta[1:(ii-1)]))*cos(theta[ii]))^2
}
w_list[n_cohort] <- (prod(sin(theta[1:(n_cohort-1)])))^2
}
if (!all.equal(sum(w_list), 1, tolerance = 1e-6)) {
stop("Error: The sum of the elements in w_list must be approximately equal to 1.")
}
## interm is previous nobs.seq
interm = interm.eff = interm.tox = (cohortSize(N = n, R = nlooks, w = w_list, n_min_cohort1 = Nmin_cohort1, n_min_incre = Nmin_increase))
boundary = get_boundarycpp_2lambda(interm.eff= interm.eff,interm.tox =interm.tox,
lambda_e=le, lambda_t=lt,
lambda_e2=le2, lambda_t2=lt2, gamma = g,
prior=inputlist$scenario[1,], r0 = inputlist$e1n, t0 = input$e2n)
interm = ceiling(cohortSize(N = n, R = nlooks, w = w_list, n_min_cohort1 = Nmin_cohort1, n_min_incre = Nmin_increase))
index_effi <- which(skip_efficacy==1) ## skip which interim
index_toxi <- which(skip_toxicity==1) ## skip which interim
if (!is.null(skip_efficacy)){ ## skip efficacy
boundary_eff <- boundary$boundary.eff
boundary_eff[index_effi] <- -1 ## stop if <= cutoff
# boundary_tox = boundary$boundary.tox
}
if(!is.null(skip_toxicity) ){ ## skip toxicity
boundary_tox <- boundary$boundary.tox
boundary_tox[index_toxi] <- 999 ## stop if >= cutoff
# boundary_eff = boundary$boundary.eff
}
################################
if(design =="minimax"){
n_final = interm[length(interm)]
}
nintm = length(interm)
new_patient = c(0, interm)
npt=rep(NA, nintm)
for(j in seq(nintm)){
npt[j] = new_patient[j+1] - new_patient[j]
}
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
# temp = .Call("_GBOP2_efftox_recursive_optim", interm=interm, npt=npt, p=inputlist$scenario[2,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N01 = temp$ptsa
a01= temp$nonstop_prob
if (a01 > inputlist$err_tox){
# print("a01")
result = 999
} else {
# temp = .Call("_GBOP2_efftox_recursive_optim",interm=interm, npt=npt, p=inputlist$scenario[3,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N10 = temp$ptsa
a10= temp$nonstop_prob
if (a10 > inputlist$err_eff){
# print("a10")
result = 999
} else {
# temp = .Call("_GBOP2_efftox_recursive_optim", interm=interm, npt=npt, p=inputlist$scenario[1,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N00 = temp$ptsa
a00= temp$nonstop_prob
if (a00 > inputlist$err_all){
result = 999
} else {
# temp = .Call("_GBOP2_efftox_recursive_optim", interm=interm, npt=npt, p=inputlist$scenario[4,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N11 = temp$ptsa
a11= temp$nonstop_prob
if (a11 < inputlist$power_all){
result = 999
} else {
if(design =="optimal"){
result = ((N00 + N01 + N10)/3 + N11)/2
} else if(design =="minimax"){
n_final = interm[length(interm)]
result = n_final + (((N00 + N01 + N10)/3 + N11)/2)/n_final
} else{ ## unified
n_final = interm[length(interm)] ## n_final is total sample size
result = unified.u*n_final + (((N00 + N01 + N10)/3 + N11)/2)/n_final
}
}
}
}
}
return(result)
}
if(nlooks ==1){
low_bound <- c(0.5, 0.5, 0, miniPatients, 0.5, 0, 0.5)
upp_bound <- c(0.99, 0.99, 1, maxPatients, 0.99, 1, 0.99)
} else{
theta_L <- rep(0, nlooks) ## lower bound of theta
theta_U <- rep(pi/2, nlooks) ## upper bound of theta
low_bound <- c(0.5, 0.5, 0, miniPatients, 0.5, theta_L, 0.5)
upp_bound <- c(0.99, 0.99, 1, maxPatients, 0.99, theta_U, 0.99)
}
n_sim = 1
set.seed(input$seed)
seeds <- round(runif(10000)*10^8)
## PSO - comparison -----
if (method == "default"){
## default
## getPSOInfo:Create a list with PSO parameters for Minimization.
alg_setting <- getPSOInfo(freeRun = 1, nSwarm = nSwarm, maxIter=maxIter) # default if "basic" Linearly Decreasing Weight PSO
} else if (method == "quantum"){
## quantum:
alg_setting <- getPSOInfo(psoType = "quantum", freeRun = 1, nSwarm = nSwarm, maxIter=maxIter)
} else {
alg_setting <- getPSOInfo(psoType = "dexp", freeRun = 1, nSwarm = nSwarm, maxIter = maxIter)
}
for ( i in n_sim){
res <- globpso(objFunc = objf, lower = low_bound, upper = upp_bound,
fixed = NULL, PSO_INFO = alg_setting,
inputlist = inputlist, seed = seeds[i])
pars = res$par
if (nlooks ==1){
le = pars[1]
lt = pars[2]
g = pars[3]
n = pars[4]
le2 = pars[5]
w1 = pars[6]
lt2 = pars[7]
w_list = c(w1, 1-w1)
} else{ ## when nlooks >=2
le = pars[1]
lt = pars[2]
g = pars[3]
n = pars[4]
le2 = pars[5]
lt2 = pars[length(pars)]
n_cohort <- nlooks +1 ## n_cohort is number of cohort
theta <- pars[6: (length(pars)-1)] ## number of thetas
w_list <- c()
w_list[1] <- (cos(theta[1]))^2
for( ii in 2: n_cohort-1){
w_list[ii] <- (prod(sin(theta[1:(ii-1)]))*cos(theta[ii]))^2
}
w_list[n_cohort] <- (prod(sin(theta[1:(n_cohort-1)])))^2
}
interm = interm.eff = interm.tox = (cohortSize(N = n, R = nlooks, w = w_list, n_min_cohort1 = Nmin_cohort1, n_min_incre = Nmin_increase))
boundary = get_boundarycpp_2lambda(interm.eff= interm.eff,interm.tox =interm.tox,
lambda_e=le, lambda_t=lt,
lambda_e2=le2, lambda_t2=lt2, gamma = g,
prior=inputlist$scenario[1,], r0 = inputlist$e1n, t0 = input$e2n)
# interm = ceiling(cohortSize(N = n, R = nlooks, w = w_list))
#
#
# index_effi <- which(skip_efficacy==1) ## skip which interim
# index_toxi <- which(skip_toxicity==1) ## skip which interim
# if (is.null(skip_efficacy)){ ## skip efficacy
# boundary_eff <- boundary$boundary.eff
# boundary_eff[index_effi] <- -1
# # boundary_tox = boundary$boundary.tox
# } else if(is.null(skip_toxicity) ){ ## skip toxicity
# boundary_tox = boundary_tox
# boundary_tox[index_toxi] <- boundary_tox[index_toxi] + 1
# # boundary_eff = boundary$boundary.eff
# }
interm = ceiling(cohortSize(N = n, R = nlooks, w = w_list, n_min_cohort1 = Nmin_cohort1, n_min_incre = Nmin_increase))
index_effi <- which(skip_efficacy==1) ## skip which interim
index_toxi <- which(skip_toxicity==1) ## skip which interim
if (!is.null(skip_efficacy)){ ## skip efficacy
boundary_eff <- boundary$boundary.eff
boundary_eff[index_effi] <- -1 ## stop if <= cutoff
# boundary_tox = boundary$boundary.tox
}
if(!is.null(skip_toxicity) ){ ## skip toxicity
boundary_tox <- boundary$boundary.tox
boundary_tox[index_toxi] <- 999 ## stop if >= cutoff
# boundary_eff = boundary$boundary.eff
}
if(design =="minimax"){
n_final = interm[length(interm)]
}
########################################################
nintm = length(interm)
new_patient = c(0, interm)
npt=rep(NA, nintm)
for(j in seq(nintm)){
npt[j] = new_patient[j+1] - new_patient[j]
}
# temp = .Call("_GBOP2_efftox_recursive_optim",interm=interm, npt=npt, p=inputlist$scenario[1,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N00 = temp$ptsa ## expected sample size under H00
a00= temp$nonstop_prob
# temp = .Call("_GBOP2_efftox_recursive_optim",interm=interm, npt=npt, p=inputlist$scenario[4,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N11 = temp$ptsa
a11= temp$nonstop_prob
# temp = .Call("_GBOP2_efftox_recursive_optim",interm=interm, npt=npt, p=inputlist$scenario[2,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N01 = temp$ptsa ## expected sample size under H01
a01= temp$nonstop_prob ## probability of not stopping under H01
# temp = .Call("_GBOP2_efftox_recursive_optim", interm=interm, npt=npt, p=inputlist$scenario[3,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N10 = temp$ptsa ## expected sample size under H10
a10= temp$nonstop_prob
expected_sample <- ((N00 + N01 + N10)/3 + N11)/2
if(design =="optimal"){
utility = ((N00 + N01 + N10)/3 + N11)/2
} else if(design =="minimax"){
utility = n_final + (((N00 + N01 + N10)/3 + N11)/2)/n_final
}else {
utility = unified.u*n_final + (((N00 + N01 + N10)/3 + N11)/2)/n_final
}
}
# Concatenate values into a single vector, flattening sub-elements as needed
if(!is.null(skip_efficacy)){
boundary$boundary.eff <- boundary_eff
}
if(!is.null(skip_toxicity)){
boundary$boundary.tox <- boundary_tox
}
results_list <- list(
"function" = "PSO_design_TE",
"design" = design,"method" = method,
"parameter" = list(
"lambdae1" = le, "lambdae2" = le2,
"lambdat1" = lt,
"lambdat2" = lt2,
"gamma" = g),
"cohort" = as.list(interm), # Cohort sizes
"boundary_effi" = as.list(boundary$boundary.eff), # Boundary for efficacy
"boundary_toxi" = as.list(boundary$boundary.tox), # Boundary for toxicity
"expected_sample" = expected_sample,
"typeI_H01 (safe but futile)" = a01,
"typeI_H10 (efficacious but toxic)" = a10,
"typeI_H00 (futile and toxic)" = a00,
"power" = a11,
"utility" = utility
)
# results_list
class(results_list)<-"gbop2"
return(results_list)
}
Try the GBOP2 package in your browser
Any scripts or data that you put into this service are public.
GBOP2 documentation built on April 11, 2025, 5:42 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions PSO_design_TE
PSO_design_TE <- function(design = "optimal",
unified.u = 1,
method = "quantum",
nlooks = 4,
skip_efficacy = NULL, # Default: NULL no skipping.
## Input a vector as the same length as total stages, 1 is skip.
## Ex: skip for the first stage of a two stage design input c(1,0).
skip_toxicity = NULL , ## Default:NULL, 1 is skip.
maxPatients = 50, ## maximum number of patients
Nmin_cohort1 = 10,
Nmin_increase = 5,
e1n = 0.3, # H0 for Eff
e2n = 0.4, # H0 for Tox
e3n = 0.2, # H0 for Eff and Tox
e1a = 0.6, # Ha for Eff
e2a = 0.2, # Ha for Tox
e3a = 0.15, # Ha for Eff and Tox
err_eff = 0.1, # Type I error rate: Efficacious but toxic
err_tox = 0.1, # Type I error rate: Safe but futile
err_all = 0.05, # Type I error rate: Futile and toxic
power_eff = 0.8,
power_tox = 0.8,
power_all = 0.8,
seed = 1024,
nSwarm = 32,
maxIter = 100){
if((!is.null(skip_efficacy) && (length(skip_efficacy) != (nlooks +1) ) )| (!is.null(skip_toxicity) && (length(skip_toxicity) != (nlooks +1)))){
stop("skip_efficacy and skip_toxicity must be the length of (nlooks +1)")
}
if(!is.null(skip_efficacy) && !is.null(skip_toxicity)){
for(i in 1: (nlooks+1)){
if (skip_efficacy[i] == 1 && skip_toxicity[i] ==1){
stop("Error: Cannot skip both efficacy and toxicity at the same stage")
}
}
}
boundary_tox <- rep(NA, nlooks + 1) # Ensure it exists before modification
boundary_eff <- rep(NA, nlooks + 1)
# library(globpso)
# library(R6)
# library(Rcpp)
# library(RcppArmadillo)
# source("BOP2_functions_EffTox.R")
# source("BOP2_TE_function.R")
# source("boundcode.R")
# Rcpp::sourceCpp(file="Calculation2_original.cpp")
# Rcpp::sourceCpp(file="Calculation_minimizeN.cpp",cacheDir="cache")
# numOfSimForTiralSetting = 10000 # Number of simulations
## Fixed parameters
input <- list(
skip_efficacy = skip_efficacy, # if FALSE then skip tox
skip_toxicity = skip_toxicity,
e1n = e1n, # H0 for Eff
e2n = e2n, # H0 for Tox
e3n = e3n, # H0 for Eff and Tox
e1a = e1a, # Ha for Eff
e2a = e2a, # Ha for Tox
e3a = e3a, # Ha for Eff and Tox
err_eff = err_eff, # Type I error rate: Efficacious but toxic
err_tox = err_tox, # Type I error rate: Safe but futile
err_all = err_all, # Type I error rate: Futile and toxic
power_eff = power_eff,
power_tox = power_tox,
power_all = power_all,
seed = seed
)
miniPatients <- Nmin_cohort1 + nlooks*Nmin_increase
if(maxPatients < miniPatients){
stop(paste0("Error: Please increase maxPatients to more than ", miniPatients ))
}
cohortSize = function(N, R, w, n_min_cohort1 = Nmin_cohort1, n_min_incre = Nmin_increase){
Nrest = N - R*n_min_incre - n_min_cohort1
nobs = c()
extra = 0
for ( i in 1:(R+1)){
if (i == 1){
tmp = Nrest * w[i] + n_min_cohort1
} else {
tmp = Nrest * w[i] + n_min_incre + nobs[i-1]
}
extra = extra + round(Nrest * w[i])
nobs = c(nobs, tmp)
}
extra = extra - Nrest
w2 = w[-length(w)]
nobs[which.max(w)] = nobs[which.max(w)] - extra
return(nobs)
}
r0 = input$e1n # H0 for Eff
t0 = input$e2n # H0 for Tox
t00 = input$e3n # H0 for Eff and Tox
r1 = input$e1a
t1 = input$e2a
t11 = input$e3a
# interm.eff = input$nobs.seq
# interm.tox = input$nobs.seqTX
## toxicity and efficacy independent or correlated
if(r0*t0 != t00 | r1*t1 != t11){ ## correlated
scen = hypotheses_corr(r0,r1,t0,t1,PA_ET=input$e3a, PN_ET = input$e3n)
} else{## independent
scen = hypotheses_ind(r0, r1, t0, t1)
}
input$scenario = scen
inputlist = input
## Build the utility function -----
objf <- function(x, inputlist) {
if (nlooks ==1){
le = x[1]
lt = x[2]
g = x[3]
n = x[4]
le2 = x[5]
w1 = x[6]
lt2 = x[7]
w_list = c(w1, 1-w1)
}else{
le = x[1]
lt = x[2]
g = x[3]
n = x[4]
le2 = x[5]
lt2 = x[length(x)]
n_cohort <- nlooks +1 ## n_cohort is number of cohort
theta <- x[6: (length(x)-1)] ## number of thetas
w_list <- c()
w_list[1] <- (cos(theta[1]))^2
for( ii in 2: (n_cohort-1)){
w_list[ii] <- (prod(sin(theta[1:(ii-1)]))*cos(theta[ii]))^2
}
w_list[n_cohort] <- (prod(sin(theta[1:(n_cohort-1)])))^2
}
if (!all.equal(sum(w_list), 1, tolerance = 1e-6)) {
stop("Error: The sum of the elements in w_list must be approximately equal to 1.")
}
## interm is previous nobs.seq
interm = interm.eff = interm.tox = (cohortSize(N = n, R = nlooks, w = w_list, n_min_cohort1 = Nmin_cohort1, n_min_incre = Nmin_increase))
boundary = get_boundarycpp_2lambda(interm.eff= interm.eff,interm.tox =interm.tox,
lambda_e=le, lambda_t=lt,
lambda_e2=le2, lambda_t2=lt2, gamma = g,
prior=inputlist$scenario[1,], r0 = inputlist$e1n, t0 = input$e2n)
interm = ceiling(cohortSize(N = n, R = nlooks, w = w_list, n_min_cohort1 = Nmin_cohort1, n_min_incre = Nmin_increase))
index_effi <- which(skip_efficacy==1) ## skip which interim
index_toxi <- which(skip_toxicity==1) ## skip which interim
if (!is.null(skip_efficacy)){ ## skip efficacy
boundary_eff <- boundary$boundary.eff
boundary_eff[index_effi] <- -1 ## stop if <= cutoff
# boundary_tox = boundary$boundary.tox
}
if(!is.null(skip_toxicity) ){ ## skip toxicity
boundary_tox <- boundary$boundary.tox
boundary_tox[index_toxi] <- 999 ## stop if >= cutoff
# boundary_eff = boundary$boundary.eff
}
################################
if(design =="minimax"){
n_final = interm[length(interm)]
}
nintm = length(interm)
new_patient = c(0, interm)
npt=rep(NA, nintm)
for(j in seq(nintm)){
npt[j] = new_patient[j+1] - new_patient[j]
}
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
# temp = .Call("_GBOP2_efftox_recursive_optim", interm=interm, npt=npt, p=inputlist$scenario[2,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N01 = temp$ptsa
a01= temp$nonstop_prob
if (a01 > inputlist$err_tox){
# print("a01")
result = 999
} else {
# temp = .Call("_GBOP2_efftox_recursive_optim",interm=interm, npt=npt, p=inputlist$scenario[3,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N10 = temp$ptsa
a10= temp$nonstop_prob
if (a10 > inputlist$err_eff){
# print("a10")
result = 999
} else {
# temp = .Call("_GBOP2_efftox_recursive_optim", interm=interm, npt=npt, p=inputlist$scenario[1,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N00 = temp$ptsa
a00= temp$nonstop_prob
if (a00 > inputlist$err_all){
result = 999
} else {
# temp = .Call("_GBOP2_efftox_recursive_optim", interm=interm, npt=npt, p=inputlist$scenario[4,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N11 = temp$ptsa
a11= temp$nonstop_prob
if (a11 < inputlist$power_all){
result = 999
} else {
if(design =="optimal"){
result = ((N00 + N01 + N10)/3 + N11)/2
} else if(design =="minimax"){
n_final = interm[length(interm)]
result = n_final + (((N00 + N01 + N10)/3 + N11)/2)/n_final
} else{ ## unified
n_final = interm[length(interm)] ## n_final is total sample size
result = unified.u*n_final + (((N00 + N01 + N10)/3 + N11)/2)/n_final
}
}
}
}
}
return(result)
}
if(nlooks ==1){
low_bound <- c(0.5, 0.5, 0, miniPatients, 0.5, 0, 0.5)
upp_bound <- c(0.99, 0.99, 1, maxPatients, 0.99, 1, 0.99)
} else{
theta_L <- rep(0, nlooks) ## lower bound of theta
theta_U <- rep(pi/2, nlooks) ## upper bound of theta
low_bound <- c(0.5, 0.5, 0, miniPatients, 0.5, theta_L, 0.5)
upp_bound <- c(0.99, 0.99, 1, maxPatients, 0.99, theta_U, 0.99)
}
n_sim = 1
set.seed(input$seed)
seeds <- round(runif(10000)*10^8)
## PSO - comparison -----
if (method == "default"){
## default
## getPSOInfo:Create a list with PSO parameters for Minimization.
alg_setting <- getPSOInfo(freeRun = 1, nSwarm = nSwarm, maxIter=maxIter) # default if "basic" Linearly Decreasing Weight PSO
} else if (method == "quantum"){
## quantum:
alg_setting <- getPSOInfo(psoType = "quantum", freeRun = 1, nSwarm = nSwarm, maxIter=maxIter)
} else {
alg_setting <- getPSOInfo(psoType = "dexp", freeRun = 1, nSwarm = nSwarm, maxIter = maxIter)
}
for ( i in n_sim){
res <- globpso(objFunc = objf, lower = low_bound, upper = upp_bound,
fixed = NULL, PSO_INFO = alg_setting,
inputlist = inputlist, seed = seeds[i])
pars = res$par
if (nlooks ==1){
le = pars[1]
lt = pars[2]
g = pars[3]
n = pars[4]
le2 = pars[5]
w1 = pars[6]
lt2 = pars[7]
w_list = c(w1, 1-w1)
} else{ ## when nlooks >=2
le = pars[1]
lt = pars[2]
g = pars[3]
n = pars[4]
le2 = pars[5]
lt2 = pars[length(pars)]
n_cohort <- nlooks +1 ## n_cohort is number of cohort
theta <- pars[6: (length(pars)-1)] ## number of thetas
w_list <- c()
w_list[1] <- (cos(theta[1]))^2
for( ii in 2: n_cohort-1){
w_list[ii] <- (prod(sin(theta[1:(ii-1)]))*cos(theta[ii]))^2
}
w_list[n_cohort] <- (prod(sin(theta[1:(n_cohort-1)])))^2
}
interm = interm.eff = interm.tox = (cohortSize(N = n, R = nlooks, w = w_list, n_min_cohort1 = Nmin_cohort1, n_min_incre = Nmin_increase))
boundary = get_boundarycpp_2lambda(interm.eff= interm.eff,interm.tox =interm.tox,
lambda_e=le, lambda_t=lt,
lambda_e2=le2, lambda_t2=lt2, gamma = g,
prior=inputlist$scenario[1,], r0 = inputlist$e1n, t0 = input$e2n)
# interm = ceiling(cohortSize(N = n, R = nlooks, w = w_list))
#
#
# index_effi <- which(skip_efficacy==1) ## skip which interim
# index_toxi <- which(skip_toxicity==1) ## skip which interim
# if (is.null(skip_efficacy)){ ## skip efficacy
# boundary_eff <- boundary$boundary.eff
# boundary_eff[index_effi] <- -1
# # boundary_tox = boundary$boundary.tox
# } else if(is.null(skip_toxicity) ){ ## skip toxicity
# boundary_tox = boundary_tox
# boundary_tox[index_toxi] <- boundary_tox[index_toxi] + 1
# # boundary_eff = boundary$boundary.eff
# }
interm = ceiling(cohortSize(N = n, R = nlooks, w = w_list, n_min_cohort1 = Nmin_cohort1, n_min_incre = Nmin_increase))
index_effi <- which(skip_efficacy==1) ## skip which interim
index_toxi <- which(skip_toxicity==1) ## skip which interim
if (!is.null(skip_efficacy)){ ## skip efficacy
boundary_eff <- boundary$boundary.eff
boundary_eff[index_effi] <- -1 ## stop if <= cutoff
# boundary_tox = boundary$boundary.tox
}
if(!is.null(skip_toxicity) ){ ## skip toxicity
boundary_tox <- boundary$boundary.tox
boundary_tox[index_toxi] <- 999 ## stop if >= cutoff
# boundary_eff = boundary$boundary.eff
}
if(design =="minimax"){
n_final = interm[length(interm)]
}
########################################################
nintm = length(interm)
new_patient = c(0, interm)
npt=rep(NA, nintm)
for(j in seq(nintm)){
npt[j] = new_patient[j+1] - new_patient[j]
}
# temp = .Call("_GBOP2_efftox_recursive_optim",interm=interm, npt=npt, p=inputlist$scenario[1,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[1,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N00 = temp$ptsa ## expected sample size under H00
a00= temp$nonstop_prob
# temp = .Call("_GBOP2_efftox_recursive_optim",interm=interm, npt=npt, p=inputlist$scenario[4,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[4,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N11 = temp$ptsa
a11= temp$nonstop_prob
# temp = .Call("_GBOP2_efftox_recursive_optim",interm=interm, npt=npt, p=inputlist$scenario[2,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[2,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N01 = temp$ptsa ## expected sample size under H01
a01= temp$nonstop_prob ## probability of not stopping under H01
# temp = .Call("_GBOP2_efftox_recursive_optim", interm=interm, npt=npt, p=inputlist$scenario[3,],
# bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
if(is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary$boundary.eff, bound_tox=boundary$boundary.tox)
}else if(!is.null(skip_efficacy) && is.null(skip_toxicity)){
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary_eff, bound_tox=boundary$boundary.tox)
} else if(is.null(skip_efficacy) && !is.null(skip_toxicity)){
temp = efftox_recursive_optim(interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary$boundary.eff, bound_tox=boundary_tox)
} else{
temp = efftox_recursive_optim( interm=interm, npt=npt, p=inputlist$scenario[3,],
bound_eff=boundary_eff, bound_tox=boundary_tox)
}
N10 = temp$ptsa ## expected sample size under H10
a10= temp$nonstop_prob
expected_sample <- ((N00 + N01 + N10)/3 + N11)/2
if(design =="optimal"){
utility = ((N00 + N01 + N10)/3 + N11)/2
} else if(design =="minimax"){
utility = n_final + (((N00 + N01 + N10)/3 + N11)/2)/n_final
}else {
utility = unified.u*n_final + (((N00 + N01 + N10)/3 + N11)/2)/n_final
}
}
# Concatenate values into a single vector, flattening sub-elements as needed
if(!is.null(skip_efficacy)){
boundary$boundary.eff <- boundary_eff
}
if(!is.null(skip_toxicity)){
boundary$boundary.tox <- boundary_tox
}
results_list <- list(
"function" = "PSO_design_TE",
"design" = design,"method" = method,
"parameter" = list(
"lambdae1" = le, "lambdae2" = le2,
"lambdat1" = lt,
"lambdat2" = lt2,
"gamma" = g),
"cohort" = as.list(interm), # Cohort sizes
"boundary_effi" = as.list(boundary$boundary.eff), # Boundary for efficacy
"boundary_toxi" = as.list(boundary$boundary.tox), # Boundary for toxicity
"expected_sample" = expected_sample,
"typeI_H01 (safe but futile)" = a01,
"typeI_H10 (efficacious but toxic)" = a10,
"typeI_H00 (futile and toxic)" = a00,
"power" = a11,
"utility" = utility
)
# results_list
class(results_list)<-"gbop2"
return(results_list)
}
Try the GBOP2 package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.