r-使用optim进行广义优化-联合最小化差异



我想尽量减少几个差异。有一点不同,这似乎是直截了当的:

target1 <- 1.887
data <- seq(0,1, by=.001)
#Step 1
somefunction <- function(dat, target1, X){
#some random function...
t <- sum(dat)
y <- t * X
#minimize this difference
diff <- target1-y
return(diff)
}
V1 <- optimize(f = somefunction,
interval = c(0,1),
dat=data, 
target1=target,
maximum = T)
V1$maximum 
6.610696e-05
#--> This value for `X` should minimize the difference...
V1$maximum * sum(data)
#0.03308653
#--> as close to zero we get

现在,我想在依赖optim的一步中最小化几个差异,但这不能正常工作:

#Step 2
set.seed(1)
data2 <- data.frame(dat1=seq(0,1, by=.01),
dat2=runif(101),
dat3=runif(101))
somefunction_general <- function(dat, target1, target2, target3, X){
#some random function...
y <- sum(dat[,1]) * X[1]
y1 <- sum(dat[,2]) * X[2]
y2 <- sum(dat[,3]) * X[3]
#minimize these differences...
diff1 <- target1-y
diff2 <- target2-y1
diff3 <- target3-y2
#almost certain that this is wrong...
vtr <- sum(abs(diff1), abs(diff2), abs(diff3))
return(vtr)
}

V2 <- optim(par=c(1,1,1),
fn = somefunction_general,
dat=data2, 
target1=1.8, 
target2=2, 
target3=4,
control = list(fnscale = -1))
sum(data2[,1])
[1] 50.5
sum(data2[,2])
[1] 44.27654
sum(data2[,3])
[1] 51.73668
V2$par[1]*sum(data2[,1])
#[1] 1.469199e+45
V2$par[2]*sum(data2[,2])
#[1] 1.128977e+45
V2$par[3]*sum(data2[,3])
[1] 2.923681e+45

第一个函数和第二个函数之间似乎有一些分歧?在第一个函数中,返回target1-sum(dat)*X,然后试图在[0,1]中找到X值上的最大值。

但是,由于返回的是原始差,而不是绝对值,因此实际上只是最大化-sum(dat)*X,或者等效地最小化sum(dat)*X。由于dat是常数,因此optimize函数自然每次都会返回间隔上的最小值(示例中为0(。

对于第一个函数,我认为你想做的是返回差值的绝对值,然后找到最小值,而不是最大值。第二个函数somefunction_general的修复更简单,因为您已经返回了sum(abs(diff1), abs(diff2), abs(diff3)):只需确保通过去掉control = list(fnscale = -1)来返回最小值

V2 <- optim(par=c(1,1,1),
fn = somefunction_general,
dat=data2, 
target1=1.8, 
target2=2, 
target3=4)
V2$par
[1] 0.03564358 0.03837754 0.07748929

您应该编写一个函数,这样无论有一个或多个参数,optim都应该处理它:

somefunction_general <- function(X, dat, target){
dat <- as.matrix(dat)
y <- colSums(dat) * X
sum((target-y)^2) # Often use the MSE
}

让我们测试一下这个

data2 <- data.frame(dat1=seq(0,1, by=.01),
dat2=runif(101),
dat3=runif(101))

data <- seq(0,1, by=.001)

(a <-optim(0,somefunction_general,dat = data,target = 1.887,method = "BFGS"))
$par
[1] 0.00377023
$value
[1] 3.64651e-28
$counts
function gradient 
25        3 
$convergence
[1] 0
$message
NULL

我们不能说函数值为零。因此参数CCD_ 10就是我们想要的。看看这个

a$par*sum(data)
[1] 1.887

我们也可以有3个参数1目标例如:

(b<-optim(c(0,0,0),somefunction_general,dat = data2,target = 1.887))
$par
[1] 0.03736837 0.04262253 0.03647203
$value
[1] 4.579334e-08
$counts
function gradient 
100       NA 
$convergence
[1] 0
$message
NULL
b$par*colSums(data2)
dat1     dat2     dat3 
1.887103 1.887178 1.886942 

每个人几乎都达到了1.887的目标。请注意,这类似于运行第一个3次。

最后:

(d<-optim(c(0,0,0),somefunction_general,dat = data2,target = c(1.8, 2, 4)))
$par
[1] 0.03564672 0.04516916 0.07730660
$value
[1] 2.004725e-07
$counts
function gradient 
88       NA 
$convergence
[1] 0
$message
NULL

目标实现了:

d$par*colSums(data2)
dat1     dat2     dat3 
1.800160 1.999934 3.999587 

这一个函数可以在n个维度上工作。请使用方法BFGS,除非它不收敛。

如果有一个参数有三个目标怎么办?这很难。除非有这样一个参数,否则它不会收敛。

假设参数是0.01,那么目标是什么?

colSums(data2)*0.01
dat1      dat2      dat3 
0.5050000 0.4427654 0.5173668 

好吧,假设我们得到了这个目标,我们能拿回0.01吗?

(e<-optim(10,somefunction_general,dat = data2,target = c(0.505, 0.4427654, 0.5173668),method = "BFGS"))
$par
[1] 0.01
$value
[1] 7.485697e-16
$counts
function gradient 
12        3 
$convergence
[1] 0
$message
NULL

啊,我们可以汇合了。这是因为有一个参数可以把我们带到那里。请注意,我确实将起点更改为10。

最新更新