I created a simple design with 13 exercises/rows using the Federov algorithm that had a d-error of 0.22669. I then tried to create a design with the same number of rows from the same candidate search space using a genetic algorithm (in R). The resulting design had a d-error of 0.22433 with the same number of exercises.
The Federov optimized design has slightly better level co-occurrence balance than the genetic algorithm optimized design and one slightly lower correlation between two variables.
Why would a design with lower d-error have worse design properties (even though just barely) than a design with a higher d-error?
Just in case anyone is interested, I've included my code to create a d-optimal design using a genetic algorithm in R below:
- Code: Select all
### Load GA
install.packages("genalg")
library(genalg)
### Defind the evaluation function
evalFunc <- function(x) {
search.space = expand.grid(F1 = c("A", "B", "C", "D"),
F2 = c("I", "II", "III"),
F3 = c("Low", "High"),
F4 = c("Yes", "No"))
current_design <- search.space[x==1,]
### Calc D-error
current_design.EC <- data.frame(model.matrix(~., current_design)) #include intercept
current_design.NU <- as.matrix(sapply(current_design.EC, as.numeric)) #numeric matrix
derror <- det(t(current_design.NU)%*%current_design.NU)^(1/ncol(current_design.NU))/(nrow(current_design.NU)) #D-error
if (sum(x) != 13)
return(0) else return(-derror)
}
### Next, we choose the number of iterations, design and run the model
GAmodel <- rbga.bin(size =48, popSize = 200, iters = 100, mutationChance = 0.01, elitism = T, evalFunc = evalFunc)
# Notice that within the settings of genalg, the type is a binary chromosome by default
plot(GAmodel)
summary(GAmodel, echo=T)
### Best solution from GA; d-error 0.2243314
chromosome = c(0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0,
0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0,
1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0,
0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1)
dopt <- search.space[chromosome==1,]
### Calc D-error by hand
dopt.EC <- data.frame(model.matrix(~., dopt)) #includes intercept
dopt.EC <-as.matrix(sapply(dopt.EC, as.numeric))
det(t(dopt.EC)%*%dopt.EC)^(1/ncol(dopt.EC))/(nrow(dopt.EC))