1. Introducción

2. Lectura y estructura del dataset

library(ISLR)
library(ggplot2)
## Registered S3 methods overwritten by 'ggplot2':
##   method         from 
##   [.quosures     rlang
##   c.quosures     rlang
##   print.quosures rlang
library(randomForest)
## randomForest 4.6-14
## Type rfNews() to see new features/changes/bug fixes.
## 
## Attaching package: 'randomForest'
## The following object is masked from 'package:ggplot2':
## 
##     margin
library(rpart)
library(rpart.plot)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following object is masked from 'package:randomForest':
## 
##     combine
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(caTools)
df <- College
summary(df)
##  Private        Apps           Accept          Enroll       Top10perc    
##  No :212   Min.   :   81   Min.   :   72   Min.   :  35   Min.   : 1.00  
##  Yes:565   1st Qu.:  776   1st Qu.:  604   1st Qu.: 242   1st Qu.:15.00  
##            Median : 1558   Median : 1110   Median : 434   Median :23.00  
##            Mean   : 3002   Mean   : 2019   Mean   : 780   Mean   :27.56  
##            3rd Qu.: 3624   3rd Qu.: 2424   3rd Qu.: 902   3rd Qu.:35.00  
##            Max.   :48094   Max.   :26330   Max.   :6392   Max.   :96.00  
##    Top25perc      F.Undergrad     P.Undergrad         Outstate    
##  Min.   :  9.0   Min.   :  139   Min.   :    1.0   Min.   : 2340  
##  1st Qu.: 41.0   1st Qu.:  992   1st Qu.:   95.0   1st Qu.: 7320  
##  Median : 54.0   Median : 1707   Median :  353.0   Median : 9990  
##  Mean   : 55.8   Mean   : 3700   Mean   :  855.3   Mean   :10441  
##  3rd Qu.: 69.0   3rd Qu.: 4005   3rd Qu.:  967.0   3rd Qu.:12925  
##  Max.   :100.0   Max.   :31643   Max.   :21836.0   Max.   :21700  
##    Room.Board       Books           Personal         PhD        
##  Min.   :1780   Min.   :  96.0   Min.   : 250   Min.   :  8.00  
##  1st Qu.:3597   1st Qu.: 470.0   1st Qu.: 850   1st Qu.: 62.00  
##  Median :4200   Median : 500.0   Median :1200   Median : 75.00  
##  Mean   :4358   Mean   : 549.4   Mean   :1341   Mean   : 72.66  
##  3rd Qu.:5050   3rd Qu.: 600.0   3rd Qu.:1700   3rd Qu.: 85.00  
##  Max.   :8124   Max.   :2340.0   Max.   :6800   Max.   :103.00  
##     Terminal       S.F.Ratio      perc.alumni        Expend     
##  Min.   : 24.0   Min.   : 2.50   Min.   : 0.00   Min.   : 3186  
##  1st Qu.: 71.0   1st Qu.:11.50   1st Qu.:13.00   1st Qu.: 6751  
##  Median : 82.0   Median :13.60   Median :21.00   Median : 8377  
##  Mean   : 79.7   Mean   :14.09   Mean   :22.74   Mean   : 9660  
##  3rd Qu.: 92.0   3rd Qu.:16.50   3rd Qu.:31.00   3rd Qu.:10830  
##  Max.   :100.0   Max.   :39.80   Max.   :64.00   Max.   :56233  
##    Grad.Rate     
##  Min.   : 10.00  
##  1st Qu.: 53.00  
##  Median : 65.00  
##  Mean   : 65.46  
##  3rd Qu.: 78.00  
##  Max.   :118.00

Podemos observar que en la columna PhD, el máximo es 103. Esto es un error pues no puede haber un 103% de profesores con doctorado. En este caso, vamos a modificarlo a 100.

#     Las columnas del dataframe están compuestas por las siguientes:
#     Private - A factor with levels No and Yes indicating private or public university
#     Apps - Number of applications received
#     Accept -  Number of applications accepted
#     Enroll -  Number of new students enrolled
#     Top10perc Pct. -  new students from top 10% of H.S. class
#     Top25perc Pct. -  new students from top 25% of H.S. class
#     F.Undergrad -  Number of fulltime undergraduates
#     P.Undergrad -  Number of parttime undergraduates
#     Outstate -  Out-of-state tuition
#     Room.Board -  Room and board costs
#     Books -  Estimated book costs
#     Personal -  Estimated personal spending
#     PhD -  Pct. of faculty with Ph.D.’s
#     Terminal -  Pct. of faculty with terminal degree
#     S.F.Ratio -  Student/faculty ratio
#     perc.alumni -  Pct. alumni who donate
#     Expend -  Instructional expenditure per student
#     Grad.Rate - Graduation rate
which(df$PhD==103)
## [1] 583
df[583, ]$PhD = 100

