library(kableExtra)
library(modelsummary)

datasummary_skim(data, type = "numeric", title = "Variables Numericas") %>%
    remove_column(columns = c(2, 3)) %>%
    column_spec(1, bold = T) %>%
    kable_material() %>%
    kable_styling(bootstrap_options = c("condensed", "responsive")) %>%
    scroll_box(width = "100%", height = "400px")

library(GGally)
ggpairs(data, mapping = aes(color = Attrition), columns = c("MonthlyIncome", "JobSatisfaction",
    "EnvironmentSatisfaction", "DistanceFromHome", "DailyRate", "Age", "PercentSalaryHike"),
    upper = list(continuous = "barDiag"), lower = list(continuous = wrap("points",
        alpha = 0.5, size = 0.1)), title = "Matriz de Visualización Variables Continuas",
    legend = 1, showStrips = T) + theme_minimal(base_size = 10, base_family = "Times") +
    theme(title = element_text(face = "bold"), legend.title = element_text(face = "bold"),
        legend.position = "bottom") + scale_fill_manual(values = c("#2E45B8", "#D6DBF5")) +
    scale_color_manual(values = c("#2E45B8", "#D6DBF5"))

datasummary_skim(data, type = "categorical", title = "Variables Categóricas") %>%
    column_spec(1, bold = T) %>%
    column_spec(2, italic = T) %>%
    kable_material() %>%
    kable_styling(bootstrap_options = c("condensed", "responsive")) %>%
    scroll_box(width = "100%", height = "400px")

theme_set( 
    theme_minimal(base_family = 'Times',
                                base_size = 10) +
    theme(
    legend.position = "none",
    panel.grid.minor.x = element_blank(),
    panel.grid.major.y = element_blank(),
    axis.text.x = element_text(color = "gray60", 
                                                         size = 8),
    axis.title.x = element_blank(),
    ) 
)

colors=c("#2E45B8","#D6DBF5")


library("cowplot")
plot_grid(
ggdraw() + draw_label("Categorical Variables of Data with Attrition", fontface = "bold"),

plot_grid(
    ggplot(data,aes(fill=Attrition,x=Gender)) +
    geom_bar(position="dodge2",alpha=0.8,color="black") +
    scale_fill_manual(values=colors) + coord_flip(),

    ggplot(data,aes(fill=Attrition,x=Department))+geom_bar(position="fill",alpha=0.8,color="black")+scale_fill_manual(values=colors)+coord_flip(),
    
  ggplot(data,aes(fill=Attrition, x=JobRole))+geom_bar(position="fill",alpha=0.8,color="black")+scale_fill_manual(values=colors)+coord_flip(),

    ggplot(data,aes(fill=Attrition, x=Education))+geom_bar(position="fill",alpha=0.8,color="black")+scale_fill_manual(values=colors)+coord_flip(),

    ggplot(data,aes(fill=Attrition, x=OverTime))+geom_bar(position="fill",alpha=0.8,color="black")+scale_fill_manual(values=colors)+coord_flip(),

    ggplot(data,aes(fill=Attrition, x=EducationField))+geom_bar(position="fill",alpha=0.8,color="black")+scale_fill_manual(values=colors)+coord_flip(),

    ncol = 2), 

rel_heights = c(0.1, 1, 0.2),

get_legend(ggplot(data,aes(fill=Attrition,x=Gender))+geom_bar(position="fill",alpha=0.8,color="black")+scale_fill_manual(values=colors)+coord_flip()+ theme(legend.position = "top")), 
ncol = 1)

# Obtener dummies por las variables categoricas, quitando y
datos <- fastDummies::dummy_cols(data[-2], remove_selected_columns = T)
# Añadir the y variable
datos <- cbind(Attrition = data$Attrition, datos)

minbucket_ <- c()
Accuracy <- c()
Kappa <- c()
Auc <- c()

