r - 在 R 中指定逻辑条件(例如“大于”和“小于”)
问题描述
我正在使用 R 编程语言 - 我正在尝试执行“多目标约束优化”。
我为此示例创建了一些数据:
#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)
然后我定义了一个具有“4 个目标”(f 1 ,f[2],f[3],f[4])的函数(“funct_set”),对于一组“七个输入”([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);
}
最后,我运行优化算法,尝试同时最小化所有 4 个与限制相关的目标:
#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)
)
上面的代码工作正常。
问题:我注意到在这段代码的输出中,优化算法没有遵守限制。例如:
在上图中,我确定了一些违反限制中指定的逻辑条件的行。
有谁知道为什么会这样?我是否错误地指定了限制?有人可以告诉我如何解决这个问题吗?
谢谢
解决方案
可能的答案:
#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)
)
现在,如果我们看一下输出:
#view output
optimization
对于任何给定的行,所有的逻辑条件似乎都得到了尊重!
推荐阅读
- javascript - RegExp:忽略 2 个连续的斜杠,但匹配 1 个单斜杠
- c# - 如果该列为空,则填写数据
- flutter - 颤振:我得到了这个异常:闭包调用参数不匹配:
- python - Strava REST API | swagger-client 不返回完整的DetailedAthelete reperesentation
- javascript - 在数组中映射数组
- javascript - Vue - 将数组作为参数传递
- c# - 为什么在 .NET 5 中指定循环枚举值时枚举的顺序很重要?
- php - 用户/浏览器是否可以看到服务器端的 PHP curl 请求
- python - 如何将列表分隔到不同的表格并将表格打印到reportlab中的各个页面pdf?
- node.js - Type-graphql,Mikoorm 查询返回 Ref
而不是用户