Proyecto Final Econometría

María Alejandra Cermeño González 12002294 16/Diciembre/2016 PUMP IT UP: Mining the Water Table

El proyecto de econometría trata de poner en prácica los conocimientos adquiridos durante el curso, para esto se ingresó a la competencia “Pump it Up: Data Mining the Water Table”.

Esta competencia utiliza data de “taarifa” y de “Tanzanian Ministry of Water” el objetivo es predecir cuales de las bombas de agua son funcionales, cuales necesitan reparaciones y cuales no funcionan. El entendimiento de esta data puede ayudar a prevenir fallas, a generar una serie de operaciones de mantenimiento con el objetivo de poder tener disponibilidad de agua potable en las comunidades en Tanzania.

Como ya se dijo, el objetivo es la predicción de la condición de las bombas de agua, algunas de las variables que el DataSet contiene son:

1. id: identificación de cada pozo
2. gps_height: Altitud del pozo
3. longitude & latitude : longitud y latitud (Coordenadas GPS)
4. region: Región geográfica del pozo
5. population: cantidadde población en los alrededores del pozo
6. construction_year: Año del construcción ddel pozo
7. extraction_type: Forma de extracción utilizada en el pozo
8. managemente: Como es manejado el pozo
9. payment: Costo del agua
10. quality_gropu: Calidad del agua extraída del pozo
11. quantity_group: Cantidad de agua extraída del pozo
12. source: La fuente del agua
13. waterpoint_type: Tipo de punto de agua

Como primer paso, se van a importar las librerías a utilizar

La Data consta de 3 partes, “train_values” en dónde se encuentran las variables independientes (las que se utilizarán para la predicción), “train_labels” en dónde se encuentra la variable dependiente (aquella que se va a predecir) y “test_values” en dónde se encuentran las variables independientes para el test

train_value<-read.csv("train_values.csv", stringsAsFactors = FALSE, na.strings = "")
train_labels<-read.csv("train_labels.csv", stringsAsFactors = FALSE, na.strings = "")
test<-read.csv("test_values.csv", stringsAsFactors = FALSE, na.strings = "")

Se unirá en un solo dataframe el train y el test, el modelo de predicción generado más adelante utiliza factores y para evitar que algunas de las variables en el train y el test no coincidan, se convertirán a factores antes de volverlos a separar y unir el train (labels y value). También se observa que cuenta con muchas variables, algunas de las cuales se repiten por diversas situaciones (previamente visualizado), por lo que se reducirá el dataframe con aquellas que son únicas y necesarias.

#Unir todo la data
all_data <- bind_rows(train_value,test)
#Reducir el dataframe
all_data <- select(all_data,id,amount_tsh,gps_height,longitude,latitude,basin,region,population,
                    construction_year,extraction_type_class,management_group,payment_type,
                    quality_group,quantity_group,source_class,waterpoint_type_group)
#convertir a factores
all_data$basin <- as.factor(all_data$basin)
all_data$region<- as.factor(all_data$region)
all_data$extraction_type_class<- as.factor(all_data$extraction_type_class)
all_data$management_group<- as.factor(all_data$management_group)
all_data$payment_type<- as.factor(all_data$payment_type)
all_data$quality_group<- as.factor(all_data$quality_group)
all_data$quantity_group<- as.factor(all_data$quantity_group)
all_data$source_class<- as.factor(all_data$source_class)
all_data$waterpoint_type_group<- as.factor(all_data$waterpoint_type_group)
#Train-Test
train <-right_join(all_data[0:59400,],train_labels,by="id")
train$status_group<-as.factor(train$status_group)
test<-all_data[59401:nrow(all_data),]
rm(train_value)
rm(train_labels)
rm(all_data)

Observar el DataSet (train)

glimpse(train)

Observations: 59,400
Variables: 17
$ id                    <int> 69572, 8776, 34310, 67743, 19728, 9944, 19816, 54551, 53934, 4614...
$ amount_tsh            <dbl> 6000, 0, 25, 0, 0, 20, 0, 0, 0, 0, 0, 200, 0, 0, 0, 0, 500, 0, 0,...
$ gps_height            <int> 1390, 1399, 686, 263, 0, 0, 0, 0, 0, 0, 62, 1062, 0, 1368, 0, 164...
$ longitude             <dbl> 34.93809, 34.69877, 37.46066, 38.48616, 31.13085, 39.17280, 33.36...
$ latitude              <dbl> -9.85632177, -2.14746569, -3.82132853, -11.15529772, -1.82535885,...
$ basin                 <fctr> Lake Nyasa, Lake Victoria, Pangani, Ruvuma / Southern Coast, Lak...
$ region                <fctr> Iringa, Mara, Manyara, Mtwara, Kagera, Tanga, Shinyanga, Shinyan...
$ population            <int> 109, 280, 250, 58, 0, 1, 0, 0, 0, 0, 345, 250, 0, 1, 0, 200, 35, ...
$ construction_year     <int> 1999, 2010, 2009, 1986, 0, 2009, 0, 0, 0, 0, 2011, 1987, 0, 2009,...
$ extraction_type_class <fctr> gravity, gravity, gravity, submersible, gravity, submersible, ha...
$ management_group      <fctr> user-group, user-group, user-group, user-group, other, user-grou...
$ payment_type          <fctr> annually, never pay, per bucket, never pay, never pay, per bucke...
$ quality_group         <fctr> good, good, good, good, good, salty, good, milky, salty, good, s...
$ quantity_group        <fctr> enough, insufficient, enough, dry, seasonal, enough, enough, eno...
$ source_class          <fctr> groundwater, surface, surface, groundwater, surface, unknown, gr...
$ waterpoint_type_group <fctr> communal standpipe, communal standpipe, communal standpipe, comm...
$ status_group          <fctr> functional, functional, functional, non functional, functional, ...

