brain: Neural Network

#' Layers
#'
#' Create layers.
#'
#' @inheritParams architecture
#' @param name Name of layer.
#' @param size Layer size.
#' @param bias A bias, numerical.
#' @param squash A object of class \code{squash} as returned by \code{\link{squash_function}}.
#'
#' @section Squashing functions:
#' \itemize{
#'   \item{\code{logistic}}
#'   \item{\code{tanh}}
#'   \item{\code{identity}}
#'   \item{\code{hlim}}
#'   \item{\code{relu}}
#'   \item{\code{step}}
#'   \item{\code{softsign}}
#'   \item{\code{sinusoid}}
#'   \item{\code{gaussian}}
#'   \item{\code{bent_identity}}
#'   \item{\code{bipolar}}
#'   \item{\code{bipolar_sigmoid}}
#'   \item{\code{hard_tanh}}
#'   \item{\code{absolute}}
#'   \item{\code{selu}}
#'   \item{\code{inverse}}
#' }
#'
#' @examples
#' brain() %>%
#'   layer("input", 2) %>%
#'   layer("hidden", 3) %>%
#'   layer("output", 1)
#'
#' @seealso \code{\link{project}} to connect the layers.
#'
#' @name layers
#' @export
layer <- function(brain, name, size, squash = NULL, bias = NULL){

  if(missing(name) || missing(size))
    stop("missing name of size", call. = FALSE)

  .check_name(name)

  brain$brain$eval(
    paste0(
      "var ", name, " = new synaptic.Layer(", size, ")"
    )
  )


  if(!is.null(squash)){
    if(!inherits(squash, "squash_function"))
      stop("squash must be of class squash_function", call. = FALSE)

    brain <- .squash(brain, name, squash, bias)
  }

  return(brain)
}

#' Project & Gate
#'
#' Project or gate layers and neurons.
#'
#' @inheritParams architecture
#' @param from,to Name of neurons or layers to project or gate.
#' @param gate The type of gate required, see gates
#' @param type An object of class \code{gate} as returned by \code{\link{gate_types}} or \code{NULL}.
#' @param name If not \code{NULL} then the projection is stored internally and can be used later on,
#' see "gate" example.
#'
#' @section Gates:
#' \itemize{
#'   \item{\code{input}: If layer C is gating connections between layer A and B, all the neurons from C gate all the input connections to B.}
#'   \item{\code{output}: If layer C is gating connections between layer A and B, all the neurons from C gate all the output connections from A.}
#'   \item{\code{one2one}: If layer C is gating connections between layer A and B, each neuron from C gates one connection from A to B. This is useful for gating self-connected layers. To use this kind of gateType, A, B and C must be the same size.}
#' }
#'
#' @examples
#' # project
#' brain() %>%
#'   layer("input", 2) %>%
#'   layer("hidden", 3) %>%
#'   layer("output", 1) %>%
#'   project("input", "hidden") %>%
#'   project("hidden", "output")
#'
#' # gate
#' brain() %>%
#'   layer("A", 5) %>%
#'   layer("B", 3) %>%
#'   project("A", "B", "connection") %>%
#'   layer("C", 4) %>%
#'   gate(
#'     "C",
#'     "connection",
#'     gate_types("input")
#'   )
#'
#' @seealso \code{\link{network}} to create a network from the connected layers.
#'
#' @name connect
#' @export
project <- function(brain, from, to, name = NULL){

  if(missing(from) || missing(to))
    stop("missing from or to", call. = FALSE)

  if(is.null(name))
    ev <- paste0(from, ".project(", to, ")")
  else
    ev <- paste0("var ", name, " = ", from, ".project(", to, ")")

  brain$brain$eval(ev)

  return(brain)

}

#' @name connect
#' @export
gate_types <- function(gate){
  type <- .get_gate(gate)

  structure(type, class = "gate")
}

