R/model-creation.R

In rstudio/keras: R Interface to 'Keras'

#' Keras Model (Functional API)
#'
#' A model is a directed acyclic graph of layers.
#'
#' @param inputs Input tensor(s) (from [`keras_input()`])
#' @param outputs Output tensors (from calling layers with `inputs`)
#' @param ... Any additional arguments
#'
#' @details
#'
#' # Examples
#' ```{r}
#' library(keras3)
#'
#' # input tensor
#' inputs <- keras_input(shape = c(784))
#'
#' # outputs compose input + dense layers
#' predictions <- inputs |>
#'   layer_dense(units = 64, activation = 'relu') |>
#'   layer_dense(units = 64, activation = 'relu') |>
#'   layer_dense(units = 10, activation = 'softmax')
#'
#' # create and compile model
#' model <- keras_model(inputs = inputs, outputs = predictions)
#' model |> compile(
#'   optimizer = 'rmsprop',
#'   loss = 'categorical_crossentropy',
#'   metrics = c('accuracy')
#' )
#' ```
#'
#' @returns A `Model` instance.
#' @export
#' @family model functions
#' @family model creation
#' @tether keras.Model
keras_model <- function(inputs = NULL, outputs = NULL, ...) {
  keras$models$Model(inputs = inputs, outputs = outputs, ...)
}


#' Create a Keras tensor (Functional API input).
#'
#' @description
#' A Keras tensor is a symbolic tensor-like object, which we augment with
#' certain attributes that allow us to build a Keras model just by knowing the
#' inputs and outputs of the model.
#'
#' For instance, if `a`, `b` and `c` are Keras tensors,
#' it becomes possible to do:
#' `model <- keras_model(input = c(a, b), output = c)`
#'
#' # Examples
#' ```{r}
#' # This is a logistic regression in Keras
#' input <- layer_input(shape=c(32))
#' output <- input |> layer_dense(16, activation='softmax')
#' model <- keras_model(input, output)
#' ```
#'
#' @returns
#' A Keras tensor,
#' which can passed to the `inputs` argument of ([`keras_model()`]).
#'
#' @param shape
#' A shape list (list of integers or `NULL` objects),
#' not including the batch size.
#' For instance, `shape = c(32)` indicates that the expected input
#' will be batches of 32-dimensional vectors. Elements of this list
#' can be `NULL` or `NA`; `NULL`/`NA` elements represent dimensions where the shape
#' is not known and may vary (e.g. sequence length).
#'
#' @param batch_size
#' Optional static batch size (integer).
#'
#' @param dtype
#' The data type expected by the input, as a string
#' (e.g. `"float32"`, `"int32"`...)
#'
#' @param sparse
#' A boolean specifying whether the expected input will be sparse
#' tensors. Note that, if `sparse` is `FALSE`, sparse tensors can still
#' be passed into the input - they will be densified with a default
#' value of 0. This feature is only supported with the TensorFlow
#' backend. Defaults to `FALSE`.
#'
#' @param name
#' Optional name string for the layer.
#' Should be unique in a model (do not reuse the same name twice).
#' It will be autogenerated if it isn't provided.
#'
#' @param tensor
#' Optional existing tensor to wrap into the `Input` layer.
#' If set, the layer will use this tensor rather
#' than creating a new placeholder tensor.
#'
#' @param batch_shape
#' Shape, including the batch dim.
#'
#' @export
#' @family model creation
# @seealso
#  + <https://keras.io/api/layers/core_layers/input/>
#'
#' @tether keras.layers.Input
keras_input <-
function (shape = NULL, batch_size = NULL, dtype = NULL, sparse = NULL,
    batch_shape = NULL, name = NULL, tensor = NULL)
{
    args <- capture_args(list(shape = normalize_shape, batch_size = as_integer,
        input_shape = normalize_shape, batch_input_shape = normalize_shape,
        batch_shape = normalize_shape))
    do.call(keras$Input, args)
}




