I am working with the R programming language. Given a data set ("my_data"), I am trying to use an mixed integer optimization algorithm (e.g. genetic algorithm) to find out which filters applied on which variables produces the smallest percentage of zero values (subject to some constraints).
Part 1: Here is the data I am using
set.seed(123)
num_var_1 <- abs(rnorm(1000, 10, 1))
num_var_2 <- abs(rnorm(1000, 10, 5))
num_var_3 <- abs(rnorm(1000, 10, 10))
num_var_4 <- abs(rnorm(1000, 10, 10))
num_var_5 <- abs(rnorm(1000, 10, 10))
factor_1 <- c("0","B", "C")
factor_2 <- c("0","BB", "CC")
factor_3 <- c("0","BBB", "CCC", "DDD")
factor_4 <- c("0","BBBB", "CCCC", "DDDD", "EEEE")
factor_5 <- c("0","BBBBB", "CCCCC", "DDDDD", "EEEEE", "FFFFFF")
factor_var_1 <- as.factor(sample(factor_1, 1000, replace=TRUE, prob=c(0.3, 0.5, 0.2)))
factor_var_2 <- as.factor(sample(factor_2, 1000, replace=TRUE, prob=c(0.5, 0.3, 0.2)))
factor_var_3 <- as.factor(sample(factor_3, 1000, replace=TRUE, prob=c(0.5, 0.2, 0.2, 0.1)))
factor_var_4 <- as.factor(sample(factor_4, 1000, replace=TRUE, prob=c(0.5, 0.2, 0.1, 0.1, 0.1)))
factor_var_5 <- as.factor(sample(factor_4, 1000, replace=TRUE, prob=c(0.3, 0.2, 0.1, 0.1, 0.1)))
id = 1:1000
my_data = data.frame(id,num_var_1, num_var_2, num_var_3, num_var_4, num_var_5, factor_var_1, factor_var_2, factor_var_3, factor_var_4, factor_var_5)
#randomly add some zeros to the data
my_data[] <- lapply(my_data, function(x) {
x[sample(seq_along(x), length(x)/2)] <- 0
x
})
head(my_data)
id num_var_1 num_var_2 num_var_3 num_var_4 num_var_5 factor_var_1 factor_var_2 factor_var_3 factor_var_4 factor_var_5
1 1 10.357273 19.219814 27.031869 0.00000 3.865392 0 BB 0 0 0
2 2 0.000000 8.746435 0.000000 0.00000 1.047103 0 0 CCC 0 0
3 3 8.608149 10.192377 5.528652 11.39321 19.821561 0 BB 0 0 BBBB
4 0 11.555258 14.732870 8.651462 12.54166 0.000000 0 BB 0 0 0
5 5 10.125296 0.000000 8.095136 0.00000 31.131257 0 0 0 CCCC EEEE
6 6 8.832702 9.877200 3.155799 16.06504 20.368927 0 0 0 0 0
Part 2: Here are the acceptable ranges for each of the variables
num_var_1 has to be between range(num_var_1) :
7.029118 , 13.014451
num_var_2 has to be between range(num_var_2) :
0.0296502 , 29.6070503
num_var_3 has to be between range(num_var_3) :
0.02422479 , 46.72178885
num_var_4 has to be between range(num_var_4) :
0.03661167 , 53.22815207
num_var_5 has to be between range(num_var_5) :
0.01581034 , 41.22046108
factor_var_1 can take any of the following values (all possible combinations of levels) :
"none" "0" "B" "C" "0 & B" "0 & C" "B & C" "0 & B & C"
factor_var_2 can take any of the following values (all possible combinations of levels):
"none" "0" "BB" "CC" "0 & BB" "0 & CC" "BB & CC" "0 & BB & CC"
factor_var_3 can take any of the following values (all possible combinations of levels):
"none" "0" "BBB" "CCC" "DDD" "0 & BBB" "0 & CCC" "0 & DDD" "BBB & CCC" "BBB & DDD" "CCC & DDD" "0 & BBB & CCC" "0 & BBB & DDD" "0 & CCC & DDD" "BBB & CCC & DDD" "0 & BBB & CCC & DDD"
factor_var_4 and factor_var_5 can take any of the following values (all possible combinations of levels):
"none" "0" "BBBB" "CCCC" "DDDD" "EEEE" "0 & BBBB" "0 & CCCC" "0 & DDDD" "0 & EEEE" "BBBB & CCCC" "BBBB & DDDD" "BBBB & EEEE" "CCCC & DDDD" "CCCC & EEEE" "DDDD & EEEE" "0 & BBBB & CCCC" "0 & BBBB & DDDD" "0 & BBBB & EEEE" "0 & CCCC & DDDD" "0 & CCCC & EEEE" "0 & DDDD & EEEE" "BBBB & CCCC & DDDD" "BBBB & CCCC & EEEE" "BBBB & DDDD & EEEE" "CCCC & DDDD & EEEE" "0 & BBBB & CCCC & DDDD" "0 & BBBB & CCCC & EEEE" "0 & BBBB & DDDD & EEEE" "0 & CCCC & DDDD & EEEE" "BBBB & CCCC & DDDD & EEEE" "0 & BBBB & CCCC & DDDD & EEEE"
Part 3: This is the function ("f") I am trying to optimize - this function takes 10 inputs (filters for each of the 10 variables in "my_data"), creates a new data set according to the specified filters, and then returns the overall percentage of zeros in the data set:
library(dplyr)
f <- function(x1, x2, x3, x4, x5, x6, x7, x8, x9, x10) {
target1 = x1
target2 = x2
target3 = x3
target4 = x4
target5 = x5
target6 = x6
target7 = x7
target8 = x8
target9 = x9
target10 = x10
result <- filter(my_data[,-1], num_var_1 < target1 & num_var_2 < target2 & num_var_3 < target3 & num_var_4 <target4 & num_var_5 <target5 &
factor_var_1 %in% target6 & factor_var_2 %in% target7 & factor_var_3 %in% target8 & factor_var_4 %in% target9 & factor_var_5 %in% target10)
s = sum(result == '0', na.rm = TRUE) / prod(dim(result)) * 100
return(1 - s)
}
As an example, we test to see if this function runs:
f(10, 10, 10, 10, 10, "0", "0", "0", c("CCCC","EEEE"), "EEEE")
[1] 63.63636
My Question: Can someone please show me how to use an optimization algorithm to optimize the function "f"? In the past, I usually used the "GA" library in R (https://cran.r-project.org/web/packages/GA/vignettes/GA.html) for optimizing functions where all variables can only take numerical outputs.
If I only had to deal with numerical inputs, I could optimize a modified version of the function "f" using the GA library in R:
#modified version of "f" with only numerical inputs
f_mod <- function(x1, x2, x3, x4, x5) {
target1 = x1
target2 = x2
target3 = x3
target4 = x4
target5 = x5
result <- filter(my_data[,-1], num_var_1 < target1 & num_var_2 < target2 & num_var_3 < target3 & num_var_4 <target4 & num_var_5 <target5 )
s = sum(result == '0', na.rm = TRUE) / prod(dim(result))
return(1 - s )
}
library(GA)
GA <- ga(type = "real-valued",
fitness = function(x) f_mod(x[1], x[2], x[3], x[4], x[5]),
lower = c( min(num_var_1), min(num_var_2), min(num_var_3), min(num_var_4), min(num_var_5)), upper = c( max(num_var_1), max(num_var_2), max(num_var_3), max(num_var_4), max(num_var_5)),
popSize = 50, maxiter = 100, run = 100)
# results of the 100 iterations:
GA | iter = 1 | Mean = 65.58077 | Best = 75.30529
GA | iter = 2 | Mean = 66.92623 | Best = 75.30529
....
GA | iter = 99 | Mean = 79.04933 | Best = 80.62201
GA | iter = 100 | Mean = 79.08810 | Best = 80.62201
#view final solution
GA@solution
x1 x2 x3 x4 x5
[1,] 7.624509 3.220958 0.3176768 2.287231 0.5194747
[2,] 7.625705 3.235704 0.3180106 2.307864 0.5196744
GA@fitnessValue
[1] 80.62201
But I do not know how I can write the above optimization algorithm to accommodate a function with numerical inputs and factor inputs.
Can someone please show me how to optimize the original function "f" using some optimization package in R (e.g. lpsolve, nloptr)?
Extra 1: Visualizing the Optimization Algorithm's Progress
plot(GA, main = "Results of Optimization on f_mod")
Extra 2: Code to Obtain All Factor Levels:
factor_1 <- c("AAAA","BBBB", "CCCC", "DDDD", "EEEE")
factor_2 <- c("B1", "C1", "D1", "E1", "F1")
factor_var_1 <- as.factor(sample(factor_1, 1000, replace=TRUE, prob=c(0.5, 0.2, 0.1, 0.1, 0.1)))
factor_var_2 <- as.factor(sample(factor_2, 1000, replace=TRUE, prob=c(0.3, 0.2, 0.1, 0.1, 0.1)))
my_data = data.frame(factor_var_1, factor_var_2)
fac4 = levels(my_data$factor_var_1)
fac5 = levels(my_data$factor_var_2)
my_list = list(fac1, fac2)
st1 <- lapply(my_list, function(x) c("none", unlist(lapply(seq_len(length(x)), function(i) combn(x, i, FUN = paste, collapse = " & ")))));
#view answer
st1
[[1]]
[1] "none" "0" "B" "C" "0 & B" "0 & C" "B & C" "0 & B & C"