Define a new loss function in Keras (R environment)

[SongchaoChen]

Dear all,

Recently, I noticed the quantile regression in Keras (Python), which applies a quantile regression loss function as bellow.

import keras.backend as K
def tilted_loss(q,y,f):
    e = (y-f)
    return K.mean(K.maximum(q*e, (q-1)*e), axis=-1)

quantile = 0.5
model.compile(loss=lambda y,f: tilted_loss(quantile,y,f), optimizer='adagrad')

I wonder whether I can define this kind of loss function in R when using Keras?
Many thanks for your suggestions in advance.

Best regards,
Songchao

[skeydan]

Yes, in the same way. Let us know when you run into problems :-)

[skeydan]

Hi, thought I'd elaborate on this because of the axis= thing which often causes confusion (not just in R, see loss function related issues in Python keras).

The keras loss functions, even though some documents may indicate otherwise, should perform averaging not over the batch, but the feature dimension (that's why in Python code, it says axis=-1 , meaning the last axis). (It seems like keras takes care of averaging over the batch internally.)

In R, using the k_ functions which start indexing from 1, this means we need axis=2.
Below is a complete example that predicts a target of 2 columns from an input of 2 columns, which allows to test the above statements (in contrast to regressing just a single output).

Also in the example I've added a way to test the custom loss function using k_get_sessionand sess$run(my_loss_function) on dummy tensors.

Finally, as an additional check I'm having keras indicate the mean_absolute_error metric that (correctly, it seems to me, from the formula) is 2 times the custom loss.

quantile <- 0.5
tilted_loss <- function(q, y, f) {
  e <- y - f
  k_mean(k_maximum(q * e, (q - 1) * e), axis = 2)
}

sess <- k_get_session()
ys <- k_constant(c(1,2,3,4), shape = c(2,2))
yhats <- k_constant(c(1,3,3,4), shape = c(2,2))
sess$run(tilted_loss(quantile, ys, yhats))

x_train <-
  iris[1:120, c("Petal.Length", "Sepal.Length")] %>% as.matrix()
y_train <-
  iris[1:120, c("Petal.Width", "Sepal.Width")] %>% as.matrix()
x_test <-
  iris[121:150, c("Petal.Length", "Sepal.Length")] %>% as.matrix()
y_test <-
  iris[121:150, c("Petal.Width", "Sepal.Width")] %>% as.matrix()

model <- keras_model_sequential()
model %>%
  layer_dense(units = 32, input_shape = 2) %>%
  layer_activation_leaky_relu() %>%
  layer_dropout(rate = 0.2) %>%
  layer_dense(units = 2)

model %>% compile(
  optimizer = "adam",
  loss = function(y_true, y_pred)
    tilted_loss(quantile, y_true, y_pred),
  metrics = "mae"
)

history <-
  model %>% fit(x_train,
                y_train,
                batch_size = 10,
                epochs = 120)

plot(history) 

[SongchaoChen]

Hi Sigrid, many thanks for your detailed descriptions and suggestions. It does work on my laptop. Thanks for your help again.
Best regards,
Songchao

[csetzkorn]

Just curious, using this approach you would have to train a model for every quantile, thus having the potential danger of quantile crossing?!