R：函数返回未使用的参数

Question

我正在使用 R。我正在学习优化并尝试遵循以下参考资料中的说明：https://www.rdocumentation.org/packages/pso/versions/1.0.3/topics/psoptim 和 https://rpubs.com/Argaadya/intro-PSO

对于这个例子，我首先生成一些随机数据：

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

从这里，我定义了我想要优化的功能（“适应度”）。此函数接受 7 个输入并计算“总”平均值（单个标量值）。此功能所需的输入是：

• “random_1”（80 到 120 之间）
• “random_2”（介于“random_1”和 120 之间）
• “random_3”（介于 85 和 120 之间）
• “random_4”（介于 random_2 和 120 之间）
• “split_1”（介于 0 和 1 之间）
• “split_2”（介于 0 和 1 之间）
• split_3"（介于 0 和 1 之间）

要优化的函数（“fitness”）定义如下（取这 7 个数字并返回单个标量“total” - 目标是获得这 7 个数字的“total”的最大值）：

fitness <- function(random_1, random_2, random_3, random_4, split_1, split_2, split_3) {

    #bin data according to random criteria
    train_data <- train_data %>% mutate(cat = ifelse(a1 <= random_1 & b1 <= random_3, "a", ifelse(a1 <= random_2 & b1 <= random_4, "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 = quantile(c1, prob = split_1)))
    
    table_b = data.frame(b_table%>% group_by(cat) %>%
                             mutate(quant = quantile(c1, prob = split_2)))
    
    table_c = data.frame(c_table%>% group_by(cat) %>%
                             mutate(quant = quantile(c1, prob = split_3)))
    
    
    
    
    #create a new variable ("diff") that measures if the quantile is bigger than the value of "c1"
    table_a$diff = ifelse(table_a$quant > table_a$c1,1,0)
    table_b$diff = ifelse(table_b$quant > table_b$c1,1,0)
    table_c$diff = ifelse(table_c$quant > table_c$c1,1,0)
    
    #group all tables
    
    final_table = rbind(table_a, table_b, table_c)
# calculate the total mean : this is what needs to be optimized
    mean = mean(final_table$diff)
    
    
}

从这里开始，我有兴趣使用“ps_optim”函数来优化我刚刚定义的函数：

library(psoptim)
set.seed(90)
psoptim(rep(NA,3), fn = fitness, lower = c(80, random_1, 85, random_2, 0,0,0), upper = c(120,120,120,120,1,1,1))

但这会返回以下错误，提示存在一些“未使用的参数”：

Error in psoptim(rep(NA, 3), fn = fitness, lower = c(80, random_1, 85,  : 
  unused arguments (fn = fitness, lower = c(80, random_1, 85, random_2, 0, 0, 0), upper = c(120, 120, 120, 120, 1, 1, 1))

有人可以告诉我为什么会产生这个错误吗？ 谢谢

Answer 1

正如 cmets 中所指出的，如果你命名参数，你需要根据函数定义来命名它们。此外，上下界不是表达式，而必须是常量（即数字，而不是诸如 random_1 之类的名称）。

可以通过惩罚来处理此类约束：在目标函数中，计算变量是否超出其范围；如果是，则从目标函数中减去一个惩罚（如果你最大化）或添加一个惩罚（如果你最小化）。

有一些优化方法可以在创建新解决方案时直接处理此类约束。一种这样的方法是本地搜索。这是一个（粗略的）示例，我假设您希望最大化。我使用包NMOF（我维护）中的实现。该算法期望最小化，但这没问题：只需将目标函数值乘以 -1。 （请注意，许多优化算法都需要最小化模型。）

本地搜索的关键要素是邻域功能。它将给定的解决方案作为输入，并产生一个稍微改变的解决方案（邻居解决方案）。然后，Local Search 在可能的解决方案空间中随机游走（步骤在邻域函数中定义），接受更好的解决方案，但拒绝导致更差目标函数值的解决方案。

library("NMOF")
nb <- function(x, ...) {
    ## randomly pick one element in x and a small change
    i <- sample.int(length(x), 1)
    stepsize <- c(1, 1, 1, 1, 0.5, 0.5, 0.5)
    x[i] <- x[i] + runif(n = 1,
                         min = -stepsize[i],
                         max =  stepsize[i])

    ## 'repair' the solution
    x <- pmin(x, c(120,  120, 120,  120, 1, 1, 1))
    x <- pmax(x, c( 80, x[1],  85, x[2], 0, 0, 0))

    x
}

初步解决方案：

x0 <- c(100, 100, 100, 100, 0.5, 0.5, 0.5)
## [1] 100.0 100.0 100.0 100.0   0.5   0.5   0.5

随机步骤：

nb(x0)
## [1] 100.000 100.000 100.000 100.000   0.759   0.500   0.500

运行算法：

sol <- LSopt(function(x) -do.call(fitness, as.list(x)),
             list(neighbour = nb,
                  x0 = x0,
                  nI = 500))
-sol$OFvalue
## 0.998
sol$xbest
## [1] 112.329 112.331 111.777 112.331   1.000   0.771   1.000

如果您可以接受这样的方法，也许这个tutorial on heuristics 很有用。

---

这将是一个使用 PSO 的解决方案，使用 NMOF::PSopt。

sol <- PSopt(function(x) -do.call(fitness, as.list(x)),
             list(nG = 25,  ## number of generations
                  nP = 20,  ## population size
                  repair = function(x) {
                     x <- pmin(x, c(120,  120, 120,  120, 1, 1, 1))
                     x <- pmax(x, c( 80, x[1],  85, x[2], 0, 0, 0))
                     x
                  },
                  min = c( 80, 80,  85, 85, 0, 0, 0),
                  max = c(120,  120, 120,  120, 1, 1, 1)))

-sol$OFvalue
## 0.998
sol$xbest
## [1]  98.551  98.551 110.750 108.639   1.000   0.312   1.000