Reputation: 357
I have a 600 x 500
Boolean array data
, where the cells represent geographical 0.1' x 0.1'
grid cells covering much of Europe. The TRUE
cells are those grid cells where (according to my weather simulations) a certain chemical substance should be detectable a few days after its release from a fixed point. My goal is to find a cone, as defined by two bearing angles and a distance, originating from the release point, that best fits this region of detectability.
To this end, I have created the 600 x 500
arrays bearing_array
and distance_array
, where each cell's value represents the bearing and distance from the release location to that grid cell, as well as the functions:
#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 ) )
}
I am trying to fit the cone's parameters as follows:
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")
But optim
keep exiting after only 1 iteration and 1 evaluation, simply returning the initial guess:
> 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"
This always happens, regardless of whether I use the above initial guess c(-40, 10, 2.5 * 10**5
, which visually appears to be a good initial guess, or a deliberately poor one.
I have not had any trouble previously using optim
for other kinds of functions, so I suspect that the discontinuous nature may be to blame here - i.e. the value of the mismatch_zone
fraction does not change for sufficiently small perturbations in the parameters, so perhaps the optimizer believes it is stuck on a flat plateau and gives up (?)
(Note: I am well clear of the boundary region where the bearing rolls over from 180
to -180
. That is not related to the problem.)
Upvotes: 1
Views: 326
Reputation: 2213
You can also consider the following approach :
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)
Upvotes: 1
Reputation: 357
Never mind, I solved it. It turns out that L-BFGS-B
was not an appropriate choice of method. Changing to the global simulated annealing method SANN
solved the problem.
Upvotes: 2