R:是否可以优化以下函数?

Question

我正在使用R编程语言。

我有以下数据:

library("dplyr")
df <- data.frame(b = rnorm(100,5,5), d = rnorm(100,2,2),
c = rnorm(100,10,10))
a <- c("a", "b", "c", "d", "e")
a <- sample(a, 100, replace=TRUE, prob=c(0.3, 0.2, 0.3, 0.1, 0.1))
a<- as.factor(a)
df$a = a
> head(df)
b          d          c a
1  3.1316480  0.5032860  4.7362991 a
2  4.3111450 -0.1142736 -0.5841322 c
3  2.8291346  3.6107839 16.0684492 a
4 14.2142245  4.9893987 -1.8145138 a
5 -6.7381302  0.0416782 -7.7675387 c
6  0.4481874  0.3370716 17.4260801 a

我还有下面的函数(my_subset_mean)，它计算"列c"的平均值;给定一个特定的输入选择:

my_subset_mean <- function(r1, r2, r3){  
subset <- df %>% filter(a %in% r1, b > r2, d < r3)
return(mean(subset$c))
}

my_subset_mean(r1 = c("a", "b"), r2 = 5, r3 = 1 ) 
[1] 5.682513

问题:使用R中的GA库，我试图优化(混合整数规划)my_subset_mean函数，根据以下约束:

• "r1"可以取任意组合("a"， "b"， "c"， "d"， ")，例如"a"， "a;b;c;d;等。

• "r2"可以取0到1之间的任意值

• "r3"可以取0到1之间的任意值

• 然而，my_subset_mean也可以用";r1&;"、";r2&;"不指定值来计算。或"r3"，例如:

my_subset_mean(r1 = c("a", "b"), r2 = 5, r3 = NA)
my_subset_mean(r1 = NA,  r2 = 5, r3 = NA )

等。

我尝试用GA库执行此优化:

library(GA)
GA <- ga(type = "real-valued", 
fitness = function(x)  my_subset_mean(x[1], x[2], x[3]),
lower = c(c("a", "b", "c", "d"), 1, 1), upper = c(c("a", "b", "c", "d"), 100, 100), 
popSize = 50, maxiter = 1000, run = 100)

但我不认为这是正确的方法。

感谢我过去的尝试:

在上一个问题中(R:添加"NA"因素的"水平"函数)，我学会了如何使用"随机网格搜索"优化一个类似的函数:

my_subset_mean <- function(r1=NA, r2=NA, r3=NA, r4 = NA) {  
if (all(is.na(r1))) r1 <- unique(df$a)
if (all(is.na(r4))) r4 <- unique(df$f)
if (is.na(r2)) r2 <- -Inf
if (is.na(r3)) r3 <- Inf
s <- filter(df, a %in% r1 , f %in% r4, b > r2 , d < r3)
return(mean(s$c))
}
create_output <- function() {
uv <- levels(df$a)
r1 <- sample(list(sample(uv, sample(length(uv))), NA), 1)[[1]]
uv1 <- levels(df$f)
r4 <-  sample(list(sample(uv1, sample(length(uv1))), NA), 1)[[1]]
rgb <- range(df$b)
rgd <- range(df$d)
r2 <- sample(c(runif(1, rgb[1], rgb[2]), NA), 1)
r3 <- sample(c(runif(1, rgd[1], rgd[2]), NA), 1)
my_subset_mean <- my_subset_mean(r1, r2, r3, r4)
data.frame(r1 = toString(r1), r4 = toString(r4), r2, r3, my_subset_mean)
}
set.seed(123)
out <- do.call(rbind, replicate(100, create_output(), simplify = FALSE))
head(out)
#            r1         r4        r2        r3 my_subset_mean
#1            NA          c        NA 4.2164973      12.095431
#2 a, b, c, d, e    b, a, c        NA 0.4394423       7.130999
#3            NA a, c, e, b  9.285701        NA       8.236054
#4            NA         NA 14.060829 3.8960888      10.562523
#5    c, b, a, d         NA        NA        NA       9.015613
#6            NA    a, c, d  2.251218        NA      10.070425

但是谁能告诉我怎么用"GA"R中的函数?

感谢参考:

• https://cran.r-project.org/web/packages/GA/vignettes/GA.html
• https://www.rdocumentation.org/packages/GA/versions/3.2.1/topics/ga

Answer 1

局部搜索算法能够处理这类问题的原因是解只有"触摸"。通过两个函数，这两个函数都需要你提供。第一个是目标函数。

我稍微改写了你的:

my_subset_mean <- function(x){  
subset <- df %>% filter(a %in% names(x$r1)[x$r1],
b > x$r2,
d < x$r3)
ans <- -mean(subset$c)
if (!is.finite(ans))
ans <- 100
ans
}

不需要三个参数，它只需要一个:原始参数的列表。同时，我假设你想要最大化，所以我在均值前面加了个减号。(我稍后要使用的算法默认是最小化的。)如果平均值不是有限的(NA, NaN)，我只是返回一个大值作为"坏"的标记。解决方案。根据你的需要调整一下。

从任意但有效的解开始。

tmp <- !logical(length(sort(unique(a))))
names(tmp) <- sort(unique(a))
x <- list(r1 = tmp,
r2 = 0.5,
r3 = 0.5)
x
## $r1
##    a    b    c    d    e 
## TRUE TRUE TRUE TRUE TRUE 
## 
## $r2
## [1] 0.5
## 
## $r3
## [1] 0.5

我重新创建您的数据。(我不使用因子，而是使用字符串)

library("dplyr")
df <- data.frame(b = rnorm(100,5,5), d = rnorm(100,2,2),
c = rnorm(100,10,10))
a <- c("a", "b", "c", "d", "e")
a <- sample(a, 100, replace=TRUE, prob=c(0.3, 0.2, 0.3, 0.1, 0.1))
df$a <- a

评估x:

my_subset_mean(x)
## [1] -11.34132

当然，这个结果依赖于随机数据。你的数字会不同。

现在，第二个函数:邻域。它接受一个解并返回稍微修改过的解。同样，由于必须提供此函数，因此您拥有完全的控制权，因此任何数据结构都可以作为输入。下面是一个例子。

nb <- function(x) {
i <- sample(c("r1", "r2", "r3"), 1)
if (i == "r1") {
j <- sample(length(x[[i]]), 1)
x[[i]][j] <- !x[[i]][j]        
} else {
x[[i]] <- x[[i]] + runif(1, min = -0.1, max = 0.1)
x[[i]] <- max(min(1, x[[i]]), 0)        
}
x
}

邻域函数(i)随机选择一个组分的解，和(ii)随机变化该组件。由于r2和r3的行为相同，该函数使用相同的代码来处理这两个函数。的邻域也处理r2和将max(min(1, x[[i]]), 0)改为r3:值更小比0增加到0;大于1的值是减少到1。如果你想要不同的限制，分别处理组件(即添加更多的else if子句)。

x  ## original solution
## $r1
##    a    b    c    d    e 
## TRUE TRUE TRUE TRUE TRUE 
## 
## $r2
## [1] 0.5
## 
## $r3
## [1] 0.5
nb(x)   ## ... and a neighbour
## $r1
##    a    b    c    d    e 
## TRUE TRUE TRUE TRUE TRUE 
## 
## $r2
## [1] 0.5
## 
## $r3
## [1] 0.42586
nb(x)   ## ... and another neighbour
## $r1
##     a     b     c     d     e 
##  TRUE FALSE  TRUE  TRUE  TRUE 
## 
## $r2
## [1] 0.5
## 
## $r3
## [1] 0.5

就是这样。有了这两个函数(目标函数和邻域函数)，就可以运行实际的算法了。这里，我使用阈值接受

library("NMOF")
ans <- TAopt(my_subset_mean, list(x0 = x, neighbour = nb, nI = 1000))
-my_subset_mean(ans$xbest)

我希望这能让你开始TAopt。有关本地搜索方法的更多信息，请参阅本教程。由于您显然想要过滤数据帧，也许下面的答案也很有帮助:找到理想的过滤器设置以最大化目标函数。声明:我是NMOF包的维护者。

---

根据注释更新:扩展nb以获得更多组件是很简单的。假设您希望r2的步长更大，它应该在-5到5之间。然后你可以这样写这个函数:

nb <- function(x) {
i <- sample(c("r1", "r2", "r3"), 1)
if (i == "r1") {
j <- sample(length(x[[i]]), 1)
x[[i]][j] <- !x[[i]][j]
} else if (i == "r2") {
x[[i]] <- x[[i]] + runif(1, min = -0.5, max = 0.5)
x[[i]] <- max(min(5, x[[i]]), -5)        
} else if (i == "r3"){
x[[i]] <- x[[i]] + runif(1, min = -0.1, max = 0.1)
x[[i]] <- max(min(1, x[[i]]), 0)        
}
x
}