R/grnn.predone.R

In yager: Yet Another General Regression Neural Network

#' Calculate a predicted value of GRNN 
#'
#' The function \code{grnn.predone} calculates a predicted value of GRNN based on an input vector
#'
#' @param net  The GRNN object generated by grnn.fit() 
#' @param x    The vector of input predictors 
#' @param type A scalar, 1 for euclidean distance and 2 for manhattan distance
#'
#' @return A scalar of the predicted value
#'
#' @references
#' Donald Specht. (1991). A General Regression Neural Network.
#'
#' @seealso \code{\link{grnn.fit}}
#'
#' @examples
#' data(iris, package = "datasets")
#' Y <- ifelse(iris[, 5] == "setosa", 1, 0)
#' X <- scale(iris[, 1:4])
#' gnet <- grnn.fit(x = X, y = Y)
#' for (i in seq(5)) print(grnn.predone(gnet, X[i, ]))

grnn.predone <- function(net, x, type = 1) {
  if (class(net) != "General Regression Neural Net") stop("net needs to be a GRNN object.", call. = F)

  ### CHECK INPUT X VECTOR ###
  if (is.vector(x) == F) stop("x needs to be a vector.", call. = F)
  if (anyNA(x) == T) stop("NA found in x.", call. = F)
  if (length(x) != ncol(net$x)) stop("x dimension is not consistent with grnn.", call. = F)

  ### CHECK INPUT TYPE (CURRENTLY SUPPORTING 1 / 2) ###
  if (!(type %in% c(1, 2))) stop("the type is not supported.", call. = F)

#  xl <- split(net$x, seq(nrow(net$x)))
  xl <- matrix(rep(x, length(net$y)), nrow = length(net$y), byrow = TRUE)

  if (type == 1) {
  ### EUCLIDEAN DISTANCE BY DEFAULT ###
    num <- sum(net$w * net$y * exp(-(rowSums((xl - net$x) ^ 2)) / (2 * (net$sigma ^ 2))))
    den <- sum(net$w * exp(-(rowSums((xl - net$x) ^ 2)) / (2 * (net$sigma ^ 2))))
#    num <- sum(net$w * net$y * exp(-Reduce(c, lapply(xl, function(xi) sum((x - xi) ^ 2))) / (2 * (net$sigma ^ 2))))
#    den <- sum(net$w * exp(-Reduce(c, lapply(xl, function(xi) sum((x - xi) ^ 2))) / (2 * (net$sigma ^ 2))))
  } else if (type == 2) {
  ### MANHATTAN DISTANCE ###
    num <- sum(net$w * net$y * exp(-(rowSums(abs(xl - net$x))) / net$sigma))
    den <- sum(net$w * exp(-(rowSums(abs(xl - net$x))) / net$sigma))
#    num <- sum(net$w * net$y * exp(-Reduce(c, lapply(xl, function(xi) sum(abs(x - xi)))) / net$sigma))
#    den <- sum(net$w * exp(-Reduce(c, lapply(xl, function(xi) sum(abs(x - xi)))) / net$sigma))
  }
  return(num / den)
}