2
$\begingroup$

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")

enter image description here

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"
$\endgroup$
4
  • 1
    $\begingroup$ First, it would help if your sample R code used a seed for the random number generator, so that it is reproducible. When I run the data generator, I get different data, so I cannot compare to your "f" function. Second, your GA example will maximize the percentage of zeros, not minimize it. Third, you are counting zeros in the "id" column. Is that deliberate? $\endgroup$
    – prubin
    Dec 29, 2021 at 22:25
  • $\begingroup$ @ prubin: Thank you so much for your comments! I made some changes - thanks! $\endgroup$
    – stats_noob
    Dec 29, 2021 at 23:45
  • 1
    $\begingroup$ I don't understand the presence of "none" as a filter option. If that were selected for any factor, wouldn't you wind up selecting zero rows from the data set (making your percent zeros measure undefined)? $\endgroup$
    – prubin
    Dec 30, 2021 at 16:35
  • 1
    $\begingroup$ Also, I think you want your corrected function f to return 100 - s, not 1 - s, since s is a percentage. $\endgroup$
    – prubin
    Dec 30, 2021 at 16:57

1 Answer 1

7
+100
$\begingroup$

It is possible (but a bit tricky) to write a mixed-integer linear program for this problem. If you are willing to accept a good but not guaranteed optimal solution, though, the GA is easily modified to handle it. The key is to use a chromosome of 10 real values, where the sixth through tenth are rounded down to the next lower integer and used to index a filter value for each factor variable from a list of all possible filter values.

I modified your code above to demonstrate this. In doing so, I corrected the output of the f function to be 100-s rather than 1-s, and also did away with the "none" option for each factor variable (which, if selected, results in no rows being chosen by the filter). You can see the results (and if desired extract the code) in this notebook file.

$\endgroup$
11
  • $\begingroup$ @ prubin: I can not thank you enough for all the work you have done! $\endgroup$
    – stats_noob
    Dec 31, 2021 at 6:13
  • $\begingroup$ I had a few questions that I wanted to ask - I am currently reviewing the code you have provided and trying to better understand it. I am learning so much - thank you! $\endgroup$
    – stats_noob
    Dec 31, 2021 at 7:37
  • $\begingroup$ If you don't think the questions will be of general interest to other people reading this question, you can always start a "chat" with me using the chat link in the page footer. $\endgroup$
    – prubin
    Dec 31, 2021 at 16:43
  • $\begingroup$ @stats555 I can $\endgroup$
    – 2653
    Jan 1 at 14:50
  • $\begingroup$ Happy New Year Everyone! I am still working on understanding the code - thanks! $\endgroup$
    – stats_noob
    Jan 2 at 2:33

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.