R/sboa_mlp.R

In SBOAtools: Secretary Bird Optimization for Continuous Optimization and Neural Network Training

#' Train a single-hidden-layer MLP using SBOA
#'
#' Trains a single-hidden-layer multilayer perceptron with the
#' Secretary Bird Optimization Algorithm.
#'
#' @param X_train Training input data.
#' @param y_train Training output data.
#' @param hidden_dim Number of hidden neurons.
#' @param n_agents Number of search agents.
#' @param max_iter Maximum number of iterations.
#' @param lower Lower bound for parameter search.
#' @param upper Upper bound for parameter search.
#' @param seed Optional random seed.
#' @param verbose Logical; if \code{TRUE}, progress is printed.
#'
#' @return An object of class \code{"sboa_mlp"}.
#' @references
#' Dilber, B., and Ozdemir, A. F. (2026). A novel approach to training
#' feed-forward multi-layer perceptrons with recently proposed secretary bird
#' optimization algorithm. Neural Computing and Applications.
#' DOI: 10.1007/s00521-026-11874-x
#' @examples
#' set.seed(123)
#'
#' X_train <- matrix(runif(40), nrow = 10, ncol = 4)
#' y_train <- matrix(runif(10), nrow = 10, ncol = 1)
#'
#' fit <- sboa_mlp(
#'   X_train = X_train,
#'   y_train = y_train,
#'   hidden_dim = 3,
#'   n_agents = 10,
#'   max_iter = 20,
#'   lower = -1,
#'   upper = 1,
#'   seed = 123,
#'   verbose = FALSE
#' )
#'
#' print(fit)
#' pred <- predict(fit, X_train)
#' head(pred)
#' @export
sboa_mlp <- function(X_train,
                     y_train,
                     hidden_dim = 10,
                     n_agents = 30,
                     max_iter = 500,
                     lower = -1,
                     upper = 1,
                     seed = NULL,
                     verbose = TRUE) {

  X_train <- as.matrix(X_train)
  y_train <- as.matrix(y_train)

  if (!is.null(seed)) {
    set.seed(seed)
  }

  x_norm <- normalize_minmax(X_train)
  y_norm <- normalize_minmax(y_train)

  Xs <- x_norm$x_scaled
  Ys <- y_norm$x_scaled

  input_dim <- ncol(Xs)
  output_dim <- ncol(Ys)

  n_params <- input_dim * hidden_dim +
    hidden_dim +
    hidden_dim * output_dim +
    output_dim

  opt <- sboa(
    fn = mlp_mse_fitness,
    lower = rep(lower, n_params),
    upper = rep(upper, n_params),
    n_agents = n_agents,
    max_iter = max_iter,
    X = Xs,
    Y = Ys,
    input_dim = input_dim,
    hidden_dim = hidden_dim,
    output_dim = output_dim,
    verbose = verbose,
    seed = seed
  )

  fitted_scaled <- forward_mlp(
    params = opt$par,
    X = Xs,
    input_dim = input_dim,
    hidden_dim = hidden_dim,
    output_dim = output_dim
  )$Y_hat

  fitted <- denormalize_minmax(fitted_scaled, y_norm$min, y_norm$max)

  metrics <- list(
    RMSE = rmse_vec(y_train, fitted),
    MAE  = mae_vec(y_train, fitted),
    MAPE = mape_vec(y_train, fitted),
    RSQ  = rsq_vec(y_train, fitted)
  )

  out <- list(
    par = opt$par,
    value = opt$value,
    convergence = opt$convergence,
    input_dim = input_dim,
    hidden_dim = hidden_dim,
    output_dim = output_dim,
    x_min = x_norm$min,
    x_max = x_norm$max,
    y_min = y_norm$min,
    y_max = y_norm$max,
    fitted = fitted,
    metrics = metrics,
    call = match.call()
  )

  class(out) <- "sboa_mlp"
  out
}

#' Predict method for SBOA-MLP objects
#'
#' Generates predictions from a trained SBOA-MLP model.
#'
#' @param object An object of class \code{"sboa_mlp"}.
#' @param newdata New predictor data.
#' @param ... Additional arguments, ignored.
#'
#' @return A matrix of predicted values.
#' @export
predict.sboa_mlp <- function(object, newdata, ...) {
  newdata <- as.matrix(newdata)
  newdata_scaled <- apply_minmax(newdata, object$x_min, object$x_max)

  pred_scaled <- forward_mlp(
    params = object$par,
    X = newdata_scaled,
    input_dim = object$input_dim,
    hidden_dim = object$hidden_dim,
    output_dim = object$output_dim
  )$Y_hat

  denormalize_minmax(pred_scaled, object$y_min, object$y_max)
}

#' Print method for SBOA-MLP objects
#'
#' Prints a summary of a trained SBOA-MLP model.
#'
#' @param x An object of class \code{"sboa_mlp"}.
#' @param ... Additional arguments, ignored.
#'
#' @return The input object, invisibly.
#' @method print sboa_mlp
#' @export
print.sboa_mlp <- function(x, ...) {
  cat("SBOA-MLP model\n")
  cat("Input dimension :", x$input_dim, "\n")
  cat("Hidden dimension:", x$hidden_dim, "\n")
  cat("Output dimension:", x$output_dim, "\n")
  cat("Best objective  :", signif(x$value, 6), "\n")
  cat("RMSE            :", signif(x$metrics$RMSE, 6), "\n")
  cat("MAE             :", signif(x$metrics$MAE, 6), "\n")
  cat("MAPE            :", signif(x$metrics$MAPE, 6), "\n")
  cat("R-squared       :", signif(x$metrics$RSQ, 6), "\n")
  invisible(x)
}

#' Plot method for SBOA-MLP objects
#'
#' Plots the convergence curve of a trained SBOA-MLP model.
#'
#' @param x An object of class \code{"sboa_mlp"}.
#' @param ... Additional graphical arguments passed to \code{graphics::plot()}.
#'
#' @return No return value. Called for its side effect.
#' @method plot sboa_mlp
#' @export
plot.sboa_mlp <- function(x, ...) {
  graphics::plot(
    x$convergence,
    type = "l",
    xlab = "Iteration",
    ylab = "Best fitness",
    main = "SBOA-MLP Convergence",
    ...
  )
}