for (minbucket in seq(from = 5, to = 205, by = 10)) {
    arbolcaret <- train(factor(attrition) ~ age + daily_rate + distance_from_home +
        environment_satisfaction + hourly_rate + job_involvement + job_satisfaction +
        monthly_income + num_companies_worked + percent_salary_hike + performance_rating +
        relationship_satisfaction + stock_option_level + total_working_years + work_life_balance +
        years_at_company + years_since_last_promotion + business_travel_travel_rarely +
        business_travel_travel_frequently + business_travel_non_travel + department_sales +
        department_research_development + department_human_resources + education_2 +
        education_1 + education_4 + education_3 + education_5 + education_field_life_sciences +
        education_field_other + education_field_medical + education_field_marketing +
        education_field_technical_degree + education_field_human_resources + gender_female +
        gender_male + job_role_sales_executive + job_role_research_scientist + job_role_laboratory_technician +
        job_role_manufacturing_director + job_role_healthcare_representative + job_role_manager +
        job_role_sales_representative + job_role_research_director + job_role_human_resources +
        marital_status_single + marital_status_married + marital_status_divorced +
        over_time_yes + over_time_no, data = upTrain, method = "rpart", trControl = control,
        tuneGrid = expand.grid(cp = c(0)), control = rpart.control(minbucket = minbucket))

    confusionMatrix <- confusionMatrix(arbolcaret$pred$pred, arbolcaret$pred$obs)

    roc <- roc(response = arbolcaret$pred$obs, predictor = arbolcaret$pred$Yes)

    Acc_i <- confusionMatrix$overall[1]
    Accuracy <- append(Accuracy, Acc_i)

    K_i <- confusionMatrix$overall[2]
    Kappa <- append(Kappa, K_i)

    Auc_i <- roc$auc
    Auc <- append(Auc, Auc_i)

    minbucket_ <- append(minbucket_, minbucket)

    # \tsvMisc::progress(minbucket)
    dput("---------------")
    dput(paste0("With minbucket= ", minbucket))
    dput(paste0("Accuracy: ", round(confusionMatrix$overall[1], 3)))
    print(roc$auc)
}
arbol_results = cbind(data.frame(Accuracy, Kappa, Auc), minbucket = as.factor(c(seq(from = 5,
    to = 205, by = 10))))

# Clear cache ----
rm(Acc_i, K_i, Auc_i, minbucket, roc)
rm(Accuracy, Auc, Kappa, minbucket_)

# Plot ----
library(apexcharter)
apexchart(width = 800, ax_opts = list(chart = list(type = "line"), stroke = list(curve = "smooth"),
    grid = list(borderColor = "#e7e7e7", row = list(colors = c("#f3f3f3", "transparent"),
        opacity = 0.5)), markers = list(style = "inverted", size = 4), series = list(list(name = "Accuracy",
        data = arbol_results$Accuracy), list(name = "Kappa", data = arbol_results$Kappa),
        list(name = "AUC", data = arbol_results$Auc)), title = list(text = "Training Results",
        align = "center"), xaxis = list(categories = arbol_results$minbucket))) %>%
    ax_yaxis(labels = list(formatter = format_num(".0%"))) %>%
    ax_stroke(curve = "stepline", width = 2) %>%
    ax_colors("#4B69CE", "#B0BDE9", "#4A80CF")

# poner maxsurrogate=0 para que solo nos presente la importancia de las
# variables que efectivamente participen en el modelo
rpart(factor(attrition) ~ ., data = upTrain, minbucket = 105, method = "class", maxsurrogate = 0,
    parms = list(split = "gini")) -> arbol

library(rpart.plot)
rpart.plot(arbol, type = 4, extra = 105, nn = F, tweak = 1.7, gap = 1, space = 2,
    box.palette = "Blues")

arbolcaret <- train(factor(attrition) ~ ., data = upTrain, method = "rpart", trControl = control,
    tuneGrid = expand.grid(cp = c(0)), control = rpart.control(minbucket = 105, maxsurrogate = 0))

source("files/ConfusionMatrix.R")
draw_confusion_matrix(confusionMatrix(arbolcaret$pred$pred, arbolcaret$pred$obs),
    "#D6DBF5", "#2E45B8")

ggplot(vip::vi(arbol) %>%
    filter(Importance > 0) %>%
    mutate(Variable = stringr::str_to_title(Variable)) %>%
    mutate(Variable = str_replace_all(Variable, "_", " ")), aes(x = reorder(Variable,
    Importance), y = Importance)) + ggchicklet::geom_chicklet(aes(fill = Importance),
    radius = grid::unit(10, "pt"), width = 1, show.legend = F) + labs(x = NULL, title = "Variable Importance Plot Arbol") +
    scale_y_continuous(position = "right") + scale_fill_gradient(low = "#D6DBF5",
    high = "#2E45B8") + coord_flip() + hrbrthemes::theme_ipsum(base_family = "Times",
    grid = "X") + theme(plot.title = element_text(hjust = 0, vjust = -0.5), plot.margin = unit(c(0,
    1, 0.5, 0.5), "cm"))

library(doParallel)
library(tictoc)
registerDoParallel(makeCluster(3) -> cpu) 

nodesize_ <- c()
sampsize_ <- c()
Accuracy <- c()
Kappa <- c()
Auc <- c()