Veamos si hay algún valor NA.

any(is.na(df))
## [1] FALSE

3. EDA

Vamos a realizar algunos gráficos para ver cómo se comportan las diferentes variables.

ggplot(df, aes(Private,Enroll)) + geom_boxplot(col="black", fill="lightblue") + theme_bw()

En la gráfica anterior podemos observar que se apuntan más estudiantes de media a universidades públicas que privadas.

ggplot(df, aes(Accept, Enroll)) + geom_point(aes(col=Private))+ theme_bw()

Podemos observar en la gráfica que parece existir una relación lineal entre ambas variables (algo que tiene bastante sentido).

ggplot(df, aes(Grad.Rate, Top10perc)) + geom_point(aes(col=Private)) + theme_bw()

Parece que las universidades privadas tienen mayor puntuación. Veámoslo mediante un histograma.

ggplot(df, aes(Grad.Rate)) + geom_histogram(aes(fill=Private), col="black") +theme_bw()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Efectivamente! Sin embargo, vemos una universidad que tiene 118 de nota! Veamos cuál es y lo editamos a 100.

which(df$Grad.Rate>100)
## [1] 96
df[96, ]$Grad.Rate <- 100
ggplot(df, aes(Grad.Rate)) + geom_histogram(aes(fill=Private), col="black") +theme_bw()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Ahora sí.

Como podemos observar también las privadas gastan más presupuesto en personal.

ggplot(df, aes(Personal)) + geom_histogram(aes(fill=Private), col="black") +theme_bw()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Veamos la distribución de los gastos en alojamiento y comida en función de la nota de la universidad. Las privadas gastan más en este aspecto.

ggplot(df, aes(Room.Board,Grad.Rate)) + geom_point(aes(col=Private)) +theme_bw()

En las siguientes gráficas podemos observar cómo se distribuyen los alumnos en función de si están matriculados en más o menos créditos.

ggplot(df, aes(F.Undergrad)) + geom_histogram(binwidth=1000,aes(fill=Private), col="black") +theme_bw()

ggplot(df, aes(P.Undergrad)) + geom_histogram(binwidth=1000,aes(fill=Private), col="black") +theme_bw()

ggplot(df, aes(x=Private, P.Undergrad)) + geom_boxplot(aes(fill=Private)) + theme_bw()

ggplot(df, aes(x=Private, F.Undergrad)) + geom_boxplot(aes(fill=Private)) + theme_bw()

Podemos observar que las universidades públicas tienen mayor número de estudiantes a tiempo parcial y completo y sin embargo existen un gran número de universidades privadas con menos de 7000 alumnos a tiempo completo y partido.

4. Creación del training y test data.

sample <- sample.split(df$Private, SplitRatio = 0.7)
test <- subset(df, sample==FALSE)
train <- subset(df, sample==TRUE)

5. Aplicando el modelo.

Aplicamos el modelo de los árboles de decisión.

model <- rpart(Private~.,method='class',data=train)
tree.predicts <- predict(model,test)
head(tree.predicts)
##                                       No       Yes
## Abilene Christian University 0.162790698 0.8372093
## Adelphi University           0.006514658 0.9934853
## Agnes Scott College          0.006514658 0.9934853
## Albertson College            0.006514658 0.9934853
## Albright College             0.006514658 0.9934853
## Alma College                 0.006514658 0.9934853

Creamos una función para pasar la matriz anterior a una columna que indique Sí o No.

tree.predicts <- as.data.frame(tree.predicts)
change <- function(x){
  if (x>=0.5){
    return ("Yes")
  }
  else{
    return("No")
  }
}
  
tree.predicts$Private <- sapply(tree.predicts$Yes, change)

Creamos la matriz de confusión.

table(tree.predicts$Private, test$Private)
##      
##        No Yes
##   No   54   6
##   Yes  10 163
prp(model)

Apliquemos el modelo mediante bosques aleatorios.

rf.model <- randomForest(Private~., data=train,importance=TRUE)
print(rf.model)
## 
## Call:
##  randomForest(formula = Private ~ ., data = train, importance = TRUE) 
##                Type of random forest: classification
##                      Number of trees: 500
## No. of variables tried at each split: 4
## 
##         OOB estimate of  error rate: 5.51%
## Confusion matrix:
##      No Yes class.error
## No  130  18  0.12162162
## Yes  12 384  0.03030303
p <- predict(rf.model, test)
table(p, test$Private)
##      
## p      No Yes
##   No   57   4
##   Yes   7 165

Como se ha comentado en otras ocasiones, tiene más precisión que el método de los árboles de decisión dependiendo de lo que se busque con el modelo!