Ensemble_ParameterTuning_H2o_R

library(h2oEnsemble)
localH2o <- h2o.init(nthreads = -1)

#impor data
train <- h2o.importFile("https://h2o-public-test-data.s3.amazonaws.com/smalldata/testng/higgs_train_5k.csv")
test <- h2o.importFile("https://h2o-public-test-data.s3.amazonaws.com/smalldata/testng/higgs_test_5k.csv")

y <- "response"
x <- setdiff(names(train),y)

family="binomial"

train[,y] <- as.factor(train[,y])
test[,y] <- as.factor(test[,y])

#random grid search
search_criteria <- list(strategy = "RandomDiscrete", max_runtime_secs=120)

nfolds <- 5

#GBM hyperparameters
learn_rate_opt  <- c(0.01,0.03)
max_depth_opt <- c(3,4,5,6,9)
sample_rate_opt <- c(0.7,0.8,0.9,1.0)
col_sample_rate_opt <- c(0.2:0.9)

hyper_params <- list(learn_rate = learn_rate_opt,
                     max_depth = max_depth_opt,
                     sample_rate = sample_rate_opt,
                     col_sample_rate = col_sample_rate_opt
                     )


gbm_grid <- h2o.grid(algorithm = "gbm",
                     x=x,
                     y=y,
                     training_frame=train,
                     ntrees=100,
                     seed=1,
                     nfolds = nfolds,
                     fold_assignment="Modulo",
                     keep_cross_validation_predictions = TRUE,
                     hyper_params = hyper_params,
                     search_criteria = search_criteria)

gbm_models <- lapply(gbm_grid@model_ids, function(model_id) h2o.getModel(model_id))


#best gbm model
gbm_sorted <- h2o.getGrid(grid_id = "Grid_GBM_RTMP_sid_b91a_30_model_R_1476700777889_17",
                          sort_by = "Logloss")
print(gbm_sorted)
best_model <- h2o.getModel(gbm_sorted@model_ids[[1]])
summary(best_model@allparameters)

#best model parameters
best_model@model$model_summary


#use best model for prediction
best_gbm_prediction <- h2o.performance(model=best_model,newdata = test)
h2o.logloss(best_gbm_prediction)

#RF hyperparameter 

mtries_opt <- 8:20
max_depth_opt <- c(4:10,15,20)
sample_rate_opt <- c(0.7,0.8,0.9,1.0)
col_sample_rate_opt<- c(0.2,0.3,0.4,0.5,0.6,0.7,0.8)

hyper_params <- list(
  mtries = mtries_opt,
  max_depth = max_depth_opt,
  sample_rate=sample_rate_opt,
  col_sample_rate_per_tree=col_sample_rate_opt
  
)


rf_grid <- h2o.grid("randomForest", x = x, y = y,
                    training_frame = train,
                    ntrees = 200,
                    seed = 1,
                    nfolds = nfolds,
                    fold_assignment = "Modulo",
                    keep_cross_validation_predictions = TRUE,                    
                    hyper_params = hyper_params,
                    search_criteria = search_criteria)

rf_models <- lapply(rf_grid@model_ids,function(model_id) h2o.getModel(model_id))


#DL Hyperparameters
activation_opt <- c("Rectifier","RectifierWithDropout",
                    "Maxout","MaxoutWithDropout")

hidden_opt <- list(c(10,10),c(20,15),c(50,50,50))
l1_opt <- c(0,1e-3,1e-5)
l2_opt <- c(0,1e-3,1e-5)

hyper_params <- list(
  activation=activation_opt,
  hidden=hidden_opt,
  l1=l1_opt,
  l2=l2_opt
)

dl_grid <- h2o.grid("deeplearning",
                    x=x,
                    y=y,
                    training_frame=train,
                    epochs=15,
                    seed=1,
                    nfolds=nfolds,
                    fold_assignment="Modulo",
                    keep_cross_validation_predictions=TRUE,
                    hyper_params = hyper_params,
                    search_criteria = search_criteria)


dl_models <- lapply(dl_grid@model_ids, function(model_id) h2o.getModel(model_id))


#GLM Hyperparameters
alpha_opt <- c(0,1,0.1)
lambda_opt <- c(0,1e-7,1e-5,1e-3,1e-1)

hyper_params <- list(
  alpha=alpha_opt,
  lambda=lambda_opt
)

glm_grid <- h2o.grid("glm",x=x,y=y,
                     training_frame=train,
                     family="binomial",
                     nfolds = nfolds,
                     fold_assignment="Modulo",
                     keep_cross_validation_predictions=T,
                     hyper_params = hyper_params,
                     search_criteria = search_criteria)

glm_models <- lapply(glm_grid@model_ids, function(model_id) h2o.getModel(model_id))


for(i in 1:length(glm_models)){
  print(cat("Logloss", h2o.logloss(glm_models[[i]])))
}



#create a list of all base models
models <- c(gbm_models,rf_models,dl_models,glm_models)

#specify meta learner
metalearner <- "h2o.glm.wrapper"

#stacking
stack <- h2o.stack(models = models,metalearner = metalearner,response_frame = train[,y])

#check performance
perf <- h2o.ensemble_performance(stack, newdata = test)
print(perf$base)


#meta learner
stack2 <- h2o.metalearn(stack,metalearner = "h2o.deeplearning.wrapper")
perf2 <- h2o.ensemble_performance(stack2,newdata = test,score_base_models = F)


#another meta learner create
h2o.glm.nn <- function(...,non_negative = TRUE){
  h2o.glm.wrapper(...,non_negative = non_negative)
}

stack3 <- h2o.metalearn(stack,metalearner = "h2o.glm.nn")
perf3 <- h2o.ensemble_performance(stack3, newdata = test, score_base_models = FALSE)
print(perf3)