Stop Keras when fails to converge after a specified time

Question

I am using a straightforward application of the Keras API in R. Depending on the set.seed(value) value, sometimes it will converge and sometimes it won't. I assume because the seed sets the initially randomized weights. If it doesn't converge at first, I can usually get it to converge on a different run by changing the seed value, but I have to monitor/stop it manually. How can I stop Keras if the model hasn't converged after a specified time (e.g., stop it after 600 seconds and restart it with a different seed value).

  set.seed(42)
  x <- as.matrix(train_data)
  y <- as.matrix(train_targets)
  
  model = keras_model_sequential() %>%
    layer_dense(units=64, kernel_regularizer=regularizer_l2(0.001), activation="relu", input_shape=dim(train_data)[[2]]) %>%
    layer_dense(units=32, kernel_regularizer=regularizer_l2(0.001), activation = "relu") %>%
    layer_dense(units=1, activation="linear")
  
  model %>% compile(
    loss = "mse", 
    optimizer = "rmsprop",
    metrics = list("mae")
  )
  
  model %>% fit(x, y, epochs = 50,verbose = 0)

Answer 1

One option is to define a function that calls itself, perhaps performing an action like setting seed before doing so. Based on this SO post and borrowing an example from the keras guides that requires a few seconds to run.

library(keras)
d <- dataset_mnist()
x_train <- d$train$x
y_train <- d$train$y
x_test <- d$test$x
y_test <- d$test$y

x_train <- array_reshape(x_train, c(nrow(x_train), 784))
x_test <- array_reshape(x_test, c(nrow(x_test), 784))
x_train <- x_train / 255
x_test <- x_test / 255
y_train <- to_categorical(y_train, 10)
y_test <- to_categorical(y_test, 10)

model <- keras_model_sequential() 
model %>% 
  layer_dense(units = 256, activation = 'relu', input_shape = c(784)) %>% 
  layer_dropout(rate = 0.4) %>% 
  layer_dense(units = 128, activation = 'relu') %>%
  layer_dropout(rate = 0.3) %>%
  layer_dense(units = 10, activation = 'softmax')

model %>% compile(
  loss = 'categorical_crossentropy',
  optimizer = optimizer_rmsprop(),
  metrics = c('accuracy')
)

We can make a recursive function that calls itself after a time out.

timed_fit <- function(t = 5) {
  Sys.sleep(1)
  set.seed(t)
  message("seed set to ", t)
  setTimeLimit(cpu = t, elapsed = t, transient = TRUE)
  on.exit({setTimeLimit(cpu = Inf, elapsed = Inf, transient = FALSE)})
  tryCatch({
    model %>% fit(
      x_train, y_train, 
      epochs = 4, batch_size = 128, 
      validation_split = 0.2
    )
  }, error = function(e) {
    if (grepl("reached elapsed time limit|reached CPU time limit", e$message)) {
      message("\n timed out!\n") # or set another seed, continue
      timed_fit(t + 10)
    } else {
      # error not related to timeout
      stop(e)
    }
  })
}

timed_fit()

The Sys.sleep(1) is inserted to avoid errors not interrupting the process properly, despite showing up.