tic()
for (nodesize in c(20,40,60,80,100)) {
    for (sampsize in c(200,500,800,1200,1570)) {
bg <- train(data=upTrain,
                factor(attrition)~.,
                method="rf", trControl= control,
                #fijar mtry for bagging
                tuneGrid= expand.grid(mtry=c(51)), 
                ntree = 5000, 
                sampsize = sampsize, 
                nodesize = nodesize,
                #muestras con reemplazamiento
                replace = TRUE, 
                linout = FALSE) 

confusionMatrix <- confusionMatrix(
    bg$pred$pred, bg$pred$obs)

roc <- roc(response = bg$pred$obs,
                     predictor = bg$pred$Yes)

Acc_i <- confusionMatrix$overall[1]
Accuracy <- append(Accuracy, Acc_i)

K_i <- confusionMatrix$overall[2]
Kappa <- append(Kappa, K_i)

Auc_i <- roc$auc
Auc <- append(Auc, Auc_i)

nodesize_ <- append(nodesize_, nodesize)
sampsize_ <- append(sampsize_, sampsize)

dput("---------------")
dput(paste0("With nodesize= ", nodesize))
dput(paste0("With sampsize= ", sampsize))
dput(paste0("Accuracy: ",
                        round(confusionMatrix$overall[1], 3)))
print(roc$auc)
    }
}
toc()
stopCluster(cpu)

# Aggregate Metrics ----
bagging_results = cbind(
    data.frame(Accuracy, Kappa, Auc, nodesize = nodesize_, sampsize=sampsize_))

#save(bagging_results, file="bagging_results.RData")

# Clear cache ----
rm(Acc_i, K_i, Auc_i, nodesize, roc, sampsize)
rm(Accuracy, Auc, Kappa, nodesize_, sampsize_)

library(ggeconodist)

ggplot(bagging_results, aes(x = factor(nodesize), Auc)) + geom_econodist(tenth_col = "#879DDD",
    median_col = "#1D2F65", ninetieth_col = "#3252B1") + scale_y_continuous(position = "right",
    limits = range(0.7, 1)) + labs(x = "nodesize", title = "Tuning Bagging nodesize",
    subtitle = "Resultados finales bucle, parametro nodesize y comparacion con AUC") +
    theme_econodist(econ_text_col = "#3b454a", econ_plot_bg_col = "#E6EAF8", econ_grid_col = "#bbcad2",
        econ_font = "Times", light_font = "Times", bold_font = "Times") + theme(plot.title = element_text(face = "bold")) ->
    gg

grid.newpage()
left_align(gg, c("subtitle", "title", "caption")) %>%
    add_econodist_legend(econodist_legend_grob(family = "Times", tenth_col = "#879DDD",
        ninetieth_col = "#3252B1"), below = "subtitle") %>%
    grid.draw()

ggplot(bagging_results, aes(x = factor(nodesize), Accuracy)) + geom_econodist(tenth_col = "#879DDD",
    median_col = "#1D2F65", ninetieth_col = "#3252B1") + scale_y_continuous(position = "right",
    limits = range(0.7, 1)) + labs(x = "nodesize", title = "Tuning Bagging nodesize",
    subtitle = "Resultados finales bucle, parametro nodesize y comparacion con Accuracy") +
    theme_econodist(econ_text_col = "#3b454a", econ_plot_bg_col = "#E6EAF8", econ_grid_col = "#bbcad2",
        econ_font = "Times", light_font = "Times", bold_font = "Times") + theme(plot.title = element_text(face = "bold")) ->
    gg

grid.newpage()
left_align(gg, c("subtitle", "title", "caption")) %>%
    add_econodist_legend(econodist_legend_grob(family = "Times", tenth_col = "#879DDD",
        ninetieth_col = "#3252B1"), below = "subtitle") %>%
    grid.draw()

library(randomForest)
bg <- randomForest(data = upTrain, factor(attrition) ~ ., mtry = 51, ntree = 1000,
    sampsize = 1570, nodesize = 40, replace = TRUE, importance = TRUE)

library(randomForest)
rf <- randomForest(data = upTrain, factor(attrition) ~ ., mtry = 45, ntree = 2000,
    sampsize = 1570, nodesize = 20, replace = TRUE, importance = TRUE)

library(kableExtra)
modelLookup("gbm")[2:3] %>%
    cbind(Description = linebreak(c("El número total de árboles para emplear.",
        "El número d de divisiones en cada árbol, este controla la complejidad del conjunto impulsado.",
        "Controla la rapidez con la que el algoritmo desciende hacía el gradient descent.",
        "Controla si utiliza o no una fracción de las observaciones de entrenamiento disponibles."))) %>%
    kable(format = "html", align = c(rep("l", 4)), caption = "Descripcion de los parámetros en GBM") %>%
    row_spec(0, font_size = 14) %>%
    column_spec(1, monospace = T)

