寻找理想的滤波器设置以最大化目标函数

Question

我有一个很大的真实数据集，其中有4列( -10到+10范围内的数值数据)，我可以用它来过滤数据。可以同时使用任意数量的筛选器，表单中筛选器的任何设置(>，<以0.5为增量的每个筛选器的特定值)都可以用于拆分数据。目标是最大化大小列中筛选出的值的平均值，同时考虑到n必须至少为5。

我试图找到过滤器的所有组合(例如，A>1、B<-2或A和C>0.5等)。但我坚持用算法找到最优解决方案，而不仅仅是尝试和错误。在暴力下尝试所有组合也不是解决方案，因为数据集很大，因此计算不会在合理的时间结束。

你将如何在4个维度上进行“网格搜索”？

下面是一个简化的示例：

library(tidyverse)
df <- tribble(~Size, ~A, ~B, ~D, ~E,
          1, "4", "7", "-2", "1",
          5, "-4", "-1", "1", "4",
          10, "-2", "-3", "1", "9",
          -3, "1", "0", "0", "-3",
          2, "4", "-1", "3", "-2",
          55, "8", "-7", "9", "0",
          -5, "3", "-4", "-1", "-5",
          2, "0", "-2", "1", "8",
          1, "-5", "1", "8", "1",
          4, "-9", "3", "2", "-3")

Answer 1

这里有一种方法来解决这个问题，并可能在R中实现。这只是一个草图，真的；也许更有建设性的方法(正如Joseph Wood在评论中指出的那样)也可能会产生良好的结果。

同样，您的数据集：

df <- read.table(text = "
   Size,  A,  B,  D,  E
      1,  4,  7, -2,  1
      5, -4, -1,  1,  4
     10, -2, -3,  1,  9
     -3,  1,  0,  0, -3
      2,  4, -1,  3, -2
     55,  8, -7,  9,  0
     -5,  3, -4, -1, -5
      2,  0, -2,  1,  8
      1, -5,  1,  8,  1
      4, -9,  3,  2, -3",
  sep = ",", header = TRUE)

我在这里使用了一个普通的数据框架。为了方便起见，我将'Size‘放在一个单独的变量中。

size <- df$Size
df <- df[, -1]
df

##     A  B  D  E
## 1   4  7 -2  1
## 2  -4 -1  1  4
## 3  -2 -3  1  9
## 4   1  0  0 -3
## 5   4 -1  3 -2
## 6   8 -7  9  0
## 7   3 -4 -1 -5
## 8   0 -2  1  8
## 9  -5  1  8  1
## 10 -9  3  2 -3

现在，我允许筛选器是一个接受一列df作为输入的函数，可能还会加上第二个参数。这样的筛选器的计算结果必须是一个逻辑向量，其元素的数量与df的行数相同。例如，大于关系将使用函数>，第二个参数将是阈值。我将所有允许的函数收集在一个列表functions中。(第一个函数实际上忽略了给定的列。)

functions <- list(function(x, ...) TRUE,
                  `<`,
                  `>`)

因此，候选解决方案x是过滤器(与df中的列一样多的过滤器)和这些过滤器的参数的列表。以下解决方案不应用任何筛选器，因为对于输入的任何列，它始终返回TRUE (即不排除任何行)：

x <- list(functions = list(function(x, ...) TRUE,
                           function(x, ...) TRUE,
                           function(x, ...) TRUE,
                           function(x, ...) TRUE),
          parameters = c(0, 0, 0, 0))

一个应用过滤器的辅助函数:它返回一个逻辑向量，其中的元素和df的行数一样多。

subs <- function(x, df) {
    rows <- !logical(nrow(df))
    for (i in seq_len(ncol(df)))
        rows <- rows & x$functions[[i]](df[, i], x$parameters[[i]])
    rows
}

我们可以用x测试这个功能。正如它应该选择的那样，它选择df的所有行。

subs(x, df)
## [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE

现在，本地搜索的策略是逐步更改x的元素。每当这样的变化导致更好的解决方案时，我们都会保留它。如果情况更糟，我们不接受它。有关更多详细信息，请参阅Optimization Heuristics: A Tutorial。(披露:我是作者；我也是下面将要使用的NMOF包的维护者。)

