Merge pull request #813 from nlmixr2/812-r-nn-interface

Create R NN activation interface

NAMESPACE

@@ -343,7 +343,13 @@ export(.udfExists)
 export(.udfMd5Info)
 export(.useUtf)
 export(.vecDf)
+export(ELU)
+export(GELU)
+export(PReLU)
+export(ReLU)
 export(RxODE)
+export(SELU)
+export(Swish)
 export(add.dosing)
 export(add.sampling)
 export(aes)
@@ -378,7 +384,24 @@ export(binomProbs)
 export(boxCox)
 export(boxCoxInv)
 export(cvPost)
+export(d2ELU)
+export(d2ELUa)
+export(d2GELU)
+export(d2aELU)
+export(d3GELU)
+export(d4GELU)
+export(dELU)
+export(dELUa)
+export(dGELU)
+export(dPReLU)
+export(dPReLUa)
+export(dPReLUa1)
+export(dReLU)
+export(dSELU)
+export(dSwish)
 export(dfWishart)
+export(dlReLU)
+export(dsoftplus)
 export(erf)
 export(et)
 export(etExpand)
@@ -414,6 +437,7 @@ export(invWR1d)
 export(is.rxEt)
 export(is.rxSolve)
 export(is.rxStackData)
+export(lReLU)
 export(label_both)
 export(label_context)
 export(label_value)
@@ -637,6 +661,7 @@ export(scale_y_continuous)
 export(scale_y_date)
 export(scale_y_discrete)
 export(setRxThreads)
+export(softplus)
 export(stat_amt)
 export(stat_cens)
 export(swapMatListWithCube)

R/elu.R

@@ -0,0 +1,102 @@
+#' Exponential Linear Unit (ELU) Activation Function
+#'
+#' @family Activation Functions
+#' @param x A numeric vector. All elements must be finite and
+#'   non-missing.
+#' @param alpha A numeric scalar. All elements must be finite and
+#'  non-missing.
+#' @return A numeric vector where the ReLU function has been applied
+#'   to each element of `x`.
+#' @author Matthew Fidler
+#' @export
+#' @examples
+#'
+#' ELU(c(-1, 0, 1, 2), 2)
+#'
+#' # Can also be used in rxode2:
+#' x <- rxode2({
+#'    r=SELU(time)
+#' })
+#'
+#' e <- et(c(-1, 0, 1, 2))
+#'
+#' rxSolve(x, e)
+#'
+ELU <- function(x, alpha=1) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  checkmate::assertNumeric(alpha, finite=TRUE, any.missing=FALSE)
+  .df <- data.frame(x=x, alpha=alpha)
+  .Call(`_rxode2_activationF2`, .df$x, .df$alpha, 1L)
+}
+#' Derivatives of the Exponential Linear Unit (ELU) Activation Function
+#'
+#'
+#' @param x A numeric vector. All elements must be finite and
+#'  non-missing.
+#' @param alpha A numeric scalar. All elements must be finite and
+#'  non-missing.
+#' @return A numeric vector where the derivative(s) of the ELU function has been applied
+#'  to each element of `x`.
+#' @export
+#' @author Matthew L. Fidler
+#' @family Activation Functions
+#' @examples
+#' dELU(c(-1, 0, 1, 2), 2)
+#' d2ELU(c(-1, 0, 1, 2), 2)
+#' d2aELU(c(-1, 0, 1, 2), 2)
+#' dELUa(c(-1, 0, 1, 2), 2)
+#' d2ELUa(c(-1, 0, 1, 2), 2)
+#'
+#' # Can also be used in rxode2:
+#' r <- rxode2({
+#'   r1=dELU(time, 2)
+#'   r2=d2ELU(time, 2)
+#'   r2a=d2aELU(time, 2)
+#'   ra=dELUa(time, 2)
+#'   r2a=d2ELUa(time, 2)
+#' })
+#'
+#' e <- et(c(-1, 0, 1, 2))
+#' rxSolve(r, e)
+dELU <- function(x, alpha=1) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  checkmate::assertNumeric(alpha, finite=TRUE, any.missing=FALSE)
+  .df <- data.frame(x=x, alpha=alpha)
+  .Call(`_rxode2_activationF2`, .df$x, .df$alpha, 2L)
+}
+
+#' @rdname dELU
+#' @export
+d2ELU <- function(x, alpha=1) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  checkmate::assertNumeric(alpha, finite=TRUE, any.missing=FALSE)
+  .df <- data.frame(x=x, alpha=alpha)
+  .Call(`_rxode2_activationF2`, .df$x, .df$alpha, 3L)
+}
+
+#' @rdname dELU
+#' @export
+d2aELU <- function(x, alpha=1) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  checkmate::assertNumeric(alpha, finite=TRUE, any.missing=FALSE)
+  .df <- data.frame(x=x, alpha=alpha)
+  .Call(`_rxode2_activationF2`, .df$x, .df$alpha, 4L)
+}
+
+#' @rdname dELU
+#' @export
+dELUa <- function(x, alpha=1) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  checkmate::assertNumeric(alpha, finite=TRUE, any.missing=FALSE)
+  .df <- data.frame(x=x, alpha=alpha)
+  .Call(`_rxode2_activationF2`, .df$x, .df$alpha, 5L)
+}
+
+#' @rdname dELU
+#' @export
+d2ELUa <- function(x, alpha=1) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  checkmate::assertNumeric(alpha, finite=TRUE, any.missing=FALSE)
+  .df <- data.frame(x=x, alpha=alpha)
+  .Call(`_rxode2_activationF2`, .df$x, .df$alpha, 6L)
+}

