R/helpers.R

In pkopper/deeppam: Machine Learning for Time-to-Event Data with Semi-Structured Deep Piecewise Additive Models

#' @import tensorflow
backend_reshape <- function(x, t, connected_units) {
  tf$keras$backend$reshape(x, c(
    # dynically set first dimension
    tf$shape(x)[1] * tf$constant(t, dtype = "int32"),
    connected_units))
}

#' @import tensorflow
backend_reduce <- function(x, t, batch_size, last_dim) {
  tf$keras$backend$reshape(x, c(batch_size, t, last_dim))
}

vector_list_prod <- function(vector_input, list_input) {
  if (length(vector_input) != length(list_input)) {
    stop("Vector and list are not of identical length.")
  }
  res <- vector(mode = "list", length = length(list_input))
  for (i in 1:length(list_input)) {
    res[[i]] <- vector_input[i] * list_input[[i]]
  }
  res
}

#' @importFrom stats lag
recompute_intlen <- function(data) {
  lagged_times <- lag(data$times)
  lagged_times[1] <- 0
  intlen <- data$times - lagged_times
  intlen[intlen < 0] <- intlen[1]
  intlen
}

`[.ped_tensor_X` <- function(x, i, j, k, drop = FALSE, ...) {
  additionals <- list("trafo_args" = attributes(x)[["trafo_args"]],
                      "raw" = attributes(x)[["raw"]])
  cls <- class(x)
  out <- unclass(x)
  out <- out[i, j, k, drop = drop]
  additionals$raw <- additionals$raw[additionals$raw[[additionals$trafo_args$id]] %in%
                                       as.integer(dimnames(out)[[1]]), ]
  attributes(out) <- append(attributes(out), additionals)
  class(out) <- cls
  out
}