Mostrando entradas con la etiqueta ISLR. Mostrar todas las entradas
Mostrando entradas con la etiqueta ISLR. Mostrar todas las entradas

2019-12-28

How to convert a continuous variable to discrete in R?

Problem

We want to convert continuous variable to discrete in R:

'Create a new qualitative variable, called Elite, by binning the Top10perc variable. We are going to divide universities into two groups based on whether or not the proportion of students coming from the top 10% of their high school classes exceeds 50%'.

library(ISLR)
library(tidyverse)
glimpse(College)
Observations: 777
Variables: 18
$ Private      Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Ye...
$ Apps         1660, 2186, 1428, 417, 193, 587, 353, 1899, 1038, 582, 17...
$ Accept       1232, 1924, 1097, 349, 146, 479, 340, 1720, 839, 498, 142...
$ Enroll       721, 512, 336, 137, 55, 158, 103, 489, 227, 172, 472, 484...
$ Top10perc    23, 16, 22, 60, 16, 38, 17, 37, 30, 21, 37, 44, 38, 44, 2...
$ Top25perc    52, 29, 50, 89, 44, 62, 45, 68, 63, 44, 75, 77, 64, 73, 4...
$ F.Undergrad  2885, 2683, 1036, 510, 249, 678, 416, 1594, 973, 799, 183...
$ P.Undergrad  537, 1227, 99, 63, 869, 41, 230, 32, 306, 78, 110, 44, 63...
$ Outstate     7440, 12280, 11250, 12960, 7560, 13500, 13290, 13868, 155...
$ Room.Board   3300, 6450, 3750, 5450, 4120, 3335, 5720, 4826, 4400, 338...
$ Books        450, 750, 400, 450, 800, 500, 500, 450, 300, 660, 500, 40...
$ Personal     2200, 1500, 1165, 875, 1500, 675, 1500, 850, 500, 1800, 6...
$ PhD          70, 29, 53, 92, 76, 67, 90, 89, 79, 40, 82, 73, 60, 79, 3...
$ Terminal     78, 30, 66, 97, 72, 73, 93, 100, 84, 41, 88, 91, 84, 87, ...
$ S.F.Ratio    18.1, 12.2, 12.9, 7.7, 11.9, 9.4, 11.5, 13.7, 11.3, 11.5,...
$ perc.alumni  12, 16, 30, 37, 2, 11, 26, 37, 23, 15, 31, 41, 21, 32, 26...
$ Expend       7041, 10527, 8735, 19016, 10922, 9727, 8861, 11487, 11644...
$ Grad.Rate    60, 56, 54, 59, 15, 55, 63, 73, 80, 52, 73, 76, 74, 68, 5...

Solution

  1. Option 1: form ISLR's book.
  2. Elite = rep("No", nrow(College))
    Elite[College$Top10perc > 50] = "Yes"
    Elite <- as.factor(Elite)
    college <- data.frame(College,  Elite)
    summary(college[, c("Top10perc", "Elite")])
    
    There are 78 elite universities.

      Top10perc     Elite    
     Min.   : 1.00   No :699  
     1st Qu.:15.00   Yes: 78  
     Median :23.00            
     Mean   :27.56            
     3rd Qu.:35.00            
     Max.   :96.00    
    
  3. Option 2: ifelse from base package and dplyr
  4. # base 
    College$Elite <- factor(ifelse(College$Top10perc > 50, "Yes", "No"))
    # dplyr
    library(dplyr)
    College <-
      college %>%
      mutate(Elite = factor(ifelse(College$Top10perc > 50, "Yes", "No")))
    
  5. Option 3: creating a logical vector.
  6. There are multiple options. I show two examples.

    college$Elite <- transform(College, Elite = Top10perc > 50)
    College$Elite <- College$Top10perc > 50
    

References

From 'An Introduction to Statistical Learning' (ISLR), page 54.

Related posts

2018-12-17

Gráficos de An Introduction to Statistical Learning con ggplot2 - Figura 3.1.

Gráfico a replicar

Continuamos con la serie iniciada sobre la creación de gráficos del libro An Introduction to Statistical Learning. En esta ocasión replicaremos el gráfico de la figura 3.1. Utiliza el conjunto de datos Advertising.Los puntos rojos representan los valores observados de ventas (sales) y los presupuestos de televisión (TV). La línea azul representa la recta de regresión. Las líneas grises verticales representan el error asociado con cada observación. Hay errores positivos (si la observación se sitúa por encima de la líneaazul) y negativos (si la observación se sitúa por debajo de la curva).

