R/fitnet_linear.R

In GerryLarios/combofitnets: The Best Combination of Hyperparameters to Create a Neural Network

#' @title Combinatios of hyperparameters to train neural networks with linear outputs
#'
#' @description Create a report and returns the best combination of hyperparameters to train a neural network.
#' @param data_main a data.frame that represents the sample
#' @param target a data.frame that represents the target of the sample
#' @param data_trn a data.frame that represents the train sample, if is not given is calculated from the data by 80%.
#' @param data_tst a data.frame that represents the testing sample, if is not given is calculated from the data by 20%.
#' @param combinations an list that represents the differents combinations to build the deeplearning network, if is not given is created by default.
#' @export
#' @keywords
#' @seealso
#' @return the report of the neural network.
#' @aliases
#' @examples

fitnet_linear <- function(
  data_main,
  target,
  output = "linear",
  combinations,
  data_trn,
  data_tst,
  data_vld
  ) {
  # take the samples
  if(missing(data_trn) || missing(data_tst) || missing(data_vld)) {
    samples <- create_data_samples(data_main)
    data_trn <- data_main[samples == 1, ]
    data_tst <- data_main[samples == 2, ]
    data_vld <- data_main[samples == 3, ]
  }

  # build combinations
  if(missing(combinations))
    combinations <- build_combinations()

  # instance the report data frame
  results <- data.frame()
  num_comb <- length(combinations$learning_rate)
  best_net <-list()

  current_mse <- 100

  for (i in 1:num_comb) {
    # append current hyperparameters
    id <- i
    learning_rate <- combinations$learning_rate[i]
    num_hidden <- combinations$num_hidden[i]
    num_neurons <- combinations$num_neurons[i]
    dropout_hidden <- combinations$dropout_hidden[i]

    # treaning net
    net <- nn.train(
      x = as.matrix(data_no_target(data_trn, target)),
      y = as.matrix(data_trn[target]),
      learningrate = learning_rate,
      hidden = rep.int(num_neurons, num_hidden),
      hidden_dropout = dropout_hidden,
      output = "linear"
    )

    #mse testing
    tst <- as.matrix(data_no_target(data_tst, target))
    tst_target <- as.matrix(data_tst[target])
    mse <- calculate_mse(nn.predict(net, tst), tst_target)

    # mse validate
    vld <- as.matrix(data_no_target(data_vld, target))
    vld_target <- as.matrix(data_vld[target])
    mse_validate <- calculate_mse(nn.predict(net, vld), vld_target)

    # change to best mse (testing)
    if(mse < current_mse) {
      best_net <- net
      current_mse <- mse
    }

    # Printe current results
    print(paste(toString(i)," - ", toString(mse)))
    # Make data frame report
    result <- data.frame(id, learning_rate, num_hidden, num_neurons, dropout_hidden, mse, mse_validate)
    results <- rbind(results, result)

  }

  # make csv report
  results <- sorting_result(results)
  create_table_results(results, name = toString(paste("report", output, sep = "_")))

  # make validation of the best net
  vld <- as.matrix(data_no_target(data_vld, target))
  vld_target <- as.matrix(data_vld[target])
  mse_vld <- calculate_mse(nn.predict(best_net, vld), vld_target)

  # print best net
  print("BEST NET")
  print(paste("VALIDATE - MSE: ", toString(mse_vld)))

  return(results)
}