R/gelu.R

@@ -0,0 +1,68 @@
+
+#' GELU activation function
+#' @param x numeric vector
+#' @return numeric vector
+#' @family Activation Functions
+#' @export
+#' @examples
+#'
+#' GELU(c(-2, -1, 0, 1, 2))
+#'
+#' # you can use rxode2 as well
+#' r <- rxode2({
+#'   r = GELU(time)
+#' })
+#' et <- et(c(-2, -1, 0, 1, 2))
+#' rxSolve(r, et)
+#'
+GELU <- function(x) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  .Call(`_rxode2_activationF`, x, 1L)
+}
+
+
+#' Derivatives of GELU
+#'
+#' @param x numeric vector
+#' @return numeric vector
+#' @family Activation Functions
+#' @export
+#' @examples
+#' dGELU(c(-2, -1, 0, 1, 2))
+#' d2GELU(c(-2, -1, 0, 1, 2))
+#' d3GELU(c(-2, -1, 0, 1, 2))
+#' d4GELU(c(-2, -1, 0, 1, 2))
+#' # you can use rxode2 as well
+#' r <- rxode2({
+#'    r1 <- dGELU(time)
+#'    r2 <- d2GELU(time)
+#'    r3 <- d3GELU(time)
+#'    r4 <- d4GELU(time)
+#' })
+#' et <- et(c(-2, -1, 0, 1, 2))
+#' rxSolve(r, et)
+dGELU <- function(x) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  .Call(`_rxode2_activationF`, x, 9L)
+}
+
+#' @rdname dGELU
+#' @export
+d2GELU <- function(x) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  .Call(`_rxode2_activationF`, x, 10L)
+}
+
+#' @rdname dGELU
+#' @export
+d3GELU <- function(x) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  .Call(`_rxode2_activationF`, x, 11L)
+}
+
+#' @rdname dGELU
+#' @export
+d4GELU <- function(x) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  .Call(`_rxode2_activationF`, x, 12L)
+}

R/lrelu.R

