自定义单调损失函数多输出R keras

Question

对于多输出回归网络，我们通常知道输出之间的关系。对于我的例子，我知道每次观察的输出都是单调递增的，

# number of observations
N <- 1000

# synthetic multiple outputs
y1 <- rnorm(N,20,5) # smallest
y2 <- y1 + rnorm(N,7,2) # middle
y3 <- y2 + rnorm(N,7,2) # largest
Y <- data.frame(y1,y2,y3) # combine
Y <- Y * rexp(N,2) # randomly scale rows

当你从左向右移动时，Y的行单调增加（y1-y3）。行之间的关系并不重要。一个好的模型将了解到，对于每次观察，它应该产生从y1到y3增加的预测，因为在训练数据中总是如此。对于这个简单的例子和​​足够的时代，网络很好地学习了这一点。然而，在我的实际例子中，有3000个观测值，35个协变量和27个输出。真实数据集的模型并不总是产生单调输出。为了证明这个模型故意使这个模型违背预测中的单调性。

创建预测变量以及训练和测试集，

# synthetic nonlinear predictors
x1 <- (sqrt(y1) + rnorm(N,0,1))^2
x2 <- log10((x1 + y2)^3)
x3 <- sqrt(abs(y3-y2))
x4 <- sqrt((x1 + y2)^2)

X <- data.frame(x1,x2,x3,x4) %>% # combine
  mutate_all(funs(scale)) %>% # scale
  as.matrix() # to matrix

# create train and test set
set.seed(0)
ind <- sample(2, N, replace=T, prob=c(0.50, 0.50))

Xtrain <- X[ind==1,]
Ytrain <- Y[ind==1,]
Xtest <- X[ind==2,]
Ytest <- Y[ind==2,]

建立keras模型并故意配合，

library(keras)
library(tidyverse)

# add covariates
input <- layer_input(shape=dim(X)[2],name="covars")

# add hidden layers
base_model <- input  %>%
  layer_dense(units = 4, activation='relu') 

# add output 1 
yhat1 <- base_model %>% 
  layer_dense(units = 1, name="yhat1") 

# add output 2
yhat2 <- base_model %>% 
  layer_dense(units = 1, name="yhat2") 

# add output 3
yhat3 <- base_model %>% 
  layer_dense(units = 1, name="yhat3")

# caclulate squared weights for mse loss
weight_fun <- function(x){mean(Y$y1/x)}
weights <- as.numeric(apply(Y,2,weight_fun))^2

# build multi-output model
model <- keras_model(input,list(yhat1,yhat2,yhat3)) %>%
  compile(optimizer = "rmsprop",
          loss="mse",
          metrics="mae",
          loss_weights=weights)

# fit model (intentionally underfit)
model_fit <- model %>% 
  fit(x=Xtrain,
      y=list(Ytrain[,1],Ytrain[,2],Ytrain[,3]), 
      epochs=75, 
      batch_size = 25, 
      validation_split = 0.1, 
      verbose=0)

预测测试集并计算违规次数，

# predict values for test set
Yhat <- predict(model, Xtest) %>%
  data.frame() %>%
  setNames(colnames(Y))

# sum monotonic violations 
sum(apply(Yhat,1,function(x){sum(cummax(x)!=x)}))
sum(apply(Ytest,1,function(x){sum(cummax(x)!=x)}))

Yhat会有一些违规，Ytest会有0。我有兴趣通过修改的损失函数向输出添加约束。如果 k 是输出的数量， i 是观察的数量，而omega（w）是每个输出损失的权重矩阵，那么多输出损失是每个输出的各个MSE的加权平均值

写出单调损失的方法可能是，

对于每次观察，我们只是简单地总结了单调性被违反的次数。最后，我们可以将它们组合起来，

其中alpha是一个强制MSE和单调误差项在同一范围内的标量。损失函数（现在没有阿尔法权重）看起来像这样，

# custom loss function
loss_custom <- function(y_true, y_pred){
  val <- k_placeholder(dtype = 'float32')
  mse <- k_placeholder(dtype = 'float32')
  n <- k_placeholder(dtype = 'float32')
  k <- k_placeholder(dtype = 'float32')
  n <- k_shape(y_pred)[[1]]
  k <- k_shape(y_pred)[[2]]
  y_pred <- array_reshape(y_pred,dim=c(k,n))
  y_true <- array_reshape(y_true,dim=c(k,n))
  val <- k_sum(k_cast(k_less(y_pred[2:k]-y_pred[1:k-1],0),'float32'))
  mse <- k_mean(k_square(y_true-y_pred)) 
  return(mse + val)
}

但这导致了一些错误，其主要原因是我不了解y_pred中每个输出的预测是如何返回的。我的主要问题是（1）如何在训练时访问三个预测（2）以增加单调性约束？