要运行这样的搜索，我们首先需要一个目标函数。它将给定的行子集映射到单个数字，即平均大小。注意，后面使用的算法是最小化的，所以我将目标函数的结果乘以-1 (最后一行中的-ans )。不可行的解决方案(少于5行)会受到惩罚。

mean_size <- function(x, df, size, ...) {
    rows <- subs(x, df)
    subset.df <- df[rows, ]
    size <- size[rows]
    ans <- sum(size) / max(1, sum(rows))
    if (sum(rows) < 5)
        ans <- ans - 1000
    -ans   ## to minimise, return 'ans'
}

检查:初始解决方案选择所有行(但请注意反转的符号)。

mean_size(x, df, size)
## [1] -7.2

mean(size)
## [1] 7.2

现在关键的部分:邻里关系。该函数选择一个过滤器或一个参数，并对其进行更改。

neighbour <- function(x, ...) {
    stepsize <- 0.5
    rand <- runif(1)         
    i <- sample(length(x$parameters), size = 1)

    if (rand > 0.5) {
        x$functions[[i]] <- sample(functions, size = 1)[[1]]
    } else {
        d <- sample(c(-stepsize, stepsize), size = 1)
        x$parameters[i] <- min(max(x$parameters[i] + d, -10), 10)        
    }
    x
}

现在我们可以运行优化了。我使用了一种称为阈值接受的方法，它在函数TAopt中实现。阈值接受是一种特殊的局部搜索类型；它也可以接受导致更差解的变化，以便它可以摆脱局部最小值。

library("NMOF")
sol <- TAopt(mean_size, list(neighbour = neighbour, 
               x0 = x,
               nI = 5000,
               printBar = FALSE,
               printDetail = FALSE),
       df = df, size = size)
sol$OFvalue  ## objective function value of best solution
## [1] -14.8

因此，该算法找到的最佳解决方案意味着平均大小为14.8。由于阈值接受是一种随机方法，因此我运行了20次重启。

restarts <- restartOpt(TAopt, n = 20, mean_size,
                       list(neighbour = neighbour,
                            x0 = x,
                            nI = 3000,
                            printDetail = FALSE,
                            printBar = FALSE),
                       df = df, size = size)
summary(sapply(restarts, `[[`, "OFvalue"))
##   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -14.80  -14.80  -14.80  -13.18  -10.50  -10.00

使用NMOF (https://github.com/enricoschumann/NMOF)的开发版本，您可以将选项drop0设置为TRUE。(对于CRAN版本，这会引发有关unknown option的警告，但这是无害的。)这应该会提高解决方案的可靠性。

restarts <- restartOpt(TAopt, n = 20, mean_size,
                       list(neighbour = neighbour,
                            x0 = x,
                            nI = 3000,
                            drop0 = TRUE,
                            printDetail = FALSE,
                            printBar = FALSE),
                       df = df, size = size)
summary(sapply(restarts, `[[`, "OFvalue"))
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -14.80  -14.80  -14.80  -14.77  -14.80  -14.60 

尽管如此，一些解决方案可能比其他解决方案更好。有不同的方法来改进搜索，但最简单的方法是运行该方法10次，并保留最佳解决方案。

best <- restartOpt(TAopt, n = 10, mean_size,
                   list(neighbour = neighbour,
                        x0 = x,
                        nI = 1000,
                        printDetail = FALSE,
                        printBar = FALSE),
                   df = df, size = size,
                   best.only = TRUE)
best$OFvalue
## [1] -14.8

因此，让我们来看看实际的解决方案。

best$xbest

## $functions
## $functions[[1]]
## function(x, ...) TRUE
## 
## $functions[[2]]
## function (e1, e2)  .Primitive("<")
## 
## $functions[[3]]
## function (e1, e2)  .Primitive(">")
## 
## $functions[[4]]
## function(x, ...) TRUE
## 
## 
## $parameters
## [1] -7.5  0.0  0.5  5.0

因此，这将转换为以下过滤器：

i <- df[[2]] < 0 & df[[3]] > 0.5

看一下隐含的均值size

cbind(size[i], df[i, ])
##   size[i]  A  B D  E
## 2       5 -4 -1 1  4
## 3      10 -2 -3 1  9
## 5       2  4 -1 3 -2
## 6      55  8 -7 9  0
## 8       2  0 -2 1  8


mean(size[i])
## [1] 14.8

正如我所说的，只是一个草图；但它可能会让您开始。