@@ -0,0 +1,40 @@
+#' Leaky ReLU activation function
+#'
+#' @param x numeric vector
+#' @return numeric vector
+#' @family Activation Functions
+#' @export
+#' @examples
+#'
+#' lReLU(c(-1, 0, 1))
+#'
+#' # Can use in rxode2 as well
+#'
+#' r <- rxode2({r <- lReLU(time)})
+#' e <- et(c(-1, 0, 1))
+#' rxSolve(r, e)
+lReLU <- function(x) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  .Call(`_rxode2_activationF`, x, 5L)
+}
+
+#' Derivative of Leaky ReLU activation function
+#'
+#' @param x numeric vector
+#' @return numeric vector
+#' @family Activation Functions
+#' @export
+#' @examples
+#'
+#' dlReLU(c(-1, 0, 1))
+#'
+#' # Can use in rxode2 as well
+#'
+#' r <- rxode2({r <- dlReLU(time)})
+#' e <- et(c(-1, 0, 1))
+#' rxSolve(r, e)
+#'
+dlReLU <- function(x) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  .Call(`_rxode2_activationF`, x, 8L)
+}

R/parseFuns.R

@@ -32,10 +32,14 @@
 "llikXUnifDalpha", "llikXUnifDbeta", "llikXWeibull", "llikXWeibullDshape", 
 "llikXWeibullDscale", "llikXGamma", "llikXGammaDshape", "llikXGammaDrate", 
 "llikXCauchy", "llikXCauchyDlocation", "llikXCauchyDscale", "llikXNorm", 
-"llikXNormDmean", "llikXNormDsd", "linCmt", "rnorm", "rxnorm", 
-"rxbinom", "rbinom", "rxcauchy", "rcauchy", "rchisq", "rxchisq", 
-"rexp", "rxexp", "rbeta", "rxbeta", "rgeom", "rxgeom", "rxpois", 
-"rpois", "rxt", "rt")
+"llikXNormDmean", "llikXNormDsd", "ReLU", "dReLU", "GELU", "dGELU", 
+"d2GELU", "d3GELU", "d4GELU", "ELU", "dELU", "d2ELU", "d2aELU", 
+"dELUa", "d2ELUa", "softplus", "dsoftplus", "d2softplus", "d3softplus", 
+"d4softplus", "SELU", "dSELU", "lReLU", "dlReLU", "PReLU", "dPReLU", 
+"d2PReLU", "dPReLUa", "dPReLUa1", "Swish", "dSwish", "linCmt", 
+"rnorm", "rxnorm", "rxbinom", "rbinom", "rxcauchy", "rcauchy", 
+"rchisq", "rxchisq", "rexp", "rxexp", "rbeta", "rxbeta", "rgeom", 
+"rxgeom", "rxpois", "rpois", "rxt", "rt")
 .parseEnv$.parseNum <- c(lgamma = 1, abs = 1, acos = 1, acosh = 1, asin = 1, asinh = 1, 
 atan = 1, atan2 = 2, atanh = 1, beta = 2, cos = 1, cosh = 1, 
 erf = 1, erfc = 1, exp = 1, gamma = 1, linCmtA = 20, linCmtC = 20, 
@@ -70,5 +74,10 @@ llikXFDdf1 = 4, llikXFDdf2 = 4, llikXGeom = 3, llikXGeomDprob = 3,
 llikXUnif = 4, llikXUnifDalpha = 4, llikXUnifDbeta = 4, llikXWeibull = 4, 
 llikXWeibullDshape = 4, llikXWeibullDscale = 4, llikXGamma = 4, 
 llikXGammaDshape = 4, llikXGammaDrate = 4, llikXCauchy = 4, llikXCauchyDlocation = 4, 
-llikXCauchyDscale = 4, llikXNorm = 4, llikXNormDmean = 4, llikXNormDsd = 4
-)
+llikXCauchyDscale = 4, llikXNorm = 4, llikXNormDmean = 4, llikXNormDsd = 4, 
+ReLU = 1, dReLU = 1, GELU = 1, dGELU = 1, d2GELU = 1, d3GELU = 1, 
+d4GELU = 1, ELU = 2, dELU = 2, d2ELU = 2, d2aELU = 2, dELUa = 2, 
+d2ELUa = 2, softplus = 1, dsoftplus = 1, d2softplus = 1, d3softplus = 1, 
+d4softplus = 1, SELU = 1, dSELU = 1, lReLU = 1, dlReLU = 1, PReLU = 2, 
+dPReLU = 2, d2PReLU = 2, dPReLUa = 2, dPReLUa1 = 2, Swish = 1, 
+dSwish = 1)