library(tictoc)
registerDoParallel(makeCluster(3) -> cpu)
tic()
gbm_results <- train(factor(attrition) ~ ., data = upTrain, method = "gbm", trControl = control,
    tuneGrid = expand.grid(shrinkage = c(0.01, 0.05, 0.1, 0.5, 1), n.minobsinnode = c(5,
        20, 35), n.trees = c(1000, 5000, 10000), interaction.depth = c(2)), distribution = "bernoulli",
    bag.fraction = 1, verbose = FALSE)
toc()  #17 min elapsed
stopCluster(cpu)

paste0(cat("Best Hyperparameters Tuning: \n"), xfun::tree(as.list(gbm_results$bestTune)))

plot(gbm_results, output = "ggplot", "line", layout = c(3, 1), par.settings = list(superpose.line = list(lwd = 1,
    col = c("#2A788E", "#2E45B8", "#440154")), superpose.symbol = list(pch = 19,
    cex = 0.6, col = c("#2A788E", "#2E45B8", "#440154")), strip.background = list(col = "#D6DBF5")))

gbm <- train(factor(attrition) ~ ., data = upTrain, method = "gbm", trControl = control,
    tuneGrid = expand.grid(shrinkage = c(1), n.minobsinnode = c(35), n.trees = c(10000),
        interaction.depth = c(2)), distribution = "bernoulli", bag.fraction = 1,
    verbose = FALSE)

modelLookup("xgbTree")[2:3] %>%
    cbind(Description = linebreak(c("El número total de árboles para emplear",
        "Se utiliza para controlar el sobreajuste ya que un valor mayor permitirá que el modelo aprenda relaciones muy específicas para una muestra particular.",
        "Hace el modelo más robusto reduciendo los pesos en cada paso.", "Controla si utiliza o no una fracción de las observaciones de entrenamiento disponibles.",
        "Gamma especifica la reducción positiva mínima en la loss función requerida para hacer una división del nodo.",
        "Denota las columnas a remuestrar para cada árbol.", "Define la suma mínima de pesos de todas las observaciones requeridas en un child node. Por valores superiores impiden que un modelo aprenda relaciones que podrían ser muy específicas."))) %>%
    kable(format = "html", align = c(rep("l", 4)), bootstrap_options = "basic", caption = "Descripcion de los parámetros en XGBoost") %>%
    column_spec(2, width = "3.2cm") %>%
    row_spec(0, font_size = 14) %>%
    column_spec(1, monospace = T, width = "4.2cm")

registerDoParallel(makeCluster(3) -> cpu)
xgbm_results <- train(factor(attrition) ~ ., data = upTrain, verbose = FALSE, method = "xgbTree",
    trControl = control, tuneGrid = expand.grid(min_child_weight = c(5, 30, 50),
        eta = c(0.1, 0.05, 0.01), nrounds = c(500, 1000, 5000, 10000), max_depth = 6,
        gamma = 0, colsample_bytree = 1, subsample = 1))
stopCluster(cpu)

paste0(cat("Best Hyperparameters Tuning: \n"), xfun::tree(as.list(xgbm_results$bestTune)))

plot(xgbm_results, output = "ggplot", "line", layout = c(3, 1), par.settings = list(superpose.line = list(lwd = 1,
    col = c("#2A788E", "#2E45B8", "#440154")), superpose.symbol = list(pch = 19,
    cex = 0.6, col = c("#2A788E", "#2E45B8", "#440154")), strip.background = list(col = "#D6DBF5")))

xgbm <- train(factor(attrition) ~ ., data = upTrain, method = "xgbTree", trControl = control,
    tuneGrid = expand.grid(eta = c(0.05), min_child_weight = c(35), nrounds = c(10000),
        gamma = c(0), subsample = c(1), max_depth = c(6), colsample_bytree = c(1)),
    verbose = FALSE)

library(kableExtra)
modelLookup("svmPoly")[2:3] %>%
    cbind(description = linebreak(c("El grado de la fúncion polinomial", "El parametro que ajusta el kernel a la hora de dividir las predicciones",
        "El parámetro de regularización (C), la constante C del término de regularización en la formulación de Lagrange, indica a la maquina de suporte cuánto evitar la clasificación errónea de cada ejemplo de entrenamiento."))) %>%
    kable(format = "html", align = c(rep("l", 3)), caption = "Descripcion de los parámetros en SVM Polinomial") %>%
    row_spec(0, font_size = 14) %>%
    column_spec(1, width = 12, monospace = T) %>%
    column_spec(2, width = 14)