1. Resumen inicial

El mejor resultado obtenido ha sido 0.7806 empleando el algoritmo Ranger ¿Qué ha sido clave para conseguir esa puntuación? Uno de los pasos que han sido claves para conseguir la puntuación mayor obtenida, ha sido la seleccion del dataset con valores missing incluidos; a pesar de que puede pensarse, inicialmente, que unos datos sin missings nos llevaran a la obtencion de un mejor modelo, en este caso se ha visto que no es asi. Ademas, el incluir tan solo variables numéricas y realizar una selección de variables utilizando el método Step AIC repetida son otros puntos claves que nos han llevado a obtener la puntuacion y conseguir un modelo satisfactorio.

2. Librerías y carga de datos

2.1. Librerías

library(data.table)
library(dplyr)
library(ranger)
library(ggplot2)
library(h2o)
library(caret)
library(corrplot)
library(questionr)
library(psych)
library(car)
library(knitr)
library(MASS)

2.2. Carga de datos

 #----- Cargo datos 
 # datLabel <- as.data.frame(fread("01_labels.csv", nThread = 4 ))
 # dim(datLabel)
 # head(datLabel)
 # datTrain <- as.data.frame(fread("02_trainset.csv", nThread = 4 ))
 # dim(datTrain)
 # head(datTrain)
 # 
#----- Junto labels y Train
 # head(datLabel[,1])
 # head(datTrain[,1])
 # all.equal(datLabel[,1], datTrain[,1])
  # tienen el mismo orden pero aun asi hago un merge.
 
 # datEnd <- merge(datTrain, datLabel, by.x = "id", by.y="id", all = TRUE)
 # head(datEnd)
#----- Guardo los datos train ya preparados con los labels
# save(datEnd, file = "datosRaw.RData")
load("datosRaw.RData")    #Se carga con el nombre DatEnd

3. Análisis de variables

3.1. Análisis en el conjunto de datos original

El conjunto de datos original obtenido del apartado de carga de datos se llama datEnd, por lo que haremos el análisis sobre este buscando missings, valores extremos y viendo cuál es la clase de cada variable