R/prelu.R

@@ -0,0 +1,82 @@
+#' Parametric ReLU Activation Function
+#'
+#' @family Activation Functions
+#' @param x A numeric vector. All elements must be finite and
+#'   non-missing.
+#' @param alpha A numeric scalar. All elements must be finite and
+#'  non-missing.
+#' @return A numeric vector where the ReLU function has been applied
+#'   to each element of `x`.
+#' @author Matthew Fidler
+#' @export
+#' @examples
+#'
+#' PReLU(c(-1, 0, 1, 2), 2)
+#'
+#' # Can also be used in rxode2:
+#' x <- rxode2({
+#'    r=PReLU(time, 2)
+#' })
+#'
+#' e <- et(c(-1, 0, 1, 2))
+#'
+#' rxSolve(x, e)
+#'
+PReLU <- function(x, alpha=1) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  checkmate::assertNumeric(alpha, finite=TRUE, any.missing=FALSE)
+  .df <- data.frame(x=x, alpha=alpha)
+  .Call(`_rxode2_activationF2`, .df$x, .df$alpha, 7L)
+}
+#' Derivatives Parametric ReLU Activation Function
+#'
+#'
+#' @param x A numeric vector. All elements must be finite and
+#'  non-missing.
+#' @param alpha A numeric scalar. All elements must be finite and
+#'  non-missing.
+#' @return A numeric vector where the derivative(s) of the ELU function has been applied
+#'  to each element of `x`.
+#' @export
+#' @author Matthew L. Fidler
+#' @family Activation Functions
+#' @examples
+#'
+#' dPReLU(c(-1, 0, 1, 2), 2)
+#' dPReLUa(c(-1, 0, 1, 2), 2)
+#' dPReLUa1(c(-1, 0, 1, 2), 2)
+#'
+#'
+#' # Can also be used in rxode2:
+#' r <- rxode2({
+#'   r1=dPReLU(time, 2)
+#'   r2a=dPReLUa(time, 2)
+#'   ra=dPReLUa1(time, 2)
+#' })
+#'
+#' e <- et(c(-1, 0, 1, 2))
+#' rxSolve(r, e)
+dPReLU <- function(x, alpha=1) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  checkmate::assertNumeric(alpha, finite=TRUE, any.missing=FALSE)
+  .df <- data.frame(x=x, alpha=alpha)
+  .Call(`_rxode2_activationF2`, .df$x, .df$alpha, 8L)
+}
+
+#' @rdname dPReLU
+#' @export
+dPReLUa <- function(x, alpha=1) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  checkmate::assertNumeric(alpha, finite=TRUE, any.missing=FALSE)
+  .df <- data.frame(x=x, alpha=alpha)
+  .Call(`_rxode2_activationF2`, .df$x, .df$alpha, 9L)
+}
+
+#' @rdname dPReLU
+#' @export
+dPReLUa1 <- function(x, alpha=1) {
+  checkmate::assertNumeric(x, finite=TRUE, any.missing=FALSE)
+  checkmate::assertNumeric(alpha, finite=TRUE, any.missing=FALSE)
+  .df <- data.frame(x=x, alpha=alpha)
+  .Call(`_rxode2_activationF2`, .df$x, .df$alpha, 10L)
+}