# Original work Copyright (c) 2016 Microsoft Corporation. All rights reserved.
# Modified work Copyright (c) 2020 - 2026 Fabio Sigrist. All rights reserved.
# Licensed under the Apache License Version 2.0 See LICENSE file in the project root for license information.

#' @importFrom R6 R6Class
Booster <- R6::R6Class(
  # Class for boosting model in GPBoost
  # Authors: Authors of the LightGBM R package, Fabio Sigrist
  classname = c("gpb.Booster","lgb.Booster"),
  cloneable = FALSE,
  public = list(
    
    best_iter = -1L,
    best_score = NA_real_,
    params = list(),
    record_evals = list(),
    
    # Initialize will create a starter booster
    initialize = function(params = list(),
                          train_set = NULL,
                          modelfile = NULL,
                          model_str = NULL,
                          gp_model = NULL,
                          ...) {
      
      # Create parameters and handle
      params <- append(params, list(...))
      handle <- NULL
      
      if (!is.null(gp_model)) { # has gp_model
        # Check if gp_model is gpb.Dataset or not
        if (!gpb.check.r6.class(gp_model, "GPModel")) {
          stop("gpb.Booster: Can only use GPModel as gp_model")
        }
        
        if (is.null(train_set)) {
          stop("gpb.Booster: You need to provide a training dataset ('train_set') for the GPBoost 
               algorithm. Boosting from a a file or a string is currently not supported.")
        }
        
      }
      
      # Create a handle for the dataset
      # Note: this was previously in a try({}) statement
      
      # Check if training dataset is not null
      if (!is.null(train_set)) {
        # Check if training dataset is gpb.Dataset or not
        if (!gpb.check.r6.class(object = train_set, name = "gpb.Dataset")) {
          stop("gpb.Booster: Can only use gpb.Dataset as training data")
        }
        train_set_handle <- train_set$.__enclos_env__$private$get_handle()
        params <- modifyList(params, train_set$get_params())
        params_str <- gpb.params2str(params = params)
        
        if (!is.null(gp_model)) { # has gp_model
          
          train_set$construct()
          
          if (gp_model$get_num_data() != train_set$dim()[1]) {
            stop("gpb.Booster: Number of data points in gp_model and train_set are not equal")
          }
          
          private$has_gp_model <- TRUE
          private$gp_model <- gp_model
          # Store booster handle
          handle <- .Call(
            LGBM_GPBoosterCreate_R
            , train_set_handle
            , params_str
            , gp_model$.__enclos_env__$private$get_handle()
          )
          
        } else { # No gp_model
          # Store booster handle
          handle <- .Call(
            LGBM_BoosterCreate_R
            , train_set_handle
            , params_str
          )
        }
        
        # Create private booster information
        private$train_set <- train_set
        private$train_set_version <- train_set$.__enclos_env__$private$version
        private$num_dataset <- 1L
        private$init_predictor <- train_set$.__enclos_env__$private$predictor
        
        # Check if predictor is existing
        if (!is.null(private$init_predictor)) {
          
          # Merge booster
          .Call(
            LGBM_BoosterMerge_R
            , handle
            , private$init_predictor$.__enclos_env__$private$handle
          )
          
        }
        
        # Check current iteration
        private$is_predicted_cur_iter <- c(private$is_predicted_cur_iter, FALSE)
        
      } else if (!is.null(modelfile)) {
        
        # Do we have a model file as character?
        if (!is.character(modelfile)) {
          stop("gpb.Booster: Can only use a string as model file path")
        }
        
        ## Does it have a gp_model?
        con <- file(modelfile)
        has_gp_model <- read.table(con,skip=1,nrow=1)
        if (paste0(as.vector(has_gp_model),collapse = "")=="has_gp_model:1,") {
          
          private$has_gp_model = TRUE
          save_data = RJSONIO::fromJSON(content=modelfile)
          # Create booster from string
          handle <- .Call(
            LGBM_BoosterLoadModelFromString_R
            , save_data[["booster_str"]]
          )
          if (!is.null(save_data[["raw_data"]])) {
            
            private$train_set <- gpb.Dataset(
              data = matrix(unlist(save_data[["raw_data"]]$data),
                            nrow = length(save_data[["raw_data"]]$data),
                            byrow = TRUE),
              label = save_data[["raw_data"]]$label)
            save_data[["gp_model_str"]][["y"]] <- save_data[["raw_data"]]$label
            
          } else {
            
            if (save_data[["gp_model_str"]][["likelihood"]] == "gaussian" & 
                save_data[["gp_model_str"]][["gp_approx"]] != "vecchia_latent") {
              private$residual_loaded_from_file <- save_data[["residual"]]
              save_data[["gp_model_str"]][["y"]] <- save_data[["residual"]]
            } else {
              private$fixed_effect_train_loaded_from_file <- save_data[["fixed_effect_train"]]
              private$label_loaded_from_file <- save_data[["label"]]
              save_data[["gp_model_str"]][["offset"]] <- save_data[["fixed_effect_train"]]
              save_data[["gp_model_str"]][["y"]] <- save_data[["label"]]
            }
            private$gp_model_prediction_data_loaded_from_file <- TRUE
          }
          private$gp_model <- gpb.GPModel$new(model_list = save_data[["gp_model_str"]])
          private$gp_model$.__enclos_env__$private$model_fitted <- FALSE
          
        } else { # has no gp_model
          
          # Create booster from model
          handle <- .Call(
            LGBM_BoosterCreateFromModelfile_R
            , modelfile
          )
          
        }
        
      } else if (!is.null(model_str)) {
        # Create booster from string
        
        # Do we have a model_str as character?
        if (!is.character(model_str)) {
          stop("gpb.Booster: Can only use a string as model_str")
        }
        
        if (substr(model_str, 20, 20) == "1") {
          # has gp_model
          
          private$has_gp_model = TRUE
          save_data = RJSONIO::fromJSON(content = model_str)
          # Create booster from string
          handle <- .Call(
            LGBM_BoosterLoadModelFromString_R
            , save_data[["booster_str"]]
          )
          if (!is.null(save_data[["raw_data"]])) {
            
            private$train_set <- gpb.Dataset(
              data = matrix(unlist(save_data[["raw_data"]]$data),
                            nrow = length(save_data[["raw_data"]]$data),
                            byrow = TRUE),
              label = save_data[["raw_data"]]$label)
            save_data[["gp_model_str"]][["y"]] <- save_data[["raw_data"]]$label
            
          } else {
            
            if (save_data[["gp_model_str"]][["likelihood"]] == "gaussian" & 
                save_data[["gp_model_str"]][["gp_approx"]] != "vecchia_latent") {
              private$residual_loaded_from_file <- save_data[["residual"]]
              save_data[["gp_model_str"]][["y"]] <- save_data[["residual"]]
            } else {
              private$fixed_effect_train_loaded_from_file <- save_data[["fixed_effect_train"]]
              private$label_loaded_from_file <- save_data[["label"]]
              save_data[["gp_model_str"]][["offset"]] <- save_data[["fixed_effect_train"]]
              save_data[["gp_model_str"]][["y"]] <- save_data[["label"]]
            }
            private$gp_model_prediction_data_loaded_from_file <- TRUE
          }
          private$gp_model <- gpb.GPModel$new(model_list = save_data[["gp_model_str"]])
          private$gp_model$.__enclos_env__$private$model_fitted <- FALSE
          
        } else { # has no gp_model
          
          handle <- .Call(
            LGBM_BoosterLoadModelFromString_R
            , model_str
          )
        }
        
      } else {
        
        # Booster non existent
        stop(
          "gpb.Booster: Need at least either training dataset, "
          , "model file, or model_str to create booster instance"
        )
        
      }
      
      # Check whether the handle was created properly if it was not stopped earlier by a stop call
      if (isTRUE(gpb.is.null.handle(x = handle))) {
        
        stop("gpb.Booster: cannot create Booster handle")
        
      } else {
        
        # Create class
        class(handle) <- "gpb.Booster.handle"
        private$handle <- handle
        private$num_class <- 1L
        .Call(
          LGBM_BoosterGetNumClasses_R
          , private$handle
          , private$num_class
        )
        
      }
      
      self$params <- params
      
      if (!is.null(self$params[["objective"]])) {
        if (self$params[["objective"]] %in% c("mean_scale_regression", "gaussian_heteroscedastic")) {
          private$is_mean_scale_regression <- TRUE
        }
      }
      
      return(invisible(NULL))
      
    },
    
    # Set training data name
    set_train_data_name = function(name) {
      
      # Set name
      private$name_train_set <- name
      return(invisible(self))
      
    },
    
    # Add validation data
    add_valid = function(data, name, valid_set_gp = NULL, use_gp_model_for_validation = TRUE) {
      
      # Check if data is gpb.Dataset
      if (!gpb.check.r6.class(object = data, name = "gpb.Dataset")) {
        stop("gpb.Booster.add_valid: Can only use gpb.Dataset as validation data")
      }
      
      # Check if predictors are identical
      if (!identical(data$.__enclos_env__$private$predictor, private$init_predictor)) {
        stop(
          "gpb.Booster.add_valid: Failed to add validation data; "
          , "you should use the same predictor for these data"
        )
      }
      
      # Check if names are character
      if (!is.character(name)) {
        stop("gpb.Booster.add_valid: Can only use characters as data name")
      }
      
      # Add validation data to booster
      .Call(
        LGBM_BoosterAddValidData_R
        , private$handle
        , data$.__enclos_env__$private$get_handle()
      )
      
      # Store private information
      private$valid_sets <- c(private$valid_sets, data)
      private$name_valid_sets <- c(private$name_valid_sets, name)
      private$num_dataset <- private$num_dataset + 1L
      private$is_predicted_cur_iter <- c(private$is_predicted_cur_iter, FALSE)
      
      # Note: Validation using the GP model is only done in R if there are custom evaluation functions in feval, 
      #        otherwise it is directly done in C++. See the function Eval() in regression_metric.hpp
      if (private$has_gp_model) {
        
        private$use_gp_model_for_validation <- use_gp_model_for_validation
        
        if (use_gp_model_for_validation) {
          
          if (!is.null(valid_set_gp)) {
            if (!is.list(valid_set_gp)) {
              stop("gpb.Booster.add_valid: Can only use lists as valid_set_gp")
            }
            private$valid_sets_gp <- append(private$valid_sets_gp, list(valid_set_gp))
          }
          
        }
        
      } else {
        private$use_gp_model_for_validation <- FALSE
      }
      
      return(invisible(self))
      
    },
    
    # Reset parameters of booster
    reset_parameter = function(params, ...) {
      
      if (methods::is(self$params, "list")) {
        params <- modifyList(self$params, params)
      }
      
      params <- modifyList(params, list(...))
      params_str <- gpb.params2str(params = params)
      .Call(
        LGBM_BoosterResetParameter_R
        , private$handle
        , params_str
      )
      self$params <- params
      
      return(invisible(self))
      
    },
    
    # Perform boosting update iteration
    update = function(train_set = NULL, fobj = NULL) {
      
      if (is.null(train_set)) {
        if (private$train_set$.__enclos_env__$private$version != private$train_set_version) {
          train_set <- private$train_set
        }
      }
      
      # Check if training set is not null
      if (!is.null(train_set)) {
        
        # Check if training set is gpb.Dataset
        if (!gpb.check.r6.class(object = train_set, name = "gpb.Dataset")) {
          stop("gpb.Booster.update: Only can use gpb.Dataset as training data")
        }
        
        # Check if predictors are identical
        if (!identical(train_set$predictor, private$init_predictor)) {
          stop("gpb.Booster.update: Change train_set failed, you should use the same predictor for these data")
        }
        
        # Reset training data on booster
        .Call(
          LGBM_BoosterResetTrainingData_R
          , private$handle
          , train_set$.__enclos_env__$private$get_handle()
        )
        
        # Store private train set
        private$train_set <- train_set
        private$train_set_version <- train_set$.__enclos_env__$private$version
        
      }
      
      # Check if objective is empty
      if (is.null(fobj)) {
        if (private$set_objective_to_none) {
          stop("gpb.Booster.update: cannot update due to null objective function")
        }
        # Boost iteration from known objective
        .Call(
          LGBM_BoosterUpdateOneIter_R
          , private$handle
        )
        
      } else {
        
        # Check if objective is function
        if (!is.function(fobj)) {
          stop("gpb.Booster.update: fobj should be a function")
        }
        if (!private$set_objective_to_none) {
          self$reset_parameter(params = list(objective = "none"))
          private$set_objective_to_none <- TRUE
        }
        # Perform objective calculation
        gpair <- fobj(private$inner_predict(1L), private$train_set)
        
        # Check for gradient and hessian as list
        if (is.null(gpair$grad) || is.null(gpair$hess)) {
          stop("gpb.Booster.update: custom objective should
            return a list with attributes (hess, grad)")
        }
        
        # Return custom boosting gradient/hessian
        .Call(
          LGBM_BoosterUpdateOneIterCustom_R
          , private$handle
          , gpair$grad
          , gpair$hess
          , length(gpair$grad)
        )
        
      }
      
      # Loop through each iteration
      for (i in seq_along(private$is_predicted_cur_iter)) {
        private$is_predicted_cur_iter[[i]] <- FALSE
      }
      
      return(invisible(self))
      
    },
    
    # Return one iteration behind
    rollback_one_iter = function() {
      
      # Return one iteration behind
      .Call(
        LGBM_BoosterRollbackOneIter_R
        , private$handle
      )
      
      # Loop through each iteration
      for (i in seq_along(private$is_predicted_cur_iter)) {
        private$is_predicted_cur_iter[[i]] <- FALSE
      }
      
      return(invisible(self))
      
    },
    
    # Get current iteration
    current_iter = function() {
      
      cur_iter <- 0L
      .Call(
        LGBM_BoosterGetCurrentIteration_R
        , private$handle
        , cur_iter
      )
      return(cur_iter)
      
    },
    
    # Get upper bound
    upper_bound = function() {
      
      upper_bound <- 0.0
      .Call(
        LGBM_BoosterGetUpperBoundValue_R
        , private$handle
        , upper_bound
      )
      return(upper_bound)
      
    },
    
    # Get lower bound
    lower_bound = function() {
      
      lower_bound <- 0.0
      .Call(
        LGBM_BoosterGetLowerBoundValue_R
        , private$handle
        , lower_bound
      )
      return(lower_bound)
      
    },
    
    # Evaluate data on metrics
    eval = function(data, name, feval = NULL) {
      
      # Check if dataset is gpb.Dataset
      if (!gpb.check.r6.class(object = data, name = "gpb.Dataset")) {
        stop("gpb.Booster.eval: Can only use gpb.Dataset to eval")
      }
      
      # Check for identical data
      data_idx <- 0L
      if (identical(data, private$train_set)) {
        data_idx <- 1L
      } else {
        
        # Check for validation data
        if (length(private$valid_sets) > 0L) {
          
          # Loop through each validation set
          for (i in seq_along(private$valid_sets)) {
            
            # Check for identical validation data with training data
            if (identical(data, private$valid_sets[[i]])) {
              
              # Found identical data, skip
              data_idx <- i + 1L
              break
              
            }
            
          }
          
        }
        
      }
      
      # Check if evaluation was not done
      if (data_idx == 0L) {
        
        # Add validation data by name
        self$add_valid(data, name)
        data_idx <- private$num_dataset
        
      }
      
      # Evaluate data
      return(
        private$inner_eval(
          data_name = name
          , data_idx = data_idx
          , feval = feval
        )
      )
      
    },
    
    # Evaluation training data
    eval_train = function(feval = NULL) {
      return(private$inner_eval(private$name_train_set, 1L, feval))
    },
    
    # Evaluation validation data
    eval_valid = function(feval = NULL) {
      
      # Create ret list
      ret <- list()
      
      # Check if validation is empty
      if (length(private$valid_sets) <= 0L) {
        return(ret)
      }
      
      # Loop through each validation set
      for (i in seq_along(private$valid_sets)) {
        ret <- append(
          x = ret
          , values = private$inner_eval(private$name_valid_sets[[i]], i + 1L, feval)
        )
      }
      
      return(ret)
      
    },
    
    # Save model
    save_model = function(filename, start_iteration = NULL, num_iteration = NULL,
                          feature_importance_type = 0L, save_raw_data = FALSE, ...) {
      
      # Check if number of iteration is non existent
      if (is.null(num_iteration)) {
        num_iteration <- self$best_iter
      }
      # Check if start iteration is non existent
      if (is.null(start_iteration)) {
        start_iteration <- 0L
      }
      
      # Save gp_model
      if (private$has_gp_model) {
        
        model_str <- self$save_model_to_string(start_iteration = start_iteration,
                                               num_iteration = num_iteration, 
                                               feature_importance_type = feature_importance_type,
                                               save_raw_data = save_raw_data)
        write(model_str, file=filename)
        
        
      } else {# has no gp_model
        
        # Save booster model
        .Call(
          LGBM_BoosterSaveModel_R
          , private$handle
          , as.integer(num_iteration)
          , as.integer(feature_importance_type)
          , filename
        )
      }
      
      return(invisible(self))
    },
    
    # Save model to string
    save_model_to_string = function(start_iteration = NULL, num_iteration = NULL,
                                    feature_importance_type = 0L, save_raw_data = FALSE, ...) {
      
      # Check if number of iteration is non existent
      if (is.null(num_iteration)) {
        num_iteration <- self$best_iter
      }
      # Check if start iteration is non existent
      if (is.null(start_iteration)) {
        start_iteration <- 0L
      }
      
      bst_model_str <- .Call(
        LGBM_BoosterSaveModelToString_R
        , private$handle
        , as.integer(start_iteration)
        , as.integer(num_iteration)
        , as.integer(feature_importance_type)
      )
      
      if (private$has_gp_model) {
        
        if (is.null(private$train_set$.__enclos_env__$private$raw_data)) {
          stop("Cannot save to file or string when " , sQuote("free_raw_data = TRUE"), ".",
               " Set ", sQuote("free_raw_data = FALSE"), " when you construct the gpb.Dataset")
        }
        save_data <- list()
        save_data[["has_gp_model"]] <- 1L
        save_data[["booster_str"]] <- bst_model_str
        save_data[["gp_model_str"]] <- private$gp_model$model_to_list(include_response_data = FALSE)
        
        if (save_raw_data) {
          
          save_data[["raw_data"]] <- list()
          save_data[["raw_data"]][["label"]] <- as.vector(private$train_set$.__enclos_env__$private$info$label)
          save_data[["raw_data"]][["data"]] <- private$train_set$.__enclos_env__$private$raw_data
          if (is.matrix(save_data[["raw_data"]][["data"]])) {
            if (dim(save_data[["raw_data"]][["data"]])[2] == 1) {
              save_data[["raw_data"]][["data"]] <- as.vector(save_data[["raw_data"]][["data"]])
            }
          }
          
        } else {# do not save raw_data
          
          predictor <- Predictor$new(private$handle, ...)
          fixed_effect_train = predictor$predict( data = private$train_set$.__enclos_env__$private$raw_data
                                                  , start_iteration = start_iteration
                                                  , num_iteration = num_iteration
                                                  , rawscore = TRUE
                                                  , predleaf = FALSE
                                                  , predcontrib = FALSE
                                                  , header = header
                                                  , reshape = FALSE )
          if (private$gp_model$get_likelihood_name() == "gaussian" & 
              private$gp_model$.__enclos_env__$private$gp_approx != "vecchia_latent") {
            residual = private$train_set$.__enclos_env__$private$info$label - fixed_effect_train
            save_data[["residual"]] <- as.vector(residual)
          } else {
            save_data[["fixed_effect_train"]] <- as.vector(fixed_effect_train)
            save_data[["label"]] <- as.vector(private$train_set$.__enclos_env__$private$info$label)
          }
          
        }# end !save_raw_data
        
        model_str <- RJSONIO::toJSON(save_data, digits=17)
        
      } else {# has no gp_model
        
        model_str <- bst_model_str
        
      }
      
      return(model_str)
      
    },
    
    # Dump model in memory
    dump_model = function(num_iteration = NULL, feature_importance_type = 0L) {
      
      # Check if number of iteration is non existent
      if (is.null(num_iteration)) {
        num_iteration <- self$best_iter
      }
      
      model_str <- .Call(
        LGBM_BoosterDumpModel_R
        , private$handle
        , as.integer(num_iteration)
        , as.integer(feature_importance_type)
      )
      
      return(model_str)
      
    },
    
    # Predict on new data
    predict = function(data,
                       start_iteration = NULL,
                       num_iteration = NULL,
                       pred_latent = FALSE,
                       predleaf = FALSE,
                       predcontrib = FALSE,
                       header = FALSE,
                       reshape = FALSE,
                       group_data_pred = NULL,
                       group_rand_coef_data_pred = NULL,
                       gp_coords_pred = NULL,
                       gp_rand_coef_data_pred = NULL,
                       cluster_ids_pred = NULL,
                       predict_cov_mat = FALSE,
                       predict_var = FALSE,
                       sample_posterior = FALSE,
                       sample_prior = FALSE,
                       num_post_samples = 100,
                       num_prior_samples = 100,
                       cov_pars = NULL,
                       offset_pred = NULL,
                       ignore_gp_model = FALSE,
                       rawscore = NULL,
                       vecchia_pred_type = NULL,
                       num_neighbors_pred = NULL,
                       type = NULL,
                       ...) {
      
      if (!is.null(type)) {
        if (type != "contrib") stop("only type = 'contrib' is currently supported ")
        predcontrib = TRUE
      }
      if (!is.null(rawscore)) {
        stop("predict: The argument 'raw_score' is discontinued. 
             Use the renamed equivalent argument 'pred_latent' instead")
      }
      if (!is.null(vecchia_pred_type)) {
        stop("predict: The argument 'vecchia_pred_type' is discontinued. 
             Use the function 'set_prediction_data' to specify this")
      }
      if (!is.null(num_neighbors_pred)) {
        stop("predict: The argument 'num_neighbors_pred' is discontinued. 
             Use the function 'set_prediction_data' to specify this")
      }
      
      # Check if number of iteration is non existent
      if (is.null(num_iteration)) {
        num_iteration <- self$best_iter
      }
      # Check if start iteration is non existent
      if (is.null(start_iteration)) {
        start_iteration <- 0L
      }
      
      # Predict on new data
      params <- list(...)
      predictor <- Predictor$new(
        modelfile = private$handle
        , params = params
      )
      
      if (private$has_gp_model & !predcontrib & !ignore_gp_model) {
        
        if (is.null(private$train_set$.__enclos_env__$private$raw_data) & 
            !private$gp_model_prediction_data_loaded_from_file) {
          stop("predict: cannot make predictions for random effects.
                Set ", sQuote("free_raw_data = FALSE"), " when you construct the gpb.Dataset")
        } else if (is.null(private$train_set$.__enclos_env__$private$raw_data) & 
                   private$gp_model_prediction_data_loaded_from_file) {
          if (start_iteration != 0L) {
            stop("predict: cannot use the option ", sQuote("start_iteration")," after loading 
                 from file without raw data. Set ", sQuote("save_raw_data = TRUE"), " when you save the model")
          }
        }
        
        random_effect_mean <- NA
        pred_var_cov <- NA
        response_mean <- NA
        response_var <- NA
        posterior_samples <- NA
        prior_samples <- NA
        
        if(private$gp_model$get_likelihood_name() == "gaussian" & 
           private$gp_model$.__enclos_env__$private$gp_approx != "vecchia_latent"){
          
          # Either use raw_data or data loaded from file for determining residual
          if (private$gp_model_prediction_data_loaded_from_file & 
              is.null(private$train_set$.__enclos_env__$private$raw_data)) {
            # Do not use raw_data but saved residual
            residual = private$residual_loaded_from_file
          } else {
            # Use raw_data
            fixed_effect_train = predictor$predict( data = private$train_set$.__enclos_env__$private$raw_data
                                                    , start_iteration = start_iteration
                                                    , num_iteration = num_iteration
                                                    , rawscore = TRUE
                                                    , predleaf = FALSE
                                                    , predcontrib = FALSE
                                                    , header = header
                                                    , reshape = FALSE )
            residual = private$train_set$.__enclos_env__$private$info$label - fixed_effect_train
          }
          
          # Note: we need to provide the response variable y as this was not saved
          #   in the gp_model ("in C++") for Gaussian data but was overwritten during training
          random_effect_pred = private$gp_model$predict( y = residual
                                                         , group_data_pred = group_data_pred
                                                         , group_rand_coef_data_pred = group_rand_coef_data_pred
                                                         , gp_coords_pred = gp_coords_pred
                                                         , gp_rand_coef_data_pred = gp_rand_coef_data_pred
                                                         , cluster_ids_pred = cluster_ids_pred
                                                         , predict_cov_mat = predict_cov_mat
                                                         , predict_var = predict_var
                                                         , sample_posterior = sample_posterior
                                                         , sample_prior = sample_prior
                                                         , num_post_samples = num_post_samples
                                                         , num_prior_samples = num_prior_samples
                                                         , cov_pars = cov_pars
                                                         , X_pred = NULL
                                                         , predict_response = !pred_latent )
          fixed_effect = predictor$predict( data = data
                                            , start_iteration = start_iteration
                                            , num_iteration = num_iteration
                                            , rawscore = TRUE
                                            , predleaf = FALSE
                                            , predcontrib = FALSE
                                            , header = header
                                            , reshape = FALSE )
          
          if (length(fixed_effect) != length(random_effect_pred$mu)){
            warning("Number of data points in fixed effect (tree ensemble) and random effect are not equal")
          }
          
          if (!is.null(offset_pred)) {
            if (length(fixed_effect) != length(offset_pred)){
              stop("Number of data points in fixed effect (tree ensemble) and 'offset_pred' are not equal")
            }
            fixed_effect <- fixed_effect + offset_pred
          }
          
          if (pred_latent) {
            random_effect_mean <- random_effect_pred$mu
            if(predict_cov_mat){
              pred_var_cov <- random_effect_pred$cov
            } else if(predict_var){
              pred_var_cov <- random_effect_pred$var
            }
            if (sample_posterior) {
              posterior_samples <- random_effect_pred$posterior_samples
            }
            if (sample_prior) {
              prior_samples <- random_effect_pred$prior_samples
            }
          } 
          else {
            response_mean <- random_effect_pred$mu + fixed_effect
            if(predict_cov_mat){
              response_var <- random_effect_pred$cov
            } else if(predict_var){
              response_var <- random_effect_pred$var
            }
            if (sample_posterior) {
              posterior_samples <- random_effect_pred$posterior_samples + fixed_effect
            }
            if (sample_prior) {
              prior_samples <- random_effect_pred$prior_samples #+ fixed_effect
            }
            fixed_effect <- NULL
          }
          
        }# end Gaussian likelihood
        else{# non-Gaussian likelihood
          
          y <- NULL
          # Either use raw_data or data loaded from file for determining fixed_effect_train
          if (private$gp_model_prediction_data_loaded_from_file & 
              is.null(private$train_set$.__enclos_env__$private$raw_data)) {
            # Do not use raw_data but used saved fixed_effect_train and label
            fixed_effect_train = private$fixed_effect_train_loaded_from_file
            y <- private$label_loaded_from_file
          } else {
            # Use raw_data
            fixed_effect_train = predictor$predict( data = private$train_set$.__enclos_env__$private$raw_data
                                                    , start_iteration = start_iteration
                                                    , num_iteration = num_iteration
                                                    , rawscore = TRUE
                                                    , predleaf = FALSE
                                                    , predcontrib = FALSE
                                                    , header = header
                                                    , reshape = FALSE )
            if (private$gp_model$.__enclos_env__$private$model_has_been_loaded_from_saved_file){
              # The label is never saved in the gp_model, so we need to provide it to the predict function when the model as loaded from file
              y <- private$train_set$.__enclos_env__$private$info$label
            }
          }
          
          fixed_effect = predictor$predict( data = data
                                            , start_iteration = start_iteration
                                            , num_iteration = num_iteration
                                            , rawscore = TRUE
                                            , predleaf = FALSE
                                            , predcontrib = FALSE
                                            , header = header
                                            , reshape = FALSE )
          
          if (!is.null(offset_pred)) {
            if (length(fixed_effect) != length(offset_pred)){
              stop("Number of data points in fixed effect (tree ensemble) and 'offset_pred' are not equal")
            }
            fixed_effect <- fixed_effect + offset_pred
          }

          if (private$gp_model$.__enclos_env__$private$num_sets_fe == 2) {
            nt <- length(fixed_effect_train) / 2
            fixed_effect_train <- fixed_effect_train[c((1:nt)*2 - 1, (1:nt)*2)]
          }
          
          if (pred_latent) {
            
            if (private$gp_model$.__enclos_env__$private$num_sets_fe == 2) {
              np <- length(fixed_effect) / 2
              fixed_effect <- fixed_effect[(1:np)*2 - 1] # take only predictions for mean
            }
            
            # Note: we don't need to provide the response variable y as this is saved
            #   in the gp_model ("in C++") for non-Gaussian data. y is only not NULL when
            #   the model was loaded from a file
            random_effect_pred = private$gp_model$predict( group_data_pred = group_data_pred
                                                          , group_rand_coef_data_pred = group_rand_coef_data_pred
                                                          , gp_coords_pred = gp_coords_pred
                                                          , gp_rand_coef_data_pred = gp_rand_coef_data_pred
                                                          , cluster_ids_pred = cluster_ids_pred
                                                          , predict_cov_mat = predict_cov_mat
                                                          , predict_var = predict_var
                                                          , sample_posterior = sample_posterior
                                                          , sample_prior = sample_prior
                                                          , num_post_samples = num_post_samples
                                                          , num_prior_samples = num_prior_samples
                                                          , cov_pars = cov_pars
                                                          , X_pred = NULL
                                                          , predict_response = FALSE
                                                          , offset = fixed_effect_train
                                                          , y = y )
            
            if (length(fixed_effect) != length(random_effect_pred$mu)){
              warning("Number of data points in fixed effect (tree ensemble) and random effect are not equal")
            }

            random_effect_mean <- random_effect_pred$mu
            if(predict_cov_mat){
              pred_var_cov <- random_effect_pred$cov
            } else if(predict_var){
              pred_var_cov <- random_effect_pred$var
            }
            if (sample_posterior) {
              posterior_samples <- random_effect_pred$posterior_samples
            }
            if (sample_prior) {
              prior_samples <- random_effect_pred$prior_samples
            }
            
          }# end pred_latent
          else {# predict response variable for non-Gaussian data
            if (private$gp_model$.__enclos_env__$private$num_sets_fe == 2) {
              np <- length(fixed_effect) / 2
              fixed_effect <- fixed_effect[c((1:np)*2 - 1, (1:np)*2)] # fixed effects predictions for mean and variance
            }
            pred_resp <- private$gp_model$predict( group_data_pred = group_data_pred
                                                  , group_rand_coef_data_pred = group_rand_coef_data_pred
                                                  , gp_coords_pred = gp_coords_pred
                                                  , gp_rand_coef_data_pred = gp_rand_coef_data_pred
                                                  , cluster_ids_pred = cluster_ids_pred
                                                  , predict_cov_mat = predict_cov_mat
                                                  , predict_var = predict_var
                                                  , sample_posterior = sample_posterior
                                                  , sample_prior = sample_prior
                                                  , num_post_samples = num_post_samples
                                                  , num_prior_samples = num_prior_samples
                                                  , cov_pars = cov_pars
                                                  , X_pred = NULL
                                                  , predict_response = TRUE
                                                  , offset = fixed_effect_train
                                                  , offset_pred = fixed_effect
                                                  , y = y )
            
            response_mean <-  pred_resp$mu
            response_var <-  pred_resp$var
            fixed_effect <- NA
            if (sample_posterior) {
              posterior_samples <- random_effect_pred$posterior_samples
            }
            if (sample_prior) {
              prior_samples <- random_effect_pred$prior_samples
            }
            
          }# end not pred_latent
          
        }# end non-Gaussian data
        
        return(list(fixed_effect = fixed_effect,
                    random_effect_mean = random_effect_mean,
                    random_effect_cov = pred_var_cov,
                    response_mean = response_mean,
                    response_var = response_var,
                    posterior_samples = posterior_samples,
                    prior_samples = prior_samples))
        
      }# end GPBoost prediction
      else if (private$is_mean_scale_regression) {
        preds <- predictor$predict(data = data, start_iteration = start_iteration
          , num_iteration = num_iteration, rawscore = pred_latent, predleaf = predleaf
          , predcontrib = predcontrib, header = header, reshape = reshape)
        npred <- length(preds) / 2
        pred_mean <- preds[(1:npred)*2 - 1]
        pred_var <- exp(preds[(1:npred)*2])
        return(list(pred_mean = pred_mean, pred_var = pred_var))
      } 
      else {# no gp_model or predcontrib or ignore_gp_model
        return(
          predictor$predict(
            data = data
            , start_iteration = start_iteration
            , num_iteration = num_iteration
            , rawscore = pred_latent
            , predleaf = predleaf
            , predcontrib = predcontrib
            , header = header
            , reshape = reshape
          )
        )
      }
    },
    
    # Transform into predictor
    to_predictor = function() {
      return(Predictor$new(modelfile = private$handle))
    },
    
    # Used for save
    raw = NA,
    
    # Save model to temporary file for in-memory saving
    save = function() {
      
      # Overwrite model in object
      self$raw <- self$save_model_to_string(NULL)
      
      return(invisible(NULL))
      
    }
    
  ),
  private = list(
    handle = NULL,
    train_set = NULL,
    name_train_set = "training",
    gp_model = NULL,
    has_gp_model = FALSE,
    valid_sets_gp = list(),
    use_gp_model_for_validation = TRUE,
    residual_loaded_from_file = NULL,
    label_loaded_from_file = NULL,
    fixed_effect_train_loaded_from_file = NULL,
    gp_model_prediction_data_loaded_from_file = FALSE,
    valid_sets = list(),
    name_valid_sets = list(),
    predict_buffer = list(),
    is_predicted_cur_iter = list(),
    num_class = 1L,
    num_dataset = 0L,
    init_predictor = NULL,
    eval_names = NULL,
    higher_better_inner_eval = NULL,
    set_objective_to_none = FALSE,
    train_set_version = 0L,
    is_mean_scale_regression = FALSE,
    
    # Finalize will free up the handles
    finalize = function() {
      .Call(
        LGBM_BoosterFree_R
        , private$handle
      )
      private$handle <- NULL
      return(invisible(NULL))
    },
    
    # Predict data
    inner_predict = function(idx) {
      
      # Store data name
      data_name <- private$name_train_set
      
      # Check for id bigger than 1
      if (idx > 1L) {
        data_name <- private$name_valid_sets[[idx - 1L]]
      }
      
      # Check for unknown dataset (over the maximum provided range)
      if (idx > private$num_dataset) {
        stop("data_idx should not be greater than num_dataset")
      }
      
      # Check for prediction buffer
      if (is.null(private$predict_buffer[[data_name]])) {
        
        # Store predictions
        npred <- 0L
        .Call(
          LGBM_BoosterGetNumPredict_R
          , private$handle
          , as.integer(idx - 1L)
          , npred
        )
        private$predict_buffer[[data_name]] <- numeric(npred)
        
      }
      
      # Check if current iteration was already predicted
      if (!private$is_predicted_cur_iter[[idx]]) {
        
        # Use buffer
        .Call(
          LGBM_BoosterGetPredict_R
          , private$handle
          , as.integer(idx - 1L)
          , private$predict_buffer[[data_name]]
        )
        private$is_predicted_cur_iter[[idx]] <- TRUE
      }
      
      return(private$predict_buffer[[data_name]])
    },
    
    # Get evaluation information
    get_eval_info = function() {
      
      # Check for evaluation names emptiness
      if (is.null(private$eval_names)) {
        
        # Get evaluation names
        eval_names <- .Call(
          LGBM_BoosterGetEvalNames_R
          , private$handle
        )
        
        # Check names' length
        if (length(eval_names) > 0L) {
          
          # Parse and store privately names
          private$eval_names <- eval_names
          
          # some metrics don't map cleanly to metric names, for example "ndcg@1" is just the
          # ndcg metric evaluated at the first "query result" in learning-to-rank
          metric_names <- gsub("@.*", "", eval_names)
          private$higher_better_inner_eval <- .METRICS_HIGHER_BETTER()[metric_names]
          
        }
        
      }
      
      return(private$eval_names)
      
    },
    
    # Perform inner evaluation
    inner_eval = function(data_name, data_idx, feval = NULL) {
      
      # Check for unknown dataset (over the maximum provided range)
      if (data_idx > private$num_dataset) {
        stop("data_idx should not be greater than num_dataset")
      }
      
      # Get evaluation information
      private$get_eval_info()
      
      # Prepare return
      ret <- list()
      
      # Check evaluation names existence
      if (length(private$eval_names) > 0L) {
        
        # Create evaluation values
        tmp_vals <- numeric(length(private$eval_names))
        .Call(
          LGBM_BoosterGetEval_R
          , private$handle
          , as.integer(data_idx - 1L)
          , tmp_vals
        )
        
        # Loop through all evaluation names
        for (i in seq_along(private$eval_names)) {
          
          # Store evaluation and append to return
          res <- list()
          res$data_name <- data_name
          res$name <- private$eval_names[i]
          res$value <- tmp_vals[i]
          res$higher_better <- private$higher_better_inner_eval[i]
          ret <- append(ret, list(res))
          
        }
        
      }
      
      # Check if there are evaluation metrics
      if (!is.null(feval)) {
        
        # Check if evaluation metric is a function
        if (!is.function(feval)) {
          stop("gpb.Booster.eval: feval should be a function")
        }
        
        # Prepare data
        data <- private$train_set
        
        # Check if data to assess is existing differently
        if (data_idx > 1L) {
          data <- private$valid_sets[[data_idx - 1L]]
        }
        
        # Perform function evaluation
        predval <- private$inner_predict(data_idx)
        # Note: the following is only done in R if there are custom evaluation functions in feval, 
        #        otherwise it is directly done in C++. See the function Eval() in regression_metric.hpp
        if (private$has_gp_model & private$use_gp_model_for_validation & data_idx > 1) {
          
          if (length(private$valid_sets_gp) == 0) {
            stop("gpb.Booster.add_valid: Validation data for the GP model not provided")
          }
          valid_set_gp <- private$valid_sets_gp[[data_idx-1]]
          fixed_effect_train = private$inner_predict(1)
          
          residual = private$train_set$.__enclos_env__$private$info$label-fixed_effect_train
          random_effect_pred = private$gp_model$predict(y=residual,
                                                        group_data_pred = valid_set_gp[["group_data_pred"]],
                                                        group_rand_coef_data_pred = valid_set_gp[["group_rand_coef_data_pred"]],
                                                        gp_coords_pred = valid_set_gp[["gp_coords_pred"]],
                                                        gp_rand_coef_data_pred = valid_set_gp[["gp_rand_coef_data_pred"]],
                                                        cluster_ids_pred = valid_set_gp[["cluster_ids_pred"]],
                                                        predict_cov_mat = FALSE,
                                                        predict_var = FALSE,
                                                        predict_response = FALSE,
                                                        cov_pars = NULL,
                                                        X_pred = NULL,
                                                        use_saved_data = FALSE)$mu
          
          predval = predval + random_effect_pred
          
        }
        res <- feval(predval, data)
        
        # Check for name correctness
        if (is.null(res$name) || is.null(res$value) ||  is.null(res$higher_better)) {
          stop("gpb.Booster.eval: custom eval function should return a
            list with attribute (name, value, higher_better)");
        }
        
        # Append names and evaluation
        res$data_name <- data_name
        ret <- append(ret, list(res))
      }
      
      return(ret)
      
    }
    
  )
)

#' @name predict.gpb.Booster
#' @title Prediction function for \code{gpb.Booster} objects
#' @description Prediction function for \code{gpb.Booster} objects
#' @inheritParams GPModel_shared_params
#' @param num_neighbors_pred an \code{integer} specifying the number of neighbors for making predictions.
#' This is discontinued here. Use the function 'set_prediction_data' to specify this
#' @param vecchia_pred_type A \code{string} specifying the type of Vecchia approximation used for making predictions.
#' This is discontinued here. Use the function 'set_prediction_data' to specify this
#' @param object Object of class \code{gpb.Booster}
#' @param data a \code{matrix} object, a \code{dgCMatrix} object or a character representing a filename
#' @param start_iteration int or NULL, optional (default=NULL)
#'                        Start index of the iteration to predict.
#'                        If NULL or <= 0, starts from the first iteration.
#' @param num_iteration int or NULL, optional (default=NULL)
#'                      Limit number of iterations in the prediction.
#'                      If NULL, if the best iteration exists and start_iteration is NULL or <= 0, the
#'                      best iteration is used; otherwise, all iterations from start_iteration are used.
#'                      If <= 0, all iterations from start_iteration are used (no limits).
#' @param pred_latent  If TRUE latent variables, both fixed effects (tree-ensemble) 
#' and random effects (\code{gp_model}) are predicted. Otherwise, the response variable 
#' (label) is predicted. Depending on how the argument 'pred_latent' is set,
#' different values are returned from this function; see the 'Value' section for more details. 
#' If there is no \code{gp_model}, this argument corresponds to 'raw_score' in LightGBM.
#' @param predleaf whether predict leaf index instead.
#' @param predcontrib return per-feature contributions for each record.
#' @param header only used for prediction for text file. True if text file has header
#' @param reshape whether to reshape the vector of predictions to a matrix form when there are several
#'                prediction outputs per case.
#' @param cov_pars A \code{vector} containing covariance parameters which are used if the 
#' \code{gp_model} has not been trained or if predictions should be made for other 
#' parameters than the trained ones
#' @param ignore_gp_model A \code{boolean}. If TRUE, predictions are only made for the tree ensemble part
#' and the \code{gp_model} is ignored
#' @param rawscore This is discontinued. Use the renamed equivalent argument 
#' \code{pred_latent} instead
#' @param ... Additional named arguments passed to the \code{predict()} method of
#'            the \code{gpb.Booster} object passed to \code{object}. 
#' @param offset_pred A \code{numeric} \code{vector}. 
#' Offsets for prediction: additional fixed effects contributions that are added to the predictor for the prediction points. 
#' The length of this vector needs to equal the number of prediction points.
#' @return either a list with vectors or a single vector / matrix depending on 
#' whether there is a \code{gp_model} or not
#' \itemize{
#'   \item {If there is a \code{gp_model}, the result dict contains the following entries.
#' \itemize{
#'   \item { 1. If \code{pred_latent} is FALSE (=default), the dict contains the following 2 entries:
#' \itemize{
#'      \item { result["response_mean"] are the predictive means of the response variable (Label) taking into account
#'     both the fixed effects (tree-ensemble) and the random effects (\code{gp_model}) }
#'       \item { result["response_var"] are the predictive  covariances or variances of the response variable
#'   (only if 'predict_var' or 'predict_cov' is TRUE) }
#'   \item { result["posterior_samples"] samples of the posterior of the response variable (if 'sample_posterior' is TRUE) }
#'   \item { result["prior_samples"] samples of the prior (if 'sample_prior' is TRUE) }
#'   }
#'   }
#'    \item { 2. If \code{pred_latent} is TRUE, the dict contains the following 3 entries:
#' \itemize{
#'       \item { result["fixed_effect"] are the predictions from the tree-ensemble }
#'       \item { result["random_effect_mean"] are the predictive means of the \code{gp_model} excluding the 'fixed_effect' }
#'       \item { result["random_effect_cov"] are the predictive covariances or variances of the \code{gp_model}
#'   (only if 'predict_var' or 'predict_cov' is TRUE) }
#'      \item { result["posterior_samples"] samples of the posterior of the \code{gp_model} (if 'sample_posterior' is TRUE) excluding the 'fixed_effect' }
#'      \item { result["prior_samples"] samples of the prior of the \code{gp_model} (if 'sample_prior' is TRUE) }
#'   }
#'   }
#'   }
#'   }
#'   \item { If there is no \code{gp_model} or \code{predcontrib} or \code{ignore_gp_model} 
#'     are TRUE, the result contains predictions from the tree-booster only. }
#' }
#' 
#' @examples
#' 
#' # See https://github.com/fabsig/GPBoost/tree/master/R-package for more examples
#' 
#' \donttest{
#' library(gpboost)
#' data(GPBoost_data, package = "gpboost")
#' 
#' #--------------------Combine tree-boosting and grouped random effects model----------------
#' # Create random effects model
#' gp_model <- GPModel(group_data = group_data[,1], likelihood = "gaussian")
#' # The default optimizer for covariance parameters (hyperparameters) is 
#' # Nesterov-accelerated gradient descent.
#' # This can be changed to, e.g., Nelder-Mead as follows:
#' # re_params <- list(optimizer_cov = "nelder_mead")
#' # gp_model$set_optim_params(params=re_params)
#' # Use trace = TRUE to monitor convergence:
#' # re_params <- list(trace = TRUE)
#' # gp_model$set_optim_params(params=re_params)
#' 
#' # Train model
#' bst <- gpboost(data = X, label = y, gp_model = gp_model, nrounds = 16,
#'                learning_rate = 0.05, max_depth = 6, min_data_in_leaf = 5,
#'                verbose = 0)
#' # Estimated random effects model
#' summary(gp_model)
#' 
#' # Make predictions
#' # Predict latent variables
#' pred <- predict(bst, data = X_test, group_data_pred = group_data_test[,1],
#'                 predict_var = TRUE, pred_latent = TRUE)
#' pred$random_effect_mean # Predicted latent random effects mean
#' pred$random_effect_cov # Predicted random effects variances
#' pred$fixed_effect # Predicted fixed effects from tree ensemble
#' # Predict response variable
#' pred_resp <- predict(bst, data = X_test, group_data_pred = group_data_test[,1],
#'                      predict_var = TRUE, pred_latent = FALSE)
#' pred_resp$response_mean # Predicted response mean
#' # For Gaussian data: pred$random_effect_mean + pred$fixed_effect = pred_resp$response_mean
#' pred$random_effect_mean + pred$fixed_effect - pred_resp$response_mean
#' 
#' #--------------------Combine tree-boosting and Gaussian process model----------------
#' # Create Gaussian process model
#' gp_model <- GPModel(gp_coords = coords, cov_function = "exponential",
#'                     likelihood = "gaussian")
#' # Train model
#' bst <- gpboost(data = X, label = y, gp_model = gp_model, nrounds = 8,
#'                learning_rate = 0.1, max_depth = 6, min_data_in_leaf = 5,
#'                verbose = 0)
#' # Estimated random effects model
#' summary(gp_model)
#' # Make predictions
# Predict latent variables
#' pred <- predict(bst, data = X_test, gp_coords_pred = coords_test,
#'                 predict_var = TRUE, pred_latent = TRUE)
#' pred$random_effect_mean # Predicted latent random effects mean
#' pred$random_effect_cov # Predicted random effects variances
#' pred$fixed_effect # Predicted fixed effects from tree ensemble
#' # Predict response variable
#' pred_resp <- predict(bst, data = X_test, gp_coords_pred = coords_test,
#'                      predict_var = TRUE, pred_latent = FALSE)
#' pred_resp$response_mean # Predicted response mean
#' }
#' @author Fabio Sigrist, authors of the LightGBM R package
#' @export
predict.gpb.Booster <- function(object,
                                data,
                                start_iteration = NULL,
                                num_iteration = NULL,
                                pred_latent = FALSE,
                                predleaf = FALSE,
                                predcontrib = FALSE,
                                header = FALSE,
                                reshape = FALSE,
                                group_data_pred = NULL,
                                group_rand_coef_data_pred = NULL,
                                gp_coords_pred = NULL,
                                gp_rand_coef_data_pred = NULL,
                                cluster_ids_pred = NULL,
                                predict_cov_mat = FALSE,
                                predict_var = FALSE,
                                sample_posterior = FALSE,
                                sample_prior = FALSE,
                                num_post_samples = 100,
                                num_prior_samples = 100,
                                cov_pars = NULL,
                                offset_pred = NULL,
                                ignore_gp_model = FALSE,
                                rawscore = NULL,
                                vecchia_pred_type = NULL,
                                num_neighbors_pred = NULL,
                                ...) {
  
  if (!gpb.is.Booster(x = object)) {
    stop("predict.gpb.Booster: object should be an ", sQuote("gpb.Booster"))
  }
  
  # Return booster predictions
  return(
    object$predict(
      data = data
      , start_iteration = start_iteration
      , num_iteration = num_iteration
      , pred_latent = pred_latent
      , predleaf =  predleaf
      , predcontrib =  predcontrib
      , header = header
      , reshape = reshape
      , group_data_pred = group_data_pred
      , group_rand_coef_data_pred = group_rand_coef_data_pred
      , gp_coords_pred = gp_coords_pred
      , gp_rand_coef_data_pred = gp_rand_coef_data_pred
      , cluster_ids_pred = cluster_ids_pred
      , predict_cov_mat = predict_cov_mat
      , predict_var = predict_var
      , sample_posterior = sample_posterior
      , sample_prior = sample_prior
      , num_post_samples = num_post_samples
      , num_prior_samples = num_prior_samples
      , cov_pars = cov_pars
      , offset_pred = offset_pred
      , ignore_gp_model = ignore_gp_model
      , rawscore = rawscore
      , vecchia_pred_type = vecchia_pred_type
      , num_neighbors_pred = num_neighbors_pred
      , ...
    )
  )
}

#' @name gpb.load
#' @title Load GPBoost model
#' @description  Load GPBoost takes in either a file path or model string.
#'               If both are provided, Load will default to loading from file
#'               Boosters with gp_models can only be loaded from file.
#' @param filename path of model file
#' @param model_str a str containing the model
#'
#' @return gpb.Booster
#'
#' @examples
#' \donttest{
#' library(gpboost)
#' data(GPBoost_data, package = "gpboost")
#' 
#' # Train model and make prediction
#' gp_model <- GPModel(group_data = group_data[,1], likelihood = "gaussian")
#' bst <- gpboost(data = X, label = y, gp_model = gp_model, nrounds = 16,
#'                learning_rate = 0.05, max_depth = 6, min_data_in_leaf = 5,
#'                verbose = 0)
#' pred <- predict(bst, data = X_test, group_data_pred = group_data_test[,1],
#'                 predict_var= TRUE, pred_latent = TRUE)
#' # Save model to file
#' filename <- tempfile(fileext = ".json")
#' gpb.save(bst,filename = filename)
#' # Load from file and make predictions again
#' bst_loaded <- gpb.load(filename = filename)
#' pred_loaded <- predict(bst_loaded, data = X_test, group_data_pred = group_data_test[,1],
#'                        predict_var= TRUE, pred_latent = TRUE)
#' # Check equality
#' pred$fixed_effect - pred_loaded$fixed_effect
#' pred$random_effect_mean - pred_loaded$random_effect_mean
#' pred$random_effect_cov - pred_loaded$random_effect_cov
#' }
#' @author Fabio Sigrist, authors of the LightGBM R package
#' @export
gpb.load <- function(filename = NULL, model_str = NULL) {
  
  filename_provided <- !is.null(filename)
  model_str_provided <- !is.null(model_str)
  
  if (filename_provided) {
    if (!is.character(filename)) {
      stop("gpb.load: filename should be character")
    }
    if (!file.exists(filename)) {
      stop(sprintf("gpb.load: file '%s' passed to filename does not exist", filename))
    }
    return(invisible(Booster$new(modelfile = filename)))
  }
  
  if (model_str_provided) {
    if (!is.character(model_str)) {
      stop("gpb.load: model_str should be character")
    }
    return(invisible(Booster$new(model_str = model_str)))
  }
  
  stop("gpb.load: either filename or model_str must be given")
}

#' @name gpb.save
#' @title Save GPBoost model (booster and GPModel)
#' @description Save GPBoost model (booster and GPModel)
#' @param booster Object of class \code{gpb.Booster}
#' @param filename saved filename
#' @param start_iteration int or NULL, optional (default=NULL)
#'                        Start index of the iteration to predict.
#'                        If NULL or <= 0, starts from the first iteration.
#' @param num_iteration int or NULL, optional (default=NULL)
#'                      Limit number of iterations in the prediction.
#'                      If NULL, if the best iteration exists and start_iteration is NULL or <= 0, the
#'                      best iteration is used; otherwise, all iterations from start_iteration are used.
#'                      If <= 0, all iterations from start_iteration are used (no limits).
#' @param save_raw_data If TRUE, the raw data (predictor / covariate data) for the Booster is also saved.
#' Enable this option if you want to change \code{start_iteration} or \code{num_iteration} at prediction time after loading.
#' @param ... Additional named arguments passed to the \code{predict()} method of
#'            the \code{gpb.Booster} object passed to \code{object}. 
#'            This is only used when there is a gp_model and when save_raw_data=FALSE
#'
#' @return gpb.Booster. After loading, the GPModel can be accessed via bst_loaded$.__enclos_env__$private$gp_model
#'
#' @examples
#' \donttest{
#' library(gpboost)
#' data(GPBoost_data, package = "gpboost")
#' 
#' # Train model and make prediction
#' gp_model <- GPModel(group_data = group_data[,1], likelihood = "gaussian")
#' bst <- gpboost(data = X, label = y, gp_model = gp_model, nrounds = 16,
#'                learning_rate = 0.05, max_depth = 6, min_data_in_leaf = 5,
#'                verbose = 0)
#' pred <- predict(bst, data = X_test, group_data_pred = group_data_test[,1],
#'                 predict_var= TRUE, pred_latent = TRUE)
#' # Save model to file
#' filename <- tempfile(fileext = ".json")
#' gpb.save(bst,filename = filename)
#' # Load from file and make predictions again
#' bst_loaded <- gpb.load(filename = filename)
#' pred_loaded <- predict(bst_loaded, data = X_test, group_data_pred = group_data_test[,1],
#'                        predict_var= TRUE, pred_latent = TRUE)
#' # Check equality
#' pred$fixed_effect - pred_loaded$fixed_effect
#' pred$random_effect_mean - pred_loaded$random_effect_mean
#' pred$random_effect_cov - pred_loaded$random_effect_cov
#' }
#' @author Fabio Sigrist, authors of the LightGBM R package
#' @export
gpb.save <- function(booster, filename, start_iteration = NULL, 
                     num_iteration = NULL, save_raw_data = FALSE, ...) {
  
  if (!gpb.is.Booster(x = booster)) {
    stop("gpb.save: booster should be an ", sQuote("gpb.Booster"))
  }
  
  if (!(is.character(filename) && length(filename) == 1L)) {
    stop("gpb.save: filename should be a string")
  }
  
  # Store booster
  return(
    invisible(booster$save_model(
      filename = filename
      , start_iteration = start_iteration
      , num_iteration = num_iteration
      , save_raw_data = save_raw_data
      , ...
    ))
  )
  
}

#' @name gpb.dump
#' @title Dump GPBoost model to json
#' @description Dump GPBoost model to json
#' @param booster Object of class \code{gpb.Booster}
#' @param num_iteration number of iteration want to predict with, NULL or <= 0 means use best iteration
#'
#' @return json format of model
#'
#' @examples
#' \donttest{
#' library(gpboost)
#' data(agaricus.train, package = "gpboost")
#' train <- agaricus.train
#' dtrain <- gpb.Dataset(train$data, label = train$label)
#' data(agaricus.test, package = "gpboost")
#' test <- agaricus.test
#' dtest <- gpb.Dataset.create.valid(dtrain, test$data, label = test$label)
#' params <- list(objective = "regression", metric = "l2")
#' valids <- list(test = dtest)
#' model <- gpb.train(
#'   params = params
#'   , data = dtrain
#'   , nrounds = 10L
#'   , valids = valids
#'   , min_data = 1L
#'   , learning_rate = 1.0
#'   , early_stopping_rounds = 5L
#' )
#' json_model <- gpb.dump(model)
#' }
#' @export
gpb.dump <- function(booster, num_iteration = NULL) {
  
  if (!gpb.is.Booster(x = booster)) {
    stop("gpb.save: booster should be an ", sQuote("gpb.Booster"))
  }
  
  # Return booster at requested iteration
  return(booster$dump_model(num_iteration =  num_iteration))
  
}

#' @name gpb.get.eval.result
#' @title Get record evaluation result from booster
#' @description Given a \code{gpb.Booster}, return evaluation results for a
#'              particular metric on a particular dataset.
#' @param booster Object of class \code{gpb.Booster}
#' @param data_name Name of the dataset to return evaluation results for.
#' @param eval_name Name of the evaluation metric to return results for.
#' @param iters An integer vector of iterations you want to get evaluation results for. If NULL
#'              (the default), evaluation results for all iterations will be returned.
#' @param is_err TRUE will return evaluation error instead
#'
#' @return numeric vector of evaluation result
#'
#' @examples
#' \donttest{
#' # train a regression model
#' data(agaricus.train, package = "gpboost")
#' train <- agaricus.train
#' dtrain <- gpb.Dataset(train$data, label = train$label)
#' data(agaricus.test, package = "gpboost")
#' test <- agaricus.test
#' dtest <- gpb.Dataset.create.valid(dtrain, test$data, label = test$label)
#' params <- list(objective = "regression", metric = "l2")
#' valids <- list(test = dtest)
#' model <- gpb.train(
#'   params = params
#'   , data = dtrain
#'   , nrounds = 5L
#'   , valids = valids
#'   , min_data = 1L
#'   , learning_rate = 1.0
#' )
#'
#' # Examine valid data_name values
#' print(setdiff(names(model$record_evals), "start_iter"))
#'
#' # Examine valid eval_name values for dataset "test"
#' print(names(model$record_evals[["test"]]))
#'
#' # Get L2 values for "test" dataset
#' gpb.get.eval.result(model, "test", "l2")
#' }
#' @export
gpb.get.eval.result <- function(booster, data_name, eval_name, iters = NULL, is_err = FALSE) {
  
  # Check if booster is booster
  if (!gpb.is.Booster(x = booster)) {
    stop("gpb.get.eval.result: Can only use ", sQuote("gpb.Booster"), " to get eval result")
  }
  
  # Check if data and evaluation name are characters or not
  if (!is.character(data_name) || !is.character(eval_name)) {
    stop("gpb.get.eval.result: data_name and eval_name should be characters")
  }
  
  # NOTE: "start_iter" exists in booster$record_evals but is not a valid data_name
  data_names <- setdiff(names(booster$record_evals), "start_iter")
  if (!(data_name %in% data_names)) {
    stop(paste0(
      "gpb.get.eval.result: data_name "
      , shQuote(data_name)
      , " not found. Only the following datasets exist in record evals: ["
      , paste(data_names, collapse = ", ")
      , "]"
    ))
  }
  
  # Check if evaluation result is existing
  eval_names <- names(booster$record_evals[[data_name]])
  if (!(eval_name %in% eval_names)) {
    stop(paste0(
      "gpb.get.eval.result: eval_name "
      , shQuote(eval_name)
      , " not found. Only the following eval_names exist for dataset "
      , shQuote(data_name)
      , ": ["
      , paste(eval_names, collapse = ", ")
      , "]"
    ))
    stop("gpb.get.eval.result: wrong eval name")
  }
  
  result <- booster$record_evals[[data_name]][[eval_name]][[.EVAL_KEY()]]
  
  # Check if error is requested
  if (is_err) {
    result <- booster$record_evals[[data_name]][[eval_name]][[.EVAL_ERR_KEY()]]
  }
  
  # Check if iteration is non existant
  if (is.null(iters)) {
    return(as.numeric(result))
  }
  
  # Parse iteration and booster delta
  iters <- as.integer(iters)
  delta <- booster$record_evals$start_iter - 1.0
  iters <- iters - delta
  
  # Return requested result
  return(as.numeric(result[iters]))
}