#Clase de cada variable
str(datEnd)
#Ponemos como factor las variables cualitativas (la fecha queda como numérica)
datEnd[,c(1,2,5,7,10,12:18,20:41)] <- lapply(datEnd[,c(1,2,5,7,10,12:18,20:41)], factor) 
#Buscando misssing y outliers
summary(datEnd)
#       id                         status_group     amount_tsh       date_recorded     
# 0      :    1   functional             :32259   Min.   :     0.0   Length:59400      
# 1      :    1   functional needs repair: 4317   1st Qu.:     0.0   Class :character  
# 2      :    1   non functional         :22824   Median :     0.0   Mode  :character  
# 3      :    1                                   Mean   :   317.7                     
# 4      :    1                                   3rd Qu.:    20.0                     
# 5      :    1                                   Max.   :350000.0                     
# (Other):59394                                                                        
# 
#                      funder        gps_height          installer       longitude        latitude      
# Government Of Tanzania: 9084   Min.   : -90.0   DWE       :17402   Min.   : 0.00   Min.   :-11.649  
#                       : 3635   1st Qu.:   0.0             : 3655   1st Qu.:33.09   1st Qu.: -8.541  
# Danida                : 3114   Median : 369.0   Government: 1825   Median :34.91   Median : -5.022  
# Hesawa                : 2202   Mean   : 668.3   RWE       : 1206   Mean   :34.08   Mean   : -5.706  
# Rwssp                 : 1374   3rd Qu.:1319.2   Commu     : 1060   3rd Qu.:37.18   3rd Qu.: -3.326  
# World Bank            : 1349   Max.   :2770.0   DANIDA    : 1050   Max.   :40.35   Max.   :  0.000  
# (Other)               :38642                    (Other)   :33202                                    
# 
#         wpt_name      num_private                    basin          subvillage            region     
# none     : 3563   Min.   :   0.0000   Lake Victoria  :10248   Madukani:  508   Iringa     : 5294  
# Shuleni  : 1748   1st Qu.:   0.0000   Pangani        : 8940   Shuleni :  506   Shinyanga  : 4982  
# Zahanati :  830   Median :   0.0000   Rufiji         : 7976   Majengo :  502   Mbeya      : 4639  
# Msikitini:  535   Mean   :   0.4741   Internal       : 7785   Kati    :  373   Kilimanjaro: 4379  
# Kanisani :  323   3rd Qu.:   0.0000   Lake Tanganyika: 6432           :  371   Morogoro   : 4006  
# Bombani  :  271   Max.   :1776.0000   Wami / Ruvu    : 5987   Mtakuja :  262   Arusha     : 3350  
# (Other)  :52130                       (Other)        :12032   (Other) :56878   (Other)    :32750  
# 
#      region_code    district_code             lga               ward         population     
# 11     : 5300   1      :12203   Njombe      : 2503   Igosi    :  307   Min.   :    0.0  
# 17     : 5011   2      :11173   Arusha Rural: 1252   Imalinyi :  252   1st Qu.:    0.0  
# 12     : 4639   3      : 9998   Moshi Rural : 1251   Siha Kati:  232   Median :   25.0  
# 3      : 4379   4      : 8999   Bariadi     : 1177   Mdandu   :  231   Mean   :  179.9  
# 5      : 4040   5      : 4356   Rungwe      : 1106   Nduruma  :  217   3rd Qu.:  215.0  
# 18     : 3324   6      : 4074   Kilosa      : 1094   Kitunda  :  203   Max.   :30500.0  
# (Other):32707   (Other): 8597   (Other)     :51017   (Other)  :57958                    
# 
#   public_meeting                  recorded_by          scheme_management        scheme_name   
#  FALSE: 5055      GeoData Consultants Ltd:59400     VWC            :36793                :28166  
#  TRUE :51011                                        WUG            : 5206   K            :  682  
#  NA's : 3334                                                       : 3877   None         :  644  
#                                                     Water authority: 3153   Borehole     :  546  
#                                                    WUA             : 2883   Chalinze wate:  405  
#                                                     Water Board    : 2748   M            :  400  
#                                                     (Other)        : 4740   (Other)      :28557  
# 
#   permit      construction_year    extraction_type  extraction_type_group  extraction_type_class
# FALSE:17492   0      :20709     gravity    :26780   gravity    :26780     gravity     :26780    
# TRUE :38852   2010   : 2645     nira/tanira: 8154   nira/tanira: 8154     handpump    :16456    
# NA's : 3056   2008   : 2613     other      : 6430   other      : 6430     motorpump   : 2987    
#               2009   : 2533     submersible: 4764   submersible: 6179     other       : 6430    
#               2000   : 2091     swn 80     : 3670   swn 80     : 3670     rope pump   :  451    
#               2007   : 1587     mono       : 2865   mono       : 2865     submersible : 6179    
#               (Other):27222     (Other)    : 6737   (Other)    : 5322     wind-powered:  117    
# 
#        management      management_group                  payment          payment_type  
# vwc             :40507   commercial: 3638   never pay            :25348   annually  : 3642  
# wug             : 6515   other     :  943   other                : 1054   monthly   : 8300  
# water board     : 2933   parastatal: 1768   pay annually         : 3642   never pay :25348  
# wua             : 2535   unknown   :  561   pay monthly          : 8300   on failure: 3914  
# private operator: 1971   user-group:52490   pay per bucket       : 8985   other     : 1054  
# parastatal      : 1768                      pay when scheme fails: 3914   per bucket: 8985  
# (Other)         : 3171                      unknown              : 8157   unknown   : 8157  
# 
#        water_quality    quality_group           quantity          quantity_group 
# soft           :50818   colored :  490   dry         : 6246   dry         : 6246  
# salty          : 4856   fluoride:  217   enough      :33186   enough      :33186  
# unknown        : 1876   good    :50818   insufficient:15129   insufficient:15129  
# milky          :  804   milky   :  804   seasonal    : 4050   seasonal    : 4050  
# coloured       :  490   salty   : 5195   unknown     :  789   unknown     :  789  
# salty abandoned:  339   unknown : 1876                                            
# (Other)        :  217                                                             
# 
#      source                    source_type         source_class  
# spring              :17021   borehole            :11949   groundwater:45794  
# shallow well        :16824   dam                 :  656   surface    :13328  
# machine dbh         :11075   other               :  278   unknown    :  278  
# river               : 9612   rainwater harvesting: 2295                      
# rainwater harvesting: 2295   river/lake          :10377                      
# hand dtw            :  874   shallow well        :16824                      
# (Other)             : 1699   spring              :17021                      
# 
#      waterpoint_type         waterpoint_type_group
# cattle trough              :  116   cattle trough     :  116    
# communal standpipe         :28522   communal standpipe:34625    
# communal standpipe multiple: 6103   dam               :    7    
# dam                        :    7   hand pump         :17488    
# hand pump                  :17488   improved spring   :  784    
# improved spring            :  784   other             : 6380    
# other                      : 6380

