R/activate.R

In brain-r/brain: Neural Network

#' Activate
#'
#' Activate the brain.
#'
#' @inheritParams architecture
#' @param data A data.frame.
#' @param print Whether to print the predictions.
#' @param rate Learning rate, if specified the brain propagates the error.
#' @param name Name of element to activate \code{net} is the network/brain, you can also activate individual \code{\link{neuron}}.
#' @param scale Set to \code{TRUE} to scale the data with \code{\link{balance}}.
#' @param ... Bare column name of input.
#'
#' @note If \code{rate} is specified the network propagates the error, otherwise the error is \emph{not} propagated.
#'
#' @examples
#' train <- dplyr::tibble(
#'   x = rep(c(0, 0, 1, 1), 100),
#'   y = rep(c(0, 1, 0, 1), 100)
#' )
#'
#' targets <- dplyr::tibble(
#'   z = rep(c(0, 1, 1, 0), 100)
#' )
#'
#' brain() %>%
#'   perceptron(c(2,3,1)) %>%
#'   train_output(x, y, data = train) %>%
#'   activate_data(targets) %>%
#'   activate(z, rate = .003)
#'
#' @name activate
#' @export
activate <- function(brain, ..., scale = FALSE, name = "net", data = NULL, rate = NULL, print = FALSE){

  data <- .get_data(data, brain, "activate")

  data <- data %>%
    dplyr::select(...) %>%
    apply(2, function(x, scale){
      if(isTRUE(scale))
        balance(x)
      else
        x
    }, scale = scale) %>%
    unname() %>%
    apply(1, as.list)

  brain$brain$eval("var activation = []")

  for(i in 1:length(data)){
    brain$brain$assign("act", data[[i]])
    brain$brain$eval(
      paste0("activation.push(", name, ".activate(act))")
    )

    if(!is.null(rate)){

      if(length(brain$opts$training$output) != length(data))
        stop("training and activation data ", crayon::red("not"), " of the same length.", call. = FALSE)

      brain$opts$trained <- TRUE
      brain$opts$trainingcost <- "propagated manually"
      out <- brain$opts$training$output[[i]] %>% unname() %>% unlist()
      brain$brain$assign("prop", out)
      brain$brain$eval(
        paste0(name, ".propagate(", rate, ", prop)")
      )
    }

  }

  if(isTRUE(print))
    print(get_activations(brain))

  brain$opts$activate <- NULL

  return(brain)
}

#' @name activate
#' @export
activate_data <- function(brain, data){

  if(missing(data))
    stop("must pass data", call. = FALSE)

  brain$opts$activate$data <- data

  return(brain)
}

#' @name activate
#' @export
get_activations <- function(brain){
  brain$brain$get("activation")
}

#' @rdname hopfield
#' @export
feed_data <- activate_data