如何解决寻找理想的滤波器设置以最大化目标功能
我有一个巨大的真实数据集,并且在其中有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
正如我所说,只是一个草图;但也许它可以帮助您入门。
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。