#' @name connect
#' @export
gate <- function(brain, from, to, type = NULL){

  if(missing(from) || missing(to))
    stop("missing from or to", call. = FALSE)

  if(!is.null(type)){
    if(!inherits(type, "gate"))
      stop("type must be of class gate", call. = FALSE)

    ev <- paste0(from, ".gate(", to, ", ", type,")")
  } else {
    ev <- paste0(from, ".gate(", to, ")")
  }

  brain$brain$eval(ev)

  return(brain)

}

#' Network
#'
#' Create networks.
#'
#' @inheritParams architecture
#' @param input,hidden,output Projected layers, see \code{\link{layer}}.
#'
#' @examples
#' brain() %>%
#'   layer("input", 2) %>%
#'   layer("hidden", 3) %>%
#'   layer("output", 1) %>%
#'   project("input", "hidden") %>%
#'   project("hidden", "output") %>%
#'   network("input", "hidden", "output")
#'
#' @seealso \code{\link{train}} to train your network.
#'
#' @export
network <- function(brain, input, hidden, output){

  net <- paste0(
    "var net = new synaptic.Network({
    	input: ", input, ",
    	hidden: [", hidden, "],
    	output: ", output, "
    });"
  )

  brain$opts$train$prt <- c(input, hidden, output)

  brain$opts$architecture <- "custom"
  brain$brain$eval(net)

  return(brain)

}

#' Neurons
#'
#' Create neurons.
#'
#' @inheritParams architecture
#' @param name Name of the neuron.
#' @param bias A bias, numerical.
#' @param squash A object of class \code{squash} as returned by \code{squash_function}.
#'
#' @examples
#' # gate
#' brain() %>%
#'   neuron("A", squash_function("tanh"), .3) %>%
#'   neuron("B") %>%
#'   project("A", "B", "connection") %>%
#'   neuron("C") %>%
#'   gate(
#'     "C",
#'     "connection"
#'   )
#'
#' @seealso \code{\link{squash_function}}
#'
#' @name neuron
#' @export
neuron <- function(brain, name, squash = NULL, bias = NULL){

  if(missing(name))
    stop("missing name", call. = FALSE)

  brain$brain$eval(
    paste0(
      "var ", name, " = new synaptic.Neuron()"
    )
  )

  if(!is.null(squash)){
    if(!inherits(squash, "squash_function"))
      stop("squash must be of class squash_function", call. = FALSE)

    brain$brain$eval(
      paste0(
        name, ".squash = ", squash
      )
    )
  }

  if(!is.null(bias))
    brain$brain$eval(paste0(name, ".bias = ", bias))

  return(brain)
}

