这是解决问题的一种方法，以及一种可能的实现
在 R 中。这只是一个草图，真的；也许还有更多
建设性方法（如 Joseph Wood 在
cmets) 也可能会产生良好的效果。
你的数据集，再次：
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 <- 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
正如我所说，只是一个草图；但也许它会让你开始。