I would like to create a custom cost function with Keras in R, similar to the Python implementation here:
https://github.com/daynebatten/keras-wtte-rnn/blob/master/wtte-rnn.py
They develop a two parameter model where ab_pred are the parameters alpha and beta. The y_true tensor has time and event values.
def weibull_loglik_continuous(y_true, ab_pred, name=None):
y_ = y_true[:, 0]
u_ = y_true[:, 1]
a_ = ab_pred[:, 0]
b_ = ab_pred[:, 1]
ya = (y_ + 1e-35) / a_
return -1 * k.mean(u_ * (k.log(b_) + b_ * k.log(ya)) - k.pow(ya, b_))
" y_true is a (samples, 2) tensor containing time-to-event (y), and an event indicator (u) ab_pred is a (samples, 2) tensor containing predicted Weibull alpha (a) and beta (b) parameters For math, see https://ragulpr.github.io/assets/draft_master_thesis_martinsson_egil_wtte_rnn_2016.pdf (Page 35)"
I would instead like to implement a three parameter model with a custom likelihood function.
brier_loss <- function(y_true, y_pred)
{
age = y_true[1] # time data
event = y_true[2] # event data
param1 = y_pred[1]
param2 = y_pred[2]
param3 = y_pred[3]
# custom likelihood function to compute probability
prob = (((100*param1*(100/param3)^-((age/param2)^param1))*((age/param2)^param1)*log(100/param3))/age)/100
return(mean((event-prob)^2))
}
If I have some data
age <- c(24.4, 7.7, 11.4, 14.3, 8.2, 13.7, 11.5, 35.3, 8.4, 6.4, 12.5, 17.3, 28.4, 51.1, 19.6)
event <- c(1,0,0,1,1,1,0,1,0,0,1,0,0,1,0)
df <- as.data.frame(cbind(age, event))
train_targets <- cbind(df$age, df$event)
train_data <- df$age
In other words, I want the model to accept an age feature and output a 3 parameter model that minimizes the brier_loss() function.
library(kerasR)
library(keras)
model <- keras_model_sequential() %>%
layer_dense(units = 64, activation = "relu",
input_shape = dim(train_data)[[2]]) %>%
layer_dense(units = 32, activation = "relu") %>%
layer_dense(units = 3)
losses <- c(brier_loss)
# compile the model
model %>% compile(
optimizer = "rmsprop",
loss = losses[1],
metrics = c("mae")
)
Running this, I get the error Dimensions must be equal, but are 2 and 3 for '{{node python_function/truediv_1}} = RealDiv[T=DT_FLOAT](python_function/strided_slice, python_function/strided_slice_3)' with input shapes: [2], [3].