#' Squash
#'
#' Squash functions, more commonly known as \emph{activation functions}.
#'
#' @param func A squashing functions name.
#' @param x A vector of integer.
#' @param print If \code{TRUE} prints the equation.
#' @param plot if \code{TRUE} plots the activation and the derivate.
#'
#' @section Functions:
#' \itemize{
#'   \item{\code{squash_function}: A squash function to use in your \code{\link{brain}}.}
#'   \item{\code{run_squash}: Test and expore the \code{squash_function}.}
#'   \item{\code{squash_*}: Convenient wrappers around \code{squash_function}.}
#' }
#'
#' @section Squashing functions:
#'
#' \code{logistic} also known as \code{sigmoid}\if{latex}{: \eqn{f(x) = \frac{1}{1 + e^{-x}}}} \cr
#' \if{html}{\figure{logistic.png}{options: width=150 al="logistic"}} \if{latex}{\figure{logistic.png}{options: width=0.5in}}
#'
#' \code{tanh}\if{latex}{: \eqn{f(x) = \frac{2}{1 + e^{-2x}} - 1}} \cr
#' \if{html}{\figure{tanh.png}{options: width=150 alt="tanh"}} \if{latex}{\figure{tanh.png}{options: width=0.5in}}
#'
#' \code{identity}\if{latex}{: \eqn{f(x) = x}} \cr
#' \if{html}{\figure{identity.png}{options: width=150 alt="identity"}} \if{latex}{\figure{identity.png}{options: width=0.5in}}
#'
#' \code{relu}\if{latex}{: \eqn{f(x)= 0 if x < 0; x if x >= 0}} \cr
#' \if{html}{\figure{relu.png}{options: width=150 alt="relu"}} \if{latex}{\figure{relu.png}{options: width=0.5in}}
#'
#' \code{step} or \code{hlim} (hard limit function)\if{latex}{: \eqn{0 if x < 0; 1 if x >= 0}} \cr
#' \if{html}{\figure{step.png}{options: width=150 alt="step"}} \if{latex}{\figure{step.png}{options: width=0.5in}}
#'
#' \code{softsign}\if{latex}{: \eqn{\frac{x}{f(x) = 1 + |x|}}} \cr
#' \if{html}{\figure{softsign.png}{options: width=150 "softsign"}} \if{latex}{\figure{softsign.png}{options: width=0.5in}}
#'
#' \code{sinusoid}\if{latex}{: \eqn{f(x) = \sin(x)}} \cr
#' \if{html}{\figure{sinusoid.png}{options: width=150 alt="sinusoid"}} \if{latex}{\figure{sinusoid.png}{options: width=0.5in}}
#'
#' \code{gaussian}\if{latex}{: \eqn{f(x) = e^{-x^{2}}}} \cr
#' \if{html}{\figure{gaussian.png}{options: width=150 alt="gaussian"}} \if{latex}{\figure{gaussian.png}{options: width=0.5in}}
#'
#' \code{bent_identity}\if{latex}{: \eqn{f(x) = \frac{\sqrt{x^{2} + 1} - 1}{2} + x}} \cr
#' \if{html}{\figure{bent_identity.png}{options: width=150 alt="bent_identity"}} \if{latex}{\figure{bent_identity.png}{options: width=0.5in}}
#'
#' \code{bipolar}\if{latex}{: \eqn{f(x) = -1 if x < 0; 1 if x >= 0}} \cr
#' \if{html}{\figure{bipolar.png}{options: width=150 alt="bipolar"}} \if{latex}{\figure{bipolar.png}{options: width=0.5in}}
#'
#' \code{bipolar_sigmoid}\if{latex}{: \eqn{f(x) = \frac{2}{1 + e^{-x}} - 1}} \cr
#' \if{html}{\figure{bipolar_sigmoid.png}{options: width=150 alt="bipolar_sigmoid"}} \if{latex}{\figure{bipolar_sigmoid.png}{options: width=0.5in}}
#'
#' \code{hard_tanh}\if{latex}{: \eqn{f(x) = \max(−1, \min(1, x))}} \cr
#' \if{html}{\figure{hard_tanh.png}{options: width=150 alt="hard_tanh"}} \if{latex}{\figure{hard_tanh.png}{options: width=0.5in}}
#'
#' \code{absolute}\if{latex}{: \eqn{f(x) = |x|}} \cr
#' \if{html}{\figure{absolute.png}{options: width=150 alt="absolute"}} \if{latex}{\figure{absolute.png}{options: width=0.5in}}
#'
#' \code{inverse}\if{latex}{: \eqn{f(x) = 1 - x}} \cr
#' \if{html}{\figure{inverse.png}{options: width=150 alt="inverse"}} \if{latex}{\figure{inverse.png}{options: width=0.5in}}
#'
#' @examples
#' run_squash("tanh")
#'
#' (x <- seq(-10, 10, by = .2))
#' run_squash("sigmoid", x)
#'
#' @name squash
#' @export
squash_function <- function(func){

  if(missing(func)) stop("missing func", call. = FALSE)

  if(func == "sigmoid") func <- "logistic"
  if(func == "hlim") func <- "step"

  func <- paste0(tolower(func), "_activation")

  func <- paste0(func)
  structure(func, class = "squash_function")

}

#' @name squash
#' @export
squash_sigmoid <- function(){
  squash_function("logistic")
}

#' @name squash
#' @export
squash_logistic <- squash_sigmoid

#' @name squash
#' @export
squash_tanh <- function(){
  squash_function("tanh")
}

