问题描述
我有一个巨大的真实数据集，并且在其中有4列（-10到+10范围内的数值数据），可以用来过滤数据。可以同时使用任意数量的过滤器，并且可以使用任何形式的过滤器设置（>，
我试图找到过滤器的所有组合（例如A> 1，B 0.5，等等），但我一直坚持寻找一种算法的最佳解决方案，而不仅仅是尝试并出错。用强力尝试所有组合也不是解决方案，因为数据集很大，因此计算不会在合理的时间内结束。
您将如何进行4维“网格搜索”？
下面是一个简化的示例：
library(tidyverse)
df <- tribble(~Size,~A,~B,~D,~E,1,"4","7","-2","1",5,"-4","-1",10,"-3","9",-3,"0",2,"3",55,"8","-7",-5,"-5",4,"-9","2","-3")
解决方法
这是解决问题的一种方法，也是一种可能的实现方式 实际上，这只是一个草图。也许更多 建设性方法（如Joseph Wood在 评论）也可能会产生良好的结果。
再次您的数据集：
df <- read.table(text = "
Size,A,B,D,E
1,4,7,-2,1
5,-4,-1,1,4
10,-3,9
-3,-3
2,3,-2
55,8,-7,9,0
-5,-5
2,8
1,-5,1
4,-9,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,function(x,...) TRUE),parameters = c(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,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,nI = 3000,printDetail = FALSE,printBar = FALSE),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,drop0 = TRUE,"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,nI = 1000,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
正如我所说，只是一个草图；但也许它可以帮助您入门。