在 R 中指定逻辑条件(例如“大于"和“小于") [英] Specifying Logical Conditions (e.g. "greater than" and "less than") in R

问题描述

我正在使用 R 编程语言 - 我正在尝试执行多目标约束优化".

我为此示例创建了一些数据:

#load 库图书馆(dplyr)# 为这个例子创建一些数据a1 = 范数(1000,100,10)b1 = 范数(1000,100,5)c1 = sample.int(1000, 1000, 替换 = TRUE)train_data = data.frame(a1,b1,c1)

然后我定义了一个具有4个目标"的函数(funct_set")(f

在上图中，我确定了一些违反限制中指定的逻辑条件的行.

有谁知道为什么会这样?我是否错误地指定了限制?有人可以告诉我如何解决这个问题吗?

谢谢

解决方案

可能的答案:

#load 库图书馆(dplyr)图书馆(mco)#定义函数funct_set <- 函数 (x) {x1 <- x[1];x2 <- x[2];x3 <- x[3] ;x4 <- x[4];x5 <- x[5];x6 <- x[6];x[7] <- x[7]f <- 数字(4)#bin 数据根据随机标准train_data <- train_data %>%变异(猫 = ifelse(a1 <= x1 & b1 <= x3，a"，ifelse(a1 <= x2 & b1 <= x4, "b", "c")))train_data$cat = as.factor(train_data$cat)#新的分裂a_table = train_data %>%过滤器(猫 == a")%>%选择(a1，b1，c1，猫)b_table = train_data %>%过滤器(猫==b")%>%选择(a1，b1，c1，猫)c_table = train_data %>%过滤器(猫==c")%>%选择(a1，b1，c1，猫)#计算每个 bin 的分位数(quant")table_a = data.frame(a_table%>% group_by(cat)%>%变异(定量 = ifelse(c1 > x[5],1,0)))table_b = data.frame(b_table%>% group_by(cat)%>%变异(定量 = ifelse(c1 > x[6],1,0)))table_c = data.frame(c_table%>% group_by(cat)%>%变异(量化 = ifelse(c1 > x[7],1,0)))f[1] = mean(table_a$quant)f[2] = mean(table_b$quant)f[3] = 平均值(table_c$quant)#分组所有表final_table = rbind(table_a, table_b, table_c)# 计算总平均值:这是需要优化的f[4] = 平均值(final_table$quant)返回 (f)；}gn <- 函数(x) {g1 <- x[3] - x[1]g2＜- x[4] - x[2]g3 <- x[7] - x[6]g4 <- x[6] - x[5]返回(c(g1，g2，g3，g4))}优化 <- nsga2(funct_set, idim = 7, odim = 4 , 约束 = gn, cdim = 4,世代=150,弹出大小=100，cprob=0.7,cdist=20,mprob=0.2,mdist=20,下限=代表(80,80,80,80, 100,200,300)，上限=代表(120,120,120,120,200,300,400))

现在，如果我们看一下输出:

#view 输出优化

对于任何给定的行，似乎都遵守所有逻辑条件！

I am using the R programming language - I am trying to perform "multi objective constrained optimization".

I created some data for this example:

#load libraries
library(dplyr)


# create some data for this example
a1 = rnorm(1000,100,10)
b1 = rnorm(1000,100,5)
c1 = sample.int(1000, 1000, replace = TRUE)
train_data = data.frame(a1,b1,c1)

I then defined a function ("funct_set") with "4 objectives" (f1, f[2], f[3], f[4]) which are to be minimized for a set of "seven inputs" ([x1], [x2], [x3], x[4], x[5], x[6], x[7]):

#load libraries
    library(dplyr)
    library(mco)
    
#define function

funct_set <- function (x) {
    x1 <- x[1]; x2 <- x[2]; x3 <- x[3] ; x4 <- x[4]; x5 <- x[5]; x6 <- x[6]; x[7] <- x[7]
    f <- numeric(4)
    
    
    #bin data according to random criteria
    train_data <- train_data %>%
        mutate(cat = ifelse(a1 <= x1 & b1 <= x3, "a",
                            ifelse(a1 <= x2 & b1 <= x4, "b", "c")))
    
    train_data$cat = as.factor(train_data$cat)
    
    #new splits
    a_table = train_data %>%
        filter(cat == "a") %>%
        select(a1, b1, c1, cat)
    
    b_table = train_data %>%
        filter(cat == "b") %>%
        select(a1, b1, c1, cat)
    
    c_table = train_data %>%
        filter(cat == "c") %>%
        select(a1, b1, c1, cat)
    
    
    
    #calculate  quantile ("quant") for each bin
    
    table_a = data.frame(a_table%>% group_by(cat) %>%
                             mutate(quant = ifelse(c1 > x[5],1,0 )))
    
    table_b = data.frame(b_table%>% group_by(cat) %>%
                             mutate(quant = ifelse(c1 > x[6],1,0 )))
    
    table_c = data.frame(c_table%>% group_by(cat) %>%
                             mutate(quant = ifelse(c1 > x[7],1,0 )))
    
    f[1] = -mean(table_a$quant)
    f[2] = -mean(table_b$quant)
    f[3] = -mean(table_c$quant)
    
    
    #group all tables
    
    final_table = rbind(table_a, table_b, table_c)
    # calculate the total mean : this is what needs to be optimized
    
    f[4] = -mean(final_table$quant)
    
    
    return (f);
}
Next, I define a series of 4 "restrictions" (i.e. logical conditions/constrains) used in the optimization:

#define restrictions

restrictions <- function (x) {
    x1 <- x[1]; x2 <- x[2]; x3 <- x[3]; x4 <- x[4]; x5<- x[5] ; x6 <- x[6]; x7 <- x[7]
    restrictions <- logical(4)
    restrictions[1] <- (x3 - x1 >= 0)
    restrictions[2] <- (x4 - x2 >= 0)
    restrictions[3] <- (x7 - x6 >= 0)
 restrictions[4] <- (x6 - x5 >= 0)
    return (restrictions);
}

Finally, I run the optimization algorithm that attempts to simultaneously minimize all 4 objectives with respect to the restrictions:

#run optimization


optimization <- nsga2(funct_set, idim = 7, odim = 4 ,   constraints = restrictions, cdim = 4,
                      
                      generations=150,
                      popsize=100,
                      cprob=0.7,
                      cdist=20,
                      mprob=0.2,
                      mdist=20,
                      lower.bounds=rep(80,80,80,80, 100,200,300),
                      upper.bounds=rep(120,120,120,120,200,300,400)
)

The above code works fine.

Problem : I noticed that in the output of this code, the optimization algorithm is not respecting the restrictions. For example:

In the above picture, I have identified some rows where the logical conditions specified in the restrictions are violated.

Does anyone know why this is happening? Have I incorrectly specified the restrictions? Can someone please show me how to fix this?

Thanks

解决方案

Possible Answer:

#load libraries
library(dplyr)
library(mco)

#define function

funct_set <- function (x) {
    x1 <- x[1]; x2 <- x[2]; x3 <- x[3] ; x4 <- x[4]; x5 <- x[5]; x6 <- x[6]; x[7] <- x[7]
    f <- numeric(4)
    
    
    #bin data according to random criteria
    train_data <- train_data %>%
        mutate(cat = ifelse(a1 <= x1 & b1 <= x3, "a",
                            ifelse(a1 <= x2 & b1 <= x4, "b", "c")))
    
    train_data$cat = as.factor(train_data$cat)
    
    #new splits
    a_table = train_data %>%
        filter(cat == "a") %>%
        select(a1, b1, c1, cat)
    
    b_table = train_data %>%
        filter(cat == "b") %>%
        select(a1, b1, c1, cat)
    
    c_table = train_data %>%
        filter(cat == "c") %>%
        select(a1, b1, c1, cat)
    
    
    
    #calculate  quantile ("quant") for each bin
    
    table_a = data.frame(a_table%>% group_by(cat) %>%
                             mutate(quant = ifelse(c1 > x[5],1,0 )))
    
    table_b = data.frame(b_table%>% group_by(cat) %>%
                             mutate(quant = ifelse(c1 > x[6],1,0 )))
    
    table_c = data.frame(c_table%>% group_by(cat) %>%
                             mutate(quant = ifelse(c1 > x[7],1,0 )))
    
    f[1] = mean(table_a$quant)
    f[2] = mean(table_b$quant)
    f[3] = mean(table_c$quant)
    
    
    #group all tables
    
    final_table = rbind(table_a, table_b, table_c)
    # calculate the total mean : this is what needs to be optimized
    
    f[4] = mean(final_table$quant)
    
    
    return (f);
}


gn <- function(x) {
    g1 <- x[3] - x[1] 
    g2<- x[4] - x[2] 
    g3 <- x[7] - x[6]
    g4 <- x[6] - x[5] 
    return(c(g1,g2,g3,g4))
}

optimization <- nsga2(funct_set, idim = 7, odim = 4 , constraints = gn, cdim = 4,
                      
                      generations=150,
                      popsize=100,
                      cprob=0.7,
                      cdist=20,
                      mprob=0.2,
                      mdist=20,
                      lower.bounds=rep(80,80,80,80, 100,200,300),
                      upper.bounds=rep(120,120,120,120,200,300,400)
)

Now, if we take a look at the output:

#view output
optimization

For any given row, all the logical conditions seem to be respected!

这篇关于在 R 中指定逻辑条件(例如“大于"和“小于")的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！