grnn_optim.R

grnn_optim.R

net <- grnn.fit(scale(Boston[, -14]), Boston[, 14], sigma = 1)

grnn.optim <- function(sigma, nn, nfolds, seed) {
  dt <- nn$set
  set.seed(seed)
  folds <- caret::createFolds(1:nrow(dt), k = nfolds, list = FALSE)
  r <- do.call(rbind,
               lapply(1:nfolds,
                      function(i) data.frame(Ya = nn$Ya[folds == i],
                                             Yp = grnn.predict(grnn.fit(nn$Xa[folds != i, ], nn$Ya[folds != i], sigma),
                                                               data.frame(nn$Xa[folds == i,])))))
  return(r2(r$Ya, r$Yp))
}

### General-Purpose Unconstrained Non-Linear Optimization ###
op_out <- ucminf::ucminf(par = 0.5, fn = function(x) -grnn.optim(x, net, 4, 2019))
# $par
# [1] 0.5611872
# $value
# [1] -0.8019319
                         
### Particle Swarm Optimization ###
set.seed(1)
ps_out <- pso::psoptim(par = 0.5, upper = 1.0, lower = 0.1,
                       fn = function(x) -grnn.optim(x, net, 4, 2019),
                       control = list(maxit = 20))
# $par
# [1] 0.5583358
# $value
# [1] -0.8019351

### Nelder–Mead Optimization ###
nm_out <- optim(par = 0.5, fn = function(x) -grnn.optim(x, net, 4, 2019), 
                method = "Nelder-Mead", control = list(warn.1d.NelderMead = FALSE))
# $par
# [1] 0.5582031
# $value
# [1] -0.8019351