Solución

Con la función theme personalizamos el formato: rotamos las etiquetas del eje y, eliminamos el color de fondo, y añadimos el borde.

library(tidyverse)
ggplot(ad_fitted, aes(x = budgets, y = sales)) +
  geom_point(colour = "red") +
  geom_smooth(se = FALSE, method = lm) +
  geom_segment(aes(
    x = budgets,
    y = sales,
    xend = budgets,
    yend = fitted
  )) +
  scale_x_continuous(breaks = seq(0, 300, by = 50)) +
  scale_y_continuous(breaks = seq(0, 25, by = 5)) +
  theme(
    axis.text.y = element_text(angle = 90, hjust = 1),
    panel.background = element_blank(),
    panel.border = element_rect(fill = NA)
  )
Si deseamos mantener la cuadrícula, pero eliminar el color de fondo (theme_bw) y modificar el título del eje x (labs):

ggplot(ad_fitted, aes(x = budgets, y = sales)) +
  geom_point(colour = "red") +
  geom_smooth(se = FALSE, method = lm) +
  geom_segment(aes(
    x = budgets,
    y = sales,
    xend = budgets,
    yend = fitted
  )) +
  labs(x = "TV")+
  scale_x_continuous(breaks = seq(0, 300, by = 50)) +
  scale_y_continuous(breaks = seq(0, 25, by = 5)) +
  theme_bw()+
  theme(axis.text.y = element_text(angle = 90, hjust = 1))

Entradas relacionadas

Referencias

2018-12-08

Discretización de variables en R

Problema

Deseamos discretizar una variable, es decir, convertir una variable continua en discreta. Utilizamos el conjunto de datos College del paquete ISLR. Crearemos una nueva variable cualitativa llamada Elite, discretizando la variable Top10perc. Vamos a dividir las universidades en dos grupos basados en si la proporción de nuevos estudiantes provienen de entre el 10% de los mejores alumnos de sus institutos excede o no el 50%.

library(ISLR)
library(tidyverse)
glimpse(College)
Observations: 777
Variables: 18
$ Private      Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Ye...
$ Apps         1660, 2186, 1428, 417, 193, 587, 353, 1899, 1038, 582, 17...
$ Accept       1232, 1924, 1097, 349, 146, 479, 340, 1720, 839, 498, 142...
$ Enroll       721, 512, 336, 137, 55, 158, 103, 489, 227, 172, 472, 484...
$ Top10perc    23, 16, 22, 60, 16, 38, 17, 37, 30, 21, 37, 44, 38, 44, 2...
$ Top25perc    52, 29, 50, 89, 44, 62, 45, 68, 63, 44, 75, 77, 64, 73, 4...
$ F.Undergrad  2885, 2683, 1036, 510, 249, 678, 416, 1594, 973, 799, 183...
$ P.Undergrad  537, 1227, 99, 63, 869, 41, 230, 32, 306, 78, 110, 44, 63...
$ Outstate     7440, 12280, 11250, 12960, 7560, 13500, 13290, 13868, 155...
$ Room.Board   3300, 6450, 3750, 5450, 4120, 3335, 5720, 4826, 4400, 338...
$ Books        450, 750, 400, 450, 800, 500, 500, 450, 300, 660, 500, 40...
$ Personal     2200, 1500, 1165, 875, 1500, 675, 1500, 850, 500, 1800, 6...
$ PhD          70, 29, 53, 92, 76, 67, 90, 89, 79, 40, 82, 73, 60, 79, 3...
$ Terminal     78, 30, 66, 97, 72, 73, 93, 100, 84, 41, 88, 91, 84, 87, ...
$ S.F.Ratio    18.1, 12.2, 12.9, 7.7, 11.9, 9.4, 11.5, 13.7, 11.3, 11.5,...
$ perc.alumni  12, 16, 30, 37, 2, 11, 26, 37, 23, 15, 31, 41, 21, 32, 26...
$ Expend       7041, 10527, 8735, 19016, 10922, 9727, 8861, 11487, 11644...
$ Grad.Rate    60, 56, 54, 59, 15, 55, 63, 73, 80, 52, 73, 76, 74, 68, 5...