#' @name squash
#' @export
squash_identity <- function(){
  squash_function("identity")
}

#' @name squash
#' @export
squash_relu <- function(){
  squash_function("relu")
}

#' @name squash
#' @export
squash_step <- function(){
  squash_function("step")
}

#' @name squash
#' @export
squash_hlim <- squash_step

#' @name squash
#' @export
squash_softsign <- function(){
  squash_function("softsign")
}

#' @name squash
#' @export
squash_sinusoid <- function(){
  squash_function("sinusoid")
}

#' @name squash
#' @export
squash_gaussian <- function(){
  squash_function("gaussian")
}

#' @name squash
#' @export
squash_bent_identity <- function(){
  squash_function("bent_identity")
}

#' @name squash
#' @export
squash_bipolar <- function(){
  squash_function("bipolar")
}

#' @name squash
#' @export
squash_bipolar_sigmoid <- function(){
  squash_function("bipolar_sigmoid")
}

#' @name squash
#' @export
squash_hard_tanh <- function(){
  squash_function("hard_tanh")
}

#' @name squash
#' @export
squash_aboslute <- function(){
  squash_function("absolute")
}

#' @name squash
#' @export
squash_inverse <- function(){
  squash_function("inverse")
}

#' @rdname squash
#' @export
run_squash <- function(func, x = seq(-1, 1, by = .1), print = TRUE, plot = TRUE){

  if(missing(func))
    stop("missing func", call. = FALSE)

  sq <- V8::new_context()
  sq$source(system.file("activations/custom.js", package = "brain"))

  sq$assign("vect", as.list(x))
  sq$eval("var squashed = []")
  fn <- squash_function(func)
  sq$eval(
    paste0(
      "vect.forEach(function(x){
        squashed.push(", fn, "(x))
      })"
    )
  )

  sq$eval("var derived = []")
  sq$eval(
    paste0(
      "vect.forEach(function(x){
        derived.push(", fn, "(x, true))
      })"
    )
  )

  y <- sq$get("squashed")
  derived <- sq$get("derived")

  squashed <- cbind.data.frame(x, y, derived)
  names(squashed) <- c("x", func, "derivate")

  if(isTRUE(print)){
    fun <- if(func == "sigmoid") "logistic" else func
    equation <- activations %>%
      dplyr::filter(func == fun) %>%
      dplyr::pull(eq)

    cat(
      cli::rule(left = func), "\n",
      crayon::yellow(cli::symbol$info),
      "f(x) =", equation, "\n\n"
    )
  }

  if(isTRUE(plot)){
    plot <- squashed %>%
      echarts4r::e_charts(x) %>%
      echarts4r::e_line_(func, color = "#FFDA45") %>%
      echarts4r::e_line(derivate, color = "#7f7f7f") %>%
      echarts4r::e_title(func) %>%
      echarts4r::e_tooltip(trigger = "axis")

    print(plot)
  }

  return(squashed)
}

#' Propagate
#'
#' Propagate error.
#'
#' @inheritParams architecture
#' @param data A data.frame.
#' @param rate Learning rate.
#' @param name Name of element to activate \code{net} is the network/brain, you can also activate individual \code{\link{neuron}}.
#' @param ... Bare column name of input.
#'
#' @examples
#' test <- dplyr::tibble(
#'   y = c(2,4,6)
#' )
#'
#' # gate
#' brain() %>%
#'   neuron("A", squash_function("tanh"), .3) %>%
#'   propagate(y, rate = .3, data = test, name = "A")
#'
#' @export
propagate <- function(brain, ..., rate, data = NULL, name = "net"){

  if(missing(rate))
    stop("missing rate", call. = FALSE)

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

  dat <- data %>%
    dplyr::select(...) %>%
    unname() %>%
    apply(1, as.list)

  for(i in 1:length(dat)){
    brain$brain$assign("propagation", dat[[i]])
    brain$brain$eval(
      paste0(name, ".propagate(", rate, ", propagation)")
    )
  }

  return(brain)
}