Tarea_Admissions

Utilizar el documento (el código de R) para responder a cada pregunta.

Preguntas del estudio, en el contexto de los chances de ser admitido a la UCLA:

1. ¿Qué tan importante es realmente el inglés (toefl) para ser aceptado en la UCLA, sobre todo si se toma en cuenta en conjunto con los puntajes de GRE y cgpa?

2. ¿Cuál es el odds ratio (OR) de ser admitido, entre los aplicantes con experiencia en investigación y los que no tienen experiencia en investigación?

3. Ranking de la universidad de orígen

1. Cuáles son los chances (odds) de un aplicante que viene de una unversidad de categoría dos (b) de ser admitido en la UCLA?
2. Son los chances de ser admitido significativamente mayores si un aplicante viene de una universidad de primera categoría, comparados con los que vienen de otra universidad de segunda categoría?
3. ¿Cuál es el papel de la experiencia en investigación, cuando se toma en cuenta en en conjunto con el ranking de la universidad de origen? ¿La importancia de la experiencia de investigación en la admisión, depende del ranking de la universidad de origen?

Packages

if(!require(FSA)){install.packages("FSA")}
if(!require(tidyverse)){install.packages("tidyverse")}
if(!require(psych)){install.packages("psych")}
if(!require(lme4)){install.packages("lme4")}
if(!require(lmerTest)){install.packages("lmerTest")}
if(!require(nlme)){install.packages("nlme")}
if(!require(car)){install.packages("car")}
if(!require(plotly)){install.packages("plotly")}
if(!require(reshape2)){install.packages("reshape2")}

#
library(googlesheets4); gs4_deauth()
library(AICcmodavg)
library(tidyverse)
library(lme4)
library(psych)
library(plotly)
library(reshape2)

Datos

####en hoja Excel en G-Classroom [primera hoja]

ss='https://docs.google.com/spreadsheets/d/1mFSGQ_rKVKtO1_J4ifju8LFlHDaKpJ7YQW9LP12NSFc/edit?usp=sharing'
hoja='UCLA_admission'
rango= 'B2:J402'
ucla.i <- read_sheet(ss,
                  col_names = TRUE,
                  sheet= hoja,
                  range= rango,
                  col_types = NULL,
                  na= "NA")

✔ Reading from Admission_UCLA.
✔ Range ''UCLA_admission'!B2:J402'.

ucla.i$admit.F <- as.factor(ucla.i$admit)
ucla.i$research.F <- as.factor(ucla.i$Research)
str(ucla.i)

tibble [400 × 11] (S3: tbl_df/tbl/data.frame)
 $ gre       : num [1:400] 337 324 316 322 314 330 321 308 302 323 ...
 $ toefl     : num [1:400] 118 107 104 110 103 115 109 101 102 108 ...
 $ u.rating  : num [1:400] 4 4 3 3 2 5 3 2 1 3 ...
 $ u.rank.F  : chr [1:400] "b" "b" "c" "c" ...
 $ SOP       : num [1:400] 4.5 4 3 3.5 2 4.5 3 3 2 3.5 ...
 $ LOR       : num [1:400] 4.5 4.5 3.5 2.5 3 3 4 4 1.5 3 ...
 $ cgpa      : num [1:400] 9.65 8.87 8 8.67 8.21 9.34 8.2 7.9 8 8.6 ...
 $ Research  : num [1:400] 1 1 1 1 0 1 1 0 0 0 ...
 $ admit     : num [1:400] 1 0 0 1 0 1 0 0 0 0 ...
 $ admit.F   : Factor w/ 2 levels "0","1": 2 1 1 2 1 2 1 1 1 1 ...
 $ research.F: Factor w/ 2 levels "0","1": 2 2 2 2 1 2 2 1 1 1 ...

Plots

GRE.

Admitidos Vrs. NO dmitidos . gre - toefl - SOP - LOR - cgpa

data <- ucla.i[,c("gre", "toefl", "cgpa", "SOP", "LOR", "admit")]
tmp <- melt(data=data, id.vars = "admit")

p <- ggplot(tmp, aes(x= as.factor(admit), y = value, fill=factor(admit)))
p + geom_boxplot() +
  geom_point(position = position_jitter(width= 0.2, height= 0.2 ), size=0.5 ) +
  facet_wrap(~variable, scales="free_y")

NA
NA

Poner atención> Las cartas se califican en base a escalas ordinales son prácticamente variables categóricas-ordinales.

Research experience

Admitidos Vrs. NO dmitidos [ admit.F ~ research.F ]

p <- ggplot(data= ucla.i, aes(x =research.F, y= admit.F, fill= admit.F) )
p + 
  geom_col()

University Ranking

Admitidos Vrs. NO dmitidos [admit.F~ u.rank.F]

p <- ggplot(data= ucla.i, aes(x = u.rank.F, y= admit.F, fill= admit.F) )
p + 
  geom_col()

GLM

Pregunta 1: ¿Qué tan importante es realmente el inglés (toefl) para ser aceptado en la UCLA, sobre todo si se toma en cuenta en conjunto con los puntajes de GRE y cgpa?

m.toefl <- glm(data= ucla.i, admit.F ~ toefl, family= binomial )
summary(m.toefl)

Call:
glm(formula = admit.F ~ toefl, family = binomial, data = ucla.i)

Coefficients:
             Estimate Std. Error z value Pr(>|z|)    
(Intercept) -55.77147    5.81613  -9.589   <2e-16 ***
toefl         0.50373    0.05286   9.530   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 502.99  on 399  degrees of freedom
Residual deviance: 246.85  on 398  degrees of freedom
AIC: 250.85

