R/OptPB.R

In daewr: Design and Analysis of Experiments with R

OptPB<-function(nruns,nfactors, randomize=FALSE){
  if (nruns != 12 && nruns !=20 ) {stop("This function only works for nruns=12 or nruns=20")}
if (nruns==12) {
  if (nfactors < 5) {stop("At least 5 factors required for 12-run PB design")}
  if (nfactors > 8) {stop("No more than 8 factors can be used for 12 run PB design")}
pbdes12 <- rbind(
c( 1, -1,  1, -1, -1, -1,  1,  1,  1,  -1,   1),
c( 1,  1, -1,  1, -1, -1, -1,  1,  1,   1,  -1),
c(-1,  1,  1, -1,  1, -1, -1, -1,  1,   1,   1),
c( 1, -1,  1,  1, -1,  1, -1, -1, -1,   1,   1),
c( 1,  1, -1,  1,  1, -1,  1, -1, -1,  -1,   1),
c( 1,  1,  1, -1,  1,  1, -1,  1, -1,  -1,  -1),
c(-1,  1,  1,  1, -1,  1,  1, -1,  1,  -1,  -1),
c(-1, -1,  1,  1,  1, -1,  1,  1, -1,   1,  -1),
c(-1, -1, -1,  1,  1,  1, -1,  1,  1,  -1,   1),
c( 1, -1, -1, -1,  1,  1,  1, -1,  1,   1,  -1),
c(-1,  1, -1, -1, -1,  1,  1,  1, -1,   1,   1),
c(-1, -1, -1, -1, -1, -1, -1, -1, -1,  -1,  -1))
colnames(pbdes12)<-c('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I','J','K')
ncol5<-c(1,2,3,4,5)
ncol6<-c(1,2,3,4,5,6)
ncol7<-c(1,2,3,4,5,6,7)
ncol8<-c(1,2,3,4,5,6,7,8)
if (nfactors==5) {design<-data.frame(pbdes12[ , ncol5])}
if (nfactors==6) {design<-data.frame(pbdes12[ , ncol6])}
if (nfactors==7) {design<-data.frame(pbdes12[ , ncol7])}
if (nfactors==8) {design<-data.frame(pbdes12[ , ncol8])}
if (randomize==TRUE) {design <- design[sample(1:12), ]}
}
if (nruns==20) {
  if (nfactors < 9) {stop("At least 9 factors required for 20-run PB design")}
  if (nfactors > 15) {stop("No more than 15 factors can be used for 20 run PB design")}

pb20<-rbind(
c( 1, 1,-1,-1, 1, 1, 1, 1,-1, 1,-1, 1,-1,-1,-1,-1, 1, 1,-1),
c(-1, 1, 1,-1,-1, 1, 1, 1, 1,-1, 1,-1, 1,-1,-1,-1,-1, 1, 1),
c( 1,-1, 1, 1,-1,-1, 1, 1, 1, 1,-1, 1,-1, 1,-1,-1,-1,-1, 1),
c( 1, 1,-1, 1, 1,-1,-1, 1, 1, 1, 1,-1, 1,-1, 1,-1,-1,-1,-1),
c(-1, 1, 1,-1, 1, 1,-1,-1, 1, 1, 1, 1,-1, 1,-1, 1,-1,-1,-1),
c(-1,-1, 1, 1,-1, 1, 1,-1,-1, 1, 1, 1, 1,-1, 1,-1, 1,-1,-1),
c(-1,-1,-1, 1, 1,-1, 1, 1,-1,-1, 1, 1, 1, 1,-1, 1,-1, 1,-1),
c(-1,-1,-1,-1, 1, 1,-1, 1, 1,-1,-1, 1, 1, 1, 1,-1, 1,-1, 1),
c( 1,-1,-1,-1,-1, 1, 1,-1, 1, 1,-1,-1, 1, 1, 1, 1,-1, 1,-1),
c(-1, 1,-1,-1,-1,-1, 1, 1,-1, 1, 1,-1,-1, 1, 1, 1, 1,-1, 1),
c( 1,-1, 1,-1,-1,-1,-1, 1, 1,-1, 1, 1,-1,-1, 1, 1, 1, 1,-1),
c(-1, 1,-1, 1,-1,-1,-1,-1, 1, 1,-1, 1, 1,-1,-1, 1, 1, 1, 1),
c( 1,-1, 1,-1, 1,-1,-1,-1,-1, 1, 1,-1, 1, 1,-1,-1, 1, 1, 1),
c( 1, 1,-1, 1,-1, 1,-1,-1,-1,-1, 1, 1,-1, 1, 1,-1,-1, 1, 1),
c( 1, 1, 1,-1, 1,-1, 1,-1,-1,-1,-1, 1, 1,-1, 1, 1,-1,-1, 1),
c( 1, 1, 1, 1,-1, 1,-1, 1,-1,-1,-1,-1, 1, 1,-1, 1, 1,-1,-1),
c(-1, 1, 1, 1, 1,-1, 1,-1, 1,-1,-1,-1,-1, 1, 1,-1, 1, 1,-1),
c(-1,-1, 1, 1, 1, 1,-1, 1,-1, 1,-1,-1,-1,-1, 1, 1,-1, 1, 1),
c( 1,-1,-1, 1, 1, 1, 1,-1, 1,-1, 1,-1,-1,-1,-1, 1, 1,-1, 1),
c(-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1))

ncol9<-c(1,2,3,4,5,8,13,15,16)
ncol10<-c(1,2,3,4,6,8,13,14,16,17)
ncol11<-c(1,2,3,4,5,6,8,13,14,16,17)
ncol12<-c(1,2,3,4,5,6,8,10,13,14,16,17)
ncol13<-c(1,2,3,4,5,6,7,8,9,10,14,17,18)
ncol14<-c(1,3,4,5,6,8,9,10,11,12,15,16,18,19)
ncol15<-c(1,2,4,5,6,7,8,9,10,11,12,13,16,17,19)
colnames(pb20)<-c('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I','J','K','L','M','N','O','P','Q','R','S')

if (nfactors==9) {design<-data.frame(pb20[ , ncol9])}
if (nfactors==10) {design<-data.frame(pb20[ , ncol10])}
if (nfactors==11) {design<-data.frame(pb20[ , ncol11])}
if (nfactors==12) {design<-data.frame(pb20[ , ncol12])}
if (nfactors==13) {design<-data.frame(pb20[ , ncol13])}
if (nfactors==14) {design<-data.frame(pb20[ , ncol14])}
if (nfactors==15) {design<-data.frame(pb20[ , ncol15])}
if (randomize==TRUE) {design <- design[sample(1:20), ]}
}
			   
return(design)
  }