R/yan.neuronLogicalUnitInput.R

In tomaszbiegacz/yan: Yet Another Neuron

#
# yan.neuronLogicalUnitInput
#

library(methods)

as.yan.neuronLogicalUnitInput <- function (cutOff) {
  cutOffValue <- if (missing(cutOff)) 0 else cutOff
  yan.neuronLogicalUnitInput(
    cutOff = cutOffValue
  )
}

setMethod("as.character", "yan.neuronLogicalUnitInput", function(x) paste('(', x@cutOff, ')'))
setMethod("show", "yan.neuronLogicalUnitInput", function(object) cat(as.character(object)))

cutOffPositive <- function (model, input) {
  cutOffValue <- 1 / model@cutOff
  if (input >= cutOffValue)
    cutOffPositiveLinear(model, input)
  else
    cutOffPositiveBlanking(model, input)
}
cutOffPositiveLinear <- function (model, input)
  model@cutOff*input
cutOffPositiveBlanking <- function (model, input)
  if (input > 0) {
    part <- model@cutOff*input
    1 + tanh((part-1)/part)
  } else 0

cutOffNegative <- function (model, input) {
  cutOffValue <- -1 * model@cutOff
  if (input <= cutOffValue)
    cutOffNegativeLinear(model, input)
  else
    cutOffNegativeBlanking(model, input)
}
cutOffNegativeLinear <- function (model, input)
  -1 * model@cutOff / input
cutOffNegativeBlanking <- function (model, input)
  1 + tanh((model@cutOff + input)/model@cutOff)

cutOffZero <- function (model, input) 0

setMethod("propagation", c(model = "yan.neuronLogicalUnitInput", input = "numeric"),
          function(model, input) {
            if (any(input < 0)) stop(paste("Invalid input:", input))

            if (model@cutOff > 0)
              sapply(input, function(x) cutOffPositive(model, x))
            else if (model@cutOff < 0)
              sapply(input, function(x) cutOffNegative(model, x))
            else
              sapply(input, function(x) cutOffZero(model, x))
})

backwardPositive <- function (model, input, output) {
  results <- mapply(function(i, o) backwardPositiveValue(model, i, o), input, output)
  data.frame(
    input=input,
    output=output,
    dX=results[1,],
    dCutOff=results[2,]
  )
}
backwardPositiveValue <- function (model, input, output) {
  if (output >= 1)
    backwardPositiveValueLinear(model, input, output)
  else
    backwardPositiveValueBlanking(model, input, output)
}
backwardPositiveValueLinear <- function (model, input, output)
  c(
    model@cutOff,
    input
  )
backwardPositiveValueBlanking <- function (model, input, output) {
  partValue <- model@cutOff * input
  partTanh <- tanh((partValue - 1) / partValue)
  dPart <- (1 - partTanh^2) / model@cutOff / input
  c(
    dPart / input,
    dPart / model@cutOff
  )
}

backwardNegative <- function (model, input, output) {
  results <- mapply(function(i, o) backwardNegativeValue(model, i, o), input, output)
  data.frame(
    input=input,
    output=output,
    dX=results[1,],
    dCutOff=results[2,]
  )
}
backwardNegativeValue <- function (model, input, output) {
  if (output >= 1)
    backwardNegativeValueLinear(model, input, output)
  else
    backwardNegativeValueBlanking(model, input, output)
}
backwardNegativeValueLinear <- function (model, input, output)
  c(
    model@cutOff / input / input,
    -1 / input
  )
backwardNegativeValueBlanking <- function (model, input, output) {
  part <- 1 + input / model@cutOff
  dPart <- (1 - (tanh(part)^2)) / model@cutOff
  c(
    dPart,
    -1 * dPart / model@cutOff * input
  )
}

backwardZero <- function (model, input, output) {
  if (any(output != 0)) stop(paste("Invalid output:", output))
  data.frame(
    input=input,
    output=output,
    dX = 0,
    dCutOff = 0
  )
}

setMethod("backpropagation", c(model = "yan.neuronLogicalUnitInput", input = "numeric"),
          function(model, input, output) {
            if (any(input < 0)) stop(paste("Invalid input:", input))
            if (any(output < 0)) stop(paste("Invalid output:", output))
            if (length(input) != length(output)) stop("Arguments don't have equal length", input, output)

            if (model@cutOff > 0)
              backwardPositive(model, input, output)
            else if (model@cutOff < 0)
              backwardNegative(model, input, output)
            else
              backwardZero(model, input, output)
          })