Number of Fisher Scoring iterations: 6

m.intx.toefl <- glm(data= ucla.i, admit.F ~ toefl + gre + cgpa, family= binomial )
summary(m.intx.toefl)

Call:
glm(formula = admit.F ~ toefl + gre + cgpa, family = binomial, 
    data = ucla.i)

Coefficients:
             Estimate Std. Error z value Pr(>|z|)    
(Intercept) -94.54004   13.20713  -7.158 8.17e-13 ***
toefl         0.11238    0.07275   1.545   0.1224    
gre           0.08697    0.04629   1.879   0.0603 .  
cgpa          6.08228    1.00226   6.069 1.29e-09 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 502.99  on 399  degrees of freedom
Residual deviance: 156.45  on 396  degrees of freedom
AIC: 164.45

Number of Fisher Scoring iterations: 7

Pregunta 2: ¿Cuál es el odds ratio (OR) de ser admitido, entre los aplicantes con experiencia en investigación y los que no tienen experiencia en investigación?

m.research <- glm(data= ucla.i, admit.F ~ research.F, family= binomial )
summary(m.research)

Call:
glm(formula = admit.F ~ research.F, family = binomial, data = ucla.i)

Coefficients:
            Estimate Std. Error z value Pr(>|z|)    
(Intercept)  -2.9503     0.3419  -8.628   <2e-16 ***
research.F1   3.1426     0.3679   8.542   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 502.99  on 399  degrees of freedom
Residual deviance: 373.15  on 398  degrees of freedom
AIC: 377.15

Number of Fisher Scoring iterations: 5

Plot: [admit ~ research]

p <- ggplot(data= ucla.i, aes(x = Research, y= admit))
p + geom_point(aes(col=admit),  position = position_jitter(width=0.1, height =0.1 )) +
  geom_smooth(method = "glm", method.args= list(family="binomial"))

Pregunta 3

Ranking de la universidad de orígen

a) Cuáles son los chances (odds) de un aplicante que viene de una unversidad de categoría dos (b) de ser admitido en la UCLA?

b) Son los chances de ser admitido significativamente mayores si un aplicante viene de una universidad de primera categoría, comparados con los que vienen de otra universidad de segunda categoría?

m.uRank <- glm(data= ucla.i, admit.F ~ u.rank.F, family= binomial )
summary(m.uRank)

Call:
glm(formula = admit.F ~ u.rank.F, family = binomial, data = ucla.i)

Coefficients:
            Estimate Std. Error z value Pr(>|z|)    
(Intercept)   1.8718     0.3798   4.929 8.28e-07 ***
u.rank.Fb    -1.1989     0.4524  -2.650  0.00805 ** 
u.rank.Fc    -3.5458     0.4481  -7.913 2.51e-15 ***
u.rank.Fd    -4.6952     0.5664  -8.290  < 2e-16 ***
u.rank.Fe    -5.0907     1.0879  -4.679 2.88e-06 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 502.99  on 399  degrees of freedom
Residual deviance: 312.51  on 395  degrees of freedom
AIC: 322.51

Number of Fisher Scoring iterations: 5

table(ucla.i$u.rank.F, ucla.i$admit.F)

   
      0   1
  a   8  52
  b  25  49
  c 112  21
  d 101   6
  e  25   1

(49/25)

[1] 1.96

(52/8)/(49/25)

[1] 3.316327

odds.b <- exp(m.uRank$coefficients[1]+m.uRank$coefficients[2])

OR.a.Vrs.b <- exp(m.uRank$coefficients[1])/exp(m.uRank$coefficients[1]+m.uRank$coefficients[2])

as.numeric(odds.b)

[1] 1.96

as.numeric(OR.a.Vrs.b)

[1] 3.316327

c) ¿Cuál es el papel de la experiencia en investigación, cuando se toma en cuenta en en conjunto con el ranking de la universidad de origen?

¿La importancia de la experiencia de investigación en la admisión, depende del ranking de la universidad de origen?

m.intx <- glm(data= ucla.i, admit.F ~ u.rank.F * Research, family= binomial )
summary(m.intx)

Call:
glm(formula = admit.F ~ u.rank.F * Research, family = binomial, 
    data = ucla.i)

Coefficients:
                   Estimate Std. Error z value Pr(>|z|)    
(Intercept)         -1.9459     1.0690  -1.820   0.0687 .  
u.rank.Fb            0.9343     1.2181   0.767   0.4431    
u.rank.Fc           -1.0330     1.2219  -0.845   0.3979    
u.rank.Fd           -2.3582     1.4685  -1.606   0.1083    
u.rank.Fe          -15.6202   863.3100  -0.018   0.9856    
Research             5.8777     1.4705   3.997 6.41e-05 ***
u.rank.Fb:Research  -3.6985     1.6115  -2.295   0.0217 *  
u.rank.Fc:Research  -3.9787     1.6085  -2.474   0.0134 *  
u.rank.Fd:Research  -3.2601     1.8474  -1.765   0.0776 .  
u.rank.Fe:Research  10.3020   863.3113   0.012   0.9905    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 502.99  on 399  degrees of freedom
Residual deviance: 245.75  on 390  degrees of freedom
AIC: 265.75

Number of Fisher Scoring iterations: 16

#
p <- ggplot(data= ucla.i, aes(x = Research, y= admit, col= u.rank.F) )
p + geom_point(position = position_jitter(width=0.1, height =0.1 )) +
  geom_smooth(method ="glm", method.args= list(family="binomial"), se=FALSE)