#' Keras Model composed of a linear stack of layers
#'
#' @param input_shape
#' A shape integer vector,
#' not including the batch size.
#' For instance, `shape=c(32)` indicates that the expected input
#' will be batches of 32-dimensional vectors. Elements of this shape
#' can be `NA`; `NA` elements represent dimensions where the shape
#' is not known and may vary (e.g. sequence length).
#'
#' @param name Name of model
#'
#' @param input_batch_size Optional static batch size (integer).
#'
#' @param input_dtype
#' The data type expected by the input, as a string
#' (e.g. `"float32"`, `"int32"`...)
#'
#' @param input_sparse
#' A boolean specifying whether the expected input will be sparse
#' tensors. Note that, if `sparse` is `FALSE`, sparse tensors can still
#' be passed into the input - they will be densified with a default
#' value of `0`. This feature is only supported with the TensorFlow
#' backend. Defaults to `FALSE`.
#'
#' @param input_batch_shape
#' An optional way to specify `batch_size` and `input_shape` as one argument.
#'
#' @param input_name
#' Optional name string for the input layer.
#' Should be unique in a model (do not reuse the same name twice).
#' It will be autogenerated if it isn't provided.
#'
#' @param input_tensor
#' Optional existing tensor to wrap into the `InputLayer`.
#' If set, the layer will use this tensor rather
#' than creating a new placeholder tensor.
#'
#' @param ... additional arguments passed on to `keras.layers.InputLayer`.
#'
#' @param layers List of layers to add to the model.
#'
#' @param trainable Boolean, whether the model's variables should be trainable.
#'   You can also change the trainable status of a model/layer with
#'   [`freeze_weights()`] and [`unfreeze_weights()`].
#'
#' @note
#'
#' If `input_shape` is omitted, then the model layer
#' shapes, including the final model output shape, will not be known until
#' the model is built, either by calling the model with an input tensor/array
#' like `model(input)`, (possibly via `fit()`/`evaluate()`/`predict()`), or by
#' explicitly calling `model$build(input_shape)`.
#'
#' @details
#'
#' # Examples
#'
#' ```{r}
#' model <- keras_model_sequential(input_shape = c(784))
#' model |>
#'   layer_dense(units = 32) |>
#'   layer_activation('relu') |>
#'   layer_dense(units = 10) |>
#'   layer_activation('softmax')
#'
#' model |> compile(
#'   optimizer = 'rmsprop',
#'   loss = 'categorical_crossentropy',
#'   metrics = c('accuracy')
#' )
#'
#' model
#' ```
#'
#' @returns A `Sequential` model instance.
#' @export
#' @family model functions
#' @family model creation
#' @tether keras.Sequential
keras_model_sequential <-
function(input_shape = NULL, name = NULL,
         ...,
         input_dtype = NULL,
         input_batch_size = NULL,
         input_sparse = NULL,
         input_batch_shape = NULL,
         input_name = NULL,
         input_tensor = NULL,
         trainable = TRUE,
         layers = list())
{
  args <- capture_args(list(layers = as_list))

  Sequental_arg_names <- c("layers", "name", "trainable")
  Sequental_args <- args[intersect(names(args), Sequental_arg_names)]
  InputLayer_args <- args[setdiff(names(args), Sequental_arg_names)]

  if (length(InputLayer_args)) {
    # If we received `layers` for the first positional arg, throw a nicer error
    # message. (The first positional arg used to be `layers`.)
    if (is_layer(input_shape) ||
        (is.list(input_shape) && any(map_lgl(input_shape, is_layer))))
      stop("`layers` must be passed in as a named argument.")

    prepend(Sequental_args$layers) <- do.call(InputLayer, InputLayer_args)
  }

  do.call(keras$models$Sequential, Sequental_args)
}




#' @tether keras.layers.InputLayer
InputLayer <-
function(input_shape = NULL,
         ...,
         input_batch_size = NULL,
         input_dtype = NULL,
         input_sparse = NULL,
         input_batch_shape = NULL,
         input_name = NULL,
         input_tensor = NULL)
{
  args <- capture_args(list(
    input_shape = normalize_shape,
    shape = normalize_shape,

    batch_shape = normalize_shape,
    input_batch_shape = normalize_shape,
    batch_input_shape = normalize_shape,

    input_batch_size = as_integer,
    batch_size = as_integer
  ))

  args <- rename(args,
                 name = "input_layer_name", # legacy
                 name = "input_name",

                 shape = "input_shape",

                 batch_shape = "batch_input_shape", # legacy
                 batch_shape = "input_batch_shape",

                 batch_size = "input_batch_size",

                 dtype = "input_dtype",

                 sparse = "input_sparse",

                 .skip_existing = TRUE)

  do.call(keras$layers$InputLayer, args)
}

#' Clone a model instance.
#'
#' Model cloning is similar to calling a model on new inputs, except that it
#' creates new layers (and thus new weights) instead of sharing the weights of
#' the existing layers.
#'
#' @param model Instance of Keras model (could be a functional model or a
#'   Sequential model).
#' @param input_tensors Optional list of input tensors to build the model upon.
#'   If not provided, placeholders will be created.
#' @param clone_function Callable to be used to clone each layer in the target
#'   model (except `InputLayer` instances). It takes as argument the layer
#'   instance to be cloned, and returns the corresponding layer instance to be
#'   used in the model copy. If unspecified, this callable defaults to the
#'   following serialization/deserialization function:
#'
#'   ```function(layer) layer$`__class__`$from_config(layer$get_config())```
#'
#'   By passing a custom callable, you can customize your copy of the model,
#'   e.g. by wrapping certain layers of interest (you might want to replace all
#'   LSTM instances with equivalent `Bidirectional(LSTM(...))` instances, for
#'   example).
#'
#' @returns A new model instance.
#'
#' @export
clone_model <- function(model, input_tensors = NULL, clone_function = NULL) {
  args <- capture_args()
  do.call(keras$models$clone_model, args)
}


# ---- Model methods ----


#' Retrieves a layer based on either its name (unique) or index.
#'
#' Indices are based on order of horizontal graph traversal (bottom-up) and are
#' 1-based. If `name` and `index` are both provided, `index` will take
#' precedence.
#'
#' @param object Keras model object
#' @param name String, name of layer.
#' @param index Integer, index of layer (1-based). Also valid are negative
#'   values, which count from the end of model.
#'
#' @returns A layer instance.
#'
#' @family model functions
#'
#' @export
get_layer <- function(object, name = NULL, index = NULL) {
  object$get_layer(
    name = name,
    index = as_layer_index(index)
  )
}


#' Remove the last layer in a Sequential model
#'
#' @param object Sequential keras model object
#' @returns The input `object`, invisibly.
#'
#' @family model functions
#'
#' @export
pop_layer <- function(object) {
  object$pop()
  invisible(object)
}