r中的最小不连续函数

Question

我有一个600 x 500布尔数组data，其中单元格代表覆盖欧洲大部分地区的地理0.1' x 0.1'网格单元格。TRUE电池是那些网格电池，在那里(根据我的天气模拟)某种化学物质从一个固定点释放几天后应该可以检测到。我的目标是找到一个锥，由两个方位角度和距离定义，从释放点开始，最适合这个可探测区域。

为此，我创建了600 x 500数组bearing_array和distance_array，其中每个单元格的值表示从释放位置到该网格单元格的方位和距离，以及函数:

#Return Boolean array of cells which belong to cone of given bearing, width, and extent:
in_zone <- function(central_bearing, cone_width, distance) {
upper_bearing <- central_bearing + cone_width/2
lower_bearing <- central_bearing - cone_width/2
return( (bearing_array >= lower_bearing) * (bearing_array <= upper_bearing) * (dist_array[,] <= distance) )
}
#Return fraction of grid cells where the cone's prediction does not match with the data (this fraction is the quantity to be minimized)
mismatch_zone <- function(params, arr) {
central_bearing <- params[1]
cone_width <- params[2]
distance <- params[3]
return( mean( in_zone(central_bearing, cone_width, distance) != arr ) )
}

我试图拟合锥体的参数如下:

guess <- c(-40, 10, 2.5 * 10**5)
lower <- c(-180, 0.1, 10**1)
upper <- c(180, 90, 10**7)
fit <- optim(guess, mismatch_zone, arr = data, lower = lower, upper = upper, method="L-BFGS-B")

但是optim只在1次迭代和1次求值后仍然存在，只是返回初始猜测:

> fit
$par
[1]    -40     10 250000
$value
[1] 0.00032
$counts
function gradient 
1        1 
$convergence
[1] 0
$message
[1] "CONVERGENCE: NORM OF PROJECTED GRADIENT <= PGTOL"

无论我是否使用上面的初始猜测c(-40, 10, 2.5 * 10**5(从视觉上看，这是一个很好的初始猜测，还是一个故意较差的猜测)，这种情况都会发生。

我以前在其他类型的函数中使用optim没有遇到任何麻烦，所以我怀疑不连续的性质可能是这里的责任-即mismatch_zone分数的值不会因为参数中足够小的扰动而改变，所以也许优化器认为它被困在一个平坦的平台上并放弃(?)

(注:我很清楚轴承从180滚动到-180的边界区域。这与问题无关

Answer 1

没关系，我解决了。结果表明，L-BFGS-B不是一个合适的选择方法。改成全局模拟退火方法SANN解决了这个问题。

Answer 2

您还可以考虑以下方法:

in_zone <- function(central_bearing, cone_width, distance) {
upper_bearing <- central_bearing + cone_width/2
lower_bearing <- central_bearing - cone_width/2
return( (bearing_array >= lower_bearing) * (bearing_array <= upper_bearing) * (dist_array[,] <= distance) )
}
mismatch_zone <- function(params, arr) {
central_bearing <- params[1]
cone_width <- params[2]
distance <- params[3]
return( mean( in_zone(central_bearing, cone_width, distance) != arr ) )
}
lower <- c(-180, 0.1, 10**1)
upper <- c(180, 90, 10**7)
library(DEoptim)
fit <- DEoptim(fn = mismatch_zone, arr = data, lower = lower, upper = upper)