R语言Keras框架中自定义损失函数能否手动提供梯度？

结论先行：目前R Keras并不支持在compile()函数中直接传入自定义梯度函数的参数，官方文档和现有社区实践里都没有相关实现路径。不过你不用纠结这个限制，因为有多种替代方案可以实现「用自定义损失函数训练模型」的核心目标，下面是具体的解决思路：

替代方案1：用TensorFlow低级API写自定义训练循环 #

R Keras底层依赖TensorFlow，你可以跳过Keras内置的compile()和fit()流程，直接用TensorFlow的R接口手动实现损失计算、梯度求解和权重更新，完全自定义训练逻辑。

示例框架：

library(keras)
library(tensorflow)
library(purrr)

# 1. 定义常规Keras模型结构
model <- keras_model_sequential() %>%
  layer_dense(units = 64, activation = "relu", input_shape = c(10)) %>%
  layer_dense(units = 1)

# 2. 写你的自定义损失函数（不用局限于Keras后端函数）
custom_loss <- function(y_true, y_pred) {
  # 这里可以写任意能处理Tensor对象的逻辑，比如复杂的非内置运算
  tf$reduce_mean(tf$abs(y_true - y_pred) + tf$math$log(tf$abs(y_pred) + 1))
}

# 3. 定义优化器和训练步骤
optimizer <- tf$keras$optimizers$Adam(learning_rate = 0.001)

train_step <- function(x, y) {
  with(tf$GradientTape() %as% tape, {
    y_pred <- model(x, training = TRUE)
    loss <- custom_loss(y, y_pred)
  })
  # 自动计算梯度（也可以手动替换成你推导的梯度公式）
  gradients <- tape$gradient(loss, model$trainable_variables)
  # 更新模型权重
  optimizer$apply_gradients(transpose(list(gradients, model$trainable_variables)))
  return(loss)
}

# 4. 手动执行训练循环
epochs <- 10
for (epoch in 1:epochs) {
  epoch_loss <- 0
  # 假设x_train、y_train是你的训练数据
  for (i in 1:nrow(x_train)) {
    x_batch <- tf$convert_to_tensor(x_train[i,,drop=FALSE], dtype = tf$float32)
    y_batch <- tf$convert_to_tensor(y_train[i,,drop=FALSE], dtype = tf$float32)
    batch_loss <- train_step(x_batch, y_batch)
    epoch_loss <- epoch_loss + as.numeric(batch_loss)
  }
  cat(sprintf("Epoch %d, Loss: %.4f\n", epoch, epoch_loss/nrow(x_train)))
}

替代方案2：子类化Keras模型重写训练步骤 #

如果想尽量贴合Keras的框架风格，可以通过子类化模型，重写train_step()方法，把自定义损失和梯度逻辑嵌入进去，这样还能正常使用fit()函数。

示例：

library(keras)
library(tensorflow)
library(purrr)

# 1. 子类化定义模型
CustomModel <- keras_model_custom(function(self) {
  self$dense1 <- layer_dense(units = 64, activation = "relu")
  self$dense2 <- layer_dense(units = 1)
  
  function(inputs, training = NULL) {
    inputs %>% self$dense1() %>% self$dense2()
  }
})

model <- CustomModel()

# 2. 自定义损失函数
custom_loss <- function(y_true, y_pred) {
  tf$reduce_mean(tf$square(y_true - y_pred) + tf$math$sqrt(tf$abs(y_pred)))
}

# 3. 重写train_step方法
model$train_step <- function(data) {
  x <- data[[1]]
  y <- data[[2]]
  
  with(tf$GradientTape() %as% tape, {
    y_pred <- self(x, training = TRUE)
    loss <- custom_loss(y, y_pred)
  })
  
  # 计算梯度（也可以替换成你手动推导的梯度）
  gradients <- tape$gradient(loss, self$trainable_variables)
  self$optimizer$apply_gradients(transpose(list(gradients, self$trainable_variables)))
  
  list(loss = loss)
}

# 4. 编译+训练（只需要指定优化器，损失已在train_step中定义）
model %>% compile(optimizer = tf$keras$optimizers$SGD(learning_rate = 0.01))
model %>% fit(x_train, y_train, epochs = 10, batch_size = 32)

替代方案3：尝试将损失转换为可微分的后端表达式 #

如果你的损失只是暂时没想到怎么用Keras后端函数表达，可以拆解逻辑：

• 用tf$math、tf$reduce_*等张量操作替代原生R运算
• 用tf$where()替代常规if-else，确保整个计算图可微分

比如把R的if(y_pred > 0) ... else ...改成tf$where(y_pred > 0, 分支1张量, 分支2张量)。

内容的提问来源于stack exchange，提问作者BestGirl