Drubbels
Drubbels

Reputation: 357

Minimizing discontinuous function in R

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

Answers (2)

Emmanuel Hamel
Emmanuel Hamel

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

Drubbels
Drubbels

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

Related Questions