3.2. Recodificación e imputación de missings

Vemos que existen missings declarados con espaciós en blanco y no declarados en algunas variables por lo que vamos a recodificar los no declarados y posteriormente los imputaremos, creando un nuevo conjunto de datos que se llamará datEnd_sinNA

Recodificando missings no declarados variables cualitativas (" “)

datEnd$funder<-recode.na(datEnd$funder,"")
datEnd$installer<-recode.na(datEnd$installer,"")
datEnd$subvillage<-recode.na(datEnd$subvillage,"")
datEnd$scheme_management<-recode.na(datEnd$scheme_management,"")
datEnd$scheme_name<-recode.na(datEnd$scheme_name,"")

Proporción de missings por variable y observación

 #Nota: Para no tocar el fichero de datos original, lo guardo en una nueva variable llamada input
input<-as.data.frame(datEnd)
input$prop_missings<-apply(is.na(input),1,mean)
summary(input$prop_missings)
(prop_missingsVars<-apply(is.na(input),2,mean))

# id          status_group     amount_tsh      date_recorded      funder        gps_height 
# 0.000000000   0.000000000   0.000000000     0.000000000       0.061195286     0.000000000 
# installer    longitude      latitude         wpt_name       num_private      basin 
# 0.061531987  0.000000000   0.000000000      0.000000000     0.000000000    0.000000000 
# subvillage      region     region_code     district_code       lga             ward 
# 0.00624579   0.000000000   0.000000000      0.000000000     0.000000000      0.000000000 
# population   public_meeting   recorded_by   scheme_management   scheme_name    permit 
# 0.000000000   0.056127946     0.000000000    0.065269360       0.474175084     0.051447811 
# construction_year extraction_type extraction_type_group extraction_type_class management  management_group 
# 0.000000000        0.000000000     0.000000000           0.000000000    0.000000000  0.000000000 
# payment     payment_type   water_quality   quality_group     quantity      quantity_group 
# 0.000000000   0.000000000   0.000000000     0.000000000     0.000000000    0.000000000 
# source       source_type    source_class  waterpoint_type waterpoint_type_group    prop_missings 
# 0.000000000  0.000000000    0.000000000   0.000000000        0.000000000           0.000000000

#Nota: scheme_name tiene 0.474 proporciones de missing  IMPORTANTE -De momento la dejo , pero tieniendo en cuenta que son muchos

Imputación de missings con la función de Aida

ImputacionCuali<-function(vv,tipo){#tipo debe tomar los valores moda o aleatorio
  if (tipo=="moda"){
    vv[is.na(vv)]<-names(sort(table(vv),decreasing = T))[1]
  } else if (tipo=="aleatorio"){
    vv[is.na(vv)]<-sample(vv[!is.na(vv)],sum(is.na(vv)),replace = T)
  }
  vv
}

Aplico la función

 # Imputo todas las cualitativas, seleccionar el tipo de imputación: moda o aleatorio
# Si solo se quiere imputar una, variable<-ImputacionCuali(variable,"moda")
input[,as.vector(which(sapply(input, class)=="factor"))]<-sapply(Filter(is.factor, input),function(x) ImputacionCuali(x,"aleatorio"))
# A veces se cambia el tipo de factor a character al imputar, así que hay que indicarle que es factor
input[,as.vector(which(sapply(input, class)=="character"))] <- lapply(input[,as.vector(which(sapply(input, class)=="character"))] , factor
# Guardo los datos ya limpios
#save(input, file = "datosRaw_sinNA.RData")
load("datosRaw_sinNA.RData")  #Se carga con el nombre datEnd_sinNA

3.3. Exploración correlación variables con la objetivo: VCramer

# Calcula el V de Cramer
Vcramer<-function(v,target){
if (is.numeric(v)){
 v<-cut(v,5)
  }
  if (is.numeric(target)){
 target<-cut(target,5)
  }
  cramer.v(table(v,target))
}
  
 # Gráfico con el V de cramer de todas las variables input para saber su importancia
 graficoVcramer<-function(matriz, target){
   salidaVcramer<-sapply(matriz,function(x) Vcramer(x,target))
   barplot(sort(salidaVcramer,decreasing =T),las=2,cex.axis = 0.5,cex.names = 0.5,ylim=c(0,1))      }

Aplico las funciones anteriores , creo dos variables aleatorias para ver qué variables son más importantes que las variables aleatorias y se hace el gráfico de VCrammer

input<-datEnd_sinNA
# Creo la variable aleatoria
 set.seed(12345678)
 input$aleatorio<-runif(nrow(input))
 input$aleatorio2<-runif(nrow(input))
 
 #quito status group
 input<-input[,c(-1,-2)]  #sin id ni status gropu
 
 graficoVcramer(input,datEnd$status_group)   #Selecciono las variables mas imprtantes
...

…

3.4. Creación de nuevas variables

Se crearan nuevas variables con las continuas donde las numéricas primero se estandarizarán para posteriormente crear a mano las transformaciones, partiremos para uno de los modelos de los datos sin missing y para otro de los modelos de los datos con missing), el archivo de datos que tendremos despues de las transformaciones será datEnd_trans

datEnd_trans<-as.data.frame(datEnd)   #si partimos de los datos con missing
datEnd_trans<-as.data.frame(datEnd_sinNA)  #si partimos de los datos sin missing
#Estandarizamos variables numericas
datEnd_trans$id<-scale(datEnd_trans$id)
datEnd_trans$amount_tsh<-scale(datEnd_trans$amount_tsh)
datEnd_trans$gps_height<-scale(datEnd_trans$gps_height)
datEnd_trans$num_private<-scale(datEnd_trans$num_private)
datEnd_trans$region_code<-scale(datEnd_trans$region_code)
datEnd_trans$district_code<-scale(datEnd_trans$district_code)
datEnd_trans$population<-scale(datEnd_trans$population)
#datEnd_trans$construction_year<-scale(datEnd_trans$construction_year)

#Probamos a hacemos transformaciones a mano logaritmo,raiz cuadrada, exponencial,raiz cuarta y productos
datEnd_trans$logamount_tsh<-log(datEnd_trans$amount_tsh)
datEnd_trans$sqrtxgps_height<-sqrt(datEnd_trans$gps_height)
datEnd_trans$explongitud<-exp(datEnd_trans$longitude)
datEnd_trans$sqrlatitude<-sqrt(datEnd_trans$latitude)
datEnd_trans$raiz4num_private<-(datEnd_trans$num_private)^(1/4)
datEnd_trans$log_population<-log(datEnd_trans$population)
               
datEnd_trans$producto1<- (datEnd_trans$gps_height*datEnd_trans$num_private)
datEnd_trans$producto2<-(datEnd_trans$population*datEnd_trans$gps_height)

4. Algoritmos probados

4.1. Random Forests(Ranger) sustituyendo categorias por frecuencia de aparición en datos limpios(sin NA) SCORE=0.7046

En primer lugar prepararemos los datos asignando a cada categoría de cada variable su frecuencia de aparición

#Asigno a cada categoría de cada variable el valor de su frecuencia de aparición
frec_funder<-as.data.frame(table(datEnd_sinNA$funder))  ##1898 niveles
frec_installer<-as.data.frame(table(datEnd_sinNA$installer))  ##2146 niveles
frec_wpt_name<-as.data.frame(table(datEnd_sinNA$wpt_name))   ##37400 niveles
frec_basin<-as.data.frame(table(datEnd_sinNA$basin))    ##9 niveles solo
frec_subvillage<-as.data.frame(table(datEnd_sinNA$subvillage))  ##19288 niveles
frec_region<-as.data.frame(table(datEnd_sinNA$region))      ##21 niveles solo
  #region_code<- como numerica      o ponerla tambien como frecuencias
  #district_code  <- como numerica
frec_lga  <-as.data.frame(table(datEnd_sinNA$lga))  #125 niveles
frec_ward<-as.data.frame(table(datEnd_sinNA$ward))  #2092
frec_scheme_management<-as.data.frame(table(datEnd_sinNA$scheme_management))  #13
frec_scheme_name<-as.data.frame(table(datEnd_sinNA$scheme_name)) #2697
  #frec_construction_year<-as.data.frame(table(datEnd_sinNA$construction_year)) #55 
frec_extraction_type<-as.data.frame(table(datEnd_sinNA$extraction_type))   #18 niveles
frec_extraction_type_group<-as.data.frame(table(datEnd_sinNA$extraction_type_group))   #13
frec_extraction_type_class<-as.data.frame(table(datEnd_sinNA$extraction_type_class))  #7 niveles
frec_management<-as.data.frame(table(datEnd_sinNA$management))   #12 niveles
frec_management_group    #5 niveles
payment     #pocos niveles
payment_type    # pocos niveles
frec_water_quality<-as.data.frame(table(datEnd_sinNA$water_quality))   #8 niveles
quality_group   # pocos niveles
quantity         #pocos niveles
quantity_group    # pocos niveles
frec_source<-as.data.frame(table(datEnd_sinNA$source))  #10 niveles
source_type    #pocos niveles
source_class    #pocos niveles
waterpoint_type  #pocos niveles
waterpoint_type_group  #pocos niveles
 
# Remplazo por las frecuencias de (funder,installer,wpt_name,subvillage,lga ,ward,scheme_name)
datEnd_conFrec<-datEnd_sinNA
datEnd_conFrec$funder<-car::recode(datEnd_conFrec$funder, 'frec_funder$Var1=frec_funder$Freq')
datEnd_conFrec$installer<-car::recode(datEnd_conFrec$installer, 'frec_installer$Var1=frec_installer$Freq')
datEnd_conFrec$wpt_name<-car::recode(datEnd_conFrec$wpt_name, 'frec_wpt_name$Var1=frec_wpt_name$Freq')
datEnd_conFrec$subvillage<-car::recode(datEnd_conFrec$subvillage,'frec_subvillage$Var1=frec_subvillage$Freq')
datEnd_conFrec$lga<-car::recode(datEnd_conFrec$lga, 'frec_lga$Var1=frec_lga$Freq')
datEnd_conFrec$ward<-car::recode(datEnd_conFrec$ward, 'frec_ward$Var1=frec_ward$Freq')
 
 #Se queda escrito como caracter por lo que Lo transformo a numéricas 
datEnd_conFrec$funder<-as.numeric(as.vector(datEnd_conFrec$funder))
datEnd_conFrec$installer<-as.numeric(as.vector(datEnd_conFrec$installer))
datEnd_conFrec$wpt_name<-as.numeric(as.vector(datEnd_conFrec$wpt_name))
datEnd_conFrec$subvillage<-as.numeric(as.vector(datEnd_conFrec$subvillage))
datEnd_conFrec$lga<-as.numeric(as.vector(datEnd_conFrec$lga))
datEnd_conFrec$ward<-as.numeric(as.vector(datEnd_conFrec$ward))

datEnd_conFrec$region_code<-as.numeric(as.vector(datEnd_conFrec$region_code))  #Tratada como numerica
datEnd_conFrec$district_code<-as.numeric(as.vector(datEnd_conFrec$district_code) ) #Tratada como numerica

Una vez que tenemos los datos con las categorías como numéricas(con su frecuencia), pasamos a hacer el modelo Random Forest teniendo en cuenta la VCrammer para la selección de las variables.

my_mod <- ranger( 
  as.factor(status_group) ~ funder + installer + wpt_name +subvillage +lga +ward + quantity +waterpoint_type+ extraction_type+ region_code,
  data = datEnd_conFrec, importance = 'impurity')

pred_mod <- predict(my_mod, datEnd_trans)
as.data.frame(importance(my_mod))
confusionMatrix( pred_mod$predictions, as.factor(datEnd_trans$status_group))

 # No hemos puesto: id + longitude + latitude + gps_height + region_code + district_code + population + construction_year + extraction_type + management + water_quality + source + waterpoint_type

El score obtenido en la plataforma fue 0.7046

4.2. Random Forests(Ranger) aplicando transformaciones a las numericas en datos con missings SCORE=0.7002

Conjunto de datos con el que se trabajará: datos datEnd_trans obtenidos tras aplicar a los datos con missings (datEnd) las transformaciones descritas en el apartado 3.4.

Modelo que se usará: Random Forest

my_mod <- ranger( 
  as.factor(status_group) ~  gps_height + region_code + district_code + population + extraction_type + management + water_quality + source + waterpoint_type + explongitud + producto1 + producto2,                         ,
  data = datEnd_trans, importance = 'impurity'
)
#No he puesto: id+ gps_height + region_code + district_code + population + extraction_type + management + water_quality + source + waterpoint_type +logamount_tsh + sqrtxgps_height + explongitud +sqrlatitude + raiz4num_private + log_population  

pred_mod <- predict(my_mod, datEnd_trans)
as.data.frame(importance(my_mod))
confusionMatrix( pred_mod$predictions, as.factor(datEnd_trans$status_group))

El score en esta ocasión bajo a 0.7002

4.3. Random Forests(Ranger) aplicando transformaciones a las numericas en datos sin missing SCORE=0.6226

Conjunto de datos con el que se trabajará: datos datEnd_trans obtenidos tras aplicar a los datos sin missings (datEnd_sinNA) las transformaciones descritas en el apartado 3.4.

Modelo que se usará: Random Forest

my_mod <- ranger( 
  as.factor(status_group) ~  gps_height + region_code + district_code + population + extraction_type + management + water_quality + source + waterpoint_type + explongitud + producto1 + producto2,                         ,
  data = datEnd_trans, importance = 'impurity'
)

#id+ gps_height + region_code + district_code + population + extraction_type + management + water_quality + source + waterpoint_type +logamount_tsh + sqrtxgps_height + explongitud +sqrlatitude + raiz4num_private + log_population  

pred_mod <- predict(my_mod, datEnd_trans)
as.data.frame(importance(my_mod))
confusionMatrix( pred_mod$predictions, as.factor(datEnd_trans$status_group))

Al haber usado los datos sin missings pensabamos que el score iba a subir,pero bajo más aun que en el segundo caso 0.6226

4.4. Resumen de los modelos probados y score

Modelos Datos usados Variables usadas Score
Random Forest Datos sin missing a 0.7046
Random Forest Datos con transformadas y con missings b 0.6226
Random Forest Datos con transformadas y sin missings b 0.6226
Variables
a funder + installer + wpt_name +subvillage +lga +ward + quantity +waterpoint_type+ extraction_type+ region_code
b gps_height + region_code + district_code + population + extraction_type + management + water_quality + source + waterpoint_type + explongitud + producto1 + producto2

5. Algoritmo y conjunto de datos ganadores

Al ver que utilizando los datos sin missing y con las tranformaciones no se obtenga ninguna mejora con el score se decide trabajar con el fichero que tiene datos missing. En la siguiente prueba se decide trabajar solo con variables numéricas y realizar una selección de variables utilizando el método Step AIC repetida.

Utilizando la función Step AIC Repetida

steprepetidobinaria<- function(data=data,vardep="vardep",
  listconti="listconti",
 sinicio=12345,sfinal=12355,porcen=0.8,criterio="AIC")
 {


resultados<-data.frame(c())
data<-data[,c(listconti,vardep)]
formu1<-formula(paste("factor(",vardep,")~.",sep=""))
formu2<-formula(paste("factor(",vardep,")~1",sep=""))
listamodelos<-list()

for (semilla in sinicio:sfinal)
{
set.seed(semilla)
sample <- sample.int(n = nrow(data),
 size = floor(porcen*nrow(data)), replace = F)

train <- data[sample, ]
test  <- data[-sample, ]

full<-glm(formu1,data=train,family = binomial(link="logit"))
null<-glm(formu2,data=train,family = binomial(link="logit"))


if  (criterio=='AIC')
  {
  selec1<-stepAIC(null,scope=list(upper=full),
   direction="both",family = binomial(link="logit"),trace=FALSE)
  } 
else   if  (criterio=='BIC')
  {
 k1=log(nrow(train))
 selec1<-stepAIC(null,scope=list(upper=full),
  direction="both",family = binomial(link="logit"),k=k1,trace=FALSE)
  }

vec<-(names(selec1[[1]]))

Se define la lista de variables continuas y la variable dependiente y se elige un conjunto de variales sugerido por el método AIC.

listcontinu<-c("id", "amount_tsh","gps_height", "longitude", "latitude", "num_private", 
                "region_code", "district_code", "population","construction_year")
vardep<-c("status_group")

data<-datEnd

lista<-steprepetidobinaria(data=data,
                           vardep=vardep,listconti=listcontinu,sinicio=12345,
                           sfinal=12355,porcen=0.8,criterio="AIC")
tabla<-lista[[1]]
dput(lista[[2]][[1]])
dput(lista[[2]][[2]])
Se obtiene dos conjunto de variables

#> dput(lista[[2]][[1]])
#c("gps_height", "amount_tsh", "region_code", "district_code", 
#"construction_year", "population", "longitude")
#> dput(lista[[2]][[2]])
#c("gps_height", "region_code", "amount_tsh", "district_code", 
#"construction_year", "longitude", "population", "num_private"
)

El conjunto de variables seleccionado para realizar el modelo ha sido el primero. Se va a seguir probando con el modelo Ranger, para ver si se puede obtener una mejora.

my_mod<- ranger(as.factor(status_group) ~ gps_height+amount_tsh+region_code+district_code+ 
                  construction_year+population+longitude,
                data=datEnd, importance = "impurity"
)
pred_mod <- predict(my_mod, datEnd)

Vemos la importancia de cada una de las variables utilizadas

as.data.frame(importance(my_mod))
#gps_height                  3755.401
#amount_tsh                  1872.230
#region_code                 1227.127
#district_code               1170.740
#construction_year           2916.068
#population                  2572.264
#longitude                   4678.020

Realizamos la matrix de predicción para ver los resultados de nuestro modelo

confusionMatrix(pred_mod$predictions, as.factor(datEnd$status_group))

#Confusion Matrix and Statistics

Reference
Prediction                functional functional needs repair non functional
functional                   30683                    2062           6866
functional needs repair         26                    1894             24
non functional                1550                     361          15934

Overall Statistics

Accuracy : 0.8167          
95% CI : (0.8135, 0.8198)
No Information Rate : 0.5431          
P-Value [Acc > NIR] : < 2.2e-16       

Kappa : 0.6475          

Mcnemar's Test P-Value : < 2.2e-16

Con este modelo se puede ver que se obtiene un nivel de predicción del 0.8167. Ahora se verá cuanto se puntuación se obtiene a través del submission.

submission

test<- as.data.frame(fread("testset.csv",nThread = 3))

pred_test <- as.vector(predict(my_mod,test)$prediction)

my_sub <- data.frame(
id=test$id,
status_group =pred_test
)

fwrite(my_sub, file="sub_v11_base_.csv", sep=",")

Con este submission obtuvimos el score más alto que fue de 0.7806.

6. Posibles desarrollos futuros

Para los posibles desarrollos futuros habría que trabajar más la fase de feature engineering. Feature Engineering es dar un paso atrás en el proceso de modelación para intentar construir nuevas variables que posean un mayor grado de correlación con la variable objetivo y que, por tanto, sean más predictivas. Aunque esta es una solución costosa para mejorar el modelo, ya que hay que volver al comienzo, es la que tiene mayor posibilidad de mejorar el poder de prediccion del modelo. Además, el poder crear nuevas variables que nos ayuden a mejorar el modelo es uno de los pasos que se proponen para futuras mejoras de este modelo. Se ha visto tambien que las variables continuas tienen un nivel de importancia alto respecto a la variable objetivo, y además mejoran nuestro score. Por esto, crear nuevas variables basándonos en las continuas podrían mejorar nuestro modelo. También se podría probar con nuevos algoritmos, tales como la red o un H2O. Un H2O permitirá mediante librerías aplicar machine learning automatizado para mejorar la predicción. Por ejemplo, la lib grid search permite aplicar el hyperparameter tunning del algoritmo mediante dos técnicas diferentes, el Grid cartesiano, que consiste en especificar una lista de valores para cada hiperparámetro que se quiere cambiar para realizar todas las combinaciones posibles en el rango definido; o el random grid. También se podría probar un ensamblado de varios modelos. Estas alternativas se proponen para posibles desarrollos futuros que puedan mejorar el scoring del modelo ganador y obtener una prediccion más precisa.