Nothing
context("create design, design space and PopED databases")
test_that("designs are created correctly using create_design()", {
source("examples_fcn_doc/examples_create_design.R")
expect_true(all(size(design_1$xt)==c(2,4)))
expect_true(is.na(design_1$xt[1,4]))
expect_true(all(size(design_2$xt)==c(2,5)))
expect_true(is.na(design_2$xt[2,5]))
expect_true(all(size(design_5$xt)==c(3,4)))
expect_true(!is.null(colnames(design_5$xt)))
expect_true(!is.null(rownames(design_5$xt)))
expect_true(!is.null(rownames(design_5$xt)))
expect_true(!any(is.na(design_6$model_switch)))
expect_null(colnames(design_7$a))
expect_true(all(size(design_7$a)==c(2,3)))
expect_true(all(size(design_9$a)==c(2,4)))
expect_null(colnames(design_9$a))
expect_true(is.na(design_9$a[2,4]))
expect_equivalent(design_10,design_8)
expect_true(!is.null(colnames(design_11$a)))
expect_true(!is.null(colnames(design_12$a)))
expect_true(all(size(design_12$a)==c(2,2)))
expect_true(all(size(design_13$a)==c(2,3)))
expect_true(is.na(design_13$a[1,3]))
expect_equivalent(design_14,design_13)
expect_true(!is.null(colnames(design_15$a)))
expect_error(create_design(xt=xt1,groupsize=20,m=3))
})
test_that("design spaces are created correctly using create_design_space()", {
source("examples_fcn_doc/examples_create_design_space.R")
expect_equivalent(ds_1$design,design_1)
expect_equivalent(ds_1$design_space$mina,design_1$a)
expect_equivalent(ds_1$design_space$maxa,design_1$a)
expect_equivalent(ds_1$design_space$minxt,design_1$xt)
expect_equivalent(ds_1$design_space$maxxt,design_1$xt)
expect_equivalent(ds_1$design_space$mingroupsize,design_1$groupsize)
expect_equivalent(ds_1$design_space$maxgroupsize,design_1$groupsize)
expect_true(length(unique(c(ds_1$design_space$grouped_a)))==length(ds_1$design_space$grouped_a))
expect_true(length(unique(c(ds_1$design_space$grouped_xt)))==length(ds_1$design_space$grouped_xt))
expect_true(all(ds_2$design_space$maxxt==10))
expect_true(all(ds_2$design_space$minxt==0))
expect_true(all(ds_2$design_space$maxni==10))
expect_error(create_design_space(design_1,maxni=10,minni=11))
expect_error(create_design_space(design_1,minni=15))
expect_error(create_design_space(design_1,maxni=10,mingroupsize=30))
expect_error(create_design_space(design_1,maxni=10,mingroupsize=20))
expect_error(create_design_space(design_1,maxni=10,mingroupsize=20,maxxt=10))
expect_error(create_design_space(design_1,maxni=10,mingroupsize=20,minxt=0))
expect_equivalent(ds_3$design_space$mintotgroupsize,40)
expect_equivalent(ds_4$design_space$maxa,rbind(c(100,2000),c(100,2000)))
expect_equivalent(ds_5$design_space$mina,rbind(c(10,20),c(10,20)))
expect_true(length(ds_6$design_space$x_space)==4)
expect_true(length(ds_6$design_space$x_space[[1,1]])==1)
expect_true(length(ds_7$design_space$x_space)==4)
expect_true(length(ds_7$design_space$x_space[[1,2]])==length(seq(100,400,by=20)))
expect_error(create_design_space(design_2,x_space=list(SEX=c(0,2),DOSE_discrete=seq(100,400,by=20))))
expect_equivalent(ds_8$design_space$grouped_xt,rbind(c(1,2,3,4,5),c(1,2,3,4,5)))
expect_error(create_design_space(design_2,x_space=list(SEX=c(1,2),DOSE_discrete=seq(100,400,by=20)),grouped_xt=c(1,2,3,4,6)))
expect_true(all(ds_9$design_space$grouped_xt[1,]==ds_9$design_space$grouped_xt[2,],na.rm=TRUE))
expect_true(all(ds_10$design_space$grouped_a[1,]==ds_10$design_space$grouped_a[2,],na.rm=TRUE))
expect_equivalent(ds_11$design_space$grouped_a, rbind(c(1,2),c(3,2)))
expect_true(all(ds_12$design_space$grouped_x[1,]==ds_12$design_space$grouped_x[2,],na.rm=TRUE))
expect_equivalent(ds_13$design_space$grouped_x, rbind(c(1,2),c(3,2)))
})
test_that("create.poped.database works for different inputs", {
source("examples_fcn_doc/examples_create.poped.database.R")
## evaluate initial design
output <- calc_ofv_and_fim(poped.db,ofv_calc_type=1)
crit <- ofv_criterion(output$ofv,size(output$fim,1),poped.db,ofv_calc_type=1)
expect_equal(crit,1794.658,tolerance=1e-3)
expect_true(!is.null(dimnames(poped.db$design$xt)))
output_2 <- calc_ofv_and_fim(poped.db,ofv_calc_type=4)
crit_2 <- ofv_criterion(output_2$ofv,size(output_2$fim,1),poped.db,ofv_calc_type=4)
expect_equal(crit_2,1794.658,tolerance=1e-3)
poped.db_1 <- create.poped.database(ff_file="ff.PK.1.comp.oral.sd.CL",
fg_file="sfg",
fError_file="feps.prop",
bpop=c(CL=0.15, V=8, KA=1.0, Favail=1),
notfixed_bpop=c(1,1,1,0),
d=c(CL=0.07, V=0.02, KA=0.6),
sigma=0.01,
groupsize=16,
xt=list(c(0.5,1,2,6,24,36,72,120),
c(0.5,1,2,6,24,36,72,120)),
minxt=0,
maxxt=120,
a=c(DOSE=70))
output_1 <- calc_ofv_and_fim(poped.db_1)
expect_equivalent(output_1,output_2)
expect_true(!is.null(dimnames(poped.db$design$a)))
})
test_that("Number of variables are counted correctly in find.largest.index()", {
sfg_test <- function(x,a,bpop,b,bocc){
parameters=c( V=bpop[1]*exp(b[1]),
KA=bpop[2]*exp(b[2]),
CL_OCC_1=bpop[3]*exp(b[3]+bocc[1,1]+bocc[2,2]),
CL_OCC_2=bpop[3]*exp(b[3]+bocc[1,2]+bocc[2,1] + bocc[1,3]),
Favail=bpop[4],
DOSE=a[1],
TAU=a[2])
return( parameters )
}
expect_equal(find.largest.index(sfg_test,"bocc",mat=T,mat.row=T),2)
expect_equal(find.largest.index(sfg_test,"bocc",mat=T,mat.row=F),3)
expect_equal(find.largest.index(sfg_test,"bpop"),4)
expect_equal(find.largest.index(sfg_test,"b"),3)
expect_equal(find.largest.index(sfg_test,"x"),0)
expect_equal(find.largest.index(sfg_test,"a"),2)
})
test_that("Named vectors are ordered correctly", {
model_def <- list(
ff_fun="ff.PK.1.comp.oral.sd.CL",
fg_fun=build_sfg(model="ff.PK.1.comp.oral.sd.CL"),
fError_fun="feps.prop")
par_def <- list(
bpop=c(CL=0.15, V=8, KA=1.0, Favail=1),
notfixed_bpop=c(CL=1,V=1,KA=1,Favail=0),
d=c(CL=0.07, V=0.02, KA=0.6),
sigma=c(prop=0.01))
design_def <- list(groupsize=32,
xt=c( 0.5,1,2,6,24,36,72,120),
minxt=0,
maxxt=120,
a=70,
mina=0,
maxa=100)
poped_db <- do.call(create.poped.database,
c(model_def,
par_def,
design_def)
)
#plot_model_prediction(poped_db)
#plot_model_prediction(poped_db,PI=T)
expect_equal(
poped_db$parameters$bpop[,2],
c(CL=0.15,Favail=1,KA=1,V=8)
)
expect_equal(
poped_db$parameters$d[,2],
c(CL=0.07,KA=0.6,V=0.02)
)
expect_equal(
poped_db$parameters$notfixed_bpop,
c(CL=1,Favail=0,KA=1,V=1)
)
sfg <- function(x,a,bpop,b,bocc){
parameters=c(CL=bpop[1]*exp(b[1]),
V=bpop[2]*exp(b[2]),
KA=bpop[3]*exp(b[3]),
Favail=bpop[4],
DOSE=a[1])
return(parameters)
}
poped_db_1 <- create.poped.database(ff_file="ff.PK.1.comp.oral.sd.CL",
fg_file="sfg",
fError_file="feps.prop",
bpop=c(CL=0.15, V=8, KA=1.0, Favail=1),
# notfixed_bpop=c(1,1,1,0),
notfixed_bpop=c(CL=1,V=1,KA=1,Favail=0),
d=c(CL=0.07, V=0.02, KA=0.6),
sigma=0.01,
groupsize=32,
xt=c( 0.5,1,2,6,24,36,72,120),
minxt=0,
maxxt=120,
a=70)
poped_db_2 <- create.poped.database(ff_file="ff.PK.1.comp.oral.sd.CL",
fg_file="sfg",
fError_file="feps.prop",
bpop=c(CL=0.15, V=8, KA=1.0, Favail=1),
notfixed_bpop=c(1,1,1,0),
#notfixed_bpop=c(CL=1,V=1,KA=1,Favail=0),
d=c(CL=0.07, V=0.02, KA=0.6),
sigma=0.01,
groupsize=32,
xt=c( 0.5,1,2,6,24,36,72,120),
minxt=0,
maxxt=120,
a=70)
FIM.1 <- evaluate.fim(poped_db_1)
FIM.2 <- evaluate.fim(poped_db_2)
expect_equal(det(FIM.1),det(FIM.2))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.