table(train$status_group)

             functional functional needs repair          non functional 
                  32259                    4317                   22824 

Observar si existe alguna de las variables independientes que contenga data no válida

sapply(train, num_na)

                   id            amount_tsh            gps_height             longitude 
                    0                     0                     0                     0 
             latitude                 basin                region            population 
                    0                     0                     0                     0 
    construction_year extraction_type_class      management_group          payment_type 
                    0                     0                     0                     0 
        quality_group        quantity_group          source_class waterpoint_type_group 
                    0                     0                     0                     0 
         status_group 
                    0 

sapply(test, num_na)

                   id            amount_tsh            gps_height             longitude 
                    0                     0                     0                     0 
             latitude                 basin                region            population 
                    0                     0                     0                     0 
    construction_year extraction_type_class      management_group          payment_type 
                    0                     0                     0                     0 
        quality_group        quantity_group          source_class waterpoint_type_group 
                    0                     0                     0                     0 

Utilizar gráficas para visualizar características de la data

train %>%
    ggplot(aes(reorder(basin),fill=status_group))+
    geom_bar()

train %>%
    ggplot(aes(reorder(extraction_type_class),fill=status_group))+
    geom_bar()

train %>%
    ggplot(aes(reorder(management_group),fill=status_group))+
    geom_bar()

train %>%
    ggplot(aes(reorder(quality_group),fill=status_group))+
    geom_bar()

train %>%
    ggplot(aes(reorder(quantity_group),fill=status_group))+
    geom_bar()

train %>%
    ggplot(aes(reorder(source_class),fill=status_group))+
    geom_bar()

train %>%
    ggplot(aes(reorder(waterpoint_type_group),fill=status_group))+
    geom_bar()

Mapear longitud y latitud en un plano cartesiano y observar el estrado de los pozos

train%>%
    subset(latitude < 0 & longitude > 0)%>%
    ggplot(aes(x = latitude, y = longitude, color = status_group)) + 
    geom_point()

Para generar el modelo de predicción, se utilizarán árboles, en este caso, se trata de generar una clasificación no binaria, dado esto, se utiliza la librería randomForest con la cual se pueden realizar clasificaciones para un máximo de 32 clases.

set.seed(100)
#Generar modelo
modelo <- randomForest(status_group~longitude+latitude+extraction_type_class+
                               quality_group+quantity_group+waterpoint_type_group+
                               construction_year+payment_type+amount_tsh+source_class, 
                             data = train, importance = TRUE, ntree = 30, nodesize = 3)
print(modelo)

Call:
 randomForest(formula = status_group ~ longitude + latitude +      extraction_type_class + quality_group + quantity_group +      waterpoint_type_group + construction_year + payment_type +      amount_tsh + source_class, data = train, importance = TRUE,      ntree = 30, nodesize = 3) 
               Type of random forest: classification
                     Number of trees: 30
No. of variables tried at each split: 3

        OOB estimate of  error rate: 20.65%
Confusion matrix:
                        functional functional needs repair non functional class.error
functional                   29062                     487           2710  0.09910413
functional needs repair       2634                     952            731  0.77947649
non functional                5452                     254          17118  0.25000000

#Generar predicciones
prediccion <- predict(object= modelo,newdata= test)
prediccion <- data.frame(id = test$id, status_group = prediccion)
write.csv(prediccion, file="Prediccion.csv",row.names = FALSE)

En la competencia no existe la posibilidad de adjuntar lo que se ha realizado, por lo tanto, adjunto un screenshot de la puntuación y la posición obtenida.

—-Función para verificar la cantidad de NA en los dataFrames—-

num_na <- function(x){
  sum(is.na(x))
}

—-Función para reordernar la data—-

reorder <- function(x) {
  factor(x, levels = names(sort(table(x))))
}