#' Build ensemble model based on h2o platform
#'
#' @param train.df row is sample, column is feature
#' @param train.group a vector
#' @param val.df Default NULL, not to evaluate in validation dataset. row is sample, column is feature
#' @param val.group a vector
#' @param candidates if not specify candidates feature, all column names will be used
#' @param nfolds Default 5. Used in internal model construction
#' @param seed Default 1
#' @param type Description for this run. Default "run"
#' @param metalearner_algorithm Default glm. Could be "AUTO", "deeplearning", "drf", "gbm", "glm", "naivebayes", "xgboost". If AUTO, (GLM with non negative weights; if validation_frame is present, a lambda search is performed
#' @param glm TRUE. Default included glm
#' @param xg TRUE. Default included xgboost
#' @param dl TRUE. Default included deep learning
#' @param nb TRUE. Default included NaiveBayes
#' @param gbm TRUE. Default included gbm
#' @param rf TRUE. Default included random forests
#'
#' @return A list include fits, training risk score, aucs
#' @export
#'
#' @examples
<- (train.df = , train.group = ,
val.df = , val.group = ,
candidates = , nfolds = 5,
seed = 1, = "run", metalearner_algorithm = "glm",
= , xg = , dl = ,
nb = , gbm = , = ){
(!("h2o")){
BiocManager::install("h2o")
("h2o")
}
h2o.init(nthreads = -1, max_mem_size = "80G") #-1表示使用你机器上所有的核
((train.df) | (train.group)){
("Train.d and train.group is mandatory")
}
train.samples = (train.df)
train.df$Class = (train.group)
train.df = as.h2o(train.df)
# if has validation data set
has.val =
val.samples =
(!(val.df)&!(val.group)){
val.samples = (val.df)
val.df$Class = (val.group)
val.df = as.h2o(val.df)
has.val =
("Have validation dataset.")
}{
("No validation dataset.")
}
# if not specify features
((candidates)){
candidates = (train.df)
}
#
base_models4ensemble = ()
train.aucs = ()
val.aucs = ()
models = ()
perf_list = ()
("Number of training samples", (train.samples),"\n")
("Number of validation samples", (val.samples),"\n")
train.risk.scores = (Samples = train.samples,
Class = train.group)
(has.val){
val.risk.scores = (Samples = val.samples,
Class = val.group)
}
############# glm
(){
glm_fit <- h2o.glm(x = candidates,
y = "Class",
training_frame = train.df,
model_id = (,".glm_fit"),
= "binomial",
seed = seed,
keep_cross_validation_predictions = T,
lambda_search = F,
nfolds = nfolds)
base_models4ensemble <- (base_models4ensemble, glm_fit@model_id)
models = (models, ("glm"=glm_fit))
glm_perf <- h2o.performance(model = glm_fit, newdata = train.df)
perf_list = (perf_list, ("train.glm" = glm_perf) )
train.aucs <- (train.aucs, ("glm" = h2o.auc(glm_perf)) )
train.risk.scores$ = ((h2o.predict(glm_fit, train.df)),(3)])
(has.val){
glm_perf <- h2o.performance(model = glm_fit, newdata = val.df)
perf_list = (perf_list, ("val.glm" = glm_perf) )
val.aucs <- (val.aucs, ("glm" = h2o.auc(glm_perf)) )
val.risk.scores$ = ((h2o.predict(glm_fit, val.df)),(3)])
}
}
############# RF
(){
rf_fit <- h2o.randomForest(x = candidates,
y = "Class",
training_frame = train.df,
model_id = (,".rf_fit"),
keep_cross_validation_predictions = T,
seed = seed,
nfolds = nfolds)
base_models4ensemble <- (base_models4ensemble, rf_fit@model_id)
models = (models, ("rf" = rf_fit))
rf_perf <- h2o.performance(model = rf_fit, newdata = train.df)
perf_list = (perf_list, ("train.rf" = rf_perf) )
train.aucs <- (train.aucs, ("rf" = h2o.auc(rf_perf)) )
train.risk.scores$ = ((h2o.predict(rf_fit, train.df)),(3)])
(has.val){
rf_perf <- h2o.performance(model = rf_fit, newdata = val.df)
perf_list = (perf_list, ("val.rf" = rf_perf) )
val.aucs <- (val.aucs, ("rf" = h2o.auc(rf_perf)) )
val.risk.scores$ = ((h2o.predict(rf_fit, val.df)),(3)])
}
}
########### GBM
(gbm){
gbm_fit <- h2o.gbm(x = candidates,
y = "Class",
training_frame = train.df,
model_id = (,".gbm_fit"),
keep_cross_validation_predictions = T,
seed = seed,
nfolds = nfolds)
base_models4ensemble <- (base_models4ensemble, gbm_fit@model_id)
models = (models, ("gbm" = gbm_fit))
gbm_perf <- h2o.performance(model = gbm_fit, newdata = train.df)
perf_list = (perf_list, ("train.gbm" = gbm_perf) )
train.aucs <- (train.aucs, ("gbm" = h2o.auc(gbm_perf)) )
train.risk.scores$gbm = ((h2o.predict(gbm_fit, train.df)),(3)])
(has.val){
gbm_perf <- h2o.performance(model = gbm_fit, newdata = val.df)
perf_list = (perf_list, ("val.gbm" = gbm_perf) )
val.aucs <- (val.aucs, ("gbm" = h2o.auc(gbm_perf)) )
val.risk.scores$gbm = ((h2o.predict(gbm_fit, val.df)),(3)])
}
}
########### deep learning
(dl){
dl_fit <- h2o.deeplearning(x = candidates,
y = "Class",
training_frame = train.df,
model_id = (,".dl_fit"),
epochs = 10,
keep_cross_validation_predictions = T,
nfolds = nfolds,
seed = seed)
base_models4ensemble <- (base_models4ensemble, dl_fit@model_id)
models = (models, ("dl" = dl_fit))
dl_perf <- h2o.performance(model = dl_fit, newdata = train.df)
perf_list = (perf_list, ("train.dl" = dl_perf) )
train.aucs <- (train.aucs, ("dl" = h2o.auc(dl_perf)) )
train.risk.scores$dl = ((h2o.predict(dl_fit, train.df)),(3)])
(has.val){
dl_perf <- h2o.performance(model = dl_fit, newdata = val.df)
perf_list = (perf_list, ("val.dl" = dl_perf) )
val.aucs <- (val.aucs, ("dl" = h2o.auc(dl_perf)) )
val.risk.scores$dl = ((h2o.predict(dl_fit, val.df)),(3)])
}
}
########## native bayes
(nb){
nb_fit <- h2o.naiveBayes(x = candidates,
y = "Class",
training_frame = train.df,
model_id = (,".nb_fit"),
keep_cross_validation_predictions = T,
nfolds = nfolds,
seed = seed)
base_models4ensemble <- (base_models4ensemble, nb_fit@model_id)
models = (models, ("nb" = nb_fit))
nb_perf <- h2o.performance(model = nb_fit, newdata = train.df)
perf_list = (perf_list, ("train.nb" = nb_perf) )
train.aucs <- (train.aucs, ("nb" = h2o.auc(nb_perf)) )
train.risk.scores$nb = ((h2o.predict(nb_fit, train.df)),(3)])
(has.val){
nb_perf <- h2o.performance(model = nb_fit, newdata = val.df)
perf_list = (perf_list, ("val.nb" = nb_perf) )
val.aucs <- (val.aucs, ("nb" = h2o.auc(nb_perf)) )
val.risk.scores$nb = ((h2o.predict(nb_fit, val.df)),(3)])
}
}
############ XGBoots
(xg){
xg_fit <- h2o.xgboost(x = candidates,
y = "Class",
training_frame = train.df,
model_id = (,".xg_fit"),
keep_cross_validation_predictions = T,
nfolds = nfolds,
seed = seed)
base_models4ensemble <- (base_models4ensemble, xg_fit@model_id)
models = (models, ("xg" = xg_fit))
xg_perf <- h2o.performance(model = xg_fit, newdata = train.df)
perf_list = (perf_list, ("train.xg" = xg_perf) )
train.aucs <- (train.aucs, ("xg" = h2o.auc(xg_perf)) )
train.risk.scores$xg = ((h2o.predict(xg_fit, train.df)),(3)])
(has.val){
xg_perf <- h2o.performance(model = xg_fit, newdata = val.df)
perf_list = (perf_list, ("val.xg" = xg_perf) )
val.aucs <- (val.aucs, ("xg" = h2o.auc(xg_perf)) )
val.risk.scores$xg = ((h2o.predict(xg_fit, val.df)),(3)])
}
}
############
ensemble_fit <- h2o.stackedEnsemble(x = candidates,
y = "Class",
training_frame = train.df,
model_id = (,".ensemble"),
base_models = base_models4ensemble,
seed = seed,
metalearner_algorithm = metalearner_algorithm)
models = (models, ("ensemble" = ensemble_fit))
ensemble_perf <- h2o.performance(model = ensemble_fit, newdata = train.df)
perf_list = (perf_list, ("train.ensemble" = ensemble_perf) )
train.aucs <- (train.aucs, ("ensemble" = h2o.auc(ensemble_perf)) )
train.risk.scores$ensemble = ((h2o.predict(ensemble_fit, train.df)),(3)])
(has.val){
ensemble_perf <- h2o.performance(model = ensemble_fit, newdata = val.df)
perf_list = (perf_list, ("val.ensemble" = ensemble_perf) )
val.aucs <- (val.aucs, ("ensemble" = h2o.auc(ensemble_perf)) )
val.risk.scores$ensemble = ((h2o.predict(ensemble_fit, val.df)),(3)])
}
train.aucs = (train.aucs)
val.aucs = (val.aucs)
( != "run"){
(train.risk.scores)[3:(train.risk.scores)] = (,".",(train.risk.scores)[3:(train.risk.scores)])
(has.val){
(val.risk.scores)[3:(val.risk.scores)] = (,".",(val.risk.scores)[3:(val.risk.scores)])
}
}
res = (fits = models, seed = seed,
train.aucs = train.aucs, val.aucs = val.aucs,
performance.objects = perf_list,
train.risk = train.risk.scores, val.risk = val.risk.scores)
res
}