Solución

  1. Opción 1:Propuesta en el libro ISLR.
  2. Elite = rep("No", nrow(College))
    Elite[College$Top10perc > 50] = "Yes"
    Elite <- as.factor(Elite)
    college <- data.frame(College,  Elite)
    summary(college[, c("Top10perc", "Elite")])
    
    Podemos observar como 78 universidades contienen alumnos pertenecientes a la élite.

      Top10perc     Elite    
     Min.   : 1.00   No :699  
     1st Qu.:15.00   Yes: 78  
     Median :23.00            
     Mean   :27.56            
     3rd Qu.:35.00            
     Max.   :96.00    
    
  3. Opción 2: ifelse con paquete base y dplyr
  4. # base 
    College$Elite <- factor(ifelse(College$Top10perc > 50, "Yes", "No"))
    # dplyr
    library(dplyr)
    College <-
      college %>%
      mutate(Elite = factor(ifelse(College$Top10perc > 50, "Yes", "No")))
    
  5. Opción 3: vector lógico.
  6. Hay múltiples opciones. Presento dos ejemplos.

    college$Elite <- transform(College, Elite = Top10perc > 50)
    College$Elite <- College$Top10perc > 50
    

Entradas relacionadas

2018-08-31

Gráficos de An Introduction to Statistical Learning con ggplot2 y plotly - Figura 1.4. interactiva

Problema

Queremos añadir interactividad al gráfico creado en la entrada anterior, el gráfico de la derecha de la figura 1.4 del libro An Introduction to Statistical Learning. El gráfico representa el conjunto de datos NCI-60, cada tipo de cáncer con un color y símbolo diferente. Las observaciones que corresponden al mismo tipo de cáncer tienden a estar cerca em este espacio bidimensional.

Solución

Empleamos el paquete plotly que permite crear gráficos interactivos en la web. En concreto la función de ggplotly que convierte un objeto ggplot2 en un objeto plotly.

# Librerías y datos NCI60 
library(ISLR)
library(tidyverse)
library(plotly)
nci.labs <- NCI60$labs
nci.data <- NCI60$data
pr.out <- prcomp(nci.data, scale = TRUE)

# Gráfico 2
df2 <- data.frame(pr.out$x[, 1:2], nci.labs)
p2 <- ggplot(df2, aes(x = PC1, y = PC2, colour = nci.labs)) +
  geom_point(size = 3)+
  labs(x = "Z1", y = "Z2")+
  theme_bw()+
  theme(legend.position="none")

# Interactividad
ggplotly(p2)

Entradas relacionadas

2018-08-27

Gráficos de An Introduction to Statistical Learning con ggplot2 - Figura 1.3.

Gráfico a replicar

Continuamos con la serie iniciada sobre la creación de gráficos del libro An Introduction to Statistical Learning con ggplot2 parte 1. En esta ocasión replicaremos el gráfico de la figura 1.3. Se trata de un diagrama de caja en el que representamos el resultado de un análisis discriminante cuadrático (lda). Aplicamos un análisis análisis discriminante cuadrático al subconjunyo de datos de Smarket comprendido entre 2001-2007 y predecimos la probabilidad de que el mercado de valores decrezca usando los datos de 2005.

Solución

# Análisis discriminante cuadrático
library(ISLR)
library(MASS)
library(ggplot2)
train <- (Smarket$Year < 2005)
Direction.2005 <- Smarket$Direction[!train]
Smarket.2005 <- Smarket[!train,]
qda.fit <-  qda(Direction ~ Lag1 + Lag2, data = Smarket, subset = train)
qda.class <- predict(qda.fit, Smarket.2005)$class
mean(qda.class == Direction.2005)
[1] 0.5992063
En media la predicción de probabilidad de que decrezca el mercado de valores es mayor en los días en los que el mercado decrece. Basándonos en estos resultados, podemos predecir correctamente la dirección del movimiento de mercado en un 60% de las veces.

  • Gráfico
  • En este caso la creación del gráfico es sencilla y prácticamente idéntica a la de la entrada anterior. El único reto es utilizar correctamente la salida de datos de qda.pred.

    qda.pred <- predict(qda.fit, Smarket.2005)
    qda.pred <- cbind(data.frame(qda.pred), pred = Direction.2005)
    
    ggplot(qda.pred, aes(x = pred, y = posterior.Down, fill = pred)) +
      stat_boxplot(geom = "errorbar", width = 0.5) +
      geom_boxplot(show.legend = FALSE, outlier.alpha = .5) +
      scale_fill_manual(values = c("royalblue", "orangered")) +
      labs(x = "Today's Direction", y = "Predicted probability")
    
    Dejo el panel de fondo por defecto pues ayuda a evaluar mejor el gráfico. Si lo que queremos en blanco tal y como el libro añadiríamos al código anterior:

    theme(panel.background = element_blank())

    Entradas relacionadas

    Nube de datos