class: center, middle, inverse, title-slide # Técnicas de minería de datos ## Máster en Minería de Datos e Inteligencia de Negocio ### Javier Álvarez Liébana (Fac. Estudios Estadísticos - UCM) ### Última actualización: 13-12-2022 --- class: inverse center middle # ATAJOS DE LAS DIAPOSITIVAS `$$\\[2in]$$` .left[Pulsa <kbd-black>O</kbd-black> para ver el **PANEL DE DIAPOSITIVAS**] .left[Pulsa <kbd-black>H</kbd-black> para ver **OTROS ATAJOS**] --- # .orange[MATERIAL] de las clases .pull-left[ - **.bg-purple_light[Diapositivas]** del curso: <https://dadosdelaplace.github.io/teaching/data_mining/slides> - **.bg-red_light[Evaluación]** de la asignatura <https://github.com/dadosdelaplace/teaching/tree/main/data_mining/eval> - **.bg-yellow[Scripts]** de la asignatura <https://github.com/dadosdelaplace/teaching/tree/main/data_mining/scripts> - **.bg-orange[Bibliografía]**: <https://github.com/dadosdelaplace/teaching/tree/main/data_mining/biblio> - **.bg-green_light[Manual introductorio de R]**: <https://dadosdelaplace.github.io/courses-intro-R/> ] --- # Me presento: la turra .pull-left[ <img src="./img/me.jpeg" width="80%" style="display: block; margin: auto auto auto 0;" /> ] .pull-right[ * **.bg-purple_light[Javier Álvarez Liébana]**, nacido en 1989 en Carabanchel Bajo (Madrid) * Licenciado (UCM) en **Matemáticas** (Erasmus en Bologna mediante). **Máster (UCM) en Ingeniería Matemática** (2013-2014) * **.bg-orange[Doctorado en estadística]** por la Universidad de Granada * Encargado de la **visualización y análisis de datos covid** de la Consejería de Salud del **Principado de Asturias** ] Intentando eso de la **.bg-yellow[divulgación]** por **Twitter** (**.bg-yellow[@dadosdelaplace]**) e **Instagram** (**.bg-yellow[@javieralvarezliebana]**) --- name: objetivos # .orange[OBJETIVOS] de la asignatura El **.bg-purple_light[propósito]** de esta asignatura será cuadruple - **.bg-orange[Quitarnos el miedo]** a programar: a programar se aprende programando, no hace falta ser Julian Assange. -- - Aprender las **.bg-orange[técnicas básicas de depuración y exploración]** datos, aprendiendo a implementarlas en un software estadístico. -- - Aprender las **.bg-orange[técnicas básicas de minería de datos]**, centrándonos en las técnicas de **.bg-orange[aprendizaje supervisado]**. -- - Ser capaces de **.bg-orange[interpretar y evaluar]** nuestros modelos. 📚 Estas **diapositivas** han sido elaboradas con el propio `R` haciendo uso de los paquetes `{xaringan}`, `{xaringanExtra}` y `{xaringanthemer}`. --- # .orange[EVALUACIÓN] de la asignatura La **.bg-purple_light[evaluación]** del curso se hará mediante entregas: * El **.bg-orange[40% de la nota]** final corresponderá a pequeñas **.bg-green_light[prácticas individuales]** (entre 2 y 4 prácticas) que se empezarán en clase y se completarán en casa (se deberán entregar ambos archivos). * El otro **.bg-orange[40% de la nota]** vendrá determinado por la entrega de **.bg-green_light[1-2 prácticas grupales]** (mínimo 3, máximo 5 personas). Se podrá solicitar a cualquier persona del grupo que explique el trabajo realizado en una tutoría individual. * El otro **.bg-orange[20% de la nota]** se asignará en función de un **.bg-green_light[datathon final]** que se realizará de forma grupal (mínimo 2, máximo 4 personas). --- # .orange[EVALUACIÓN] de la asignatura * Para poder promediar nota es **.bg-red_light[obligatorio]** entregar **.bg-purple_light[todas las entregas individuales]** con una **.bg-green_light[nota superior al 3]** sobre 10, amén de participar en **.bg-purple_light[al menos una entrega grupal]**. * Además la nota media de las entregas **.bg-red_light[individuales no podrá ser un 50% inferior]** a la media de notas grupales. * En caso de **.bg-red_light[no cumplir dichos requisitos]**, y/o haya faltado a más de un tercio de las clases, tendrá que presentarse a un examen final, cuya nota será el 100% de la nota del curso. --- # .orange[CONTENIDOS] de la asignatura - Las **.bg-purple_light[primeras clases]** las dedicaremos a una **.bg-orange[introducción de la programación]** en R (ya que necesitaremos algunas nociones básicas para poder funcionar) así como **.bg-orange[algunos conceptos básicos de estadística]** (medidas de centralización, dispersión, sesgo/varianza, supervisado vs no supervisado, metolodogía SEMMA, etc). -- - Metodologías de **.bg-purple_light[aprendizaje supervisado]**: - Algoritmo de los **.bg-orange[k-vecinos (knn)]**: clasificaremos elementos en función de la moda/media de los elementos más cercanos. - **.bg-orange[Árboles de decisión]**: clasificaremos elementos en función de la moda/media de una partición final (hoja) tras segmentar nuestro espacio de variables (reglas de decisión). - **.bg-orange[Regresión lineal]**: realizaremos una predicción (variable continua) teniendo como inputs una colección de variables continuas, asumiendo una relación lineal. - **.bg-orange[Regresión logística y GLM]**: realizaremos una predicción continua de la probabilidad de que una variable cualitativa tome cada una de las categorías (probabilidad de estar sano o enfermo, por ejemplo). --- # .orange[EJEMPLOS] reales de alumnos ✈️ **.bg-purple_light[Clasificación de vuelos]**: usando, entre otras, variables de tráfico de aereo, tipología de vuelo, variables meteorológicas, se consiguió clasificar el retraso (o no) de 4 millones de vuelos (TFM de Almudena María Moreno Maderuelo) -- 📰 **.bg-purple_light[Clasificación de Fake News]**: usando técnicas de minería de datos aplicadas a textos (minería de textos), se propuso clasificar noticias en verdaderas o falsas, analizando la frecuencia y sentimientos de las palabras analizadas, así como la relación entre las palabras (TFM de Iván Guarionex de Frías Chireno) -- 🩺 **.bg-purple_light[Predicción de diabetes]**: haciendo uso de diferente variables médicas y de hábitos de salud sacados de la encuesta de salud pública de EE.UU., se pretende predecir la aparición o no de diabetes en personas adultos, y determinar posibles factores de riesgo (TFM de María Martínez Ramudo). -- 🗳 **.bg-purple_light[Predicción de encuestas electorales]**: usando el promedio de diferentes encuestas, y considerando diferentes variables sociológicos (como el sesgo de las casas encuestadores), conseguir una predicción del % de voto de cada partido promediando por tamaño de muestra y ventana temporal (TFM de Enric Palau Payeras) --- class: inverse center middle # CLASES .pull-left[ #### [CLASE 1: INTRODUCCIÓN A R](#clase-1) #### [CLASE 2: PRIMEROS DATOS Y CONCEPTOS](#clase-2) #### [CLASE 3: TIDYDATA](#clase-3) #### [CLASE 4: INTRO A LA MINERÍA (SEMMA)](#clase-4) #### [CLASE 5: PRIMER ALGORITMO (KNN)](#clase-5) #### [CLASE 6: DEPURACIÓN PARA KNN](#clase-6) ] .pull-right[ #### [CLASE 7: TIDYMODELS](#clase-7) #### [CLASE 8: PROFUNDIZANDO EN TIDYMODELS (KNN)](#clase-8) #### [CLASE 9: VALIDACIÓN CRUZADA, SOBREMUESTREO Y DATAVIZ](#clase-9) #### [CLASE 10: ÁRBOLES DE CLASIFICACIÓN/REGRESIÓN](#clase-10) #### [CLASE 11: REG. LINEAL MULTI](#clase-11) #### [CLASE 12: REGRESIÓN LOGÍSTICA Y GLM](#clase-12) ] --- class: inverse center middle name: clase-1 # CLASE 1: introducción a R desde cero. ### [Instalación](#instalacion) ### [¿Qué es R? Primeros pasos](#que-es-R) ### [Primeros ejercicios](#ejercicios1) ### [Variables numéricas y caracteres](#variables) ### [Variables lógicas y de tipo fecha](#logicas) ### [Ejercicios](#ejercicios2) --- name: instalacion # Requisitos Para la asignatura los únicos **.bg-purple_light[requisitos]** serán: -- 1. **.bg-orange[Conexión a internet]** (para la descarga de algunos datos y paquetes). -- 2. **.bg-orange[Instalar R]**: será nuestro lenguaje, nuestro **.bg-yellow[castellano]** para poder «comunicarnos con el ordenador. La descarga la haremos (gratuitamente) desde <https://cran.r-project.org/> -- 3. **.bg-orange[Instalar R Studio]**. De la misma manera que podemos escribir castellano en un Word o en un tuit, podemos usar **distintos IDE** (entornos de desarrollo integrados, nuestro Office), para que el trabajo sea más cómodo. Nuestro **.bg-yellow[Word]** para nosotros será **RStudio**. .left[ <img src = "https://raw.githubusercontent.com/dadosdelaplace/slides-ECI-2022/main/img/cran-R.jpg" alt = "cran-R" align = "left" width = "460" style = "margin-top: 2vh"> ] .right[ <img src = "https://raw.githubusercontent.com/dadosdelaplace/slides-ECI-2022/main/img/R-studio.jpg" alt = "RStudio" align = "right" width = "460" style = "margin-top: 2vh;"> ] --- # Instalación de R El lenguaje `R` será nuestra **.bg-purple_light[gramática]**, nuestra ortografía y nuestro diccionario .pull-left[ - **Paso 1**: entra en <https://cran.r-project.org/> y selecciona **.bg-purple_light[sistema operativo]**. - **Paso 2**: para **.bg-purple_light[Mac]** basta con que hacer click en el archivo .pkg, y abrirlo una vez descargado. Para sistemas **.bg-purple_light[Windows]**, debemos clickar en `install R for the first time` y en la siguiente pantalla en `Download R for Windows`. Una vez descargado, abrirlo como cualquier archivo de instalación. - **Paso 3**: abrir el **ejecutable**. ] .pull-right[ <img src = "https://raw.githubusercontent.com/dadosdelaplace/slides-ECI-2022/main/img/cran-R.jpg" alt = "cran-R" align = "left" width = "900" style = "margin-top: 1vh"> ] **.bg-green_light[Consejito]**: siempre que tengas que descargar algo de CRAN (ya sea el propio R o un paquete), asegúrate de tener conexión a **.bg-orange[internet]**. --- # Primera operación Para comprobar que se ha instalado correctamente, tras abrir `R`, deberías ver una **pantalla blanca** similar a esta (en realidad se llama **.bg-purple_light[consola]**). Vamos a escribir nuestra **.bg-orange[primera operación]** en la consola: .pull-left[ * A una variable llamada `a` le asignaremos el valor 1 (asignamos con `<-`, como una flecha) ```r # Una variable a con valor --> 1 *a <- 1 ``` ] -- .pull-right[ * A otra variable llamada `b` le asignaremos el valor 2 (cambia a la izquierda el nombre, cambia a la derecha el valor). ```r # Una variable b con valor --> 2 *b <- 2 ``` ] -- .pull-left[ * Sumamos las variables haciendo `a + b`. ```r # Primera operación a <- 1 # Una variable a con valor --> 1 b <- 2 # Una variable b con valor --> 2 *a + b ``` ] -- .pull-right[ * El resultado que nos devuelve será `3`. ``` > [1] 3 ``` ] --- # .orange[INSTALACIÓN] de RStudio El **.bg-purple_ligth[Word]** que usaremos para trabajar y escribir en nuestro lenguaje será **.bg-purple_ligth[RStudio]** (lo que se conoce como un **IDE**, un entorno integrado de desarrollo). .pull-left[ * **Paso 1**: entra en la [web oficial de RStudio](https://www.rstudio.com/products/rstudio/download/#download) y selecciona la **.bg-purple_light[descarga gratuita]**. * **Paso 2**: selecciona el ejecutable que te aparezca, acorde a tu sistema operativo. * **Paso 3**: tras descargar el ejecutable, hay que abrirlo como otro cualquier otro ejecutable y dejar que **.bg-purple_light[termine la instalación]**. ] .pull-right[ <img src="./img/R-studio.jpg" width="80%" style="display: block; margin: auto auto auto 0;" /> ] --- # .orange[ORGANIZACIÓN] de RStudio .pull-left[ <img src="./img/inicio_rstudio_2.jpg" width="95%" style="display: block; margin: auto auto auto 0;" /> ] .pull-right[ * **.bg-purple_light[Consola]**: es el nombre para llamar a la ventana grande que te ocupa buena parte de tu pantalla. Prueba a escribir el mismo código que antes (la suma) en ella. La consola será donde **.bg-orange[ejecutaremos órdenes]** y **.bg-yellow[mostraremos resultados]**. ] --- # .orange[ORGANIZACIÓN] de RStudio .pull-left[ <img src="./img/inicio_rstudio_3.jpg" width="75%" style="display: block; margin: auto auto auto 0;" /> ] .pull-right[ * **.bg-purple_light[Environment]** (entorno de variables): la pantalla pequeña (puedes ajustar los márgenes con el ratón) que tenemos en la parte superior derecha. Nos mostrará las **variables que tenemos definidas, el tipo y su valor**. ] --- # .orange[ORGANIZACIÓN] de RStudio .pull-left[ <img src="./img/inicio_rstudio_4.jpg" width="85%" style="display: block; margin: auto auto auto 0;" /> ] .pull-right[ * **.bg-purple_light[Panel multiusos]**: la ventana que tenemos en la parte inferior derecha no servirá para buscar **.bg-orange[ayuda de funciones]**, además de para **.bg-yellow[visualizar gráficos]**. ] --- name: que-es-R # ¿Qué es R? <img src = "https://logos.turbio.repl.co/rlang.svg" alt = "Rstudio" align = "left" width = "300" style = "margin-top: 1vh;margin-right: 2rem;"> `R` es un **.bg-purple_light[lenguaje estadístico]**, creado por y para la estadística, con 4 ventajas fundamentales: -- * **.bg-purple_light[Software libre]** (como C++, Python, etc). no solo es gratis, sino que permite **.bg-orange[acceder libremente a código ajeno]**. -- * **.bg-purple_light[Lenguaje modular]**: en la instalación que hemos realizado solo se ha instalado el mínimo para poder funcionar. Al ser software libre, existen **.bg-orange[trozos de código]** hechos por otras personas (**.bg-yellow[paquetes]**) que podemos instalar según necesidades. -- * **.bg-purple_light[Gran comunidad de usuarios]**: `R` tiene una comunidad de usuarios gigante para hacer estadística (Python tiene una comunidad más enfocada al Machine Learning), con más de 18 000 paquetes. -- * **.bg-purple_light[Lenguaje de alto nivel]**. Los lenguajes de alto nivel, como `R` o `Python`, facilitan la programación al usuario (menor curva de aprendizaje, aunque más lentos en ejecución). --- # Paquetes en R A lo largo del curso usaremos varios de esos **.bg-purple_light[paquetes]**, como por ejemplo el paquete `{ggplot2}`, un paquete para la elaboración de **.bg-purple_light[visualizaciones de datos]**. Vamos a instalarlo (necesitamos internet para ello) con la orden `install.packages("ggplot")` ```r install.packages("ggplot2") ``` La **.bg-purple_light[instalación]** de un paquete es el equivalente a **.bg-orange[comprar a un libro]**: solo lo debemos hacer **la primera vez** que lo usemos en un ordenador. Una vez que tenemos comprado nuestro libro, para poder usarlo, simplemente debemos indicar al programa que nos lo **.bg-purple_light[acerque de la estantería]** con `library(ggplot2)`. ```r library(ggplot2) ``` --- class: inverse center middle **COMPRAR** libro --> instalar un paquete (una sola vez) `install.packages()` <figure> <img src = "https://cdn.cienradios.com/wp-content/uploads/sites/14/2020/09/Book-Depository-2.jpg" alt = "comprar-libros" align = "middle" width = "480" style = "margin-top: 1vh;"> </figure> **SELECCIONAR** libro (ya comprado) --> acceder a un paquete instalado (en cada sesión que queramos usarlo) `library()` <figure> <img src = "https://cdn.sincroguia.tv/uploads/programs/l/a/-/la-biblioteca-de-los-libros-rechazados-704306_SPA-77.jpg" alt = "comprar-libros-2" align = "middle" width = "480" style = "margin-top: 1vh;"> </figure> --- class: center middle # .orange[CASOS REALES] de uso de R .pull-left[ <img src="./img/covid_isciii.jpg" width="97%" style="display: block; margin: auto auto auto 0;" /> ] .pull-right[ <img src="./img/momo_isciii.jpg" width="97%" style="display: block; margin: auto auto auto 0;" /> ] Las webs del Instituto de Salud Carlos III <https://cnecovid.isciii.es/covid19/> y <https://momo.isciii.es/panel_momo/> están hechas con `R` (con `{shiny}` y `{plotly}` ) --- # .orange[CASOS REALES] de uso de R .pull-left[ <img src="./img/elpais_R.jpg" width="99%" style="display: block; margin: auto auto auto 0;" /> ] .pull-right[ El **.bg-purple_light[equipo de datos]** (Borja Andrino, Kiko Llaneras y Daniele Grasso) trabaja con `R` para elaborar sus análisis, desde los datos electorales hasta el cambio climático. Es una de las razones por las que son capaces de realizar brillantes análisis de grandes volúmenes de datos de forma rápida y ágil: la **.bg-purple_light[automatización de procesos]** que nos permite programar en `R` puede ser fundamental para analizar datos que hasta entonces no podíamos. ] --- # .orange[Incel] vs excel <img src="./img/incel.jpg" width="75%" style="display: block; margin: auto;" /> --- class: inverse center middle # ¿Por qué .orange[NO] usamos Excel? ![](./img/meme_barco.jpg) --- # ¿Por qué .orange[NO] usamos Excel? Excel es una **.bg-purple_light[hoja de cálculo]**, ni más ni menos, y el propio **Microsoft desaconseja su uso** para el análisis de datos. El Excel es una herramienta maravillosa para ser usada como una sencilla hoja de cálculo (llevar cuentas de tu familia, declaración de Renta, planificar viajes, etc). **.bg-red_light[NO ESTÁ DISEÑADO]** para ser una base de datos, y muchos menos pensado para generar un entorno flexible para el análisis estadístico: * **.bg-red_light[Software de pago]** * **.bg-red_light[Software cerrado]**: solo podemos hacer lo que Excel ha creído que interesante que podamos hacer. * **.bg-red_light[Alto consumo de memoria]**. * **.bg-red_light[No es universal]**: no solo es de pago sino que además, dependiendo de la versión que tengas de Excel, tendrá un formato distinto para datos como fechas, teniendo incluso extensiones distintas. --- # .red[EPIC FAILS] en Excel Problemas de **.red[versiones]** <img src="./img/excel_genes.jpg" width="37%" style="display: block; margin: auto auto auto 0;" /> 📚 Ver **.bg-green_light[bibliografía]** en <https://github.com/dadosdelaplace/teaching/tree/main/data_mining/biblio> --- # .red[EPIC FAILS] en Excel Problemas de **.red[memoria]** <img src="./img/excel_uk.jpg" width="50%" style="display: block; margin: auto auto auto 0;" /> 📚 Ver **.bg-green_light[bibliografía]** en <https://github.com/dadosdelaplace/teaching/tree/main/data_mining/biblio> --- # .red[EPIC FAILS] en Excel Problemas de **.red[codificación]** <img src="./img/excel_edades.jpg" width="50%" style="display: block; margin: auto auto auto 0;" /> 📚 Ver **.bg-green_light[bibliografía]** en <https://github.com/dadosdelaplace/teaching/tree/main/data_mining/biblio> --- name: primeros-pasos # Primeros pasos en R: .orange[CALCULADORA] Empecemos por lo sencillo: **.bg-purple-light[¿cómo usar R como una calculadora?]** Si escribimos `2 + 1` en la consola y pulsamos ENTER, la consola nos mostrará el resultado de la suma. ```r 2 + 1 ``` ``` > [1] 3 ``` -- Si dicha suma la quisiéramos utilizar para un segundo cálculo: ¿y si la **.bg-purple-light[almacenamos en alguna variable]**? Por ejemplo, vamos a guardar la suma en una variable `x` ```r *x <- 2 + 1 ``` -- Si te fijas ahora `x` aparece definida en nuestro **.bg-yellow[environment]**, y puede ser usada de nuevo ```r x + 3 ``` ``` > [1] 6 ``` --- # Primeros pasos en R: .orange[CALCULADORA] ### Multiplicación ```r *x * y ``` ### Elevar al cuadrado ```r *x^2 ``` ### Valor absoluto ```r *abs(x) ``` --- # .red[Errores] Durante tu aprendizaje va a ser **muy habitual** que las cosas no salgan a la primera, apareciendo en consola **.bg-purple_light[mensajes de error]** en un **.bg-red_light[color rojo]**. No te asustes: lo peor que puede pasar es que tengas que reiniciar `R`). * Mensajes de **.bg-red_light[ERROR]**: irán precedidos de la frase **.bg-yellow[«Error in…»]**, y serán aquellos fallos que **impidan la ejecución del código** ```r "a" + 1 # intentando sumar 1 a un texto ``` ``` > Error in "a" + 1: argumento no-numérico para operador binario ``` **.bg-green_light[CONSEJO]**: lee siempre los mensajes de error para aprender de ellos (ya que suelen dar pistas de cómo resolverlos). --- # .red[Errores] Durante tu aprendizaje va a ser **muy habitual** que las cosas no salgan a la primera, apareciendo en consola **.bg-purple_light[mensajes de error]** en un **.bg-red_light[color rojo]**. No te asustes: lo peor que puede pasar es que tengas que reiniciar `R`). * Mensajes de **.bg-orange[WARNING]**: irán precedidos de la frase **.bg-yellow[«Warning in…»]**, y son los fallos más delicados ya que son posibles incoherencias pero sin que tu código deje de ejecutarse. ```r sqrt(-1) # raiz cuadrada de número negativo ``` ``` > Warning in sqrt(-1): Se han producido NaNs ``` ``` > [1] NaN ``` **¿Ha ejecutado la orden?** Sí, pero te advierte de que el resultado de la operación es un `NaN`, **Not A Number**, un valor que no existe (al menos dentro de los números reales). --- # ¿Dónde programamos? .orange[SCRIPTS] Un **.bg-purple_light[script]** será el documento en el que programamos, nuestro equivalente a un archivo .doc, pero aquí será un archivo con extensión `.R`, donde **escribiremos las órdenes**. Para **.bg-purple_light[abrir nuestro primero script]**, haz click en el menú superior en `File << New File << R Script`. .pull-left[ <img src="./img/inicio_rstudio_5.jpg" width="95%" style="display: block; margin: auto auto auto 0;" /> ] .pull-right[ **.bg-green_light[CONSEJO]**: intenta no abusar de la consola, ya que todo lo que no escribas en un script, cuando cierres `RStudio`, lo **habrás perdido** (cómo si en lugar de escribir en un Word y guardarlo, nunca guardases el documento). ] --- # ¿Dónde programamos? .orange[SCRIPTS] Ahora tenemos una **cuarta ventana**: la ventana donde **escribiremos nuestros códigos** ### **¿Cómo ejecutar nuestro script?** .pull-left[ <img src="./img/inicio_rstudio_6.jpg" width="95%" style="display: block; margin: auto auto auto 0;" /> ] .pull-right[ 1. **.bg-purple_light[Escribimos el código]** a ejecutar. 2. **.bg-purple_light[Guardamos]** el archivo `.R` haciendo click en `Save current document`. 3. El código **no se ejecuta salvo que se lo indiquemos**. Tenemos tres opciones: - **.orange[Copiar y pegar]** en consola. - **.orange[Seleccionar líneas]** y clickar en `Run`. - Activar `Source on save` a la **derecha de guardar**: no solo guarda sino que ejecuta el código completo. ] --- name: ejercicios1 # Primeros ejercicios .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 1**: añade debajo otra línea para definir una variable `b` con el valor `5`. Tras asignarles valores, multiplica los números en consola. ```r a <- 2 ``` * 📝 **Ejercicio 2**: modifica el código inferior para definir dos variables `c` y `d`, con valores 3 y -1. ```r c <- # deberías asignarle el valor 3 d <- # deberías asignarle el valor -1 ``` * 📝 **Ejercicio 3**: con las variables `a` y `b` del ej. 1, crea una nueva variable `e` guardando el resultado de su multiplicación `a * b`. Escribe `e` en consola para ver su resultado ] .panel[.panel-name[Solución ej. 1] ```r # Para poner comentarios en el código se usa # # Definición de variables a <- 2 b <- 5 # Multiplicación a * b ``` ``` > [1] 10 ``` ] .panel[.panel-name[Solución ej. 2] ```r # Definición de variables c <- 3 d <- -1 ``` ] .panel[.panel-name[Solución ej. 3] ```r # Variables a <- 2 b <- 5 # Resultado e <- a * b # Muestro en consola e ``` ``` > [1] 10 ``` ] ] --- # Primeros ejercicios .panelset[ .panel[.panel-name[Ejercicios extra] * 📝 **Ejercicio 4**: asigna un valor positivo a `x` y calcula su raíz cuadrada; asigna otro negativo y calcula su valor absoluto con la función `abs()`. * 📝 **Ejercicio 5**: usando la variable `x` ya definida, completa/modifica el código inferior para guardar en una nueva variable `z` el resultado guardado en `x` menos 5. ```r z <- ? - ? # completa el código z ``` * 📝 **Ejercicio 6**: usando las variables `x` e `y` ya definidas, calcula el máximo de ambas (función `max()`), y guárdalo en una nueva variable `t`. ] .panel[.panel-name[Solución ej. 4] ```r # Raíz cuadrada x <- 73 # por ejemplo sqrt(x) ``` ``` > [1] 8.544004 ``` ```r # Valor absoluto y <- -19 # por ejemplo abs(y) ``` ``` > [1] 19 ``` ] .panel[.panel-name[Solución ej. 5] ```r z <- x - 5 z ``` ``` > [1] 68 ``` ] .panel[.panel-name[Solución ej. 6] ```r t <- max(x, y) t ``` ``` > [1] 73 ``` ] ] --- name: variables # De la .orange[celda] a la .green[tabla] ¿De qué tipo pueden ser los datos que tenemos contenidos en cada celda de una «tabla»? <img src="./img/celdas.jpg" width="55%" style="display: block; margin: auto;" /> * **.bg-purple_light[Celda]**: un dato **.bg-orange[individual]** de un tipo concreto. * **.bg-purple_light[Variable]**: una **.bg-orange[concatenación de valores]** del mismo tipo (**vectores**). * **.bg-purple_light[Matriz]**: **.bg-orange[concatenación de variables]** del **.bg-yellow[mismo tipo]** y longitud. * **.bg-purple_light[Tabla]**: **.bg-orange[concatenación de variables]** de **.bg-yellow[distinto tipo]** pero igual longitud. --- # .orange[Celdas]: tipos de datos individuales ¿Existen **variables más allá de los números**? Piensa por ejemplo en los **datos guardados de una persona**: * La edad o el peso será un **.bg-purple_light[número]**. * Su nombre será una cadena de **.bg-purple_light[texto]**. * Su fecha de nacimiento será precisamente eso, una **.bg-purple_light[fecha]**. * A la pregunta «¿está usted soltero/a?» la respuesta será lo que llamamos una **.bg-purple_light[variable lógica]** (`TRUE` si está soltero/a o `FALSE` en otro caso). <img src="./img/celdas.jpg" width="40%" style="display: block; margin: auto;" /> --- # Variables .orange[NUMÉRICAS] El **dato más sencillo**, dato que ya hemos usado en nuestros primeros pasos como calculadora, serán las variables que guardan simplemente números ```r a <- 1 b <- 2 a + b ``` ``` > [1] 3 ``` -- En el código anterior, tanto `a` como `b` como la suma `a + b` son de **.bg-purple_light[tipo numérico]** ```r *class(a) ``` ``` > [1] "numeric" ``` ```r *typeof(a) ``` ``` > [1] "double" ``` --- # Variables .orange[NUMÉRICAS] Como ya hemos visto, con los datos numéricos podemos realizar todas las **.bg-purple_light[operaciones aritméticas]** que se nos ocurriría hacer en una **calculadora** como sumar (`+`), restar (`-`), multiplicar (`+`), dividir (`/`), raíz cuadrada (`sqrt()`), valor absoluto (`abs()`), elevar al cuadrado (`^2`), elevar al cubo (`^3`), etc. ```r a <- 5 a^3 # Elevar al cubo ``` ``` > [1] 125 ``` ```r b <- -43 abs(b) # valor absoluto ``` ``` > [1] 43 ``` --- # Variables de .orange[TEXTO] No solo de números viven los datos: imagina que además de la edad de una persona queremos **guardar su nombre** (**.bg-purple_light[tipo caracter]**: una **cadena de texto**) ```r *nombre <- "Javier" class(nombre) ``` ``` > [1] "character" ``` -- Las cadenas de texto son un **tipo especial de dato** con los que obviamente no podremos hacer operaciones aritméticas (pero sí **.bg-purple_light[otras operaciones]** como pegar o localizar patrones). ```r nombre + 1 # error al sumar número a texto ``` ``` > Error in nombre + 1: argumento no-numérico para operador binario ``` -- **.bg-green_light[IMPORTANTE]**: las variables de tipo texto van **.bg-red_light[SIEMPRE ENTRE comillas]**. --- name: primer-paquete # .orange[PRIMERA FUNCIÓN]: paste Una **.bg-purple_light[función]** es un **trozo de código encapsulado** bajo un nombre, que depende de unos **.bg-purple_light[argumentos de entrada]**. -- Nuestra primera función será `paste()`: dadas dos cadenas de texto como argumento de entrada nos permite pegarlas, indicándole en el argumento `sep = ` el caracter que queremos entre medias. ```r # todo junto, sin espacios, igual a paste0("Javier", "Álvarez") paste("Javier", "Álvarez", sep = "") ``` ``` > [1] "JavierÁlvarez" ``` ```r paste("Javier", "Álvarez", sep = "?*?") # separados por un ?*? ``` ``` > [1] "Javier?*?Álvarez" ``` --- # .orange[PRIMERA FUNCIÓN]: paste ```r *paste("Javier", "Álvarez") ``` ``` > [1] "Javier Álvarez" ``` Por defecto, `paste()` añade un espacio, es decir, `sep = " "`. Muchas funciones en `R` tendrán lo que llamamos **.bg-purple_light[argumentos por defecto]**, el valor que tomará sino se le asigna otro. Puedes mirar la **.bg-green_light[ayuda de la función]** escribiendo en consola `? paste` Existe una función similar llamada `paste0()` que pega por defecto con `sep = ""` (sin nada). ```r paste0("Javier", "Álvarez") ``` ``` > [1] "JavierÁlvarez" ``` ```r paste("Javier", "Álvarez", sep = "") ``` ``` > [1] "JavierÁlvarez" ``` --- # .orange[PRIMER PAQUETE]: glue Otra forma **más intuitiva de trabajar con textos** es usar el **paquete** `{glue}`. ```r library(glue) # solo la 1ª vez install.packages("glue") ``` -- Con dicho paquete podemos **.bg-purple_light[usar variables dentro de cadenas]** de texto. Por ejemplo, la frase «la edad es de ... años», donde la edad concreta la tenemos guardada en una variable. ```r edad <- 33 *glue("La edad es de {edad} años") ``` ``` > La edad es de 33 años ``` Dentro de las llaves también podemos ejecutar operaciones ```r unidades <- "días" *glue("La edad es de {edad * 365} {unidades}") ``` ``` > La edad es de 12045 días ``` --- # .orange[VECTORES]: concatenación ¿Y si en lugar de querer almacenar un solo elemento, por ejemplo , tenemos una **colección de elementos**? Hasta ahora solo hemos operado con el contenido de las **celdas**, pero cuando trabajamos con datos normalmente tendremos columnas que representan variables o características: llamaremos **.bg-purple_light[vectores]** a una **.bg-orange[concatenación]** de variables del **.bg-orange[mismo tipo]** -- La forma más sencilla es con el comando `c()` (c de concatenar), y basta con introducir sus **elementos entre paréntesis y separados por comas** (por ejemplo, la edad de 4 personas). ```r *edades <- c(33, 27, 60, 61) edades ``` ``` > [1] 33 27 60 61 ``` -- **.bg-green_light[IMPORTANTE]**: un número individual (`x <- 1`) es en realidad un vector de longitud uno. --- # .orange[VECTORES]: concatenación Como ves ahora en el `environment` tenemos una **.bg-purple_light[colección de elementos]** guardada .pull-left[ ```r edades ``` ``` > [1] 33 27 60 61 ``` ] .pull-right[ <img src="./img/vectores_enviroment.jpg" width="80%" style="display: block; margin: auto auto auto 0;" /> ] -- .pull-left[ La **.bg-purple_light[longitud de un vector]** se puede calcular con `length()` ```r *length(edades) ``` ``` > [1] 4 ``` ] .pull-right[ También podemos **.bg-purple_light[concatenar vectores]** ```r c(edades, edades, 8) ``` ``` > [1] 33 27 60 61 33 27 60 61 8 ``` ] --- # Vectores: .orange[SECUENCIAS NUMÉRICAS] En muchas ocasiones querremos **.bg-purple_light[crear secuencias numéricas]** mucho más rápido (por ejemplo, un vector con los días del mes). El comando `seq()` nos permite crear una **secuencia** desde un elemento inicial hasta un elemento final, avanzando de uno en uno. ```r seq(1, 31) ``` ``` > [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 > [26] 26 27 28 29 30 31 ``` -- El comando `1:n` nos devuelve lo mismo que la orden `seq(1, n)`. Además, si el elemento inicial es mayor que el final, `R` entenderá solo que la secuencia es **decreciente**. ```r n <- 5 n:1 ``` ``` > [1] 5 4 3 2 1 ``` --- # Vectores: .orange[SECUENCIAS NUMÉRICAS] También podemos definir **.bg-purple_light[otro tipo de distancia]** (**.bg-orange[paso de discretización]**) entre dos elementos consecutivos ```r seq(1, 7, by = 0.5) # secuencia desde 1 a 7 de 0.5 en 0.5 ``` ``` > [1] 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.5 5.0 5.5 6.0 6.5 7.0 ``` -- Otras veces nos interesará definir una **.bg-purple_light[secuencia con un número concreto]** de elementos. ```r seq(1, 50, l = 7) # secuencia desde 1 a 50 de longitud 7 ``` ``` > [1] 1.000000 9.166667 17.333333 25.500000 33.666667 41.833333 50.000000 ``` -- También podemos crear **.bg-purple_light[vectores de elementos repetidos]** con la función `rep()` ```r rep(0, 7) # vector de 7 ceros ``` ``` > [1] 0 0 0 0 0 0 0 ``` --- # .green[OPERACIONES] .orange[ARITMÉTICAS] Dado que un **.bg-purple_light[número es un vector]** de longitud 1, toda **.bg-orange[operación aritmética]** (suma, resta, multiplicación, etc) que podamos hacer con un número la vamos a poder a hacer con un vector de números. -- Si hacemos por ejemplo la operación `2 * x`, siendo `x` un vector, lo que sucederá es que la operación se realizará en **.bg-purple_light[CADA ELEMENTO]** del vector (una sola línea de código paro realizar operaciones en 10, 20, 1000 o 100000 elementos). ```r # Multiplicamos por 2 a CADA ELEMENTO del vector x <- c(2, 4, 6) *2 * x ``` ``` > [1] 4 8 12 ``` -- **.bg-green_light[IMPORTANTE]**: el **.bg-purple_light[resultado]** de una operación aritmética sobre un vector será **.bg-orange[otro vector]**. --- # .green[OPERACIONES] .orange[ARITMÉTICAS] De la misma manera podemos **.bg-purple_light[sumar o restar una constante]** al vector ```r # Sumamos 3 a CADA ELEMENTO DEL VECTOR x + 3 ``` ``` > [1] 5 7 9 ``` -- Los vectores también pueden **.bg-purple_light[interactuar entre ellos]**, así que podemos definir sumas de vectores, como `x + y` ```r y <- c(1, 3, 5) # suma de vectores *x + y ``` ``` > [1] 3 7 11 ``` -- **.bg-green_light[IMPORTANTE]**: salvo que especifiquemos lo contrario, toda operación aritmética que hagas a un vector será **.bg-purple_light[elemento a elemento]**. --- # .green[OPERACIONES] con .orange[AUSENTES] Imagina que tenemos un vector de temperaturas pero varios de los días el aparato de medición no funcionaba, por lo que tenemos un **.bg-purple_light[dato ausente]** marcado como `NA`. ```r x <- c(21, NA, 13, NA, NA, 25, 36, 17, 19, 5) sum(x) ``` ``` > [1] NA ``` -- Dado que hay días que no tenemos disponibles, la suma tampoco la podemos conocer. Para evitar que nos impida hacer ciertas operaciones, en muchas funciones de `R` podemos añadir el **argumento** `na.rm = TRUE`: primero elimina ausentes, y luego ejecuta la función. ```r # eliminando datos ausentes antes de aplicar la función *sum(x, na.rm = TRUE) ``` ``` > [1] 136 ``` ```r mean(x, na.rm = TRUE) ``` ``` > [1] 19.42857 ``` --- # .green[OPERACIONES] con .orange[AUSENTES] Para **comprobar** si tenemos un **dato ausente** podemos hacer uso de la función `is.na()` ```r is.na(x) ``` ``` > [1] FALSE TRUE FALSE TRUE TRUE FALSE FALSE FALSE FALSE FALSE ``` -- También puede aparecernos un **.bg-purple_light[resultado no permitido]**, marcado como `NaN` (not a number): no es un dato ausente, es un dato resultado de una **operación no permitida**. ```r x <- c(1, NA, 3, 4, 6, 7, sqrt(-1), NA) x ``` ``` > [1] 1 NA 3 4 6 7 NaN NA ``` ```r is.nan(x) ``` ``` > [1] FALSE FALSE FALSE FALSE FALSE FALSE TRUE FALSE ``` --- # .orange[SELECCIONAR] elementos Otra operación muy habitual es la **.bg-purple_light[extraer un subconjunto del mismo]**. La forma más sencilla es **usar el operador de selección** `[i]` para **acceder al elemento i-ésimo** ```r edades <- c(20, 30, 33, NA, 61) # accedemos a la edad de la tercera persona en la lista *edades[3] ``` ``` > [1] 33 ``` ```r # accedemos a la edad de la cuarta persona edades[4] ``` ``` > [1] NA ``` --- # .orange[SELECCIONAR] elementos Un número no es más que un vector de longitud uno, así que esta operación también la podemos aplicar usando un **.bg-purple_light[vector de índices a seleccionar]** ```r # Tercer y cuarto elemento *edades[c(3, 4)] ``` ``` > [1] 33 NA ``` -- Esta lógica para acceder a elementos también sirve para **vectores de caracteres**. ```r y <- c("hola", "qué", "tal", "todo", "ok", "?") y[1:2] ``` ``` > [1] "hola" "qué" ``` -- **.bg-green_light[TIP]**: para **.bg-purple_light[acceder al último elemento]** podemos pasarle como índice la longitud del vector ```r y[length(y)] ``` ``` > [1] "?" ``` --- # .green[OPERACIONES] .orange[ARITMÉTICAS] Dado que la operación (por ejemplo, una suma) se realiza elemento a elemento, ¿qué sucederá si **.bg-purple_light[sumamos dos vectores de distinta longitud]**? -- Por ejemplo, definamos `z` con los 4 primeros impares, e intentemos hacer la suma `x + z`. ```r z <- c(1, 3, 5, 7) x + z ``` ``` > [1] 2 NA 8 11 7 10 NaN NA ``` -- .pull-left[ <img src="./img/recycle.jpg" width="99%" style="display: block; margin: auto auto auto 0;" /> ] .pull-right[ `R` intenta molestarte lo menos posible, así que lo que hace es **.bg-purple_light[reciclar elementos]**: si tiene un vector de 4 elementos y le intentas sumar uno de 3 elementos, lo que hará será reciclar elementos del vector con menor longitud: hará `1 + 2`, `3 + 4`, `5 + 6` pero… `7 + 2` (vuelve al primero). ] --- # Vectores: .orange[CARACTERES] Un vector es una **.bg-purple_light[concatenación de elementos del mismo tipo]**, pero no tienen porque ser necesariamente números. Vamos a crear una frase de ejemplo, con 4 elementos. .pull-left[ ```r *vector <- c("Me", "llamo", "Javi") vector ``` ``` > [1] "Me" "llamo" "Javi" ``` ```r length(vector) ``` ``` > [1] 3 ``` ] .pull-right[ ```r frase <- "Mi llamo Javi" frase ``` ``` > [1] "Mi llamo Javi" ``` ```r length(frase) ``` ``` > [1] 1 ``` ] Fíjate la **diferencia** entre tenerlo guardado en un vector o tenerlo como una sola cadena de texto (unida). --- # Vectores: .orange[CARACTERES] Cuando usamos la función `paste()` con variables diferentes, usábamos `sep = ...`. Cuando la función `paste()` la aplicamos a un vector de caracteres, decidiremos que caracter queremos que vaya entre palabra con el argumento `collapse = ...`. ```r paste(vector, collapse = ".") # separados por un punto ``` ``` > [1] "Me.llamo.Javi" ``` Podemos **combinar las secuencias de números y un vector de caracteres** con `glue()` ```r edad <- 10:12 # edades glue("La edad es de {edad} años") ``` ``` > La edad es de 10 años > La edad es de 11 años > La edad es de 12 años ``` --- name: logicas # Datos de tipo .orange[LÓGICO] Un tipo de datos muy importante en todo lenguaje de programación: los **.bg-purple_light[valores lógicos]**. Un valor lógico puede tomar **tres valores**: * `TRUE` (guardado internamente como un `1`). * `FALSE` (guardado internamente como un `0`). * `NA` (**.bg-purple_light[dato ausente]**, son las siglas de **.bg-orange[not available]**). -- Los valores lógicos suelen ser resultado de evaluar **.bg-purple_light[condiciones lógicas]** (preguntar a los datos). Por ejemplo, imaginemos que definimos un vector de temperaturas. ¿Qué días hizo menos de 22 grados? ```r x <- c(15, 20, 31, 27, 15, 29) *x < 22 ``` ``` > [1] TRUE TRUE FALSE FALSE TRUE FALSE ``` Nos devolverá un **vector lógico** con `TRUE` o `FALSE` en cada hueco, en función de si cumple o no la condición pedida. --- # Datos de tipo .orange[LÓGICO] Dicha condición lógica puede hacerse con `<=` (menor o igual), `>` (mayor) o `>=` (mayor igual). ```r x <= 22 ``` ``` > [1] TRUE TRUE FALSE FALSE TRUE FALSE ``` -- ```r x > 30 ``` ``` > [1] FALSE FALSE TRUE FALSE FALSE FALSE ``` -- ```r x >= 15 ``` ``` > [1] TRUE TRUE TRUE TRUE TRUE TRUE ``` --- # Datos de tipo .orange[LÓGICO] También podemos comparar **.bg-purple_light[si es igual a otro elemento]**, para lo que usaremos el operador `==`, pudiendo usar también su opuesto `!=` («distinto de»). ```r x == 15 ``` ``` > [1] TRUE FALSE FALSE FALSE TRUE FALSE ``` ```r x != 15 ``` ``` > [1] FALSE TRUE TRUE TRUE FALSE TRUE ``` -- Si tuviéramos un **.bg-purple_light[dato ausente]** (por error del aparato ese día, marcado como `NA`), la condición evaluada también sería `NA` ```r y <- c(15, 20, NA, 31, 27, 7, 29, 10) y < 22 ``` ``` > [1] TRUE TRUE NA FALSE FALSE TRUE FALSE TRUE ``` --- # Datos de tipo .orange[LÓGICO] Las **.bg-purple_light[condiciones pueden ser combinadas]**, principalmente de dos maneras: .pull-left[ * **.bg-purple_light[Intersección]**: **.bg-orange[TODAS]** las condiciones concatenadas se deben cumplir (conjunción y) para devolver un `TRUE`. ```r x ``` ``` > [1] 15 20 31 27 15 29 ``` ```r x < 30 & x > 15 ``` ``` > [1] FALSE TRUE FALSE TRUE FALSE TRUE ``` ] .pull-right[ * **.bg-purple_light[Unión]**: basta con que **.bg-orange[AL MENOS UNA]** de las condiciones se cumpla (conjunción o) para devolver un `TRUE`. ```r x ``` ``` > [1] 15 20 31 27 15 29 ``` ```r x < 30 | x > 15 ``` ``` > [1] TRUE TRUE TRUE TRUE TRUE TRUE ``` ] --- name: fecha # Datos de tipo .orange[FECHA] Un tipo de datos muy especial: los **.bg-purple_light[datos de tipo fecha]**. ```r # Cadena de texto fecha_char <- "2021-04-21" class(fecha_char) ``` ``` > [1] "character" ``` Podríamos pensar que no tiene nada de especial ya que parece una simple cadena de texto pero representa un **.bg-purple_light[instante en el tiempo]**, que deberíamos poder operar como tal. -- ¿Qué sucedería si **sumamos un 1 (un día)** a una fecha definida como una cadena de texto? ```r fecha_char + 1 ``` ``` > Error in fecha_char + 1: argumento no-numérico para operador binario ``` -- Si guardamos las fechas como un cadena de texto **.bg-red_light[no podemos operar con ellas]** --- # Datos de tipo .orange[FECHA] Para trabajar con fechas tenemos el paquete `{lubridate}`, y su función `as_date()`: nos **.bg-purple_light[convierte texto a fecha]**. ```r library(lubridate) *fecha <- as_date(fecha_char) class(fecha) ``` ``` > [1] "Date" ``` -- ```r fecha + 1 # día siguiente ``` ``` > [1] "2021-04-22" ``` -- ```r fecha - 3 # 3 días antes ``` ``` > [1] "2021-04-18" ``` -- Al convertir texto a fecha, aunque se visualice como un texto, **.bg-purple_light[internamente es un número]**. --- # Datos de tipo .orange[FECHA] La función `as_date()` tiene un argumento opcional, el **.bg-purple_light[formato]**, que por defecto será `format = "yyyy-mm-dd"` (que podemos cambiar) ```r *as_date("10-03-2020", format = "%d-%m-%Y") ``` ``` > [1] "2020-03-10" ``` -- ```r as_date("10-03-20", format = "%d-%m-%y") ``` ``` > [1] "2020-03-10" ``` -- ```r as_date("03-10-2020", format = "%m-%d-%Y") ``` ``` > [1] "2020-03-10" ``` -- ```r as_date("Octubre 21, 1995 21:24", format = "%B %d, %Y %H:%M") ``` ``` > [1] "1995-10-21" ``` --- # Datos de tipo .orange[FECHA] Para facilitar conversiones de formatos habituales, el paquete también tiene a nuestra disposición diferentes funciones preparadas para directamente **.bg-purple_light[convertir fechas en distintos formatos]**, como la función `ymd_hms()` o `ydm_hms()` ```r ymd_hms("2017-11-28 14:02:00") # convertir a fecha una cadena año-mes-día + hora ``` ``` > [1] "2017-11-28 14:02:00 UTC" ``` ```r ydm_hms("2017-22-12 10:00:00") # convertir a fecha una cadena año-día-mes + hora ``` ``` > [1] "2017-12-22 10:00:00 UTC" ``` -- De la misma manera tenemos la función `dmy_hms()` ```r dmy_hms("1 Jan 2017 23:59:59") # convertir a fecha una cadena textual de fecha + hora ``` ``` > [1] "2017-01-01 23:59:59 UTC" ``` --- # Datos de tipo .orange[FECHA] También podemos hacerlo de forma muy simplificada con `ymd()` ```r ymd(20170131) ``` ``` > [1] "2017-01-31" ``` -- Otra de las funcionalidades que nos proporciona dicho paquete es obtener automáticamente la **.bg-purple_light[fecha de hoy]**, haciendo uso de la función `today()` ```r *hoy <- today() hoy ``` ``` > [1] "2022-12-13" ``` -- También podemos obtener el **.bg-purple_light[«hoy y ahora»]** con la función `now()` ```r *now() ``` ``` > [1] "2022-12-13 23:16:49 CET" ``` --- # Datos de tipo .orange[FECHA] También tenemos disponibles funciones para **.bg-purple_light[extraer facilmente algunas variables]**. .pull-left[ ```r year(fecha) ``` ``` > [1] 2021 ``` ```r month(fecha) ``` ``` > [1] 4 ``` ```r hour(fecha) ``` ``` > [1] 0 ``` ```r second(fecha) ``` ``` > [1] 0 ``` ] .pull-right[ ```r week(fecha) ``` ``` > [1] 16 ``` ```r wday(fecha) ``` ``` > [1] 4 ``` ```r wday(fecha, week_start = 1) # Día de la semana ``` ``` > [1] 3 ``` ] --- # Datos de tipo .orange[FECHA] También podemos **.bg-purple_light[realizar comparaciones]** ```r fecha_actual <- today() fecha_actual > ymd(20170131) # Actual vs 2017-01-31 ``` ``` > [1] TRUE ``` ```r fecha_actual > ymd(21000131) # Actual vs 2100-01-31 ``` ``` > [1] FALSE ``` -- Con la función `leap_year()` podremos saber si la fecha **.bg-purple_light[corresponde a un año bisiesto]** ```r leap_year(as_date(ymd(20190131))) ``` ``` > [1] FALSE ``` --- # Datos de tipo .orange[FECHA] .pull-left[ <div class="figure" style="text-align: right"> <img src="./img/lubridate.png" alt="Chuleta de https://lubridate.tidyverse.org/" width="101%" /> <p class="caption">Chuleta de https://lubridate.tidyverse.org/</p> </div> ] .pull-right[ También podemos hacer uso de diferentes funciones para **.bg-purple_light[añadir intervalos]** de tiempo. ```r fecha + weeks(0:2) ``` ``` > [1] "2021-04-21" "2021-04-28" "2021-05-05" ``` ```r fecha + seconds(2) ``` ``` > [1] "2021-04-21 00:00:02 UTC" ``` ] --- name: ejercicios2 # Ejercicios .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 1**: define una variable `edad` que guarde tu edad y otra `nombre` con tu nombre. * 📝 **Ejercicio 2**: define otra variable con tus apellidos y junta las variables `nombre` y `apellidos` en una sola cadena de texto que guardes en `nombre_completo`. * 📝 **Ejercicio 3**: define un vector que contenga los números `1`, `10`, `-1` y `2`, y guárdalo en una variable llamada `vector_num`. Obtén la longitud del vector anterior. * 📝 **Ejercicio 4**: crea una secuencia de -2 a 17 de forma que salte de uno en uno (y también de forma decreciente). Repite el proceso pero saltando de 3 en 3. ] .panel[.panel-name[Solución ej. 1] ```r # variable numérica edad <- 33 edad ``` ``` > [1] 33 ``` ```r # variable de tipo texto nombre <- "Javi" nombre ``` ``` > [1] "Javi" ``` ] .panel[.panel-name[Solución ej. 2] ```r apellidos <- "Álvarez Liébana" # Opción 1 nombre_completo <- glue("{nombre} {apellidos}") nombre_completo ``` ``` > Javi Álvarez Liébana ``` ```r # Opción 2 nombre_completo <- paste(nombre, apellidos) nombre_completo ``` ``` > [1] "Javi Álvarez Liébana" ``` ] .panel[.panel-name[Solución ej. 3] ```r vector_num <- c(1, 10, -1, 2) vector_num ``` ``` > [1] 1 10 -1 2 ``` ```r # longitud length(vector_num) ``` ``` > [1] 4 ``` ] .panel[.panel-name[Solución ej. 4] ```r secuencia <- -2:17 secuencia ``` ``` > [1] -2 -1 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 ``` ```r # otra forma secuencia <- seq(-2, 17, by = 1) # decreciente 17:-2 ``` ``` > [1] 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 -1 -2 ``` ```r # de 3 en 3 seq(-2, 17, by = 3) ``` ``` > [1] -2 1 4 7 10 13 16 ``` ] ] --- # Ejercicios .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 5**: crea una secuencia que repita 7 veces el patrón -1, 2, 4. Después crea otra que repita dicho patrón pero de forma intercalada. * 📝 **Ejercicio 6**: crea una secuencia de 7 valores lógicos en los que haya 2 valores ciertos, 3 valores falsos y 2 valores ausentes. * 📝 **Ejercicio 7**: toma el vector `vector_num` del ejercicio 3 y obtén un vector lógico que nos diga que valores son mayores de 0. Obtén otro vector lógico que nos diga que valores están entre 0 y 7. Obtén otro vector lógico que nos diga que valores son distintos de 1 en valor absoluto. * 📝 **Ejercicio 8**: obtén la fecha de hoy, define la fecha de tu cumpleaños, y calcula la diferencia de días. * 📝 **Ejercicio 9**: suma un mes y una semana a la fecha de tu cumpleaños ] .panel[.panel-name[Sol ej. 5] ```r secuencia <- rep(c(-1, 2, 4), 7) secuencia ``` ``` > [1] -1 2 4 -1 2 4 -1 2 4 -1 2 4 -1 2 4 -1 2 4 -1 2 4 ``` ```r # intercalada rep(c(-1, 2, 4), each = 7) ``` ``` > [1] -1 -1 -1 -1 -1 -1 -1 2 2 2 2 2 2 2 4 4 4 4 4 4 4 ``` ] .panel[.panel-name[Sol ej. 6] ```r secuencia <- c(FALSE, TRUE, NA, FALSE, NA, TRUE, FALSE) secuencia ``` ``` > [1] FALSE TRUE NA FALSE NA TRUE FALSE ``` ] .panel[.panel-name[Sol ej. 7] ```r vector_num > 0 ``` ``` > [1] TRUE TRUE FALSE TRUE ``` ```r vector_num > 0 & vector_num < 7 ``` ``` > [1] TRUE FALSE FALSE TRUE ``` ```r abs(vector_num) != 1 ``` ``` > [1] FALSE TRUE FALSE TRUE ``` ] .panel[.panel-name[Sol ej. 8] ```r library(lubridate) hoy <- today() cumple <- as_date("1989-09-10") hoy - cumple ``` ``` > Time difference of 12147 days ``` ] .panel[.panel-name[Sol ej. 9] ```r cumple + months(1) + weeks(1) ``` ``` > [1] "1989-10-17" ``` ] ] --- # Ejercicios extras .panelset[ .panel[.panel-name[Ejercicios extra] * 📝 **Ejercicio 10**: construye con `glue()` una frase que diga «Hola, me llamo … y tengo … años». * 📝 **Ejercicio 11**: modifica el código inferior para crear un vector de nombre `vector_num` que contenga los números 1, 5 y -7. ```r # Vector de números vector_num <- c(1) vector_num ``` * 📝 **Ejercicio 12**: extrae el mes, año y día de la semana de tu cumpleaños ] .panel[.panel-name[Solución ej. 10] ```r nombre <- "Javi" edad <- 33 glue("Hola, me llamo {nombre} y tengo {edad} años") ``` ``` > Hola, me llamo Javi y tengo 33 años ``` ] .panel[.panel-name[Solución ej. 11] ```r # Vector de números vector_num <- c(1, 5, -7) vector_num ``` ``` > [1] 1 5 -7 ``` ```r # longitud length(vector_num) ``` ``` > [1] 3 ``` ] .panel[.panel-name[Solución ej. 12] ```r library(lubridate) cumple <- as_date("1989-09-10") month(cumple) ``` ``` > [1] 9 ``` ```r day(cumple) ``` ``` > [1] 10 ``` ```r year(cumple) ``` ``` > [1] 1989 ``` ```r wday(cumple, week_start = 1, label = TRUE) ``` ``` > [1] dom > Levels: lun < mar < mié < jue < vie < sáb < dom ``` ] ] --- class: inverse center middle name: clase-2 # CLASE 2: primeros datos. Primeros conceptos. ### [Operaciones con vectores](#operaciones-vectores) ### [Matrices](#matrices) ### [data.frame y tibble](#data.frame) ### [Ejercicios datasets](#ejercicios-tibble) ### [Intro estadística](#intro-estadistica) --- name: operaciones-vectores # .green[OPERACIONES] .orange[ARITMÉTICAS] Los **.bg-purple_light[valores lógicos]** `TRUE` y `FALSE` son **.bg-orange[guardados internamente]** como `0` y `1`, por lo que podemos usar operaciones aritméticas con ellos. -- Por ejemplo, si queremos **.bg-purple_light[averiguar el número de elementos que cumplen una condición]** (por ejemplo, `< 3`), los que lo hagan tendrán asignado un 1 y los que no un 0, por lo que basta con sumar dicho vector lógico para obtener el número de elementos que cumplen dicha condición (elementos que son `TRUE`). ```r # sumamos el vector de TRUE/FALSE x ``` ``` > [1] 15 20 31 27 15 29 ``` ```r sum(x < 3) ``` ``` > [1] 0 ``` --- # .green[OPERACIONES] .orange[ESTADÍSTICAS] También podemos realizar **.bg-purple_light[operaciones estadísticas]** con los vectores, como calcular su **suma**, su **media**, su **mediana**, entre otros. -- Hagamos antes un **.bg-purple_light[breve repaso]** de algunos términos estadísticos: * **.bg-purple_light[Media]**: medida de **.bg-orange[centralización]** que consiste en sumar todos los elementos y dividirlos entre la cantidad de elementos sumados (función `mean()`). La más conocida pero la menos robusta: dado un conjunto, si se introducen valores atípicos o outliers (valores muy grandes o muy pequeños), la media se perturba con mucha facilidad. `$$\overline{x} = \frac{1}{n} \sum_{i=1}^{n} x_i$$` ```r x <- c(165, 170, 181, 191, 150, 155, 167, 173, 177) mean(x) ``` ``` > [1] 169.8889 ``` --- # .green[OPERACIONES] .orange[ESTADÍSTICAS] También podemos realizar **.bg-purple_light[operaciones estadísticas]** con los vectores, como calcular su **suma**, su **media**, su **mediana**, entre otros. Hagamos antes un **.bg-purple_light[breve repaso]** de algunos términos estadísticos: * **.bg-purple_light[Mediana]**: medida de **.bg-orange[centralización]** (función `median()`) que consiste en, tras **.bg-orange[ordenar]** los datos de menor a mayor, quedarnos con el valor que ocupa el medio (deja tantos números por debajo como por encima). `$$Me_{x} = \displaystyle \arg \min_{x_i} \left\lbrace F_i > 0.5 \right\rbrace, \quad F_i = \frac{\# \left\lbrace x_j \leq x_i \right\rbrace}{n}$$` ```r x <- c(165, 170, 181, 191, 150, 155, 167, 173, 177) median(x) ``` ``` > [1] 170 ``` --- # .green[OPERACIONES] .orange[ESTADÍSTICAS] También podemos realizar **.bg-purple_light[operaciones estadísticas]** con los vectores, como calcular su **suma**, su **media**, su **mediana**, entre otros. Hagamos antes un **.bg-purple_light[breve repaso]** de algunos términos estadísticos: * **.bg-purple_light[Moda]**: medida de **.bg-orange[centralización]** que consiste en encontrar el **.bg-orange[valor o valores más repetidos]**. Es la medida de centralización más robusta. `$$Mo_{x} = \displaystyle \arg \max_{x_i} f_i , \quad f_i = \frac{\# \left\lbrace x_j = x_i \right\rbrace}{n}$$` **.bg-red_light[PROBLEMA]**: la moda no siempre es fácil de calcular (aunque existen paquetes para calcularla como `{modeest}`) --- # .green[OPERACIONES] .orange[ESTADÍSTICAS] Otra de las funciones más útil es la **.bg-purple_light[suma de elementos]** de un vector con `sum()` ```r # suma *sum(x) ``` ``` > [1] 1529 ``` ```r sum(x) / length(x) # media artesanal ``` ``` > [1] 169.8889 ``` -- Otra función útil es la **.bg-purple_light[suma acumulada]** de un vector haciendo uso de `cumsum()` ```r # suma acumulada *cumsum(c(1, 2, 4, 7, 7, 10)) ``` ``` > [1] 1 3 7 14 21 31 ``` --- # .green[OPERACIONES] .orange[ESTADÍSTICAS] No solo de medidas de centralización vive la estadística: **.bg-purple_light[¿cómo calcular las medidas de dispersión?]** * **.bg-purple_light[Varianza]**: definida como la media de desviaciones (respecto a la media) al cuadrado, tal que `\(s_{x}^{2} = \frac{1}{n} \sum_{i = 1}^{n} \left(x_i - \overline{x} \right)^2 = \overline{x^2} - \overline{x}^2\)` ```r var(x) ``` ``` > [1] 159.8611 ``` -- **.bg-green_light[IMPORTANTE]**: las funciones de `R` (y de cualquier calculadora) nos devuelve la **.bg-red_light[cuasivarianza]** (dividido entre `\(n-1\)`) ```r # Varianza real mean((x - mean(x))^2) ``` ``` > [1] 142.0988 ``` --- # .green[OPERACIONES] .orange[ESTADÍSTICAS] No solo de medidas de centralización vive la estadística: **.bg-purple_light[¿cómo calcular las medidas de dispersión?]** * **.bg-purple_light[Desv. típica (standard deviation)]**: definida como la raíz cuadrada de la varianza, tal que `\(s_{x} = \sqrt{s_{x}^{2} }\)` ```r sd(x) ``` ``` > [1] 12.64362 ``` -- **.bg-green_light[IMPORTANTE]**: las funciones de `R` (y de cualquier calculadora) nos devuelve la **.bg-red_light[cuasidesviación típica]** (raíz de la cuasivarianza, dividida entre `\(n-1\)`) ```r # Desv. típica real sqrt(mean((x - mean(x))^2)) ``` ``` > [1] 11.92052 ``` --- # .green[OPERACIONES] .orange[ESTADÍSTICAS] También pueden sernos útiles las **.bg-purple_light[medidas de posición/localización]**, como los **.bg-orange[percentiles]** (valores que nos dividen en partes iguales los datos). ```r y <- c(1, 2, 5, 5, 10, 10, 10, 13, 15, 20, 25) # Percentiles por defecto: cuartiles *quantile(y) ``` ``` > 0% 25% 50% 75% 100% > 1 5 10 14 25 ``` -- En `quantile()` hay un argumento por defecto `probs = c(0, 0.25, 0.5, 0.75, 1)` (**percentiles** a calcular) que puede ser cambiado, por ejemplo, para percentiles 20%-30%-70%-90%. ```r quantile(y, probs = c(0.2, 0.3, 0.7, 0.9)) ``` ``` > 20% 30% 70% 90% > 5 5 13 20 ``` --- # Valores .orange[ÚNICOS] Con la función `unique()` podemos también extraer los **.bg-purple_light[valores únicos de una variable]** ```r colores <- c("azul", "azul", "verde", "amarillo", "azul", "rojo", "rojo", "azul", "rojo", "verde", "morado") *unique(colores) ``` ``` > [1] "azul" "verde" "amarillo" "rojo" "morado" ``` --- # .orange[FILTRAR] elementos Otras veces no querremos seleccionar un elemento en concreto sino **.bg-purple_light[filtrar algunos elementos en concreto]** y no extraerlos, **.bg-orange[eliminarlos]**. Deberemos repetir la misma operación pero con el signo `-` delante: el operador `[-i]` **no selecciona** el elemento i-ésimo del vector sino que lo **elimina** ```r y ``` ``` > [1] 1 2 5 5 10 10 10 13 15 20 25 ``` ```r y[-2] ``` ``` > [1] 1 5 5 10 10 10 13 15 20 25 ``` --- # .orange[FILTRAR] elementos Lo habitual es que dicho filtro lo hagamos **.bg-purple_light[en base a una condición lógica]**. Supongamos que tenemos las edades de dos grupos de personas y que queremos quedarnos **solo con los mayores edad**: vamos a seleccionar los **elementos que cumplen una condición dada**. ```r edades_1 <- c(7, 20, 18, 3, 19, 9, 13, 3, 45) edades_2 <- c(17, 21, 58, 33, 15, 59, 13, 1, 45) ``` -- ```r *edades_1[edades_1 >= 18] ``` ``` > [1] 20 18 19 45 ``` ```r edades_2[edades_2 >= 18] ``` ``` > [1] 21 58 33 59 45 ``` Lo que hemos hecho ha sido pasar como **índices a seleccionar un vector lógico** `TRUE/FALSE`: solo filtrará los lugares donde se guarde un `TRUE`. --- # .orange[FILTRAR] elementos Esto también nos puede servir para **.bg-purple_light[limpiar de datos ausentes]**, combinando la función `is.na()`: nos localiza el lugar que ocupan los ausentes, con el operador `!` (**negar el valor lógico** que venga detrás). ```r x <- c(7, NA, 20, 3, 19, 21, 25, 80, NA) x[is.na(x)] # solo valores ausentes ``` ``` > [1] NA NA ``` ```r x[!is.na(x)] # sin valores ausentes: ! es el símbolo de ``` ``` > [1] 7 20 3 19 21 25 80 ``` -- También podemos probar a **combinar condiciones lógicas** para nuestra selección. ```r x[x >= 18 & x <= 25] # los valores que cumplen ambas (&): entre 18 y 25 años ``` ``` > [1] NA 20 19 21 25 NA ``` --- # .green[SELECCIONAR] elementos: .orange[WHICH] A veces no querremos el elemento en sí, sino el **.bg-purple_light[lugar que ocupa]**: ¿qué valores de un vector cumplen una condición lógica? Para obtener dicho índice usaremos la función `which()`. ```r x <- c(7, NA, 20, 3, 19, 21, 25, 80, NA) which(x >= 18) # Obtenemos los lugares ``` ``` > [1] 3 5 6 7 8 ``` -- Esta función es muy útil especialmente cuando queremos el valor que ocupa el **.bg-purple_light[máximo/mínimo]** de un vector, con las funciones `which.max()` y `which.min()`. ```r max(x, na.rm = TRUE) ``` ``` > [1] 80 ``` ```r which.max(x) # Lugar que ocupa el máximo ``` ``` > [1] 8 ``` --- # .green[SELECCIONAR] elementos: .orange[any/all] Existen dos funciones muy útiles para saber si **.bg-purple_light[todos o alguno de los elementos]** de un vector cumple una condición: `all()` y `any()` nos devolverá un único valor lógico. ```r x <- c(1, 2, 3, 4, 5, NA, 7) *all(x < 3) ``` ``` > [1] FALSE ``` ```r any(x < 3) ``` ``` > [1] TRUE ``` ```r all(x > 0) ``` ``` > [1] NA ``` --- # .orange[NOMBRAR] elementos `R` nos permite dar **.bg-purple_light[significado léxico a nuestros valores]** (significan algo, no solo números), pudiendo poner **nombres a los elementos** de un vector. ```r x <- c("edad" = 31, "tlf" = 613910687, "cp" = 33007) x ``` ``` > edad tlf cp > 31 613910687 33007 ``` -- Esto es una ventaja ya que nos permite su **.bg-purple_light[selección usando dichos nombres]** ```r x[c("edad", "cp")] # seleccionamos los elementos que tienen ese nombre asignado ``` ``` > edad cp > 31 33007 ``` -- Con la función `names()` podemos, no solo **.bg-purple_light[consultar los nombres]** sino **cambiarlos**. --- # .orange[ORDENAR] vectores Una acción también habitual al trabajar con datos es saber **.bg-purple_light[ordenarlos]**: de menor a mayor edad, datos más recientes vs antiguos, etc. Para ello tenemos la función `sort()`, que podemos usar directamente para ordenar de **menor a mayor**. ```r edades <- c(81, 7, 25, 41, 65, 20, 33, 23, 77) # orden de joven a mayor *sort(edades) ``` ``` > [1] 7 20 23 25 33 41 65 77 81 ``` -- Por defecto, `sort()` ordena de menor a mayor. Con el argumento opcional `decreasing = TRUE` podemos **ordenar de mayor a menor**. ```r # orden de mayor a joven *sort(edades, decreasing = FALSE) ``` ``` > [1] 7 20 23 25 33 41 65 77 81 ``` --- # .orange[ORDENAR] vectores Otra forma de ordenar es obtener los **índices de los elementos ordenados**, y luego usar dichos índices para **reorganizar los elementos**, con la función `order()`. ```r *order(x) ``` ``` > [1] 1 3 2 ``` ```r x[order(x)] ``` ``` > edad cp tlf > 31 33007 613910687 ``` --- # .orange[MEDIR] tiempos de ejecución Hay un paquete muy útil para **.bg-purple_light[medir tiempos de distintas órdenes]** que hacen lo mismo (el paquete `{microbenchmark}`). Vamos a comparar `order()` y `sort()`. ```r library(microbenchmark) # instalar primera vez x <- rnorm(1e3) # 1000 elementos aleatorias *microbenchmark(sort(x), x[order(x)], times = 1e3) ``` ``` > Unit: microseconds > expr min lq mean median uq max neval cld > sort(x) 47.237 52.1995 65.34929 57.1900 69.257 229.271 1000 b > x[order(x)] 31.154 37.1685 45.91756 40.1995 46.794 496.202 1000 a ``` --- name: ejercicios-vectores # Ejercicios de vectores .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 1**: define el vector `x` como la concatenación de los 5 primeros números impares, y calcula su suma. * 📝 **Ejercicio 2**: obtén los elementos de `x` mayores que 4. Determina los lugares que ocupan. Calcula el número de elementos de `x` mayores que 4. * 📝 **Ejercicio 3**: calcula el vector `1/x` y obtén la versión ordenada (de menor a mayor). * 📝 **Ejercicio 4**: define un vector con tu estatura y peso, y nombra cada elemento. ] .panel[.panel-name[Solución ej. 1] ```r x <- c(1, 3, 5, 7, 9) # otra forma x <- seq(1, 9, by = 2) # Suma sum(x) ``` ``` > [1] 25 ``` ] .panel[.panel-name[Solución ej. 2] ```r # Elementos mayores que 4 x[x > 4] ``` ``` > [1] 5 7 9 ``` ```r # Lugares que ocupan which(x > 4) ``` ``` > [1] 3 4 5 ``` ```r # Cantidad de elementos mayores que 4 sum(x > 4) ``` ``` > [1] 3 ``` ] .panel[.panel-name[Solución ej. 3] ```r y <- 1/x # una forma sort(y) ``` ``` > [1] 0.1111111 0.1428571 0.2000000 0.3333333 1.0000000 ``` ```r # otra forma y[order(y)] ``` ``` > [1] 0.1111111 0.1428571 0.2000000 0.3333333 1.0000000 ``` ] .panel[.panel-name[Solución ej. 4] ```r x <- c("estatura" = 180, "peso" = 80) x ``` ``` > estatura peso > 180 80 ``` ] ] --- # Ejercicios de vectores .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 5**: encuentra del vector `x` del ejercicio 1 los elementos mayores (estrictos) que 1 y menores (estrictos) que 7. Encuentra una forma de averiguar si todos los elementos son o no positivos. * 📝 **Ejercicio 6**: define el vector `x <- c(-1, 0, -2, 5, 3, 7)` y obtén los elementos que ocupan una posición impar. * 📝 **Ejercicio 7**: define el vector de los primeros números impares (hasta el 21) y extrae los elementos que ocupan los lugares `1, 4, 5, 8`. Elimina del vector el segundo elemento * 📝 **Ejercicio 8**: define un vector de 8 valores y determina la media, la mediana y los cuartiles. ] .panel[.panel-name[Solución ej. 5] ```r x <- c(1, 3, 5, 7, 9) # valores >1 y <7 x[x > 1 & x < 7] ``` ``` > [1] 3 5 ``` ```r # ¿Todos positivos? all(x > 0) ``` ``` > [1] TRUE ``` ```r sum(all(x <= 0)) # debe dar 0 ``` ``` > [1] 0 ``` ] .panel[.panel-name[Solución ej. 6] ```r x <- c(-1, 0, -2, 5, 3, 7) x[seq(1, length(x), by = 2)] ``` ``` > [1] -1 -2 3 ``` ] .panel[.panel-name[Solución ej. 7] ```r x <- seq(1, 21, by = 2) # posiciones pedidas x[c(1, 4, 5, 8)] ``` ``` > [1] 1 7 9 15 ``` ```r # sin las posiciones pedidas x[-c(1, 4, 5, 8)] ``` ``` > [1] 3 5 11 13 17 19 21 ``` ```r # eliminamos del vector el segundo elemento x[-2] ``` ``` > [1] 1 5 7 9 11 13 15 17 19 21 ``` ] .panel[.panel-name[Solución ej. 8] ```r x <- c(0, -2, 3, 7, -5, 9, 3, 1) mean(x) ``` ``` > [1] 2 ``` ```r median(x) ``` ``` > [1] 2 ``` ```r quantile(x) ``` ``` > 0% 25% 50% 75% 100% > -5.0 -0.5 2.0 4.0 9.0 ``` ] ] --- name: matrices # De la .orange[celda] a la .green[tabla] <img src="./img/celdas.jpg" width="55%" style="display: block; margin: auto;" /> * **.bg-purple_light[Celda]**: un dato **.bg-orange[individual]** de un tipo concreto. * **.bg-purple_light[Variable]**: una **.bg-orange[concatenación de valores]** del mismo tipo (**vectores**). -- **.bg-purple_light[Matriz]**: **.bg-orange[concatenación de variables]** del **.bg-yellow[mismo tipo]** y longitud. --- # .orange[MATRICES]: concatenando variables Cuando analizamos datos solemos tener varias **variables distintas** de cada individuo: necesitamos una «tabla» con **.bg-purple_light[distintas variables]** (de **.bg-orange[IGUAL longitud]**). Las **.bg-purple_light[matrices]** son una concatenación de variables, del **.bg-orange[mismo tipo e igual longitud]**, dispuestas en **p columnas** (datos p-dimensionales) -- Vamos a empezar definiendo una **matriz sencilla**: imagina que tenemos las estaturas y pesos de 5 personas. ¿Cómo juntar las dos variables creando nuestro primer conjunto de datos? Fíjate que son del mismo tipo e igual longitud. ```r estaturas <- c(150, 160, 170, 180, 190) pesos <- c(60, 70, 80, 90, 100) ``` --- # .orange[MATRICES]: concatenando variables ```r estaturas <- c(150, 160, 170, 180, 190) pesos <- c(60, 70, 80, 90, 100) ``` ¿Cómo juntar las dos variables creando nuestro primer conjunto de datos? Vamos a **.bg-purple_light[crear una matriz]**, un conjunto de números organizado en 2 columnas (una por variable) y 5 filas o registros (una por persona). Para ello usaremos la función `cbind()`, que nos **concatena vectores de igual longitud en columnas**. ```r # Construimos la matriz por columnas *datos_matriz <- cbind(estaturas, pesos) datos_matriz ``` ``` > estaturas pesos > [1,] 150 60 > [2,] 160 70 > [3,] 170 80 > [4,] 180 90 > [5,] 190 100 ``` --- # .orange[MATRICES]: concatenando variables .pull-left[ <img src="./img/datos_matriz_1.jpg" width="99%" style="display: block; margin: auto auto auto 0;" /> ] .pull-right[ ```r View(datos_matriz) ``` Podemos **.bg-purple_light[visualizar la matriz]** en un formato «excelizado» con la función `View()`. También podemos **.bg-purple_light[construir la matriz por filas]** con la función `rbind()` (aunque lo recomendable es tener cada variable en columna y cada individuo en fila). ```r # Construimos la matriz por filas rbind(estaturas, pesos) ``` ``` > [,1] [,2] [,3] [,4] [,5] > estaturas 150 160 170 180 190 > pesos 60 70 80 90 100 ``` ] --- # .orange[MATRICES]: concatenando variables Podemos comprobar las **.bg-purple_light[dimensiones de una matriz]** con `dim()`, `nrow()` y `ncol()`: nuestros datos están **.bg-orange[tabulados]**: ```r dim(datos_matriz) # vector ``` ``` > [1] 5 2 ``` ```r nrow(datos_matriz) ``` ``` > [1] 5 ``` ```r ncol(datos_matriz) ``` ``` > [1] 2 ``` --- # .orange[MATRICES]: concatenando variables Veamos un ejemplo con **tres variables/columnas**: edades, teléfonos y códigos postales. ```r edades <- c(14, 24, 56, 31, 20, 87, 73) tlf <- c(NA, 683839390, 621539732, 618211286, NA, 914727164, NA) cp <- c(33007, 28019, 37005, 18003, 33091, 25073, 17140) # Construimos la matriz por columnas *datos_matriz <- cbind(edades, tlf, cp) datos_matriz ``` ``` > edades tlf cp > [1,] 14 NA 33007 > [2,] 24 683839390 28019 > [3,] 56 621539732 37005 > [4,] 31 618211286 18003 > [5,] 20 NA 33091 > [6,] 87 914727164 25073 > [7,] 73 NA 17140 ``` --- # .orange[MATRICES]: añadir registros/variables Las funciones `cbind()` y `rbind()` no solo nos permiten crear matrices desde cero sino también **.bg-purple_light[añadir filas o columnas]** a matrices existentes. ```r # Añadimos una fila rbind(datos_matriz, c(27, 620125780, 28051)) ``` ``` > edades tlf cp > [1,] 14 NA 33007 > [2,] 24 683839390 28019 > [3,] 56 621539732 37005 > [4,] 31 618211286 18003 > [5,] 20 NA 33091 > [6,] 87 914727164 25073 > [7,] 73 NA 17140 > [8,] 27 620125780 28051 ``` --- # .orange[MATRICES]: valores repetidos Podemos definir una **.bg-purple_light[matriz de nº repetidos]** con `matrix(..., nrow = ..., ncol = ...)` ```r # matriz de ceros de 3 filas, 2 columnas, *matrix(0, nrow = 3, ncol = 2) ``` ``` > [,1] [,2] > [1,] 0 0 > [2,] 0 0 > [3,] 0 0 ``` -- También podemos definir una **.bg-purple_light[matriz a partir de un vector numérico]**, reorganizando los valores en forma de matriz (sabiendo que los elementos se van colocando por columnas). ```r matrix(1:15, ncol = 5) # Matriz con el vector 1:15 ``` ``` > [,1] [,2] [,3] [,4] [,5] > [1,] 1 4 7 10 13 > [2,] 2 5 8 11 14 > [3,] 3 6 9 12 15 ``` --- # .green[OPERACIONES] con .orange[MATRICES] Con las matrices sucede como con los vectores: cuando aplicamos una **.bg-purple_light[operación aritmética]** lo hacemos **.bg-orange[elemento a elemento]** ```r z <- matrix(1:15, ncol = 5) z / 5 ``` ``` > [,1] [,2] [,3] [,4] [,5] > [1,] 0.2 0.8 1.4 2.0 2.6 > [2,] 0.4 1.0 1.6 2.2 2.8 > [3,] 0.6 1.2 1.8 2.4 3.0 ``` ```r z + 3 ``` ``` > [,1] [,2] [,3] [,4] [,5] > [1,] 4 7 10 13 16 > [2,] 5 8 11 14 17 > [3,] 6 9 12 15 18 ``` --- # .orange[MATRICES] de .green[CARACTERES] También podemos crear matrices de otros tipos de datos, siempre y cuando las **.bg-purple_light[columnas sean del mismo tipo e igual longitud]**, por ejemplo una **.bg-orange[matriz de caracteres]**. ```r # matriz de caracteres nombres <- c("Javier", "Carlos", "María") apellidos <- c("Álvarez", "García", "Pérez") cbind(nombres, apellidos) ``` ``` > nombres apellidos > [1,] "Javier" "Álvarez" > [2,] "Carlos" "García" > [3,] "María" "Pérez" ``` -- ```r # matriz de valores lógicos cbind(c(TRUE, FALSE), c(FALSE, TRUE)) ``` ``` > [,1] [,2] > [1,] TRUE FALSE > [2,] FALSE TRUE ``` --- # .orange[SELECCIONAR] elementos Si recuerdas para los vectores, usábamos el operador `[i]` para **acceder al elemento i-ésimo**. En el caso de las matrices la lógica será la misma: * para **.bg-purple_light[acceder a la fila i-ésima]** se usa el operador `[i, ]` (dejando libre la columna). ```r datos_matriz[1, ] # fila 1 ``` ``` > edades tlf cp > 14 NA 33007 ``` --- # .orange[SELECCIONAR] elementos Si recuerdas para los vectores, usábamos el operador `[i]` para **acceder al elemento i-ésimo**. En el caso de las matrices la lógica será la misma: * para **.bg-purple_light[acceder a la columna j-ésima]** se usa el operador `[, j]` (dejando libre la fila). ```r datos_matriz[, 3] # columna 3 ``` ``` > [1] 33007 28019 37005 18003 33091 25073 17140 ``` --- # .orange[SELECCIONAR] elementos Si recuerdas para los vectores, usábamos el operador `[i]` para **acceder al elemento i-ésimo**. En el caso de las matrices la lógica será la misma: * para **.bg-purple_light[acceder conjuntamente al elemento (i, j)]** se usa el operador `[i, j]`. ```r datos_matriz[1, 3] # elemento (1, 3) ``` ``` > cp > 33007 ``` ```r datos_matriz[2, 2] # elemento (1, 3) ``` ``` > tlf > 683839390 ``` --- # .orange[NOMBRAR] variables Una matriz por defecto adopta los nombres de los vectores como los nombres de columnas, pero podemos **.bg-purple_light[personalizar los nombres de las variables]** ```r estaturas <- c(150, 160, 170) pesos <- c(60, 70, 80) cbind("altura" = estaturas, "pesaje" = pesos) ``` ``` > altura pesaje > [1,] 150 60 > [2,] 160 70 > [3,] 170 80 ``` -- Si las columnas tienen nombres podemos hacer uso de ellos para **acceder a las columnas** ```r datos_matriz[, c("edades", "tlf")] ``` ``` > edades tlf > [1,] 14 NA > [2,] 24 683839390 > [3,] 56 621539732 > [4,] 31 618211286 > [5,] 20 NA > [6,] 87 914727164 > [7,] 73 NA ``` --- # .orange[NOMBRAR] variables También podemos **.bg-purple_light[asignar nombres]** a las filas de una matriz con `row.names()` y acceder a filas y columnas por nombres. ```r row.names(datos_matriz) <- c("Javi", "Laura", "Patricia", "Carlos", "Juan", "Luis", "Carla") datos_matriz ``` ``` > edades tlf cp > Javi 14 NA 33007 > Laura 24 683839390 28019 > Patricia 56 621539732 37005 > Carlos 31 618211286 18003 > Juan 20 NA 33091 > Luis 87 914727164 25073 > Carla 73 NA 17140 ``` ```r datos_matriz["Javi", "edades"] ``` ``` > [1] 14 ``` --- # .orange[OPERACIONES] por filas/columnas Normalmente, para explicar las **operaciones con matrices** en un lenguaje de programación al uso, necesitaríamos hablar de una **herramienta llamada bucles**. Lo mencionaremos más adelante pero no los vamos a necesitar de momento (cuántos menos los usemos en `R`, mejor) -- Imagina que tuviésemos nuestra matriz de estaturas y pesos. ```r datos_matriz <- cbind(estaturas, pesos) datos_matriz ``` ``` > estaturas pesos > [1,] 150 60 > [2,] 160 70 > [3,] 170 80 ``` -- ¿Cómo podemos **.bg-purple_light[aplicar una operación para cada una de las filas o columnas]** de una matriz? --- # .orange[OPERACIONES] por filas/columnas Imagina que queremos obtener la **.bg-purple_light[media de cada columna]**. Lo haremos con la función `apply()`, y le indicaremos como argumentos la matriz, el **.bg-orange[sentido de la operación]** (`MARGIN = 1` por filas, `MARGIN = 2` por columnas) y la **función a aplicar** ```r # Media (mean) por columnas (MARGIN = 2) apply(datos_matriz, MARGIN = 2, FUN = "mean") ``` ``` > estaturas pesos > 160 70 ``` -- Si la función **requiere de argumentos extras** se lo podemos indicar al final. ```r estaturas_bis <- c(150, NA, 170, 180, 190) datos_matriz_bis <- cbind(estaturas_bis, pesos) apply(datos_matriz_bis, MARGIN = 2, FUN = "mean") ``` ``` > estaturas_bis pesos > NA 68 ``` --- name: ejercicios-matrices # Ejercicios de matrices .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 1**: modifica el código para definir una matriz `x` de ceros de 3 filas y 7 columnas. ```r # Matriz x <- matrix(0, nrow = 2, ncol = 3) x ``` * 📝 **Ejercicio 2**: a la matriz anterior, suma un 1 a cada número de la matriz y divide el resultado entre 5. * 📝 **Ejercicio 3**: tras definir la matriz `x` calcula su transpuesta y obtén sus dimensiones ] .panel[.panel-name[Solución ej. 1] ```r x <- matrix(0, nrow = 3, ncol = 7) x ``` ``` > [,1] [,2] [,3] [,4] [,5] [,6] [,7] > [1,] 0 0 0 0 0 0 0 > [2,] 0 0 0 0 0 0 0 > [3,] 0 0 0 0 0 0 0 ``` ] .panel[.panel-name[Solución ej. 2] ```r # sumamos 1 x + 1 ``` ``` > [,1] [,2] [,3] [,4] [,5] [,6] [,7] > [1,] 1 1 1 1 1 1 1 > [2,] 1 1 1 1 1 1 1 > [3,] 1 1 1 1 1 1 1 ``` ```r # dividimos entre 5 (x + 1) / 5 ``` ``` > [,1] [,2] [,3] [,4] [,5] [,6] [,7] > [1,] 0.2 0.2 0.2 0.2 0.2 0.2 0.2 > [2,] 0.2 0.2 0.2 0.2 0.2 0.2 0.2 > [3,] 0.2 0.2 0.2 0.2 0.2 0.2 0.2 ``` ] .panel[.panel-name[Solución ej. 3] ```r # dimensiones originales dim(x) ``` ``` > [1] 3 7 ``` ```r # transpuesta y <- t(x) y ``` ``` > [,1] [,2] [,3] > [1,] 0 0 0 > [2,] 0 0 0 > [3,] 0 0 0 > [4,] 0 0 0 > [5,] 0 0 0 > [6,] 0 0 0 > [7,] 0 0 0 ``` ```r dim(y) ``` ``` > [1] 7 3 ``` ] ] --- # Ejercicios de matrices .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 4**: define la matriz `x <- matrix(1:12, nrow = 4)`. Obtén la primera fila, la tercera columna, y el elemento (4, 1). * 📝 **Ejercicio 5**: en la matriz anterior, pon a cada fila `i` el nombre `fila_i` (fila_1, fila_2, fila_3, fila_4). * 📝 **Ejercicio 6**: con la matriz anterior definida como `matrix(1:12, nrow = 4)`, calcula la media de todos los elementos, la media de cada fila y la media de cada columna. Calcula la suma de de cada fila y de cada columna ] .panel[.panel-name[Solución ej. 4] ```r x <- matrix(1:12, nrow = 4) # primera fila x[1, ] ``` ``` > [1] 1 5 9 ``` ```r # tercera columna x[, 3] ``` ``` > [1] 9 10 11 12 ``` ```r # (4, 1) x[4, 1] ``` ``` > [1] 4 ``` ] .panel[.panel-name[Solución ej. 5] ```r x ``` ``` > [,1] [,2] [,3] > [1,] 1 5 9 > [2,] 2 6 10 > [3,] 3 7 11 > [4,] 4 8 12 ``` ```r row.names(x) <- glue("fila_{1:4}") x ``` ``` > [,1] [,2] [,3] > fila_1 1 5 9 > fila_2 2 6 10 > fila_3 3 7 11 > fila_4 4 8 12 ``` ] .panel[.panel-name[Solución ej. 6] ```r # media por filas apply(x, MARGIN = 1, FUN = mean) ``` ``` > fila_1 fila_2 fila_3 fila_4 > 5 6 7 8 ``` ```r # media por columnas apply(x, MARGIN = 2, FUN = mean) ``` ``` > [1] 2.5 6.5 10.5 ``` ```r # suma por filas apply(x, MARGIN = 1, FUN = sum) ``` ``` > fila_1 fila_2 fila_3 fila_4 > 15 18 21 24 ``` ```r # suma por columnas apply(x, MARGIN = 2, FUN = sum) ``` ``` > [1] 10 26 42 ``` ] ] --- # Ejercicios extras (matrices y vectores) .panelset[ .panel[.panel-name[Ejercicios extra] * 📝 **Ejercicio 1**: define un vector `y` que contenga los 5 primeros pares, y otro `x` con los 5 primeros impares. Haz la suma de `x` (ejercicio 1 anterior) e `y`. * 📝 **Ejercicio 2**: encuentra del vector `x <- c(-1, 0, -2, 5, 3, 7)` el lugar (el índice) que ocupa su mínimo y su máximo. * 📝 **Ejercicio 3**: define el vector `c(-1, 0, 4, 5, -2)`, calcula la raíz cuadrada del vector y determina que lugares son de tipo `NaN`. * 📝 **Ejercicio 4**: el siguiente código define una matriz de dimensiones `4 x 3` y calcula la suma por columnas. Modifica el código para que realice la suma por filas. ```r matriz <- matrix(1:12, nrow = 4) apply(matriz, MARGIN = 2, FUN = "sum") ``` ] .panel[.panel-name[Solución ej. 1] ```r y <- c(0, 2, 4, 6, 8) x <- y + 1 # forma más rápida de (1, 3, 5, 7, 9) x + y ``` ``` > [1] 1 5 9 13 17 ``` ] .panel[.panel-name[Solución ej. 2] ```r x <- c(-1, 0, -2, 5, 3, 7) which.max(x) ``` ``` > [1] 6 ``` ```r which.min(y) ``` ``` > [1] 1 ``` ] .panel[.panel-name[Solución ej. 3] ```r x <- c(-1, 0, 4, 5, -2) sqrt(x) ``` ``` > [1] NaN 0.000000 2.000000 2.236068 NaN ``` ```r is.nan(sqrt(x)) ``` ``` > [1] TRUE FALSE FALSE FALSE TRUE ``` ] .panel[.panel-name[Solución ej. 4] ```r matriz <- matrix(1:12, nrow = 4) apply(matriz, MARGIN = 1, FUN = "sum") ``` ``` > [1] 15 18 21 24 ``` ] ] --- name: data.frame # .orange[TABLAS]: variables .green[data.frame] <img src="./img/celdas.jpg" width="45%" style="display: block; margin: auto;" /> * **.bg-purple_light[Celda]**: un dato **.bg-orange[individual]** de un tipo concreto. * **.bg-purple_light[Variable]**: una **.bg-orange[concatenación de valores]** del mismo tipo (**vectores**). * **.bg-purple_light[Matriz]**: **.bg-orange[concatenación de variables]** del **.bg-yellow[mismo tipo]** y longitud. -- * **.bg-purple_light[data.frame (tabla)]**: **.bg-orange[concatenación de variables]** de **.bg-yellow[DISTINTO tipo]** e igual longitud. --- # .red[PROBLEMAS] de las .green[MATRICES] Retomemos nuestra matriz de edades, teléfonos y códigos postales. ```r edades <- c(14, 24, 56, 31, 20, 87) tlf <- c(NA, 683839390, 621539732, 618211286, NA, 914727164) cp <- c(33007, 28019, 37005, 18003, 33091, 25073) # Construimos la matriz por columnas *datos_matriz <- cbind(edades, tlf, cp) datos_matriz ``` ``` > edades tlf cp > [1,] 14 NA 33007 > [2,] 24 683839390 28019 > [3,] 56 621539732 37005 > [4,] 31 618211286 18003 > [5,] 20 NA 33091 > [6,] 87 914727164 25073 ``` -- ¿Qué sucederá si ahora **.bg-purple_light[añadimos una columna con los nombres]** (tipo caracter) de cada persona? --- # .red[PROBLEMAS] de las .green[MATRICES] ```r nombres <- c("Sonia", "Carla", "Pepito", "Carlos", "Lara", "Sandra", "Javi") datos_matriz_nueva <- cbind(nombres, datos_matriz) ``` ``` > nombres edades tlf cp > [1,] "Sonia" "14" NA "33007" > [2,] "Carla" "24" "683839390" "28019" > [3,] "Pepito" "56" "621539732" "37005" > [4,] "Carlos" "31" "618211286" "18003" > [5,] "Lara" "20" NA "33091" > [6,] "Sandra" "87" "914727164" "25073" ``` **.bg-red_light[¿Has visto lo que ha sucedido?]** -- Como una **.bg-purple_light[matriz solo puedes tener un tipo de dato]**, al añadir una variable de tipo texto, `R` se ha visto obligado a **convertir los números en texto** (poniéndole **comillas**). ```r datos_matriz_nueva[, "edades"] + 1 ``` ``` > Error in datos_matriz_nueva[, "edades"] + 1: argumento no-numérico para operador binario ``` --- # .red[PROBLEMAS] de las .green[MATRICES] Las **.bg-purple_light[matrices]** nos permiten almacenar distintas variables SIEMPRE Y CUANDO tengan * **.bg-orange[Misma longitud]**. * **.bg-orange[Mismo tipo]** de dato (sin mezclar). Esto es bastante limitante en la vida real nuestros datos tendrán variables de todo tipo: supongamos que queremos **guardar de 7 personas las siguientes variables**. ```r # Nombres nombres <- c("Sonia", "Carla", "Pepito", "Carlos", "Lara", "Sandra", "Javi") # Apellidos apellidos <- c(NA, "González", "Fernández", "Martínez", "Liébana", "García", "Ortiz") # Código postal cp <- c(28019, 28001, 34005, 18410, 33007, 34500, 28017) # Edades edades <- c(45, 67, NA, 31, 27, 19, 50) ``` --- # .red[PROBLEMAS] de las .green[MATRICES] Las **.bg-purple_light[matrices]** nos permiten almacenar distintas variables SIEMPRE Y CUANDO tengan * **.bg-orange[Misma longitud]**. * **.bg-orange[Mismo tipo]** de dato (sin mezclar). Esto es bastante limitante en la vida real nuestros datos tendrán variables de todo tipo: supongamos que queremos **guardar de 7 personas las siguientes variables**. ```r # Teléfono tlf <- c(618910564, 914718475, 934567891, 620176565, NA, NA, 688921344) # Estado civil (no lo sabemos de una persona) casado <- c(TRUE, FALSE, FALSE, NA, TRUE, FALSE, FALSE) # Fecha de creación (fecha en el que esa persona entra en el sistema) # lo convertimos a tipo fecha fecha_creacion <- as_date(c("2021-03-04", "2020-10-12", "1990-04-05", "2019-09-10", "2017-03-21", "2020-07-07", "2000-01-28")) ``` --- # .red[PROBLEMAS] de las .green[MATRICES] Aahora tenemos un **popurrí de variables**, de la misma longitud pero de tipos distintos: * `(edades, tlf, cp)` son variables **numéricas**. * `(nombres, apellidos)` son variables de **texto**. * `casado` es una variable **lógica**. * `fecha_creacion` de tipo **fecha**. ¿Qué sucedería si **.bg-purple_light[intentamos mezclar todo en una matriz]**? -- ```r # Juntamos por columnas datos_matriz <- cbind(nombres, apellidos, edades, tlf, cp, casado, fecha_creacion) datos_matriz ``` ``` > nombres apellidos edades tlf cp casado fecha_creacion > [1,] "Sonia" NA "45" "618910564" "28019" "TRUE" "18690" > [2,] "Carla" "González" "67" "914718475" "28001" "FALSE" "18547" > [3,] "Pepito" "Fernández" NA "934567891" "34005" "FALSE" "7399" > [4,] "Carlos" "Martínez" "31" "620176565" "18410" NA "18149" > [5,] "Lara" "Liébana" "27" NA "33007" "TRUE" "17246" > [6,] "Sandra" "García" "19" NA "34500" "FALSE" "18450" > [7,] "Javi" "Ortiz" "50" "688921344" "28017" "FALSE" "10984" ``` --- # .red[PROBLEMAS] de las .green[MATRICES] ```r datos_matriz ``` ``` > nombres apellidos edades tlf cp casado fecha_creacion > [1,] "Sonia" NA "45" "618910564" "28019" "TRUE" "18690" > [2,] "Carla" "González" "67" "914718475" "28001" "FALSE" "18547" > [3,] "Pepito" "Fernández" NA "934567891" "34005" "FALSE" "7399" > [4,] "Carlos" "Martínez" "31" "620176565" "18410" NA "18149" > [5,] "Lara" "Liébana" "27" NA "33007" "TRUE" "17246" > [6,] "Sandra" "García" "19" NA "34500" "FALSE" "18450" > [7,] "Javi" "Ortiz" "50" "688921344" "28017" "FALSE" "10984" ``` Dado que en una **.bg-purple_light[matriz solo podemos almacenar datos del mismo tipo]**, los números los convierte a texto, las variables lógicas las convierte a texto (`TRUE` era un valor lógico, `"TRUE"` es un texto, sin significado de verdadero/falso) y las fechas las ha convertido a texto. ```r datos_matriz[1, "fecha_creacion"] - datos_matriz[2, "fecha_creacion"] ``` ``` > Error in datos_matriz[1, "fecha_creacion"] - datos_matriz[2, "fecha_creacion"]: argumento no-numérico para operador binario ``` --- # .orange[TABLAS]: variables .green[data.frame] Vamos a aprender cómo juntar variables de distinto tipo, sin **modificar la integridad** del dato. El formato de **.bg-purple_light[tabla de datos]** que vamos a empezar a usar se llama `data.frame`: una **.bg-purple_light[colección de variables de igual longitud]** pero cada una puede ser de un **.bg-orange[tipo distinto]**. -- Para crearlo basta con usar la función `data.frame()`, pasándole como argumentos (separados por comas) las variables que queremos reunir. ```r # Creamos nuestro primer data.frame tabla <- data.frame(nombres, apellidos, edades, tlf, * cp, casado, fecha_creacion) tabla ``` ``` > nombres apellidos edades tlf cp casado fecha_creacion > 1 Sonia <NA> 45 618910564 28019 TRUE 2021-03-04 > 2 Carla González 67 914718475 28001 FALSE 2020-10-12 > 3 Pepito Fernández NA 934567891 34005 FALSE 1990-04-05 > 4 Carlos Martínez 31 620176565 18410 NA 2019-09-10 > 5 Lara Liébana 27 NA 33007 TRUE 2017-03-21 > 6 Sandra García 19 NA 34500 FALSE 2020-07-07 > 7 Javi Ortiz 50 688921344 28017 FALSE 2000-01-28 ``` --- # .orange[TABLAS]: variables .green[data.frame] ```r tabla ``` ``` > nombres apellidos edades tlf cp casado fecha_creacion > 1 Sonia <NA> 45 618910564 28019 TRUE 2021-03-04 > 2 Carla González 67 914718475 28001 FALSE 2020-10-12 > 3 Pepito Fernández NA 934567891 34005 FALSE 1990-04-05 > 4 Carlos Martínez 31 620176565 18410 NA 2019-09-10 > 5 Lara Liébana 27 NA 33007 TRUE 2017-03-21 > 6 Sandra García 19 NA 34500 FALSE 2020-07-07 > 7 Javi Ortiz 50 688921344 28017 FALSE 2000-01-28 ``` ```r class(tabla) ``` ``` > [1] "data.frame" ``` ```r dim(tabla) ``` ``` > [1] 7 7 ``` --- # .orange[TABLAS]: variables .green[data.frame] Al igual que con matrices, podemos **.bg-purple_light[crear un data.frame]** indicando **nombre de columnas** ```r tabla <- data.frame("nombre" = nombres, "apellido" = apellidos, "edad" = edades, "teléfono" = tlf, "cp" = cp, "casado" = casado, "fecha_registro" = fecha_creacion) tabla ``` ``` > nombre apellido edad teléfono cp casado fecha_registro > 1 Sonia <NA> 45 618910564 28019 TRUE 2021-03-04 > 2 Carla González 67 914718475 28001 FALSE 2020-10-12 > 3 Pepito Fernández NA 934567891 34005 FALSE 1990-04-05 > 4 Carlos Martínez 31 620176565 18410 NA 2019-09-10 > 5 Lara Liébana 27 NA 33007 TRUE 2017-03-21 > 6 Sandra García 19 NA 34500 FALSE 2020-07-07 > 7 Javi Ortiz 50 688921344 28017 FALSE 2000-01-28 ``` **.bg-green_light[¡TENEMOS NUESTRO PRIMER CONJUNTO DE DATOS!]** Puedes visualizarlo escribiendo su nombre en consola o con `View(tabla)` --- # .orange[TABLAS]: variables .green[data.frame] Si tenemos uno ya creado y queremos **.bg-purple_light[añadir una columna]** es tan simple como usar la `función data.frame()` que ya hemos visto para concatenar la columna. Vamos añadir por ejemplo una nueva variable, el **número de hermanos** de cada individuo. ```r # Añadimos una nueva columna con nº de hermanos/as hermanos <- c(0, 0, 1, 5, 2, 3, 0) tabla <- data.frame(tabla, "n_hermanos" = hermanos) tabla ``` ``` > nombre apellido edad teléfono cp casado fecha_registro n_hermanos > 1 Sonia <NA> 45 618910564 28019 TRUE 2021-03-04 0 > 2 Carla González 67 914718475 28001 FALSE 2020-10-12 0 > 3 Pepito Fernández NA 934567891 34005 FALSE 1990-04-05 1 > 4 Carlos Martínez 31 620176565 18410 NA 2019-09-10 5 > 5 Lara Liébana 27 NA 33007 TRUE 2017-03-21 2 > 6 Sandra García 19 NA 34500 FALSE 2020-07-07 3 > 7 Javi Ortiz 50 688921344 28017 FALSE 2000-01-28 0 ``` --- # .orange[TABLAS]: variables .green[data.frame] Si queremos **.bg-purple_light[acceder a una columna, fila o elemento]** en concreto, los `data.frame` tienen las mismas ventajas que una matriz, así que bastaría con usar los mismos operadores. ```r tabla[5, ] # Accedemos a la quinta fila ``` ``` > nombre apellido edad teléfono cp casado fecha_registro n_hermanos > 5 Lara Liébana 27 NA 33007 TRUE 2017-03-21 2 ``` -- .pull-left[ <div class="figure" style="text-align: left"> <img src="./img/tabla_dolar.jpg" alt="Menú desplegable de variables (columnas)" width="99%" /> <p class="caption">Menú desplegable de variables (columnas)</p> </div> ] .pull-right[ No solo tiene las ventajas de una matriz sino que también tiene las **.bg-purple_light[ventajas de una «base» de datos]**: podemos aceder a las variables por el índice de columna que ocupan pero también **.bg-purple_light[acceder por su nombre]**, poniendo el nombre de la tabla, el símbolo `$` y, con el tabulador, nos aparecerá un menú de columnas a elegir. ] --- # Primer .orange[ANÁLISIS DE DATOS] .panelset[ .panel[.panel-name[USArrests] Nuestro primer conjunto será `USArrests`, un dataset de **.bg-purple_light[arrestos en EE.UU.]** del paquete `{datasets}` (si escribimos `datasets::` y pulsamos tabulador, se nos abre un desplegable con distintos conjuntos de datos para ser usado) ```r # install.packages("datasets") # Descomentar si nunca se ha instalado library(datasets) datasets::USArrests ``` ``` > Murder Assault UrbanPop Rape > Alabama 13.2 236 58 21.2 > Alaska 10.0 263 48 44.5 > Arizona 8.1 294 80 31.0 > Arkansas 8.8 190 50 19.5 > California 9.0 276 91 40.6 > Colorado 7.9 204 78 38.7 > Connecticut 3.3 110 77 11.1 > Delaware 5.9 238 72 15.8 > Florida 15.4 335 80 31.9 > Georgia 17.4 211 60 25.8 > Hawaii 5.3 46 83 20.2 > Idaho 2.6 120 54 14.2 > Illinois 10.4 249 83 24.0 > Indiana 7.2 113 65 21.0 > Iowa 2.2 56 57 11.3 > Kansas 6.0 115 66 18.0 > Kentucky 9.7 109 52 16.3 > Louisiana 15.4 249 66 22.2 > Maine 2.1 83 51 7.8 > Maryland 11.3 300 67 27.8 > Massachusetts 4.4 149 85 16.3 > Michigan 12.1 255 74 35.1 > Minnesota 2.7 72 66 14.9 > Mississippi 16.1 259 44 17.1 > Missouri 9.0 178 70 28.2 > Montana 6.0 109 53 16.4 > Nebraska 4.3 102 62 16.5 > Nevada 12.2 252 81 46.0 > New Hampshire 2.1 57 56 9.5 > New Jersey 7.4 159 89 18.8 > New Mexico 11.4 285 70 32.1 > New York 11.1 254 86 26.1 > North Carolina 13.0 337 45 16.1 > North Dakota 0.8 45 44 7.3 > Ohio 7.3 120 75 21.4 > Oklahoma 6.6 151 68 20.0 > Oregon 4.9 159 67 29.3 > Pennsylvania 6.3 106 72 14.9 > Rhode Island 3.4 174 87 8.3 > South Carolina 14.4 279 48 22.5 > South Dakota 3.8 86 45 12.8 > Tennessee 13.2 188 59 26.9 > Texas 12.7 201 80 25.5 > Utah 3.2 120 80 22.9 > Vermont 2.2 48 32 11.2 > Virginia 8.5 156 63 20.7 > Washington 4.0 145 73 26.2 > West Virginia 5.7 81 39 9.3 > Wisconsin 2.6 53 66 10.8 > Wyoming 6.8 161 60 15.6 ``` Contiene **.bg-purple_light[estadísticas de arrestos en 1973 (por cada 100 000 habitantes)]** por agresión, asesinato y violación, en cada uno de los 50 estados de Estados Unidos. ] .panel[.panel-name[Visualizar] Con `View()` se nos abrirá el conjunto en un formato «excelizado». Además con `head()` podemos **.bg-purple_light[visualizar la cabecera]** (primeras) del conjunto de datos. ```r head(USArrests) ``` ``` > Murder Assault UrbanPop Rape > Alabama 13.2 236 58 21.2 > Alaska 10.0 263 48 44.5 > Arizona 8.1 294 80 31.0 > Arkansas 8.8 190 50 19.5 > California 9.0 276 91 40.6 > Colorado 7.9 204 78 38.7 ``` ] .panel[.panel-name[Variables] Con la función `names()` podemos obtener directamente el **.bg-purple_light[nombre de las variables]** (también podemos usarlo para renombrarlas) ```r names(USArrests) ``` ``` > [1] "Murder" "Assault" "UrbanPop" "Rape" ``` El conjunto contiene los **3 tipos de delito** mencionados (para cada estado), y además el **porcentaje de población que vive en áreas urbanas**. Esto lo podemos saber ejecutando la ayuda con `? datasets::USArrests`. ] .panel[.panel-name[Individuos] Con la función `row.names()` podemos obtener el **.bg-purple_light[nombre de las filas]** (de los estados) para cada uno de ellos. ```r row.names(USArrests) ``` ``` > [1] "Alabama" "Alaska" "Arizona" "Arkansas" > [5] "California" "Colorado" "Connecticut" "Delaware" > [9] "Florida" "Georgia" "Hawaii" "Idaho" > [13] "Illinois" "Indiana" "Iowa" "Kansas" > [17] "Kentucky" "Louisiana" "Maine" "Maryland" > [21] "Massachusetts" "Michigan" "Minnesota" "Mississippi" > [25] "Missouri" "Montana" "Nebraska" "Nevada" > [29] "New Hampshire" "New Jersey" "New Mexico" "New York" > [33] "North Carolina" "North Dakota" "Ohio" "Oklahoma" > [37] "Oregon" "Pennsylvania" "Rhode Island" "South Carolina" > [41] "South Dakota" "Tennessee" "Texas" "Utah" > [45] "Vermont" "Virginia" "Washington" "West Virginia" > [49] "Wisconsin" "Wyoming" ``` ] .panel[.panel-name[Dimensiones] ¿Cómo averiguar el **.bg-purple_light[número de registros y el número de variables]**? ```r dim(USArrests) ``` ``` > [1] 50 4 ``` ```r nrow(USArrests) ``` ``` > [1] 50 ``` ```r ncol(USArrests) ``` ``` > [1] 4 ``` ] .panel[.panel-name[Selección] Al igual que antes, podemos **.bg-purple_light[seleccionar filas por índices]** y **.bg-purple_light[variables nombre]**. ```r USArrests[c(2, 10), c("Murder", "Assault")] ``` ``` > Murder Assault > Alaska 10.0 263 > Georgia 17.4 211 ``` También podemos usar las ventajas de los `data.frame` para acceder a las variables. ```r USArrests$Murder ``` ``` > [1] 13.2 10.0 8.1 8.8 9.0 7.9 3.3 5.9 15.4 17.4 5.3 2.6 10.4 7.2 2.2 > [16] 6.0 9.7 15.4 2.1 11.3 4.4 12.1 2.7 16.1 9.0 6.0 4.3 12.2 2.1 7.4 > [31] 11.4 11.1 13.0 0.8 7.3 6.6 4.9 6.3 3.4 14.4 3.8 13.2 12.7 3.2 2.2 > [46] 8.5 4.0 5.7 2.6 6.8 ``` ] .panel[.panel-name[subset] En el caso de los `data.frame` tenemos además a nuestro disposición una **herramienta muy potente**: la función `subset()`. Dicha función nos va a permitir **.bg-purple_light[seleccionar filas y columnas a la vez]**, tomando de entrada la tabla, `subset = ...` igual a la **condición lógica** para filtrar registros (filas) y `select = ...` igual al nombre de las columnas que queremos seleccionar. ```r subset(USArrests, subset = UrbanPop > 70, select = c("Murder")) ``` ``` > Murder > Arizona 8.1 > California 9.0 > Colorado 7.9 > Connecticut 3.3 > Delaware 5.9 > Florida 15.4 > Hawaii 5.3 > Illinois 10.4 > Massachusetts 4.4 > Michigan 12.1 > Nevada 12.2 > New Jersey 7.4 > New York 11.1 > Ohio 7.3 > Pennsylvania 6.3 > Rhode Island 3.4 > Texas 12.7 > Utah 3.2 > Washington 4.0 ``` ] .panel[.panel-name[Caso práctico] * 📝 **Ejercicio**: filtra aquellos estados cuyo porcentaje de población urbana sea inferior al 70% y donde las agresiones sean superiores a 250 por cada 100 000 habitantes, seleccionando solo las variables `Murder` y `Rape` ] .panel[.panel-name[Caso práctico] * 📝 **Ejercicio**: filtra aquellos estados cuyo porcentaje de población urbana sea inferior al 70% y donde las agresiones sean superiores a 250 por cada 100 000 habitantes, seleccionando solo las variables. ```r subset(USArrests, subset = UrbanPop < 70 & Assault > 250, select = c("Murder", "Rape")) ``` ``` > Murder Rape > Alaska 10.0 44.5 > Maryland 11.3 27.8 > Mississippi 16.1 17.1 > North Carolina 13.0 16.1 > South Carolina 14.4 22.5 ``` ] ] --- name: tibble # Mejorando los data.frame: .orange[TIBBLE] Las tablas en formato `tibble` (con `tibble()` del paquete `{tibble}`, su clase será `tbl_df`) son un tipo de `data.frame` mejorado, para una gestión **.bg-purple_light[más ágil, eficiente y coherente]**. Las tablas en formato `tibble` tienen **.bg-purple_light[4 ventajas principales]** <img src="./img/tibble.svg" width="30%" style="display: block; margin: auto;" /> --- # Mejorando los data.frame: .orange[TIBBLE] * Muestran **.bg-purple_light[metainformación de las variables]**, y solo imprime por defecto las primeras filas. ```r library(tibble) tabla_tb <- tibble("x" = 1:50, "y" = rep(c("a", "b", "c", "d", "e"), 10), "logica" = rep(c(TRUE, FALSE), 25)) tabla_tb ``` ``` > # A tibble: 50 × 3 > x y logica > <int> <chr> <lgl> > 1 1 a TRUE > 2 2 b FALSE > 3 3 c TRUE > 4 4 d FALSE > 5 5 e TRUE > 6 6 a FALSE > 7 7 b TRUE > 8 8 c FALSE > 9 9 d TRUE > 10 10 e FALSE > # … with 40 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Mejorando los data.frame: .orange[TIBBLE] Puedes **imprimir las filas y columnas** que quieras con `print()` ```r *print(tabla_tb, n = 12, width = Inf) ``` ``` > # A tibble: 50 × 3 > x y logica > <int> <chr> <lgl> > 1 1 a TRUE > 2 2 b FALSE > 3 3 c TRUE > 4 4 d FALSE > 5 5 e TRUE > 6 6 a FALSE > 7 7 b TRUE > 8 8 c FALSE > 9 9 d TRUE > 10 10 e FALSE > 11 11 a TRUE > 12 12 b FALSE > # … with 38 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Mejorando los data.frame: .orange[TIBBLE] * La función `tibble()` **.bg-purple_light[construye las variables secuencialmente]**, pudiendo hacer uso en la propia definición de variables recién definidas en dicha definición. ```r # data.frame data.frame("x1" = 1:3, "x2" = 4:6, "y" = x1 * x2) ``` ``` > Error in data.frame(x1 = 1:3, x2 = 4:6, y = x1 * x2): objeto 'x1' no encontrado ``` ```r # tibble tibble("x1" = 1:3, "x2" = 4:6, "y" = x1 * x2) ``` ``` > # A tibble: 3 × 3 > x1 x2 y > <int> <int> <int> > 1 1 4 4 > 2 2 5 10 > 3 3 6 18 ``` --- # Mejorando los data.frame: .orange[TIBBLE] * Si accedes a una **.bg-purple_light[columna que no existe]** avisa con un **.bg-red[warning]**. ```r tabla_df <- data.frame("x" = 1:50, "y" = rep(c("a", "b", "c", "d", "e"), 10), "logica" = rep(c(TRUE, FALSE), 25)) ``` .pull-left[ ```r # data.frame tabla_df$variable_inexistente ``` ``` > NULL ``` ] .pull-right[ ```r # tibble tabla_tb$variable_inexistente ``` ``` > Warning: Unknown or uninitialised column: `variable_inexistente`. ``` ``` > NULL ``` ] --- # Mejorando los data.frame: .orange[TIBBLE] * No solo no te cambiará el tipo de datos sino que **.bg-purple_light[no te cambiará el nombre de las variables]**. .pull-left[ ```r data.frame(":)" = "emoticono", " " = "en blanco", "2000" = "número") ``` ``` > X.. X. X2000 > 1 emoticono en blanco número ``` ] .pull-right[ ```r tibble(":)" = "emoticono", " " = "en blanco", "2000" = "número") ``` ``` > # A tibble: 1 × 3 > `:)` ` ` `2000` > <chr> <chr> <chr> > 1 emoticono en blanco número ``` ] --- # Mejorando los data.frame: .orange[TIBBLE] Si ya tienes un `data.frame` es altamente recomendable **.bg-purple_light[convertirlo a tibble]** con `as_tibble()` (del paquete `{dplyr}`) ```r library(dplyr) as_tibble(USArrests) ``` ``` > # A tibble: 50 × 4 > Murder Assault UrbanPop Rape > <dbl> <int> <int> <dbl> > 1 13.2 236 58 21.2 > 2 10 263 48 44.5 > 3 8.1 294 80 31 > 4 8.8 190 50 19.5 > 5 9 276 91 40.6 > 6 7.9 204 78 38.7 > 7 3.3 110 77 11.1 > 8 5.9 238 72 15.8 > 9 15.4 335 80 31.9 > 10 17.4 211 60 25.8 > # … with 40 more rows > # ℹ Use `print(n = ...)` to see more rows ``` Puedes consultar **más funcionalidades** de dichos datos en <https://tibble.tidyverse.org/> --- # Mejorando los data.frame: .orange[TIBBLE] Una de las ventajas es la función `glimpse()`, que nos permite obtener el **.bg-purple_light[resumen de columnas]** (no es para tener un resumen de los datos sino para ver las variables que tenemos y su tipo). ```r glimpse(tabla_tb) ``` ``` > Rows: 50 > Columns: 3 > $ x <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, … > $ y <chr> "a", "b", "c", "d", "e", "a", "b", "c", "d", "e", "a", "b", "c"… > $ logica <lgl> TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE… ``` --- # Mejorando los data.frame: .orange[TIBBLE] Amén de poder convetir con `as_tibble()` podemos **.bg-purple_light[crearlos por filas]** (como copiar y pegar de una tabla en documento) en lugar de por columnas con `tribble()` ```r datos <- tribble( ~colA, ~colB, "a", 1, "b", 2) datos ``` ``` > # A tibble: 2 × 2 > colA colB > <chr> <dbl> > 1 a 1 > 2 b 2 ``` -- **.bg-green_light[CONSEJO]**: prueba además el paquete `{datapasta}`, que nos permite **.bg-purple_light[copiar y pegar tablas de páginas web]** --- name: ejercicios-tibble # Ejercicios .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 1**: carga del paquete `{datasets}` el conjunto de datos `airquality` (contiene variables de la calidad del aire de la ciudad de Nueva York desde mayo hasta septiembre de 1973). ¿Es el conjunto de datos airquality de tipo tibble? En caso negativo, conviértelo a `tibble`. * 📝 **Ejercicio 2**: obtén el nombre de las variables y las dimensiones del conjunto de datos. ¿Cuántas variables hay? ¿Cuántos días se han medido? * 📝 **Ejercicio 3**: modifica el código inferior para que nos filtre solo los datos del mes de agosto. ```r # Filtramos filas filtro_fila <- subset(., subset = Month < 6) filtro_fila ``` ] .panel[.panel-name[Solución ej. 1] ```r library(datasets) class(airquality) # no es data.frame ``` ``` > [1] "data.frame" ``` ```r # Convertimos a tibble airquality <- as_tibble(airquality) class(airquality) ``` ``` > [1] "tbl_df" "tbl" "data.frame" ``` ] .panel[.panel-name[Solución ej. 2] ```r names(airquality) ``` ``` > [1] "Ozone" "Solar.R" "Wind" "Temp" "Month" "Day" ``` ```r dim(airquality) ``` ``` > [1] 153 6 ``` ```r # Número variables ncol(airquality) ``` ``` > [1] 6 ``` ```r # Número días nrow(airquality) ``` ``` > [1] 153 ``` ] .panel[.panel-name[Solución ej. 3] ```r # Filtramos filas filtro_fila <- subset(airquality, subset = Month == 8) filtro_fila ``` ``` > # A tibble: 31 × 6 > Ozone Solar.R Wind Temp Month Day > <int> <int> <dbl> <int> <int> <int> > 1 39 83 6.9 81 8 1 > 2 9 24 13.8 81 8 2 > 3 16 77 7.4 82 8 3 > 4 78 NA 6.9 86 8 4 > 5 35 NA 7.4 85 8 5 > 6 66 NA 4.6 87 8 6 > 7 122 255 4 89 8 7 > 8 89 229 10.3 90 8 8 > 9 110 207 8 90 8 9 > 10 NA 222 8.6 92 8 10 > # … with 21 more rows > # ℹ Use `print(n = ...)` to see more rows ``` ] ] --- # Ejercicios .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 4**: del conjunto selecciona aquellos datos que no sean ni de julio ni de agosto. * 📝 **Ejercicio 5**: modifica el siguiente código para quedarte solo con las variable de ozono y temperatura. ```r filtro_col <- subset(., select = c("Ozone")) filtro_col ``` * 📝 **Ejercicio 6**: selecciona los datos de temperatura y viento de agosto. Traduce a castellano el nombre de las columnas del conjunto filtrado. * 📝 **Ejercicio 7**: añade a los datos originales una columna con la fecha completa (recuerda que es del año 1973 todas las observaciones). ] .panel[.panel-name[Solución ej. 4] ```r subset(airquality, subset = !(Month %in% c(7, 8))) ``` ``` > # A tibble: 91 × 6 > Ozone Solar.R Wind Temp Month Day > <int> <int> <dbl> <int> <int> <int> > 1 41 190 7.4 67 5 1 > 2 36 118 8 72 5 2 > 3 12 149 12.6 74 5 3 > 4 18 313 11.5 62 5 4 > 5 NA NA 14.3 56 5 5 > 6 28 NA 14.9 66 5 6 > 7 23 299 8.6 65 5 7 > 8 19 99 13.8 59 5 8 > 9 8 19 20.1 61 5 9 > 10 NA 194 8.6 69 5 10 > # … with 81 more rows > # ℹ Use `print(n = ...)` to see more rows ``` ] .panel[.panel-name[Solución ej. 5] ```r # Filtramos columnas filtro_col <- subset(airquality, select = c("Ozone", "Temp")) filtro_col ``` ``` > # A tibble: 153 × 2 > Ozone Temp > <int> <int> > 1 41 67 > 2 36 72 > 3 12 74 > 4 18 62 > 5 NA 56 > 6 28 66 > 7 23 65 > 8 19 59 > 9 8 61 > 10 NA 69 > # … with 143 more rows > # ℹ Use `print(n = ...)` to see more rows ``` ] .panel[.panel-name[Solución ej. 6] ```r datos <- subset(airquality, subset = Month == 8, select = c("Temp", "Wind")) datos ``` ``` > # A tibble: 31 × 2 > Temp Wind > <int> <dbl> > 1 81 6.9 > 2 81 13.8 > 3 82 7.4 > 4 86 6.9 > 5 85 7.4 > 6 87 4.6 > 7 89 4 > 8 90 10.3 > 9 90 8 > 10 92 8.6 > # … with 21 more rows > # ℹ Use `print(n = ...)` to see more rows ``` ```r # Traducimos a castellano el nombre names(datos) <- c("temperatura", "viento") glimpse(datos) ``` ``` > Rows: 31 > Columns: 2 > $ temperatura <int> 81, 81, 82, 86, 85, 87, 89, 90, 90, 92, 86, 86, 82, 80, 79… > $ viento <dbl> 6.9, 13.8, 7.4, 6.9, 7.4, 4.6, 4.0, 10.3, 8.0, 8.6, 11.5, … ``` ] .panel[.panel-name[Solución ej. 7] ```r nuevos_datos <- tibble(airquality, "fecha" = as_date(glue("1973-{Month}-{Day}"))) nuevos_datos ``` ``` > # A tibble: 153 × 7 > Ozone Solar.R Wind Temp Month Day fecha > <int> <int> <dbl> <int> <int> <int> <date> > 1 41 190 7.4 67 5 1 1973-05-01 > 2 36 118 8 72 5 2 1973-05-02 > 3 12 149 12.6 74 5 3 1973-05-03 > 4 18 313 11.5 62 5 4 1973-05-04 > 5 NA NA 14.3 56 5 5 1973-05-05 > 6 28 NA 14.9 66 5 6 1973-05-06 > 7 23 299 8.6 65 5 7 1973-05-07 > 8 19 99 13.8 59 5 8 1973-05-08 > 9 8 19 20.1 61 5 9 1973-05-09 > 10 NA 194 8.6 69 5 10 1973-05-10 > # … with 143 more rows > # ℹ Use `print(n = ...)` to see more rows ``` ] ] --- # Ejercicios extras .panelset[ .panel[.panel-name[Ejercicios extras] * 📝 **Ejercicio 8**: define un `tibble` con tres variables numéricas `a, b, c`, tal que la tercera sea el producto de las dos primeras `c = a * b`. * 📝 **Ejercicio 9**: define un tibble con tres variables de nombres `variable`, `2`, `tercera` y `:)`, e intenta acceder a ellas. * 📝 **Ejercicio 10**: obten de los paquetes `{dplyr}` y `{gapminder}` los conjuntos de datos `starwars` y `gapminder`. Comprueba el número de variables, de registros e imprime los datos ] .panel[.panel-name[Solución ej. 8] ```r tibble("a" = 1:4, "b" = 11:14, "c" = a * b) ``` ``` > # A tibble: 4 × 3 > a b c > <int> <int> <int> > 1 1 11 11 > 2 2 12 24 > 3 3 13 39 > 4 4 14 56 ``` ] .panel[.panel-name[Solución ej. 9] ```r datos <- tibble("variable" = 1, "2" = "a", "tercera" = 3, ":)" = "b") # Accedemos datos$variable ``` ``` > [1] 1 ``` ```r datos$`2` ``` ``` > [1] "a" ``` ```r datos$tercera ``` ``` > [1] 3 ``` ```r datos$`:)` ``` ``` > [1] "b" ``` ] .panel[.panel-name[Solución ej. 10] ```r library(dplyr) dim(starwars) ``` ``` > [1] 87 14 ``` ```r library(gapminder) dim(gapminder) ``` ``` > [1] 1704 6 ``` ] ] --- class: inverse center middle name: intro-estadistica # Introducción a la ESTADÍSTICA --- # Introducción a la .orange[ESTADÍSTICA] <img src="./img/tellme.jpg" width="50%" style="display: block; margin: auto;" /> --- # Introducción a la .orange[ESTADÍSTICA] .pull-left[ **.bg-purple_light[¿Qué es la estadística?]** Según la RAE... * **.bg-purple_light[Estudio de los datos]** cuantitativos de la población, de los recursos naturales e industriales, del tráfico o de cualquier otra manifestación de las sociedades * **.bg-purple_light[Rama de la matemática]** que utiliza grandes conjuntos de datos numéricos para obtener inferencias basadas en el cálculo de probabilidades. ] .pull-right[ <img src="./img/perez_reverte.jpg" width="90%" style="display: block; margin: auto;" /> ] --- # Introducción a la .orange[ESTADÍSTICA] .pull-left[ **.bg-purple_light[¿Qué es la estadística?]** Según la RAE... * **.bg-purple_light[Estudio de los datos]** cuantitativos de la población, de los recursos naturales e industriales, del tráfico o de cualquier otra manifestación de las sociedades * **.bg-purple_light[Rama de la matemática]** que utiliza grandes conjuntos de datos numéricos para obtener inferencias basadas en el cálculo de probabilidades. ] .pull-right[ <img src="./img/perez_reverte.jpg" width="51%" style="display: block; margin: auto;" /> ] > «La estadística está caracterizada por una información acerca de un colectivo o universo, lo que constituye su objeto material; un modo propio de razonamiento, el método estadístico, lo que constituye su objeto formal y unas previsiones de cara al futuro, lo que implica un ambiente de incertidumbre» (Cabriá, 1994). --- # Introducción a la .orange[ESTADÍSTICA] .pull-left[ La **.bg-purple_light[estadística]** como ciencia nació como una **.bg-purple_light[ciencia del Estado]**, de hecho nuestra palabra actual viene de dos palabras previas * del término (neo)latino «statisticum collegium»: consejo de Estado. * del alemán **.bg-purple_light[«statistik»]** (ciencia del Estado), término introducido por G. Achenwall. En su origen fue una desarrollada como una mera **.bg-purple_light[herramienta para la administración eficiente]** de la sociedad. ] .pull-right[ <img src="./img/biblia.jpg" width="95%" style="display: block; margin: auto auto auto 0;" /> ] --- # Introducción a la .orange[ESTADÍSTICA] .pull-left[ Los **.bg-purple_light[primeros usos]** documentados son de hecho para elaborar **.bg-purple_light[censos y de uso militar]** en Mesopotamia, China y Egipto, con el objetivo de tener un **.bg-purple_light[recuento y organización de recursos]** * Cobrar **impuestos** * Repartir **tierras** * Reclutar **soldados** Según Tucídides, conceptos como la **.bg-purple_light[moda]** ya existían en el siglo V a.C.: para asaltar la muralla de Platea, se usaba la estadística para el recuento de ladrillos de la muralla y aproximar su altura. ] .pull-right[ <img src="./img/census.jpg" width="95%" style="display: block; margin: auto auto auto 0;" /> ] --- # Introducción a la .orange[ESTADÍSTICA] El **.bg-purple_light[objetivo principal]** de la estadística, ayudada por la probabilidad, es **.bg-purple_light[analizar datos y fenómenos]** cuyo mecanismo subyacente suele ser un experimento aleatorio. -- ### Experimento .green[ALEATORIO] Un experimento se puede clasificar principalmente en * **.bg-purple_light[Determinista]**: con las mismas condiciones iniciales, se obtiene el mismo resultado. Por ejemplo, el movimiento parabólico de un proyectil sin rozamiento. * **.bg-purple_light[Aleatorio]**: con las mismas condiciones iniciales, se pueden obtener resultados diferentes. Por ejemplo, el tiempo entre clientes que entran en un establecimiento. --- # Introducción a la .orange[ESTADÍSTICA] Un error muy habitual es interpretar lo «aleatorio» como **.bg-purple_light[equiprobable]**: un suceso aleatorio **.bg-red_light[NO IMPLICA]** que todas sus opciones tengan la misma probabilidad de suceder. * **.bg-purple_light[Aleatorio]**: el resultado individual inmediato no se puede asegurar con total certeza (tenemos **.bg-orange[incertidumbre]**) * **.bg-purple_light[Sucesos equiprobables]**: colección de sucesos de una variable aleatoria cuya probabilidad de suceder es la misma para todos ellos. -- **.bg-green_light[RECUERDA]**: un **dado trucado** sigue siendo aleatorio, igual de aleatorio que un dado sin trucar. No hay algo más o menos aleatorio, solo **.bg-purple_light[diferentes distribuciones de probabilidad]** que modelizan los sucesos. --- # .green[POBLACIÓN] vs .orange[MUESTRA] .pull-left[ **.bg-green_light[POBLACIÓN]** Una población será el conjunto total o **.bg-purple_light[colectivo de individuos factibles de estudiar]**, o de posibles elementos/eventos de los podríamos tener observaciones (por ejemplo, 47 millones de españoles). Es nuestro **.bg-purple_light[universo teórico]**, y nuestro objetivo será conocer algunas de las propiedades de esa población. **.bg-green_light[INDIVIDUO]** Cada uno de los elementos o eventos de la población. ] .pull-right[ **.bg-orange[MUESTRA (SAMPLE)]** Dado que la **.bg-red_light[población suele ser inaccesible]** en su totalidad (no podemos medir a TODA la población), debemos realizar una **.bg-purple_light[selección]** de un conjunto de individuos Dicho subconjunto será siempre de **.bg-purple_light[tamaño finito n]**, de forma que la muestra sea de alguna manera **.bg-purple_light[«representativa»]** de la población (bien a lo largo de los individuos, bien a lo largo del tiempo). Un estudio estadístico realizado sobre la totalidad de una población se denomina censo. ] --- # .green[POBLACIÓN] vs .orange[MUESTRA] <img src="./img/poblacion_muestra.jpg" width="55%" style="display: block; margin: auto;" /> --- # .green[CARACTERES] y .orange[MODALIDADES] .pull-left[ * **.bg-purple_light[Caracteres (variables)]**: cada una de las **características o cualidades** que se podrían medir o analizar para cada individuo de la población (y de los que disponemos el valor para cada individuo de la muestra). * **.bg-purple_light[Modalidades]**: conjunto de los **diferentes valores** que puede adoptar una característica o variable. ] .pull-right[ Un **.bg-purple_light[ejemplo]** (población de alumnos de UCM) * **.bg-orange[Caracteres o variables]**: - sexo - edad - carrera - estatura * **.bg-orange[Modalidades]**: - sexo: hombre/mujer. - edad: 18, 19, 20, 21, 22, ..., 98, 99, 100 - carrera: mates, filología, historia, etc. - estatura: intervalo [130cm, 200cm]. * **.bg-orange[Muestra]**: conjunto de 300 estudiantes seleccionados al azar. ] --- # .orange[TIPOS] de variables Imagina las siguientes variables: * ¿Tienes hermanos? * Resultado de la tirada de un dado * Color de zapatillas * Nivel de estudios * Número de hermanos * Número de pelos en la cabeza * Resultado de un dado dividido entre 10 * Temperatura ºC * Género * Estatura o peso * Religión **.bg-purple_light[¿CUÁL ES LA DIFERENCIA ENTRE ELLAS?]** --- # .orange[TIPOS] de variables .pull-left[ Imagina las siguientes variables: * ¿Tienes hermanos? * Resultado de la tirada de un dado * Color de zapatillas * Nivel de estudios * Número de hermanos * Número de pelos en la cabeza * Resultado de un dado dividido entre 10 * Temperatura ºC * Género * Estatura o peso * Religión **.bg-purple_light[¿CUÁL ES LA DIFERENCIA ENTRE ELLAS?]** ] .pull-right[ * **.bg-purple_light[Cualitativas]**: representan **.bg-orange[cualidades o categorías]** no cuantificables numéricamente (sexo, estado civil, etc). - **.bg-purple_light[Ordinales]**: admiten **jerarquía** (suspenso-aprobado-notable). - **.bg-purple_light[Nominales]**: no tienen asociada una jerarquía (sexo, religión, color, etc). * **.bg-purple_light[Cuantitativas]**: característica **.bg-orange[cuantificable numéricamente]**. - **.bg-purple_light[Discretas]**: se pueden contar y enumerar (aunque sean infinitos) (nº granos de arena, nº hermanos, etc). - **.bg-purple_light[Continuas]**: además de tomar infinitos valores, entre dos valores cualesquiera hay a su vez infinitas opciones (estatura, peso, etc). ] --- # .orange[DISCRETA] vs .green[CONTINUAS] <img src="./img/discreta_continua.jpg" width="76%" style="display: block; margin: auto;" /> --- # Resumiendo información: .orange[MOMENTOS] En estadística los **.bg-purple_light[momentos]** serán parámetros calculados a partir de los datos que, mediante una fórmula, **.bg-purple_light[resumen numéricamente]** algunas características de nuestros datos: -- * Medidas de **.bg-purple_light[centralización]**: en torno a qué valores se **concentran** los datos. -- * Medidas de **.bg-purple_light[dispersión]**: cuantifican la **dispersión respecto al centro**. -- * Medidas de **.bg-purple_light[posición/localización]**: cómo se **localizan** los datos, valores que nos permiten segmentar nuestros datos en conjuntos de partes iguales (mismo % de datos, los famosos percentiles). -- * Medidas de **.bg-purple_light[forma]**: nos complementan la caracterización de la distribución, por ejemplo, indicándonos la **dirección** en la que se desvían los datos. --- # Medidas de .orange[CENTRALIZACIÓN] Las **.bg-purple_light[medidas de centralización]** nos informan de los valores en torno a los que se **concentra** nuestra variable, un **.bg-purple_light[«representante»]** de nuestra variable. -- * **.bg-purple_light[Media]** (aritmética, sin ponderar): definida como la suma de valores, dividida entre el tamaño muestral. **.bg-red_light[Solo para cuantitativas]** -- * **.bg-purple_light[Mediana]**: si ordenamos los datos de menor a mayor, el valor central (por debajo el 50%, por encima el 50%). **.bg-red_light[Solo si existe jerarquía de orden]**. -- * **.bg-purple_light[Moda]**: el **valor o valores más repetidos** de nuestra variable, lo más frecuente. **.bg-red_light[Amodal]**: todos se repiten por igual -> no hay moda. --- # .orange[MEDIA] aritmética .pull-left[ Dada una muestra, la **.bg-purple_light[media (aritmética) muestral]** `\(\overline{x}\)` se define como la suma de todos los valores dividida por el tamaño muestral. `$$\overline{x} = \frac{1}{N} \sum_{i=1}^{N} x_i$$` También se puede definir como el **.bg-purple_light[valor «más cercano» a todos los datos]** a la vez, minimizando las distancias (al cuadrado) de los datos a dicho valor. ] .pull-right[ <div class="figure" style="text-align: left"> <img src="./img/media.jpg" alt="Extraída de instagram.com/javieralvarezliebana" width="89%" /> <p class="caption">Extraída de instagram.com/javieralvarezliebana</p> </div> ] --- # .orange[ROBUSTEZ] de la media <div class="figure" style="text-align: center"> <img src="./img/robustez.jpg" alt="Extraída de instagram.com/javieralvarezliebana" width="43%" /> <p class="caption">Extraída de instagram.com/javieralvarezliebana</p> </div> --- # .orange[MEDIANA] .pull-left[ Dada una muestra, la **.bg-purple_light[mediana muestral]** se define como el valor que es mayor o igual que al menos el 50%, y menor igual que al menos el 50% de los datos `$$Me_{x} = \displaystyle \arg \min_{x_i} \left\lbrace F_i > 0.5 \right\rbrace$$` En caso de `\(F_i = 0.5\)` en variables discretas, realizaremos la media de `\(x_i\)` y `\(x_{i+1}\)`. ] .pull-right[ <div class="figure" style="text-align: left"> <img src="./img/mediana.jpg" alt="Extraída de instagram.com/javieralvarezliebana" width="89%" /> <p class="caption">Extraída de instagram.com/javieralvarezliebana</p> </div> ] --- # .orange[MODA] .pull-left[ Dada una muestra, la **.bg-purple_light[moda muestral]** se define como el valor o valores más repetidos (en caso de que existan) `$$Mo_{x} = \displaystyle \arg \max_{x_i} f_i$$` Podríamos tener distribuciones **unimodales**, **bimodales**, **trimodales**...incluso **amodales** ] .pull-right[ <div class="figure" style="text-align: left"> <img src="./img/moda.jpg" alt="Extraída de instagram.com/javieralvarezliebana" width="89%" /> <p class="caption">Extraída de instagram.com/javieralvarezliebana</p> </div> ] --- # .orange[ROBUSTEZ] **.bg-green_light[¿Cuál es cuál?]** <img src="./img/ine_salarios.jpg" width="70%" style="display: block; margin: auto;" /> --- # Medidas de .orange[DISPERSIÓN] <img src="./img/iker.jpg" width="45%" style="display: block; margin: auto;" /> -- El cambio climático, un problema de dispersión --- # Medidas de .orange[DISPERSIÓN] <img src="./img/fenom_extremos.jpg" width="70%" style="display: block; margin: auto;" /> El cambio climático, un **.bg-purple_light[problema de dispersión]** --- # Medidas de .orange[DISPERSIÓN] .pull-left[ Una primera idea podría ser **.bg-purple_light[medir la distancia de cada dato al centro]**, es decir, restar cada dato de la media, y después realizar su promedio. `$$\frac{1}{N} \sum_{i=1}^{N} \left(x_i - \overline{x} \right)$$` **.bg-red_light[¿Problema?]** ] .pull-right[ <img src="./img/distancia_var.jpg" width="99%" style="display: block; margin: auto;" /> ] -- Imagina que tenemos `\(X = \left\lbrace -5, -3, -1, 0, 1, 3, 5 \right\rbrace\)`: la media es 0, y el promedio de las distancias a la media también ya que se **.bg-red_light[cancelan los signos]**. **.bg-green_light[¿Solución?]** --- # Medidas de .orange[DISPERSIÓN] En matemáticas suele ser **desaconsejable usar el valor absoluto** (dado que es una función no derivable), así que lo que haremos será calcula el **.bg-purple_light[promedio de las distancias al cuadrado]** `$$s_{x}^{2} = \frac{1}{N} \sum_{i=1}^{N} \left(x_i - \overline{x} \right)^2 = \overline{x^2} - \overline{x}^2$$` -- Esta medida de dispersión es lo que conocemos como **.bg-purple_light[VARIANZA muestral]**. -- **.bg-red_light[CUIDADO]**: tanto `R` como el resto de software nos devolverán la cuasivarianza `\(S_{x}^{2}\)` (promedio entre `\(N-1\)`, no entre `\(N\)`), ya que es el **estimador insesgado** de la varianza poblacional `\(\sigma_{x}^2\)`: asumimos que los estimadores casi nunca coincidirán con su valor teórico pero si repetimos el experimento un número suficiente de veces, su promedio si tenderá a él. `$${\rm E} [\overline{x}] = \mu, \quad {\rm E} [S_{x}^{}] = \sigma_{x}^{2}$$` --- # Medidas de .orange[DISPERSIÓN] **.bg-red_light[¿Problema?]** -- <img src="./img/albert_rivera.jpg" width="70%" style="display: block; margin: auto;" /> Necesitamos una medida de dispersión en las **unidades de los datos**. --- # Medidas de .orange[DISPERSIÓN] Para tener una **.bg-purple_light[medida de dispersión en las unidades]** de los datos calcularemos la **.bg-purple_light[desviación típica]**, como la raíz cuadrada de la varianza `$$s_{x} = \sqrt{s_{x}^{2}} = \sqrt{\frac{1}{N} \sum_{i=1}^{N} \left(x_i - \overline{x} \right)^2} = \sqrt{\overline{x^2} - \overline{x}^2}$$` -- Imaginemos entonces que tenemos dos conjuntos de datos: estaturas (de 165 a 175 cm) y diámetros de núcleos de células (de 3 a 7 micrómetros). Si obtenemos una desviación típica de 1 cm y 1.5 micrómetros, **.bg-purple_light[¿cuál es más dispersa?]** -- ¿**.bg-red_light[NO podemos comparar]** varianzas y desviaciones típicas? --- # Medidas de .orange[DISPERSIÓN] <img src="./img/sorry.jpg" width="80%" style="display: block; margin: auto;" /> **.bg-red_light[NO podemos comparar]** ni varianzas ni desviaciones típicas: dependen de la magnitud y unidades de los datos. --- # Medidas de .orange[DISPERSIÓN] Para tener una **.bg-purple_light[medida de dispersión adimensional]** que podamos comparar en distintos conjuntos de datos calcularemos el **.bg-purple_light[coeficiente de variación]**, como la desv. típica entre el valor absoluto de la media `$$CV_{x} = \frac{s_{x}}{\left| \overline{x} \right|}$$` --- # Medidas de .orange[LOCALIZACIÓN/POSICIÓN] Las **.bg-purple_light[medidas de posición]** nos **localizan** los datos: son **.bg-purple_light[valores que nos dividen]** un conjunto ordenado en un número de tramos con el mismo tamaño muestral. Ejemplo: la mediana es el percentil `\(P_{50}\)`, el decil `\(D_{5}\)` y el cuartil `\(C_{2}\)` o `\(q_2\)`. * **.bg-purple_light[Percentil]**: valores `\(P_{\alpha}\)` del conjunto ordenado que dejan por debajo, al menos, el `\(\alpha \%\)` de datos y el `\((100-\alpha) \%\)` por encima. * **.bg-purple_light[Decil]**: valores `\(D_{\alpha}\)` del conjunto ordenado que dividen los datos en 10 partes iguales, que dejan por debajo, al menos, el `\(10*\alpha \%\)` de datos y el `\((100-10*\alpha) \%\)` por encima. * **.bg-purple_light[Cuartil]**: valores `\(C_{\alpha}\)` o `\(q_{\alpha}\)` del conjunto ordenado que dividen los datos en 4 partes iguales, que dejan por debajo, al menos, el `\(25*\alpha \%\)` de datos y el `\((100-25*\alpha) \%\)` por encima. --- class: inverse center middle name: clase-3 # CLASE 3: Tidydata ### [Estructuras de control](#estructuras-condicionales) ### [Tidydata](#tidydata) ### [Comunicando resultados](#rmd) ### [Caso práctico: datos de la OMS](#oms) --- name: estructuras-condicionales # Estructuras de control: .orange[IF-ELSE] Una **.bg-purple_light[expresión de control]** será un conjunto de órdenes que nos permiten **.bg-purple_light[decidir el camino]** por el que queremos que avance nuestro código: * ¿Qué hacemos si sucede A? * ¿Y si sucede B? * ¿Tengo que programar X veces lo mismo si quiere que se repita? Si has programado en algún otro lenguaje, estarás familiarizado/a con **.bg-purple_light[estructuras condicionales]** como un `if (blabla) {...} else {...}` (que los usaremos a veces) o **.bg-purple_light[bucles]** `for/while` (que intentaremos evitarlos lo máximo posible). --- # Estructuras de control: .orange[IF] Una de las estructuras de control más famosas de cualquier lenguaje de programación es la **.bg-purple_light[estructura condicional]** `if` > SI las condiciones impuestas se cumplen (TRUE), ejecuta las órdenes que tengamos dentro de la misma. Por ejemplo, la estructura `if (x == 1) { código A }` lo que hará será **.bg-purple_light[ejecutar el código entre llaves]** pero **.bg-orange[SI Y SOLO SI]** la **.bg-purple_light[condición es cierta]** (en este caso, solo si `x` es igual 1). En **caso contrario, no hace nada**. -- Definamos por ejemplo una variable sencilla, las edades de 8 personas y comprobemos cuales son menores de edad. ```r edades <- c(14, 17, 24, 56, 31, 20, 87, 73) edades < 18 ``` ``` > [1] TRUE TRUE FALSE FALSE FALSE FALSE FALSE FALSE ``` --- # Estructuras de control: .orange[IF] Recuerda que con las funciones `any()` y `all()` podemos saber si **.bg-purple_light[todos o alguno de los elementos]** de un vector cumplen una condición. ```r any(edades < 18) # existe algun menor de edad ``` ``` > [1] TRUE ``` -- Con dichos elementos vamos a construir nuestra primera estructura condicional: queremos que, **.bg-purple_light[SI existe algún menor de edad, nos imprima un mensaje]**. ```r if (any(edades < 18)) { print("existe alguna persona mayor de edad") } ``` ``` > [1] "existe alguna persona mayor de edad" ``` --- # Estructuras de control: .orange[IF] ```r if (any(edades < 18)) { print("existe alguna persona mayor de edad") } ``` En caso de que **.bg-purple_light[no se cumplan las condiciones]** dentro del `if()` (FALSE), no sucederá nada. ```r if (all(edades >= 18)) { print("todas las personas son mayores de edad") } ``` Fíjate que en este caso **no hemos obtenido ningún mensaje** porque la condición `all(edades >= 18)` no es cierta (no son todos mayores de 18 años), así que **no ha ejecutado el código**. --- # Estructuras de control: .orange[IF-ELSE] La estructura `if (condicion) { }` puede ser combinada con un `else { }`: cuando la **.bg-purple_light[condición no se cumpla]** (como en el último ejemplo), se **.bg-purple_light[ejecutará el código alternativo]** que haya dentro del `else { }`, permitiéndonos decidir que sucede cuando SÍ se cumple y cuando NO se cumple. -- Por ejemplo, la estructura `if (x == 1) { código A } else { código B }` ejecutará A si `x` es 1 y B en cualquier otro caso. ```r if (all(edades >= 18)) { print("todas las personas son mayores de edad") *} else { print("existe alguna persona menor de edad") } ``` ``` > [1] "existe alguna persona menor de edad" ``` --- # Estructuras de control: .orange[IF-ELSE] Dicha estructura `if - else` puede **.bg-purple_light[anidarse]**: imagina que queremos realizar una acción si todos fuesen mayores de edad; en caso contrario, pero si todos los menores tienen 16 años o más, realizar otra acción; en caso contrario, otra acción ```r if (all(edades >= 18)) { print("todas las personas son mayores de edad") } else if (all(edades >= 16)) { print("Existe alguna persona menor de edad pero todos con 16 años o más") } else { print("Existe alguna persona menor de 16 años") } ``` ``` > [1] "Existe alguna persona menor de 16 años" ``` **.bg-green_light[CONSEJO]**: puedes **colapsar las estructuras de control** pulsando en la flecha que aparece a la izquierda de ellas en tu script. --- # Estructuras de control: .orange[IFELSE()] Esta estructura condicional puede ser **.bg-purple_light[vectorizada]**: reunir en una sola fila un número elevado de estructuras de comparación con la función `ifelse()`, cuyos argumentos de entrada serán * la condición a evaluar * lo que sucede cuando se cumple * lo que sucede cuando no se cumple Con el ejemplo de las edades, vamos a dejar el dato ausente si son menores de edad, y si son mayores de edad se queda como está. ```r # NA si no cumple la condición, la edad si se cumple. *ifelse(edades >= 18, edades, NA) ``` ``` > [1] NA NA 24 56 31 20 87 73 ``` --- # Estructuras de control: .orange[IFELSE()] Todas estas estructuras **.bg-purple_light[no solo sirven para datos numéricos]**. Vamos a definir un vector de nombres con algunos ausentes, y vamos a sustituir los ausentes por el texto `"nombre_desconocido"` (los que no sean ausentes, es decir los que `is.na()` devuelva FALSE, se quedan como están). ```r nombres <- c("Juan", "María", NA, NA, "Lucía", "Carmen", "Javier", NA, "Carlos", NA, "Gregorio", "Paloma") # Si tiene ausente --> "nombre_desconocido" # Si no tiene ausente --> nombres originales nombres <- ifelse(is.na(nombres), "nombre_desconocido", nombres) nombres ``` ``` > [1] "Juan" "María" "nombre_desconocido" > [4] "nombre_desconocido" "Lucía" "Carmen" > [7] "Javier" "nombre_desconocido" "Carlos" > [10] "nombre_desconocido" "Gregorio" "Paloma" ``` --- name: bucles # Estructuras de control: .orange[BUCLES] Aunque la mayoría de veces son sustituibles por otras expresiones más legibles y eficientes, es importante que conozcamos otra archiconocida expresion de control: **.bg-purple_light[los bucles]**. * `for { }`: permite **.bg-purple_light[repetir el mismo código]** un **.bg-orange[número fijo y conocido]** de veces (normalmente en función de un índice). * `while { }`: permite **.bg-purple_light[repetir el mismo código]** un **.bg-orange[número indeterminado de veces]**, hasta que una **condición** dada se deje de cumplir. --- # Estructuras de control: .orange[BUCLES FOR] Un **.bg-purple_light[bucle for]** es una estructura que nos permite **.bg-purple_light[repetir]** un conjunto de órdenes un **.bg-orange[número finito y conocido]** de veces: dado un **conjunto de índices**, el bucle irá recorriendo cada uno de ellos. Vamos a definir un vector `x`. Si quisiéramos el primer elemento al cuadrado escribiríamos `x[1]^2`; si quisiéramos el segundo elemento al cuadrado `x[2]^2`; si lo quisiéramos hacer en general, para el elemento i-ésimo, `x[i]^2`. Lo que haremos dentro del `for (indices) { órdenes }` es indicarle que valores irá tomando `i` (**.bg-purple_light[vector de índices]**). ```r x <- c(0, -7, 1, 4) *for (i in 1:4) { print(x[i]^2) # órdenes } ``` ``` > [1] 0 > [1] 49 > [1] 1 > [1] 16 ``` --- # Estructuras de control: .orange[BUCLES FOR] ```r *for (i in 1:4) { print(x[i]^2) # órdenes } ``` Lo que tenemos dentro de los paréntesis `for ()` no es más que la **.bg-purple_light[secuencia de números]** que hemos aprendido a construir. Si quisiéramos que haga lo mismo pero excluyendo por ejemplo el segundo elemento bastaría con definir los índices a recorrer como `c(1, 3, 4)`. ```r for (i in c(1, 3, 4)) { print(x[i]^2) # que lo imprima } ``` ``` > [1] 0 > [1] 1 > [1] 16 ``` --- # Estructuras de control: .orange[BUCLES FOR] Podemos definir también una variable `y <- rep(0, 4)` (un **vector «vacío»** lleno de ceros), y hacer que el **.bg-purple_light[elemento i-ésimo del vector]** se defina como `x[i]^2` ```r y <- rep(0, 4) for (i in 1:4) { y[i] <- x[i]^2 } y ``` ``` > [1] 0 49 1 16 ``` -- Lo anterior es equivalente a esto ```r y <- x^2 y ``` ``` > [1] 0 49 1 16 ``` --- # .orange[BUCLES] suelen ser .red[INEFICIENTES] Haciendo uso del paquete `microbenchmark` podemos comprobar como los **.bg-purple_light[bucles son menos eficientes]** (de ahí que la mayoría de veces los intentemos evitar si existe otra alternativa) ```r library(microbenchmark) x <- 1:100 microbenchmark(x^2, for (i in 1:100) { y[i] <- x[i]^2 }, times = 1000) ``` ``` > Unit: nanoseconds > expr min lq mean median > x^2 347 468 1234.826 1054 > for (i in 1:100) { y[i] <- x[i]^2 } 1761281 1936134 2289621.980 2073489 > uq max neval cld > 1837 19156 1000 a > 2376263 10898102 1000 b ``` --- # Estructuras de control: .orange[BUCLES FOR] Veamos otro ejemplo **.bg-purple_light[combinando vectores numéricos y de caracteres]**: vamos a definir de nuevo un vector de edades y nombres, y vamos a recorrer cada uno imprimiento un mensaje por pantalla. ```r nombres <- c("Javi", "Laura", "Carlos", "Lucía", "Mar") edades <- c(33, 51, 18, 43, 29) # Recorremos cada uno de los 5 elementos e imprimimos un # mensaje que depende de ese índice i for (i in 1:5) { print(glue("{nombres[i]} tiene {edades[i]} años")) } ``` ``` > Javi tiene 33 años > Laura tiene 51 años > Carlos tiene 18 años > Lucía tiene 43 años > Mar tiene 29 años ``` --- # Estructuras de control: .orange[BUCLES FOR] Fíjate que **.bg-purple_light[si no nos queremos preocupar de si añadimos otra persona]**, podemos hacer que el bucle empiece en 1 y termine en el **.bg-purple_light[último lugar]** (sea el que sea), usando `length()`. ```r for (i in 1:length(nombres)) { print(glue("{nombres[i]} tiene {edades[i]} años")) } ``` ``` > Javi tiene 33 años > Laura tiene 51 años > Carlos tiene 18 años > Lucía tiene 43 años > Mar tiene 29 años ``` --- # Estructuras de control: .orange[BUCLES FOR] Aunque normalmente el conjunto que recorre el bucle suelen ser índices numéricos, podemos **.bg-purple_light[recorrer cualquier tipo de objeto]**, por ejemplo días e la semana ```r library(stringr) dias_semana <- c("lunes", "martes", "miércoles", "jueves", "viernes", "sábado", "domingo") for (dias in dias_semana) { # dias recorre los días de la semana print(str_to_upper(dias)) # Imprimimos en mayúsculas el día } ``` ``` > [1] "LUNES" > [1] "MARTES" > [1] "MIÉRCOLES" > [1] "JUEVES" > [1] "VIERNES" > [1] "SÁBADO" > [1] "DOMINGO" ``` --- # Estructuras de control: .orange[BUCLES FOR] Un último ejemplo: vamos a recorrer nuestro conjunto de datos `swiss` del paquete `{datasets}` y vamos a **pasar a dato ausente** todos los valores de fertilidad superiores a 80. Para ello recorreremos cada fila para después ejecutar un `if`. ```r for (i in 1:nrow(swiss)) { # si cumple la condición dicha fila, ponemos ausente. if (swiss$Fertility[i] > 80) { swiss$Fertility[i] <- NA } } ``` -- Esto sería exactamente equivalente al `ifelse()` vectorizado que vimos en el tema anterior ```r data("swiss") # lo cargamos de 0 swiss$Fertility <- ifelse(swiss$Fertility > 80, NA, swiss$Fertility) ``` --- # Estructuras de control: .orange[BUCLES WHILE] Otra manera de diseñar un bucle es con la estructura `while { }`, que ejecutará el bucle un **.bg-purple_light[número de veces a priori desconocido]**, lo hará hasta que la **.bg-purple_light[condición impuesta deje de ser cierta]**. Por ejemplo, vamos a inicializar una variable `ciclos <- 1`, y en cada paso aumentaremos una unidad, y no saldremos del bucle hasta que `ciclos > 4` ```r ciclos <- 1 # Mientras el número de ciclos sea inferior 4, imprime while(ciclos <= 4) { print(paste("Todavía no, vamos por el ciclo ", ciclos)) # Pegamos la frase al número de ciclo por el que vayamos con paste ciclos <- ciclos + 1 } ``` ``` > [1] "Todavía no, vamos por el ciclo 1" > [1] "Todavía no, vamos por el ciclo 2" > [1] "Todavía no, vamos por el ciclo 3" > [1] "Todavía no, vamos por el ciclo 4" ``` --- # Estructuras de control: .orange[BUCLES WHILE] ¿Y qué sucede cuando la **.bg-purple_light[condición nunca llega a ser FALSE]**? Compruébalo tú mismo/a. ```r while (1 > 0) { # Nunca va a dejar de ser cierto print("Presiona ESC para salir del bucle") } ``` **.bg-red_light[CUIDADO]**: un bucle `while { }` puede ser muy peligroso sino se controla bien que el bucle acaba en algún momento. --- # Estructuras de control: .orange[BUCLES WHILE] Tenemos dos comandos reservados para poder **.bg-purple_light[abortar un bucle o avanzar forzosamente]**: * `break`: os habilita para **.bg-purple_light[parar un bucle]** aunque no haya llegado al final de su conjunto de índices a recorrer (o se siga cumpliendo la condición). ```r for(i in 1:10) { if (i == 3) { break # si i es 3, el bucle frena aquí } print(i) } ``` ``` > [1] 1 > [1] 2 ``` --- # Estructuras de control: .orange[BUCLES WHILE] Tenemos dos comandos reservados para poder **.bg-purple_light[abortar un bucle o avanzar forzosamente]**: * `next`: **.bg-purple_light[obliga al bucle a avanzar]** a la siguiente iteracción, abortando la iteración actual en la que se encuentra. ```r for(i in 1:5) { if (i == 3) { next # si i es 3, pasará a la siguiente } print(i) } ``` ``` > [1] 1 > [1] 2 > [1] 4 > [1] 5 ``` --- # Ejercicios .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 1**: modifica el código inferior para imprimir un mensaje por pantalla si todos los datos del conjunto `airquality` son de meses que no sean enero. ```r # install.packages("dataset") # solo la primera vez library(datasets) # paquete con los datos mes <- airquality$Month if (mes == 2) { print("Ningún dato es del mes de enero") } ``` ] .panel[.panel-name[Solución ej. 1] * 📝 **Ejercicio 1**: modifica el código inferior para imprimir un mensaje por pantalla si todos los datos del conjunto `airquality` son de meses que no sean enero. ```r # install.packages("dataset") # solo la primera vez library(datasets) # paquete con los datos mes <- airquality$Month if (all(mes != 1)) { print("Ningún dato es del mes de enero") } ``` ``` > [1] "Ningún dato es del mes de enero" ``` ] ] --- # Ejercicios .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 2**: modifica el código inferior para guardar en una variable llamada `temperatura_alta` un valor `TRUE` si alguno de los registros tiene una temperatura mayor a 90 (están en Farenheit) y un `FALSE` en caso contrario. ```r temperatura <- airquality$Temp if (temperatura == 100) { print("Alguno de los registros tiene temperatura superior a 90 Farenheit") } ``` ] .panel[.panel-name[Solución ej. 2] * 📝 **Ejercicio 2**: modifica el código inferior para guardar en una variable llamada `temperatura_alta` un valor `TRUE` si alguno de los registros tiene una temperatura mayor a 90 (están en Farenheit) y un `FALSE` en caso contrario. ```r # Opción 1 temperatura <- airquality$Temp temperatura_alta <- FALSE if (any(temperatura > 90)) { temperatura_alta <- TRUE } # Opción 2 temperatura_alta <- any(airquality$Temp > 90) ``` ] ] --- # Ejercicios .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 3**: modifica el código inferior para diseñar un bucle `for` de 5 iteraciones que recorra los 5 primeros impares y les sume uno. ```r for (i in 1:5) { print(i) } ``` * 📝 **Ejercicio 4**: modifica el código inferior para diseñar un bucle `while` que parta con una variable `conteo <- 1` y pare cuando llegue a 6. ```r conteo <- 1 while (conteo == 2) { print(conteo) } ``` ] .panel[.panel-name[Solución ej. 3] * 📝 **Ejercicio 3**: modifica el código inferior para diseñar un bucle `for` de 5 iteraciones que recorra los 5 primeros impares y les sume uno. ```r for (i in c(1, 3, 5, 7, 9)) { print(i + 1) } ``` ``` > [1] 2 > [1] 4 > [1] 6 > [1] 8 > [1] 10 ``` ] .panel[.panel-name[Solución ej. 4] * 📝 **Ejercicio 4**: modifica el código inferior para diseñar un bucle `while` que parta con una variable `conteo <- 1` y pare cuando llegue a 6. ```r conteo <- 1 while (conteo < 6) { print(conteo) conteo <- conteo + 1 } ``` ``` > [1] 1 > [1] 2 > [1] 3 > [1] 4 > [1] 5 ``` ] ] --- # Ejercicios .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 5**: diseña un bucle `for` de 200 iteraciones que, empezando en un valor inicial de 100 (euros), te sume 3€ (actualizando el valor) si el número actual de la iteración es par, y te reste 5€ si es impar (investiga la función `%%`). * 📝 **Ejercicio 6**: diseña el anterior bucle pero guardando el dinero de cada iteración en alguna variable * 📝 **Ejercicio 7**: diseña el bucle del ejercicio 5 pero parando cuando no nos quede dinero. ] .panel[.panel-name[Sol. ej. 5] Un número par será todo aquel número que al dividir entre 2, la división es exacta, es decir, que su resto es nulo. Para calcular ese resto usaremos la función `%%`. ```r # dinero inicial dinero <- 100 for (i in 1:200) { dinero <- ifelse(i %% 2 == 0, dinero + 3, dinero - 5) } dinero ``` ``` > [1] -100 ``` ] .panel[.panel-name[Sol. ej. 6] ```r # vector inicial de importes dinero <- rep(0, 201) dinero[1] <- 100 # dinero inicial # Bucle for for (i in 2:201) { # si i es par o impar dinero[i] <- ifelse(i %% 2 == 0, dinero[i - 1] + 3, dinero[i - 1] - 5) } dinero ``` ``` > [1] 100 103 98 101 96 99 94 97 92 95 90 93 88 91 86 > [16] 89 84 87 82 85 80 83 78 81 76 79 74 77 72 75 > [31] 70 73 68 71 66 69 64 67 62 65 60 63 58 61 56 > [46] 59 54 57 52 55 50 53 48 51 46 49 44 47 42 45 > [61] 40 43 38 41 36 39 34 37 32 35 30 33 28 31 26 > [76] 29 24 27 22 25 20 23 18 21 16 19 14 17 12 15 > [91] 10 13 8 11 6 9 4 7 2 5 0 3 -2 1 -4 > [106] -1 -6 -3 -8 -5 -10 -7 -12 -9 -14 -11 -16 -13 -18 -15 > [121] -20 -17 -22 -19 -24 -21 -26 -23 -28 -25 -30 -27 -32 -29 -34 > [136] -31 -36 -33 -38 -35 -40 -37 -42 -39 -44 -41 -46 -43 -48 -45 > [151] -50 -47 -52 -49 -54 -51 -56 -53 -58 -55 -60 -57 -62 -59 -64 > [166] -61 -66 -63 -68 -65 -70 -67 -72 -69 -74 -71 -76 -73 -78 -75 > [181] -80 -77 -82 -79 -84 -81 -86 -83 -88 -85 -90 -87 -92 -89 -94 > [196] -91 -96 -93 -98 -95 -100 ``` ] .panel[.panel-name[Sol. ej. 7] ```r dinero <- 100 # dinero inicial # Bucle while while (dinero > 0) { dinero <- ifelse(i %% 2 == 0, dinero + 3, dinero - 5) } dinero ``` ``` > [1] 0 ``` ] ] --- name: tidydata # Datos limpios: .orange[TIDY DATA] .pull-left[ <img src="./img/tidyverrse_universe.jpg" width="99%" style="display: block; margin: auto;" /> ] .pull-right[ <img src="./img/flow_tidyverse.jpg" width="99%" style="display: block; margin: auto;" /> ] Universo de **.bg-purple_light[paquetes tidyverse]**: un conjunto de paquetes para un flujo de **trabajo eficiente, coherente y lexicográficamente** sencillo de entender. --- # Datos limpios: .orange[TIDY DATA] > Tidy datasets are all alike, but every messy dataset is messy in its own way (Hadley Wickham, Chief Scientist en RStudio) Hasta ahora solo le hemos dado importancia al «qué» pero no al **.bg-purple_light[«cómo» manejamos los datos]**. La organización de nuestros datos es fundamental para que su **.bg-purple_light[preparación y explotación]** sea lo más eficiente posible. <div class="figure" style="text-align: center"> <img src="./img/tidy_flow.jpg" alt="Flujo deseable de datos según Hadley Wickham, extraída de https://r4ds.had.co.nz/wrangle-intro.html" width="60%" /> <p class="caption">Flujo deseable de datos según Hadley Wickham, extraída de https://r4ds.had.co.nz/wrangle-intro.html</p> </div> --- # Datos limpios: .orange[TIDY DATA] El concepto **.bg-purple_light[tidy data]** fue introducido por **Hadley Wickham** (Wickham, 2014) como el primer paso de un flujo de trabajo eficiente. Para ello haremos uso del paquete `{tidyr}` (dentro de `{tidyverse}`) que nos proporciona herramientas eficientes y sencillaspara su manejo. Los **.bg-purple_light[conjuntos tidy u ordenados]** tienen tres objetivos * **.bg-orange[Estandarización]** en su estructura para una depuración y análisis eficiente. * **.bg-orange[Sencillez]** en su manipulación. * Listos para ser **.bg-orange[modelizados y visualizados]**. 📚 Ver Wickham (2014) en **.bg-green_light[bibliografía]** en <https://github.com/dadosdelaplace/teaching/tree/main/data_mining/biblio> --- # Datos limpios: .orange[TIDY Dblob/main/data_mining/biblio/tidy_data_wickham_2014.pdfbg-purple_light[datos ordenados o tidy data]** deben cumplir: 1. Cada **.bg-green_light[variable en una columna]**. 2. Cada **.bg-orange[observación/individuo en una fila]** diferente. 3. Cada **.bg-green_light[celda con un único valor]**. 4. Cada **.bg-orange[conjunto en un tibble]** (tabla). 5. Si usamos múltiples tablas a la vez debemos tener una **.bg-green_light[columna común para poder cruzarlas]**. ] .pull-right[ <img src="./img/tidy_def.jpg" width="85%" style="display: block; margin: auto;" /> <img src="./img/tidyr_1.jpg" width="53%" style="display: block; margin: auto;" /> ] --- # Tubería .orange[PIPE] En este entorno de trabajo tendremos un **.bg-purple_light[operador clave]**: el **.bg-purple_light[operador pipeline]** `%>%` (podemos usar el atajo con `ctrl+shift+M` o `command+shift+M`). Dicho operador lo debemos interpretar como una **.bg-purple_light[tubería]** que va pasando por los datos y los va transformando. Por ejemplo, si tuviésemos tres funciones `first()`, `second()` y `third()`, la opción más inmediata sería anidar las tres funciones tal que `third(second(first(x)))`, algo que dificulta la lectura posterior del código -- Con `%>%` podremos escribir (y leer) la concetanción de acciones como una **.bg-purple_light[tubería de izquierda a derecha]**: ```r first(x) %>% second(x) %>% third(x) ``` -- Dicho operador viene del paquete `{magrittr}`. Para **evitar esta dependencia** (cuantos menos paquetes tengamos que cargar, mejor), desde la versión 4.1.0 de R, disponemos de un pipeline nativo de R, el **operador** `|>` (disponible además fuera del entorno tidyverse). --- # Tubería .orange[PIPE] .pull-left[ ```r datos %>% limpio(...) %>% selecciono(...) %>% filtro(...) %>% ordeno(...) %>% agrupo(...) %>% cuento(...) %>% resumo(...) %>% pinto(...) ``` ```r datos |> limpio(...) |> selecciono(...) |> filtro(...) |> ordeno(...) |> agrupo(...) |> cuento(...) |> resumo(...) |> pinto(...) ``` ] .pull-right[ <img src="./img/tuberia.jpg" width="90%" style="display: block; margin: auto;" /> ] --- # Datos .orange[SUCIOS]: messy data Por ejemplo, vamos a cargar la tabla `table4a` del paquete `{tidyr}` (que ya lo tenemos cargado del entorno `{tidyverse}`). ```r table4a ``` ``` > # A tibble: 3 × 3 > country `1999` `2000` > * <chr> <int> <int> > 1 Afghanistan 745 2666 > 2 Brazil 37737 80488 > 3 China 212258 213766 ``` **.bg-purple_light[¿Qué falla?]** --- # Datos .orange[SUCIOS]: messy data .pull-left[ ```r table4a ``` ``` > # A tibble: 3 × 3 > country `1999` `2000` > * <chr> <int> <int> > 1 Afghanistan 745 2666 > 2 Brazil 37737 80488 > 3 China 212258 213766 ``` **.bg-purple_light[¿Qué falla?]** ] .pull-right[ ❎ Cada **.bg-green_light[variable en una columna]**. ❎ Cada **.bg-orange[observación/individuo en una fila]** diferente. ❎ Cada **.bg-green_light[celda con un único valor]**. ] Aunque la columna `$country` representa una variable, las otras columnas no: **.bg-purple_light[ambas son la misma variable]**, solo que medida en años distintos (que debería ser a su vez otra variable), de forma que **.bg-purple_light[cada fila está representando dos observaciones]** (1999, 2000). Tenemos datos en los nombres de las columnas. --- # Datos .orange[SUCIOS]: messy data .pull-left[ Lo que haremos será incluir una nueva columna llamada (por ejemplo) `year` que nos marque el año y otra llamada `cases` que nos diga el valor de la variable de interés en cada uno de esos años. ] .pull-right[ <img src="./img/table4a.jpg" width="65%" style="display: block; margin: auto;" /> ] -- Con la función `pivot_longer()` pivotaremos la tabla para pasarla a **formato long**: ```r table4a %>% * pivot_longer(cols = c("1999", "2000"), names_to = "year", values_to = "cases") ``` ``` > # A tibble: 6 × 3 > country year cases > <chr> <chr> <int> > 1 Afghanistan 1999 745 > 2 Afghanistan 2000 2666 > 3 Brazil 1999 37737 > 4 Brazil 2000 80488 > 5 China 1999 212258 > 6 China 2000 213766 ``` --- # Datos .orange[SUCIOS]: messy data .pull-left[ ```r table4a %>% pivot_longer(cols = c("1999", "2000"), names_to = "year", * values_to = "cases") ``` ] .pull-right[ <img src="./img/table4a_2.png" width="110%" style="display: block; margin: auto;" /> ] * `cols`: el **.bg-purple_light[nombre de las columnas a pivotar]** (con comillas por ser números y no caracteres). * `names_to`: el **.bg-purple_light[nombre de la nueva columna]** a la mandamos los **.bg-purple_light[nombres]** de las columnas. * `values_to`: el **.bg-purple_light[nombre de la nueva columna]** a la que vamos a mandar los **.bg-purple_light[datos]**. --- # Datos .orange[SUCIOS]: messy data Echa un vistazo a la tabla `{table4b}` ```r table4b ``` ``` > # A tibble: 3 × 3 > country `1999` `2000` > * <chr> <int> <int> > 1 Afghanistan 19987071 20595360 > 2 Brazil 172006362 174504898 > 3 China 1272915272 1280428583 ``` **.bg-purple_light[TODO TUYO]**: ¿es tidy o messy? ¿Cómo convertirla a tidy data en caso de que no lo sea ya? --- # Datos .orange[SUCIOS]: messy data Echa un vistazo a la tabla `{relig_income}` ```r relig_income ``` ``` > # A tibble: 18 × 11 > religion `<$10k` $10-2…¹ $20-3…² $30-4…³ $40-5…⁴ $50-7…⁵ $75-1…⁶ $100-…⁷ > <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> > 1 Agnostic 27 34 60 81 76 137 122 109 > 2 Atheist 12 27 37 52 35 70 73 59 > 3 Buddhist 27 21 30 34 33 58 62 39 > 4 Catholic 418 617 732 670 638 1116 949 792 > 5 Don’t know/r… 15 14 15 11 10 35 21 17 > 6 Evangelical … 575 869 1064 982 881 1486 949 723 > 7 Hindu 1 9 7 9 11 34 47 48 > 8 Historically… 228 244 236 238 197 223 131 81 > 9 Jehovah's Wi… 20 27 24 24 21 30 15 11 > 10 Jewish 19 19 25 25 30 95 69 87 > 11 Mainline Prot 289 495 619 655 651 1107 939 753 > 12 Mormon 29 40 48 51 56 112 85 49 > 13 Muslim 6 7 9 10 9 23 16 8 > 14 Orthodox 13 17 23 32 32 47 38 42 > 15 Other Christ… 9 7 11 13 13 14 18 14 > 16 Other Faiths 20 33 40 46 49 63 46 40 > 17 Other World … 5 2 3 4 2 7 3 4 > 18 Unaffiliated 217 299 374 365 341 528 407 321 > # … with 2 more variables: `>150k` <dbl>, `Don't know/refused` <dbl>, and > # abbreviated variable names ¹`$10-20k`, ²`$20-30k`, ³`$30-40k`, ⁴`$40-50k`, > # ⁵`$50-75k`, ⁶`$75-100k`, ⁷`$100-150k` > # ℹ Use `colnames()` to see all variable names ``` **.bg-purple_light[TODO TUYO]**: ¿es tidy o messy? ¿Cómo convertirla a tidy data en caso de que no lo sea ya? --- # Datos .orange[SUCIOS]: messy data Veamos un segundo tipo de dato sucio: vamos a cargar la tabla `table2` del paquete `{tidyr}` (que ya lo tenemos cargado del entorno `{tidyverse}`). **.bg-purple_light[¿Qué falla?]** ```r table2 ``` ``` > # A tibble: 12 × 4 > country year type count > <chr> <int> <chr> <int> > 1 Afghanistan 1999 cases 745 > 2 Afghanistan 1999 population 19987071 > 3 Afghanistan 2000 cases 2666 > 4 Afghanistan 2000 population 20595360 > 5 Brazil 1999 cases 37737 > 6 Brazil 1999 population 172006362 > 7 Brazil 2000 cases 80488 > 8 Brazil 2000 population 174504898 > 9 China 1999 cases 212258 > 10 China 1999 population 1272915272 > 11 China 2000 cases 213766 > 12 China 2000 population 1280428583 ``` --- # Datos .orange[SUCIOS]: messy data .pull-left[ ```r head(table2) ``` ``` > # A tibble: 6 × 4 > country year type count > <chr> <int> <chr> <int> > 1 Afghanistan 1999 cases 745 > 2 Afghanistan 1999 population 19987071 > 3 Afghanistan 2000 cases 2666 > 4 Afghanistan 2000 population 20595360 > 5 Brazil 1999 cases 37737 > 6 Brazil 1999 population 172006362 ``` ] .pull-right[ <img src="./img/table2.jpg" width="69%" style="display: block; margin: auto;" /> ] ❎ Cada **.bg-orange[observación/individuo en una fila]** diferente. Fíjate en las cuatro primeras filas: los registros con el mismo año deberían ser el mismo, es la misma información, **.bg-purple_light[debería estar en la misma fila]**, pero está dividada en dos. --- # Datos .orange[SUCIOS]: messy data Lo que haremos será lo opuesto a antes: con `pivot_wider()` «ampliaremos» la **.bg-purple_light[tabla a lo ancho]**, con menos filas pero con más columnas. ```r table2 %>% * pivot_wider(names_from = type, values_from = count) ``` ``` > # A tibble: 6 × 4 > country year cases population > <chr> <int> <int> <int> > 1 Afghanistan 1999 745 19987071 > 2 Afghanistan 2000 2666 20595360 > 3 Brazil 1999 37737 172006362 > 4 Brazil 2000 80488 174504898 > 5 China 1999 212258 1272915272 > 6 China 2000 213766 1280428583 ``` * `names_from`: el **.bg-purple_light[nombre de la columna original]** de la que vamos a sacar las **.bg-purple_light[nuevas columnas]** que vamos a crear (`cases` y `population`). * `values_from`: el **.bg-purple_light[nombre de la columna orignal]** de la que vamos a sacar los **.bg-purple_light[datos]**. --- # Datos .orange[SUCIOS]: messy data Por último veamos un tercer tipo de dato sucio: vamos a cargar la tabla `table3` del paquete `{tidyr}` (que ya lo tenemos cargado del entorno `{tidyverse}`). **.bg-purple_light[¿Qué falla?]** ```r table3 ``` ``` > # A tibble: 6 × 3 > country year rate > * <chr> <int> <chr> > 1 Afghanistan 1999 745/19987071 > 2 Afghanistan 2000 2666/20595360 > 3 Brazil 1999 37737/172006362 > 4 Brazil 2000 80488/174504898 > 5 China 1999 212258/1272915272 > 6 China 2000 213766/1280428583 ``` -- ❎ Cada **.bg-green_light[celda con un único valor]**. --- # Datos .orange[SUCIOS]: messy data Lo que haremos será usar `separate()` para mandar **.bg-purple_light[cada valor a una columna diferente]**. ```r *table3 %>% separate(rate, into = c("cases", "pop")) ``` ``` > # A tibble: 6 × 4 > country year cases pop > <chr> <int> <chr> <chr> > 1 Afghanistan 1999 745 19987071 > 2 Afghanistan 2000 2666 20595360 > 3 Brazil 1999 37737 172006362 > 4 Brazil 2000 80488 174504898 > 5 China 1999 212258 1272915272 > 6 China 2000 213766 1280428583 ``` * `into`: **.bg-purple_light[nombre de nuevas columnas]** donde separaremos valores. <img src="./img/seperate.jpg" width="40%" style="display: block; margin: auto;" /> --- # Datos .orange[SUCIOS]: messy data Por defecto lo que hace es **.bg-purple_light[localizar como separador cualquier caracter que no sea alfa-numérico]**. Si queremos un caracter concreto para dividir podemos indicárselo explícitamente. Si usas un separador que no está en los datos te devolverá dichas columnas vacías ya que no ha podido dividirlas. ```r table3 %>% separate(rate, into = c("cases", "population"), sep = ".") ``` ``` > Warning: Expected 2 pieces. Additional pieces discarded in 6 rows [1, 2, 3, 4, > 5, 6]. ``` ``` > # A tibble: 6 × 4 > country year cases population > <chr> <int> <chr> <chr> > 1 Afghanistan 1999 "" "" > 2 Afghanistan 2000 "" "" > 3 Brazil 1999 "" "" > 4 Brazil 2000 "" "" > 5 China 1999 "" "" > 6 China 2000 "" "" ``` --- # Datos .orange[SUCIOS]: messy data De la misma manera que podemos separar columnas también podemos **.bg-purple_light[unir columnas]**. Para ello vamos a usar la tabla `table5` del ya mencionado paquete. ```r table5 ``` ``` > # A tibble: 6 × 4 > country century year rate > * <chr> <chr> <chr> <chr> > 1 Afghanistan 19 99 745/19987071 > 2 Afghanistan 20 00 2666/20595360 > 3 Brazil 19 99 37737/172006362 > 4 Brazil 20 00 80488/174504898 > 5 China 19 99 212258/1272915272 > 6 China 20 00 213766/1280428583 ``` --- # Datos .orange[SUCIOS]: messy data .pull-left[ Con la función `unite()` vamos a **.bg-purple_light[unir]** el siglo (en `century`) y el año (en `year`), y al inicio le indicaremos como se llamará la nueva variable `year_ok` ```r table5 %>% unite(col = year_ok, century, year, sep = "") ``` ``` > # A tibble: 6 × 3 > country year_ok rate > <chr> <chr> <chr> > 1 Afghanistan 1999 745/19987071 > 2 Afghanistan 2000 2666/20595360 > 3 Brazil 1999 37737/172006362 > 4 Brazil 2000 80488/174504898 > 5 China 1999 212258/1272915272 > 6 China 2000 213766/1280428583 ``` ] .pull-right[ <img src="./img/unite.jpg" width="99%" style="display: block; margin: auto;" /> ] --- # Eliminando .orange[AUSENTES] El paquete `{tidyr}` también dispone de algunas herramientas útiles para **.bg-purple_light[quitar ausentes]** ```r datos <- tibble(x = c(1, 2, NA), y = c("a", NA, "b")) datos ``` ``` > # A tibble: 3 × 2 > x y > <dbl> <chr> > 1 1 a > 2 2 <NA> > 3 NA b ``` --- # Eliminando .orange[AUSENTES] Con `drop_na()` podemos indicarle que nos **.bg-purple_light[elimine las filas con algún ausente]** en alguna de las variables (o especificarle la variable concreta). .pull-left[ ```r datos %>% drop_na() ``` ``` > # A tibble: 1 × 2 > x y > <dbl> <chr> > 1 1 a ``` ] .pull-right[ ```r datos %>% drop_na(x) ``` ``` > # A tibble: 2 × 2 > x y > <dbl> <chr> > 1 1 a > 2 2 <NA> ``` ] --- # Eliminando .orange[AUSENTES] A veces no querremos eliminarlos sino **.bg-purple_light[imputar por el valor previo/siguiente]** con `fill()` .pull-left[ ```r datos %>% fill(x) ``` ``` > # A tibble: 3 × 2 > x y > <dbl> <chr> > 1 1 a > 2 2 <NA> > 3 2 b ``` ```r datos %>% fill(x, .direction = c("up")) ``` ``` > # A tibble: 3 × 2 > x y > <dbl> <chr> > 1 1 a > 2 2 <NA> > 3 NA b ``` ] .pull-right[ ```r datos %>% fill(y) ``` ``` > # A tibble: 3 × 2 > x y > <dbl> <chr> > 1 1 a > 2 2 a > 3 NA b ``` ```r datos %>% fill(y, .direction = c("up")) ``` ``` > # A tibble: 3 × 2 > x y > <dbl> <chr> > 1 1 a > 2 2 b > 3 NA b ``` ] --- # Eliminando .orange[AUSENTES] Los **.bg-purple_light[ausentes]** también pueden ser **.bg-purple_light[eliminados al pivotar]** con `values_drop_na`. ```r stocks <- tibble(qtr = 1:4, "2015" = c(1.88, 0.59, 0.35, NA), "2016" = c(NA, 0.92, 0.17, 2.66)) stocks ``` ``` > # A tibble: 4 × 3 > qtr `2015` `2016` > <int> <dbl> <dbl> > 1 1 1.88 NA > 2 2 0.59 0.92 > 3 3 0.35 0.17 > 4 4 NA 2.66 ``` --- # Eliminando .orange[AUSENTES] Los **.bg-purple_light[ausentes]** también pueden ser **.bg-purple_light[eliminados al pivotar]** con `values_drop_na`. ```r stocks %>% pivot_longer(cols = c("2015", "2016"), names_to = "year", values_to = "return", values_drop_na = TRUE) ``` ``` > # A tibble: 6 × 3 > qtr year return > <int> <chr> <dbl> > 1 1 2015 1.88 > 2 2 2015 0.59 > 3 2 2016 0.92 > 4 3 2015 0.35 > 5 3 2016 0.17 > 6 4 2016 2.66 ``` --- # Reemplazando .orange[AUSENTES] Otras veces querremos **.bg-purple_light[imputar los ausentes por un valor fijo]**, algo que podemos hacer con `replace_na()` .pull-left[ ```r datos ``` ``` > # A tibble: 3 × 2 > x y > <dbl> <chr> > 1 1 a > 2 2 <NA> > 3 NA b ``` ] .pull-right[ ```r datos %>% replace_na(list(x = -1, y = "unknown")) ``` ``` > # A tibble: 3 × 2 > x y > <dbl> <chr> > 1 1 a > 2 2 unknown > 3 -1 b ``` ] --- # Completando .orange[AUSENTES] Por último, también podemos **.bg-purple_light[crear todas las combinaciones posibles de variables]** (para completar datos ausentes que se hayan podido eliminar). ```r stocks <- tibble(year = c(2015, 2015, 2015, 2015, 2016, 2016, 2016), qtr = c(1, 2, 3, 4, 2, 3, 4), return = c(1.88, 0.59, 0.35, NA, 0.92, 0.17, 2.66)) ``` .pull-left[ ```r stocks ``` ``` > # A tibble: 7 × 3 > year qtr return > <dbl> <dbl> <dbl> > 1 2015 1 1.88 > 2 2015 2 0.59 > 3 2015 3 0.35 > 4 2015 4 NA > 5 2016 2 0.92 > 6 2016 3 0.17 > 7 2016 4 2.66 ``` ] .pull-right[ ```r stocks %>% complete(year, qtr) ``` ``` > # A tibble: 8 × 3 > year qtr return > <dbl> <dbl> <dbl> > 1 2015 1 1.88 > 2 2015 2 0.59 > 3 2015 3 0.35 > 4 2015 4 NA > 5 2016 1 NA > 6 2016 2 0.92 > 7 2016 3 0.17 > 8 2016 4 2.66 ``` ] --- name: rmd # .orange[COMUNICANDO] resultados: archivos .green[.Rmd] Una de las principales **.bg-purple_light[fortalezas]** de `R` es la facilidad para generar informes, libros, webs, **.bg-purple_light[apuntes y hasta diapositivas]** (este material por ejemplo). Para ello instalaremos antes el paquete `{rmarkdown}` que nos permitirá generar documentos `.Rmd` ```r install.packages("rmarkdown") ``` --- # .orange[COMUNICANDO] resultados: archivos .green[.Rmd] ¿Cuál son las **ventajas** de generarlos desde **.bg-purple_light[rmarkdown]**? -- * Al hacerlo desde `RStudio`, puedes generar un informe o una presentación **.bg-purple_light[sin salirte del entorno]** de programación en el que estás trabajando -- * Podrás analizar los datos, resumirlos y a la vez **.bg-purple_light[comunicarlos]**. -- * Permite **.bg-purple_light[integrar fácilmente código]** `R`, de forma que no solo podremos integrar las salidas de nuestro trabajo sino también el código con el que lo hemos generado. --- # ¿Qué es .orange[RMARKDOWN]? Una herramienta que nos permite crear de forma sencilla **documentos combinando**: -- * **.bg-purple_light[Markdown]**: creado en 2004 por John Gruber, y de uso libre, es un «lenguaje» que nos permite crear contenido de una manera sencilla de escribir, y que en todo momento mantenga un diseño legible, con algunas de las ventajas de un HTML (si acostumbras a escribir en wordpress o blogs, seguramente hayas escrito de esta forma). -- * **.bg-green_light[Matemáticas (latex)]**: herramienta (lenguaje en realidad) para escribir notación matemática como `\(x^2\)` o `\(\sqrt{2}\)` (si escribes notación similar en editores de texto, seguramente sin saberlo estés usando ya latex). -- * **.bg-purple_light[Código]** y salidas de `R`: podremos no solo mostrar el paso final sino el código que has ido realizando, con **cajitas de código** como las del manual. -- * **.bg-green_light[Imágenes y tablas]**. -- * **.bg-purple_light[Estilos]** (css, js, etc). --- # Creando nuestro .orange[PRIMER INFORME] .pull-left[ <div class="figure" style="text-align: left"> <img src="./img/file_rmarkdown.jpg" alt="Creando el primer fichero .rmd" width="80%" /> <p class="caption">Creando el primer fichero .rmd</p> </div> ] .pull-right[ Vamos a crear el **.bg-purple_light[primer fichero]** con extensión `.Rmd` (la extensión de los archivos R Markdown). Haz click en el botón `File << New File << R Markdown`. ] --- # Creando nuestro .orange[PRIMER INFORME] .pull-left[ <div class="figure" style="text-align: left"> <img src="./img/new_rmd.jpg" alt="Creando el primer fichero .rmd" width="80%" /> <p class="caption">Creando el primer fichero .rmd</p> </div> ] .pull-right[ Tras hacerlo, nos aparecerán **.bg-purple_light[varias opciones]**de formatos de salida: * archivo `.pdf` * archivo `.html` (**.bg-purple_light[recomendable]**): documento dinámico, permite la interacción con el usuario, como una «página web») * archivo `.doc` (nada recomendable) De momento dejaremos marcado el **.bg-purple_light[formato HTML que viene por defecto]**, y escribiremos el título de nuestro documento. Tras ello tendremos nuestro archivo `.Rmd` (ya no es un script `.R` como los que hemos abierto hasta ahora) ] --- # Creando nuestro .orange[PRIMER INFORME] Un fichero `.Rmd` se divide básicamente en **.bg-purple_light[tres partes]** 1. **.bg-purple_light[Cabecera]**: la parte que tienes al inicio entre `---`. 2. **.bg-purple_light[Texto]**: que podremos formatear y mejorar con **negritas** (escrito como `**negritas**`, con doble astérisco al inicio y final), _cursivas_ (`_cursivas_`, con barra baja al inicio y final) o destacar nombres de funciones o variables de `R` (con ``R`). Recuerda que puedes añadir además ecuaciones como `\(x^2\)` (he escrito `$x^2$`, la ecuación entre dólares). 3. **.bg-purple_light[Código R]**. --- # .orange[PRIMER INFORME]: .green[CABECERA] La cabecera están en formato `YAML`, y contiene los **.bg-purple_light[metadatos del documento]**: título, autor, fecha, estilos (si los tuviésemos), etc. Para probar, vamos a cambiar la cabecera que nos ha generado por defecto de la siguiente forma: ```r --- title: "Probando Probando" author: "Señor/a X" date: "11/7/2014" output: html_document --- ``` Tras tunear nuestra cabecera borraremos todo lo que viene después para **.bg-purple_light[empezar desde cero]**. <div class="figure" style="text-align: left"> <img src="./img/rmd_vacio.jpg" alt="Fichero .Rmd vacío, solo con la cabecera" width="27%" /> <p class="caption">Fichero .Rmd vacío, solo con la cabecera</p> </div> --- # .orange[PRIMER INFORME]: .green[TEXTO] Solo hay una cosa **.bg-purple_light[importante]** a tener en cuenta en este entorno: salvo que indiquemos lo contrario, **.bg-purple_light[TODO lo que vamos a escribir en el documento es texto]**. No código R. Texto plano que podremos mejorar un poco con algun detalle, pero texto. Vamos a empezar nuestro documento escribiendo por ejemplo la siguiente frase ```r Este material ha sido diseñado por el profesor Javier Álvarez Liébana, docente en la Universidad Complutense de Madrid ``` --- # .orange[PRIMER INFORME]: .green[TEXTO] .pull-left[ <div class="figure" style="text-align: left"> <img src="./img/html_con_texto.jpg" alt="Primer informe html" width="99%" /> <p class="caption">Primer informe html</p> </div> ] .pull-right[ Una vez que hemos escrito el texto vamos a **.bg-purple_light[guardar el archivo .Rmd]** haciendo click en el botón `Guardar` (yo he llamado al archivo `primer_rmarkdown.Rmd`). Tras guardar el documento, **.bg-purple_light[«tejeremos» nuestro documento]** haciendo click en el botón `Knit`. Al «tejer» se nos habrá generado (seguramente en una ventana al margen) un archivo .html, que podemos incluso **.bg-purple_light[abrir en nuestro navegador]**. Hemos creado nuestro primer informe, obviamente vacío de momento. ] --- # .orange[PRIMER INFORME]: .green[TEXTO] .pull-left[ <div class="figure" style="text-align: left"> <img src="./img/rmd_con_formato.jpg" alt="Tuneando nuestro primer informe html" width="99%" /> <p class="caption">Tuneando nuestro primer informe html</p> </div> ] .pull-right[ Vamos a **.bg-purple_light[mejorar]** un poco el texto haciendo lo siguiente: * Vamos a añadir **.bg-purple_light[negrita]** al nombre (poniendo `**` al inicio y al final). * Vamos añadir _cursiva_ a la palabra `material` (poniendo `_` al inicio y al final). * Vamos añadir un enlace `https://www.ucm.es`, asociándolo al nombre de la Universidad. Para ello el título lo ponemos entre corchetes y justo detrás el enlace entre paréntesis `[«Universidad Complutense de Madrid»](https://www.ucm.es)` ] --- # .orange[PRIMER INFORME]: .green[CHUNKS] de R Para añadir **.bg-purple_light[código R]** debemos crear nuestras **.bg-purple_light[cajas de código]** llamadas **.bg-orange[chunks]**: altos en el camino en nuestro texto markdown donde podremos incluir **código**. Para incluir uno deberá de ir encabezado de la siguiente forma. <div class="figure" style="text-align: left"> <img src="./img/chunk_1.jpg" alt="Encabezado/final del chunk" width="90%" /> <p class="caption">Encabezado/final del chunk</p> </div> --- # .orange[PRIMER INFORME]: .green[CHUNKS] de R Dentro de dicha **.bg-purple_light[cajita]** (que tiene ahora **otro color** en el documento) escribiremos **.bg-purple_light[código R]**, como lo veníamos haciendo hasta ahora. Vamos por ejemplo a **.bg-purple_light[definir dos variables]** y su suma de la siguiente manera, escribiendo dicho código en nuestro `.Rmd` (dentro de ese chunk) .pull-left[ ```r # Código R x <- 1 y <- 2 x + y ``` ``` > [1] 3 ``` ] .pull-right[ <div class="figure" style="text-align: left"> <img src="./img/rmd_3.jpg" alt="Primer chunk con código" width="99%" /> <p class="caption">Primer chunk con código</p> </div> ] --- # .orange[PRIMER INFORME]: .green[CHUNKS] de R .pull-left[ ```r # Código R x <- 1 y <- 2 x + y ``` ``` > [1] 3 ``` ] .pull-right[ <div class="figure" style="text-align: left"> <img src="./img/rmd_3.jpg" alt="Primer chunk con código" width="70%" /> <p class="caption">Primer chunk con código</p> </div> ] Como ves dentro de esos _chunks_ puedes **.bg-purple_light[comentar código]** con `#` (ahora veremos que hace `#` fuera de esas cajas de código). Tras hacerlo tejemos de nuevo y obtenemos ahora un documento que tiene una caja de código y su salida. <div class="figure" style="text-align: left"> <img src="./img/html_rmd_3.jpg" alt="Salida del html con el primer chunk" width="40%" /> <p class="caption">Salida del html con el primer chunk</p> </div> --- # .orange[PRIMER INFORME]: .green[CHUNKS] de R Somos capaces de **.bg-purple_light[escribir en un mismo documento texto]** con cierto formato, **.bg-purple_light[código R y la salida]** del resultado, permitiéndonos generar informes (ya veremos como incluir gráficas). De hecho, lo más práctico para **.bg-purple_light[tomar apuntes de R]** es ir anotando en un archivo `.Rmd`. Los chunks pueden tener un **.bg-purple_light[nombre o etiqueta]**, de forma que podamos referenciarlos de nuevo para no repetir código. <div class="figure" style="text-align: left"> <img src="./img/chunk_repe_tag.jpg" alt="Etiquetando un chunk y reciclándolo" width="40%" /> <p class="caption">Etiquetando un chunk y reciclándolo</p> </div> --- # .orange[PRIMER INFORME]: .green[ORGANIZANDO] Con todo incluido en el documento podemos **.bg-purple_light[dividirlo en secciones y subsecciones]**. Para ello usaremos la sintaxis de markdown, poniendo **.bg-purple_light[almohadillas]**: una `#` para secciones, `##` para subsecciones, `###` para subsubsecciones, etc. Por ejemplo, vamos a * Hacer una sección principal que sea `# Primer informe` * Tras ello añadiremos la parte de texto. * Creamos una subsección que se titule `## Chunks de código` donde incluiremos los dos chunks que tenemos hasta ahora. .pull-left[ <div class="figure" style="text-align: right"> <img src="./img/secciones_rmd.jpg" alt="Secciones en el rmd" width="80%" /> <p class="caption">Secciones en el rmd</p> </div> ] .pull-right[ <div class="figure" style="text-align: left"> <img src="./img/secciones_html.jpg" alt="Secciones en el html" width="80%" /> <p class="caption">Secciones en el html</p> </div> ] --- # .orange[PRIMER INFORME]: .green[ORGANIZANDO] Además podemos incluir tras el título (y entre llaves `{}`) **.bg-purple_light[etiquetas]** (con `{#etiqueta}`) para luego **.bg-purple_light[referenciar dichas secciones]** en el documento. .pull-left[ <div class="figure" style="text-align: left"> <img src="./img/ref_rmd.jpg" alt="Referencias a secciones y subsecciones" width="75%" /> <p class="caption">Referencias a secciones y subsecciones</p> </div> ] .pull-right[ También podemos organizar nuestro código **.bg-purple_light[creando listas]**, usando `*` como ítems. <div class="figure" style="text-align: left"> <img src="./img/items_rmd.jpg" alt="Creando listas con ítems" width="85%" /> <p class="caption">Creando listas con ítems</p> </div> ] --- # .orange[PRIMER INFORME]: .green[PERSONALIZAR] En cada chunk aparece una **.bg-purple_light[botón de play]**: pulsándolo podemos tener la **ejecución y salida** de cada chunk en nuestro `.Rmd`, sin tener que esperar a «tejer» (con Knit) todo el documento para ver lo que vamos ejecutando. .pull-left[ <div class="figure" style="text-align: left"> <img src="./img/play_chunk.jpg" alt="Pulsando al botón play" width="99%" /> <p class="caption">Pulsando al botón play</p> </div> ] .pull-right[ <div class="figure" style="text-align: left"> <img src="./img/chunk_ejecutado.jpg" alt="Chunk ejecutado in-line" width="99%" /> <p class="caption">Chunk ejecutado in-line</p> </div> ] --- # .orange[PRIMER INFORME]: .green[PERSONALIZAR] Además podemos **.bg-purple_light[incluir código R dentro de la línea de texto]** (en lugar de mostrar el texto x ejecuta el código R mostrando la variable). .pull-left[ <div class="figure" style="text-align: left"> <img src="./img/codigo_inline_rmd.jpg" alt="Código R inline" width="99%" /> <p class="caption">Código R inline</p> </div> ] .pull-right[ <div class="figure" style="text-align: left"> <img src="./img/codigo_inline_html.jpg" alt="Salida del código in-line" width="99%" /> <p class="caption">Salida del código in-line</p> </div> ] --- # .orange[PRIMER INFORME]: .green[PERSONALIZAR] Los chunk podemos **.bg-purple_light[personalizar su salida]** con algunas opciones, pasándolos como argumentos dentro de las llaves ({r etiqueta, ...}). * `include = FALSE`: **.bg-green_light[ejecuta código]** pero **.bg-red_light[no se muestra (ni resultados)]** en la salida. * `echo = FALSE`: **.bg-green_light[ejecuta código]** y se **.bg-green_light[muestra resultado]** pero **.bg-red_light[no el código]** en la salida. * `eval = FALSE`: se **.bg-green_light[muestra el código]** pero **.bg-red_light[no se ejecuta]** en la salida final. * `message = FALSE`: se **.bg-green_light[ejecuta el código]** pero **.bg-red_light[no se muestran mensajes]** de salida que tendríamos en consola. * `warning = FALSE`: **.bg-green_light[ejecuta código]** pero **.bg-red_light[no se muestran warning]**. * `error = TRUE`: se **.bg-green_light[ejecuta el código]** pero permite ejecutar el código **.bg-green_light[con errores]** mostrando los mensajes de error. -- Estas opciones podemos aplicarlas chunk a chunk o fijar los parámetros de forma global con `knitr::opts_chunk$set()` (dentro de un chunk), pasándole como argumentos dichas opciones (por ejemplo, `knitr::opts_chunk$set(echo = FALSE)`). --- # .orange[PRIMER INFORME]: .green[VARIABLES/ECUACIONES] Por último en este primer documento vamos a añadir una subsección `## Variables y ecuaciones` donde añadiremos un chunk asignando la suma `x + y` a una variable `z`, escribiendo antes en texto el nombre de la variable y la **.bg-purple_light[fórmula]** ($z = x + y$ entre dólares). .pull-left[ <div class="figure" style="text-align: left"> <img src="./img/variables_rmd.jpg" alt="Añadiendo variables en el .rmd" width="90%" /> <p class="caption">Añadiendo variables en el .rmd</p> </div> ] .pull-right[ <div class="figure" style="text-align: left"> <img src="./img/variables_html.jpg" alt="Añadiendo variables en el .rmd" width="110%" /> <p class="caption">Añadiendo variables en el .rmd</p> </div> ] --- name: oms # .orange[CASO PRÁCTICO]: datos de la OMS Instala el paquete `{tidyr}` y usa el conjunto `who` contenido en él mismo (sobre casos de tuberculosis). Lee la ayuda `? who` para detalles de los datos. ```r # install.packages("tidyr") library(tidyr) who ``` ``` > # A tibble: 7,240 × 60 > country iso2 iso3 year new_s…¹ new_s…² new_s…³ new_s…⁴ new_s…⁵ new_s…⁶ > <chr> <chr> <chr> <int> <int> <int> <int> <int> <int> <int> > 1 Afghanistan AF AFG 1980 NA NA NA NA NA NA > 2 Afghanistan AF AFG 1981 NA NA NA NA NA NA > 3 Afghanistan AF AFG 1982 NA NA NA NA NA NA > 4 Afghanistan AF AFG 1983 NA NA NA NA NA NA > 5 Afghanistan AF AFG 1984 NA NA NA NA NA NA > 6 Afghanistan AF AFG 1985 NA NA NA NA NA NA > 7 Afghanistan AF AFG 1986 NA NA NA NA NA NA > 8 Afghanistan AF AFG 1987 NA NA NA NA NA NA > 9 Afghanistan AF AFG 1988 NA NA NA NA NA NA > 10 Afghanistan AF AFG 1989 NA NA NA NA NA NA > # … with 7,230 more rows, 50 more variables: new_sp_m65 <int>, > # new_sp_f014 <int>, new_sp_f1524 <int>, new_sp_f2534 <int>, > # new_sp_f3544 <int>, new_sp_f4554 <int>, new_sp_f5564 <int>, > # new_sp_f65 <int>, new_sn_m014 <int>, new_sn_m1524 <int>, > # new_sn_m2534 <int>, new_sn_m3544 <int>, new_sn_m4554 <int>, > # new_sn_m5564 <int>, new_sn_m65 <int>, new_sn_f014 <int>, > # new_sn_f1524 <int>, new_sn_f2534 <int>, new_sn_f3544 <int>, … > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- class: inverse center middle name: clase-4 # CLASE 4: introducción a la minería (SEMMA) ### [Introducción al aprendizaje estadístico](#learning) ### [Sesgo vs varianza](#sesgo-varianza) ### [Introducción a la minería de datos (SEMMA)](#data-mining) ### [Muestreo (sample)](#sample) --- name: learning <img src="./img/ml_maths.jpg" width="80%" style="display: block; margin: auto;" /> --- # .orange[CIENCIA DE DATOS] **.bg-purple_light[¿Qué es la ciencia de datos]** ¿Qué incluye? La conocida como **.bg-purple_light[Data Science (Ciencia de Datos)]** es un campo muy extenso en el que, según algunos autores, se podría incluir (o intersecar con) campos como la **Minería de Datos**, el **Machine Learning** o el **Big Data** <img src="./img/stats_IA.jpg" width="40%" style="display: block; margin: auto;" /> 📚 Ver definiciones en **.bg-green_light[Fernández-Casal et al. (2021)]** en <https://rubenfcasal.github.io/aprendizaje_estadistico> --- # .orange[APRENDIZAJE] estadístico Uno de los conceptos clave es la idea de **.bg-purple_light[aprendizaje estadístico]**: formularemos modelos que buscan **.bg-purple_light[aprender]** de los datos (teniendo en cuenta la incertidumbre subyacente), mejorando los resultados si **.bg-purple_light[aumentamos la calidad de la información]** (!= aumentar su tamaño). -- En ese aprendizaje normalmente realizaremos una **.bg-purple_light[partición preliminar de los datos]**: - **.bg-purple_light[Entrenamiento]**: conjunto del que modelo **.bg-orange[aprenderá para su construcción]** (por ej., 70%). -- - **.bg-purple_light[Validación]**: conjunto que usaremos para **.bg-orange[evaluar nuestras decisiones]** (el modelo no ha podido aprender de él) y poder afinar los hiperparámetros (por ej., 20%). -- - **.bg-purple_light[Test]**: conjunto final que nos proporcionará una **.bg-orange[evaluación insesgada]** (por ej., 10%). 📚 Ver explicación detallada en <https://mlu-explain.github.io/train-test-validation/> --- # .orange[APRENDIZAJE] estadístico .pull-left[ Veamos un ejemplo: imagina que queremos construir un método que nos permita **.bg-purple_light[clasificar]** si un animal es un **.bg-purple_light[gato o perro]** en función de dos variables: **suavidad** y **peso**. En concreto el aprendizaje será **.bg-purple_light[supervisado]** (sé a priori en mi dataset cuál es gato o perro, veremos más adelante qué es el aprendizaje supervisado y el no supervisado). ] .pull-right[ <img src="./img/dogs_cats.jpg" width="85%" style="display: block; margin: auto auto auto 0;" /> ] 📚 Ver explicación en <https://mlu-explain.github.io/train-test-validation/> --- # .orange[APRENDIZAJE] estadístico <img src="./img/train_valid_test.jpg" width="45%" style="display: block; margin: auto;" /> .pull-left[ - **.bg-orange[Conjunto train]**: datos que el **modelo conocerá** para **.bg-purple_light[aprender patrones]**, siendo lo más representativo de mi conjunto global (para evitar la propagación de sesgos) ] .pull-right[ <img src="./img/train_dataset.jpg" width="55%" style="display: block; margin: auto;" /> ] --- # .orange[APRENDIZAJE] estadístico .pull-left[ El aprendizaje no solo dependerá de los datos, también de **.bg-purple_light[nuestras decisiones]**: cada decisión es un sesgo que acumulamos. * un clasificador tonto (**.bg-green_light[dummy]**) que diga que todos son la moda (gatos) * usar solo la variable suavidad * usar solo la variable peso * un clasificador que use ambas variables **.bg-purple_light[¿Cuál elegir?]** Y si tuviéramos más variables, ¿con cuántas? **.bg-green_light[Clasificador dummy]**: asigna la moda (cuali)/media (cuanti) o bien un valor al azar, sin asumir patrón alguno en los datos. ] .pull-right[ .pull-left[ <img src="./img/model_1.jpg" width="140%" style="display: block; margin: auto;" /> <img src="./img/model_3.jpg" width="140%" style="display: block; margin: auto;" /> ] .pull-right[ <img src="./img/model_2.jpg" width="150%" style="display: block; margin: auto;" /> <img src="./img/model_4.jpg" width="150%" style="display: block; margin: auto;" /> ] ] --- # .orange[APRENDIZAJE] estadístico <img src="./img/train_valid_test.jpg" width="45%" style="display: block; margin: auto;" /> .pull-left[ - **.bg-orange[Conjunto validation]**: datos que el modelo **no ha conocido** para aprender pero que usaremos para **.bg-purple_light[afinar y calibrar nuestras decisiones]**, de forma que sea **.bg-purple_light[independiente del entrenamiento]** ] .pull-right[ <img src="./img/validation_dataset.jpg" width="99%" style="display: block; margin: auto;" /> ] --- # .orange[APRENDIZAJE] estadístico <img src="./img/train_valid_test.jpg" width="45%" style="display: block; margin: auto;" /> .pull-left[ - **.bg-orange[Conjunto test]**: datos que el **modelo no ha conocido** ❎ ni para aprender ❎ ni para afinar hiperparámetros/decisiones Es un modelo que SOLO será usado para una **.bg-purple_light[evaluación final]** (insesgada): **.bg-red_light[NUNCA se usará en el proceso]**, solo cuando ya se ha terminado (simulando un cliente final). ] .pull-right[ <img src="./img/test_dataset.jpg" width="99%" style="display: block; margin: auto;" /> ] --- # .orange[APRENDIZAJE] estadístico .pull-left[ Si te fijas en este ejemplo, la **.bg-purple_light[métrica (tasa de bien clasificados)]** es superior en el conjunto de test que en el conjunto de validación. **.bg-red_light[¿Es malo? ¿Extraño?]** ] .pull-right[ <img src="./img/test_vs_validation.jpg" width="97%" style="display: block; margin: auto;" /> ] -- No, no es ni malo ni extraño. Es más, es un síntoma de que el conjunto de test no está sesgado a ninguna otra de las particiones **.bg-green_light[RECUERDA]**: el éxito del conjunto test **.bg-purple_light[NO es algo a optimizar]**, es simplemente una **.bg-purple_light[estimación de cómo funcionará]** nuestro modelo en datos reales. --- name: sesgo-varianza # Sobreajuste. .green[SESGO] vs .orange[VARIANZA] En el campo del aprendizaje estadístico (y por tanto en la minería de datos) será recurrente un término a evitar: **.bg-purple_light[sobrejauste]**. 📚 Ver bibliografía en * «The bias-variance tradeoff»: <https://mlu-explain.github.io/bias-variance/> * «Understanding the bias-variance tradeoff»: <https://towardsdatascience.com/understanding-the-bias-variance-tradeoff-165e6942b229> * «Bias–variance tradeoff»: <https://daviddalpiaz.github.io/r4sl/biasvariance-tradeoff.html> * «Understanding the Bias-Variance Tradeoff»: <https://scott.fortmann-roe.com/docs/BiasVariance.html> --- # Sobreajuste. .green[SESGO] vs .orange[VARIANZA] En el campo del aprendizaje estadístico (y por tanto en la minería de datos) será recurrente un término a evitar: **.bg-purple_light[sobrejauste]**. <img src="./img/bustamante.jpg" width="80%" style="display: block; margin: auto;" /> --- # Sobreajuste. .green[SESGO] vs .orange[VARIANZA] Imagina que tenemos los siguientes ingredientes * **.bg-purple_light[Modelo real]** `\(f(X)\)` donde `\(X\)` serán los datos, con `\(\hat{f}(X)\)` las estimaciones. -- * **.bg-purple_light[Output real]** que llamaremos `\(Y = f(X) + \varepsilon\)` ($\varepsilon$ será el **.bg-orange[ruido existente]**) -- * **.bg-purple_light[Output estimada]** que llamaremos `\(\hat{Y}\)`, definido como `\(\hat{Y} = \hat{f}(X)\)` -- * **.bg-purple_light[Error]** tras aplicar el modelo que llamaremos `\(E(x, f)\)`, y que podríamos definir como la **.bg-purple_light[media de las equivocaciones al cuadrado]** -- `$$Error := E(x, f) := {\rm E} \left[ \left(realidad - estimado\right)^2 \right] = {\rm E} \left[ \left(Y - \hat{Y}\right)^2 \right] = {\rm E}\left[\left(Y - \hat{f}(X)\right)^2 \right]$$` -- ¿Cómo podemos **.bg-purple_light[descomponer el error]**? --- # Sobreajuste. .green[SESGO] vs .orange[VARIANZA] * **Paso 1**: añadir y restar `\({\rm E} \left[ \hat{Y} \right]\)` dentro del paréntesis. $$E(x, f) := {\rm E}\left[\left(Y - \hat{f}(X)\right)^2 \right] = {\rm E}\left[\left(\left(Y - {\rm E} \left[ \hat{Y} \right] \right) + \left( {\rm E} \left[ \hat{Y} \right] - \hat{f}(X)\right)^2 \right) \right] $$ -- * **Paso 2**: resolver `\((a-c+c-b)^2 = ((a-c)+(c-b))^2 = (a-c)^2 + (c-b)^2 - 2*(a-c)(c-b)\)` $$E(x, f) := \left(Y - {\rm E} \left[ \hat{Y} \right] \right)^2 + {\rm E}\left[ \left( {\rm E} \left[ \hat{Y} \right] - \hat{f}(X)\right)^2 \right] + 2 {\rm E} \left[\left(Y - {\rm E} \left[ \hat{Y} \right] \right) \left( {\rm E} \left[ \hat{Y} \right] - \hat{f}(X)\right) \right] $$ -- * **Paso 3**: identificar términos `$$E(x, f) := {\rm E}\left[\left(Y - \hat{f}(X)\right)^2 \right] = sesgo^2 + varianza + ruido$$` --- # Sobreajuste. .green[SESGO] vs .orange[VARIANZA] * **.bg-red_light[Sesgo (bias)]** será igual a `\(\left(Y - {\rm E} \left[ \hat{Y} \right] \right)^2\)` (diferencia media entre la predicción media del modelo y el valor correcto a predecir). -- * **.bg-green_light[Varianza (variance)]** será igual a `\({\rm E}\left[ \left( {\rm E} \left[ \hat{Y} \right] - \hat{f}(X)\right)^2 \right]\)` (la dispersión/variación entre las predicción individuales y la predicción media). -- * **.bg-orange[Ruido]**: error aleatorio **irreducible** `\(\varepsilon\)` (la componente aleatoria del modelo no determinístico) de media nula. -- El **.bg-red_light[sesgo]** será por tanto lo que nos **.bg-red_light[equivocamos/desviamos de forma sistemática]** y la **.bg-green_light[varianza]** del modelo será la **.bg-green_light[dispersión entre las predicciones]** de un mismo valor, como si repitieramos el modelo con distintas muestras aleatorias obtenidas de la misma población. --- # Sobreajuste. .green[SESGO] vs .orange[VARIANZA] <div class="figure" style="text-align: center"> <img src="./img/bias_variance.jpg" alt="Extraída de https://scott.fortmann-roe.com/docs/BiasVariance.html" width="40%" /> <p class="caption">Extraída de https://scott.fortmann-roe.com/docs/BiasVariance.html</p> </div> --- # Sobreajuste. .green[SESGO] vs .orange[VARIANZA] .pull-left[ * **.bg-red_light[Bajoajuste (underfitting)]**: modelos **muy simples** proporcionan un **.bg-red_light[sesgo muy grande]**, y poca varianza ya que la predicción siempre será muy parecida (errores altos en train). * **.bg-green_light[Sobreajuste (overfitting)]**: modelos **muy complicados** proporcionan un **.bg-green_light[sesgo bajo]** pero al ser tan complejas proporcionarán una **.bg-green_light[mayor varianza]** para cada intento (errores altos en test). ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/bias_varianc_tradeoff.jpg" alt="Extraída de https://mlu-explain.github.io/bias-variance/" width="99%" /> <p class="caption">Extraída de https://mlu-explain.github.io/bias-variance/</p> </div> Lo deseable será encontrar ese **.bg-purple_light[punto óptimo de equilibrio]** en el que el error será mínimo. ] --- # Sobreajuste. .green[SESGO] vs .orange[VARIANZA] .pull-left[ <div class="figure" style="text-align: center"> <img src="./img/train_test_underfitting.jpg" alt="Extraída de https://mlu-explain.github.io/bias-variance/" width="99%" /> <p class="caption">Extraída de https://mlu-explain.github.io/bias-variance/</p> </div> ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/simple_model.jpg" alt="Extraída de https://mlu-explain.github.io/bias-variance/" width="99%" /> <p class="caption">Extraída de https://mlu-explain.github.io/bias-variance/</p> </div> ] --- # Sobreajuste. .green[SESGO] vs .orange[VARIANZA] .pull-left[ <div class="figure" style="text-align: center"> <img src="./img/train_test_overfitting.jpg" alt="Extraída de https://mlu-explain.github.io/bias-variance/" width="99%" /> <p class="caption">Extraída de https://mlu-explain.github.io/bias-variance/</p> </div> ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/complex_model.jpg" alt="Extraída de https://mlu-explain.github.io/bias-variance/" width="99%" /> <p class="caption">Extraída de https://mlu-explain.github.io/bias-variance/</p> </div> ] --- # Sobreajuste. .green[SESGO] vs .orange[VARIANZA] <div class="figure" style="text-align: center"> <img src="./img/overfitting.jpg" alt="Extraída de https://365datascience.com/tutorials/machine-learning-tutorials/overfitting-underfitting/" width="60%" /> <p class="caption">Extraída de https://365datascience.com/tutorials/machine-learning-tutorials/overfitting-underfitting/</p> </div> Un **.bg-purple_light[modelo muy simple no captura los patrones]** subyancetes en los datos mientras que un **.bg-purple_light[modelo muy complejo solo memoriza]**, no aprende. --- # Sobreajuste. .green[SESGO] vs .orange[VARIANZA] <img src="./img/meme_overfitting.jpg" width="45%" style="display: block; margin: auto;" /> --- # .green[SUPERVISADO] vs .orange[NO SUPERVISADO] <img src="./img/non_supervised.jpg" width="47%" style="display: block; margin: auto;" /> --- # .green[SUPERVISADO] vs .orange[NO SUPERVISADO] .pull-left[ * **.bg-purple_light[Aprendizaje supervisado]**: tendremos dos tipos de variables, la **.bg-orange[variable dependiente (output/target)]** que se quiere predecir/clasificar (con su valor conocido en el conjunto de entrenamiento) y las **.bg-orange[variables independientes (inputs)]** o variables explicativas, que contienen la información disponible. Todo lo que veremos en esta asignatura entra dentro de la idea de **aprendizaje supervisado** ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/esquema_supervised.jpg" alt="Extraída de https://realpython.com/knn-python/basics-of-machine-learning" width="110%" /> <p class="caption">Extraída de https://realpython.com/knn-python/basics-of-machine-learning</p> </div> ] --- # .green[SUPERVISADO] vs .orange[NO SUPERVISADO] .pull-left[ * **.bg-purple_light[Aprendizaje no supervisado]**: no existe la distinción entre target y variables explicativas ya que **.bg-orange[no tenemos etiquetados los datos]**, no sabemos a priori la respuesta correcta. El aprendizaje no supervisado buscará **.bg-orange[similitudes/diferencias]**. ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/esquema_nonsupervised.jpg" alt="Extraída de https://realpython.com/knn-python/basics-of-machine-learning" width="110%" /> <p class="caption">Extraída de https://realpython.com/knn-python/basics-of-machine-learning</p> </div> ] --- # .green[CLASIFICACIÓN] vs .orange[PREDICCIÓN] Dos opciones dependiendo de la **.bg-purple_light[naturaleza de la variable objetivo]** (output/target): * **.bg-purple_light[Predicción]**: la variable objetivo es una variable **.bg-purple_light[cuantitativa continua]** (por ejemplo, precio, glucosa, etc), y la etiqueta del conjunto de entrenamiento tomará un **valor continuo**, a partir de una (unidimensional) o varias variables (multidimensional). * **.bg-purple_light[Clasificación]**: la variable objetivo es una variable **.bg-purple_light[cualitativa]** (por ejemplo, especie de flor, ausencia/presencia de enfermedad, si/no, etc) o **.bg-purple_light[cuantitativa discreta]** (por ejemplo, número de accidentes). La etiqueta tomará un valor dentro del conjunto de **modalidades permitidas**, pudiendo ser binaria (si/no) o multiclase (A, B, C, D). De aquí en adelante `\(Y\)` será nuestra variable objetivo (cdentro de un rango o de un grupo de modalidades `\(G = \left\lbrace 1, 2, \ldots,k \right\rbrace\)`), y el conjunto `\(\left(X_1, \ldots, X_p \right)\)` serán las variables predictoras. 📚 Ver «The elements of Statistical Learning» (Hastie et al., 2008): <https://github.com/dadosdelaplace/teaching/blob/main/data_mining/biblio/datamining_hastieetal_2008.pdf> --- name: data-mining # .orange[DATA MINING]: ¿qué es? No hay una definición única o formal pero podemos ayudarnos de las definiciones dadas por algunos de los máximos gigantes tecnológicos. -- Según **.bg-purple_light[IBM]**... > La minería de datos es una forma innovadora de obtener información comercial valiosa mediante el análisis de los datos contenidos en la base de datos de la empresa (IBM) -- Según **.bg-purple_light[Microsoft]**... > La minería de datos es el proceso de detectar información procesable de grandes conjuntos de datos para deducir los patrones y tendencias que existen. Normalmente, estos patrones no se pueden detectar mediante la exploración tradicional de los datos porque las relaciones son demasiado complejas o hay demasiados datos (Microsoft) --- # .orange[DATA MINING]: ¿qué es? .pull-left[ La minería de datos tiene como objetivo **.bg-purple_light[descubrir patrones]** de forma automática o semiautomática, patrones que a simple vista (o con estadística básica) no podemos aflorar, bien por contar con **.bg-orange[grandes conjuntos de datos]**, bien por existir **.bg-green_light[relaciones muy complejas]**. No solo comprende la exploración y el modelado, sino también la **.bg-purple_light[evaluación]** y la **.bg-purple_light[transformación de la información]** para su uso posterior. ] .pull-right[ <div class="figure" style="text-align: left"> <img src="./img/proceso-mineria-de-datos.png.webp" alt="Extraída de https://www.masterdatascienceucm.com" width="90%" /> <p class="caption">Extraída de https://www.masterdatascienceucm.com</p> </div> El **gran tamaño muestral** suele hacer inviable la aplicación de técnicas de inferencia clásica (problemas de potencia). ] --- # .orange[DATA MINING]: ejemplos de uso * **.bg-purple_light[Clasificación de vuelos]**: usando, entre otras, variables de tráfico de aereo, tipología de vuelo, variables meteorológicas, las aerolíneas pueden calcular la probabilidad de retraso en un vuelo. * **.bg-purple_light[Marketing y ventas]**: conocer el perfil de público objetivo para enfocar campañas personalizadas, en función de patrones en su comportamiento, y predecir futuras bajas. * **.bg-purple_light[Minería de textos]**: extracción de patrones en textos para clasificar, por ejemplo, noticias (detección de Fake News). * **.bg-purple_light[Supermercados]**: pueden analizar el conjunto de compras masivas que hacen sus clientes, para identificar asociaciones de productos o las ofertas que mejor han funcionado. * **.bg-purple_light[Predicción de enfermedades]**: haciendo uso de diferente variables médicas y de hábitos de salud se puede predecir la probabilidad de aparición de ciertas enfermedades, así como encontrar factores explicativos que nos puedan ayudar a su prevención. --- # Metodología .orange[SEMMA] Existen distintas metodologías/esquemas dentro de la minería de datos como la CRISP-DM (desarrollada por IBM) la **.bg-purple_light[metodología SEMMA]** (desarrollada por SAS), que usaremos parcialmente en esta asignatura. En esta metodología SEMMA no siempre intervienen todas las fases del proceso y, además, las fases pueden repetirse y el orden de las mismas modificarse. .pull-left[ * **.bg-purple_light[SAMPLE (muestreo)]**: amén de las particiones train-validate-train, si la base de datos es demasiado grande, será necesario tomar una **.bg-purple_light[submuestra representativa]** para poder ser procesada computacionalmente. ] .pull-right[ <img src="./img/SEMMA.JPG" width="82%" style="display: block; margin: auto auto auto 0;" /> ] --- # Metodología .orange[SEMMA] En esta metodología SEMMA no siempre intervienen todas las fases del proceso y, además, las fases pueden repetirse y el orden de las mismas modificarse. .pull-left[ * **.bg-purple_light[EXPLORE (explorar)]**: antes de tomar decisiones deberemos **.bg-purple_light[explorar, visualizar y entender]** los datos que tenemos, para poder detectar posibles tendencias, inconsistencias, datos ausentes o anomalías. ] .pull-right[ <img src="./img/SEMMA.JPG" width="95%" style="display: block; margin: auto auto auto 0;" /> ] --- # Metodología .orange[SEMMA] En esta metodología SEMMA no siempre intervienen todas las fases del proceso y, además, las fases pueden repetirse y el orden de las mismas modificarse. .pull-left[ * **.bg-purple_light[MODIFY (modificar)]**: para preparar los datos de forma adecuada a los modelos, a veces es necesario realizar una **.bg-purple_light[transformación]** previa de los mismos. ] .pull-right[ <img src="./img/SEMMA.JPG" width="95%" style="display: block; margin: auto auto auto 0;" /> ] --- # Metodología .orange[SEMMA] En esta metodología SEMMA no siempre intervienen todas las fases del proceso y, además, las fases pueden repetirse y el orden de las mismas modificarse. .pull-left[ * **.bg-purple_light[MODEL (modelizar)]**: aplicación de los **.bg-purple_light[modelos y técnicas estadísticas]** en el conjunto del entrenamiento para predecir la variable objetivo (regresión, knn, árboles de decisión, redes neuronales, etc). ] .pull-right[ <img src="./img/SEMMA.JPG" width="95%" style="display: block; margin: auto auto auto 0;" /> ] --- # Metodología .orange[SEMMA] En esta metodología SEMMA no siempre intervienen todas las fases del proceso y, además, las fases pueden repetirse y el orden de las mismas modificarse. .pull-left[ * **.bg-purple_light[ASSESS (evaluar)]**: comprobar y **.bg-purple_light[evaluar nuestras decisiones]** para decidir los mejores parámetros haciendo uso del conjunto de validación. Es habitual tener que volver a la fase de modelización, para plantear correcciones en el modelado. Finalmente, al final del camino, se proveerá de la calidad del modelo en el conjunto test. ] .pull-right[ <img src="./img/SEMMA.JPG" width="95%" style="display: block; margin: auto auto auto 0;" /> ] --- name: sample # Primera fase SEMMA: .orange[MUESTREO] Como hemos comentado, **.bg-purple_light[ANTES]** de las posibles particiones train-validación-test que necesitemos, si la base de datos es **.bg-purple_light[demasiado grande]**, será necesario tomar una **.bg-purple_light[submuestra]** (representativa) para poder ser procesada de forma eficiente. -- .pull-left[ * **.bg-purple_light[No aleatorio]** (por cuotas) en base a **.bg-orange[condiciones]** sobre los registros (`filter()`) * **.bg-purple_light[No aleatorio]** (intencional/discreccional) en base a **.bg-orange[posición]** (`slice`) * **.bg-purple_light[Aleatorio]** **.bg-orange[simple]** (`slice_sample()`) * **.bg-purple_light[Aleatorio]** **.bg-orange[estratificado]** (`group_by()` + `slice_sample()`) ] .pull-right[ <img src="./img/sample.jpg" width="99%" style="display: block; margin: auto auto auto 0;" /> ] 📚 Ver otros tipos de muestreo <https://www.unir.net/ingenieria/revista/tipos-de-muestreo/> --- # Introducción a .orange[TIDYVERSE] .pull-left[ <img src="./img/tidyverrse_universe.jpg" width="89%" style="display: block; margin: auto;" /> También tenemos los paquetes `{purrr}` y `{lubridate}` para el manejo de **listas** y **fechas**, `{readxl}` para importar archivos **.xls y .xlsx**, `{haven}` para importar archivos **SPSS, Stata y SAS**, `{httr}` para importar **desde web** y `{rvest}` para **web scraping**. ] .pull-right[ * `{tibble}`: **.bg-purple_light[optimizando data.frame]**. * `{tidyr}`: **.bg-purple_light[limpiar datos]**. * `{readr}`: **.bg-purple_light[carga rápida]** de datos rectangulares (formatos .csv, .tsv, etc). * `{dplyr}`: gramática para **.bg-purple_light[depuración de datos]** para facilitar su procesamiento. * `{stringr}`: manejo de **.bg-purple_light[textos]**. * `{forcast}` manejo de **.bg-purple_light[cualitativas]**. * `{ggplot2}`: una gramática para la **.bg-purple_light[visualización de datos]**. * `{tidymodels}`: una gramática para la **.bg-purple_light[modelización y predicción]**. ] Puedes ver su **documentación completa** en <https://www.tidyverse.org/>. --- # Introducción a .orange[TIDYVERSE] <div class="figure" style="text-align: center"> <img src="./img/dplyr.png" alt="Cheet sheet de las opciones del paquete dplyr" width="60%" /> <p class="caption">Cheet sheet de las opciones del paquete dplyr</p> </div> El paquete vamos a usar para **.bg-purple_light[depurar y muestrear los datos]** será el paquete `{dplyr}`, una gramática para la manipulación de datos. --- # No aleatorio por condiciones: .orange[FILTER] El conocido como **.bg-purple_light[muestreo no aleatorio por cuotas]** se basa en seleccionar (filtrar) individuos (registros) concretos que cumplan condiciones concretas. .pull-left[ ```r datos %>% filtro(condicion) ``` ] .pull-right[ ```r starwars %>% filter(condicion) ``` ] -- Comparadores habituales: * `==, !=` igual/distinto que * `>, <` mayor/menor que * `>=, <=` mayor/menor o igual que * `%in%` los valores pertenecen a un listado * `!is.na()` los valores no son ausentes (mejor usar `drop_na()`) * `between(variable, val1, val2)`: si los valores (normalmente continuos) están dentro de un rango. --- # No aleatorio por condiciones: .orange[FILTER] .pull-left[ ```r datos %>% filtro(condicion) ``` ] .pull-right[ ```r starwars %>% filter(condicion) ``` ] <div class="figure" style="text-align: center"> <img src="./img/tablas_verdad.jpg" alt="Tablas de verdad de operadores lógicos" width="80%" /> <p class="caption">Tablas de verdad de operadores lógicos</p> </div> --- # No aleatorio por condiciones: .orange[FILTER] Dicha función `filter()` también la usaremos cuando queramos **.bg-purple_light[depurar los datos]** en nuestra fase exploratoria. .pull-left[ ```r datos %>% filtro(condicion) ``` ] .pull-right[ ```r starwars %>% filter(condicion) ``` ] -- Por ejemplo, vamos a **filtrar** aquellos personajes con **.bg-purple_light[ojos marrones]**. ```r starwars %>% * filter(eye_color == "brown") ``` ``` > # A tibble: 21 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 2 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 3 Han Solo 180 80 brown fair brown 29 male mascu… Corell… > 4 Yoda 66 17 white green brown 896 male mascu… <NA> > 5 Boba Fett 183 78.2 black fair brown 31.5 male mascu… Kamino > 6 Lando Calr… 177 79 black dark brown 31 male mascu… Socorro > 7 Arvel Cryn… NA NA brown fair brown NA male mascu… <NA> > 8 Wicket Sys… 88 20 brown brown brown 8 male mascu… Endor > 9 Quarsh Pan… 183 NA black dark brown 62 <NA> <NA> Naboo > 10 Shmi Skywa… 163 NA black fair brown 72 fema… femin… Tatooi… > # … with 11 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # .orange[VISUALIZAR] operaciones con datos En la web <https://tidydatatutor.com/> podemos visualizar el flujo de datos d las transformaciones que podemos hacer con `dplyr` <div class="figure" style="text-align: center"> <img src="./img/filter1.jpg" alt="Flujo de https://tidydatatutor.com/" width="90%" /> <p class="caption">Flujo de https://tidydatatutor.com/</p> </div> ] --- # No aleatorio por condiciones: .orange[FILTER] De la misma manera podemos **filtrar** los personajes que **.bg-purple_light[no tienen ojos marrones]** (en realidad estamos eliminando filas de alguna manera). ```r starwars %>% filter(eye_color != "brown") ``` ``` > # A tibble: 66 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywa… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 C-3PO 167 75 <NA> gold yellow 112 none mascu… Tatooi… > 3 R2-D2 96 32 <NA> white,… red 33 none mascu… Naboo > 4 Darth Vader 202 136 none white yellow 41.9 male mascu… Tatooi… > 5 Owen Lars 178 120 brown,… light blue 52 male mascu… Tatooi… > 6 Beru White… 165 75 brown light blue 47 fema… femin… Tatooi… > 7 R5-D4 97 32 <NA> white,… red NA none mascu… Tatooi… > 8 Obi-Wan Ke… 182 77 auburn… fair blue-g… 57 male mascu… Stewjon > 9 Anakin Sky… 188 84 blond fair blue 41.9 male mascu… Tatooi… > 10 Wilhuff Ta… 180 NA auburn… fair blue 64 male mascu… Eriadu > # … with 56 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # No aleatorio por condiciones: .orange[FILTER] Al ser una variable discreta, sería bastante lógico comprobar si toma algún valor **.bg-purple_light[dentro de una lista permitida]** (por ejemplo, personjes con ojos marrones o azules). ```r starwars %>% filter(eye_color %in% c("brown", "blue")) ``` ``` > # A tibble: 40 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywa… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 3 Owen Lars 178 120 brown,… light blue 52 male mascu… Tatooi… > 4 Beru White… 165 75 brown light blue 47 fema… femin… Tatooi… > 5 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 6 Anakin Sky… 188 84 blond fair blue 41.9 male mascu… Tatooi… > 7 Wilhuff Ta… 180 NA auburn… fair blue 64 male mascu… Eriadu > 8 Chewbacca 228 112 brown unknown blue 200 male mascu… Kashyy… > 9 Han Solo 180 80 brown fair brown 29 male mascu… Corell… > 10 Jek Tono P… 180 110 brown fair blue NA male mascu… Bestin… > # … with 30 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # No aleatorio por condiciones: .orange[FILTER] Cuando es una variable continua el interés podría estar en comprobar si la variable toma valores **.bg-purple_light[dentro de un intervalo continuo]**. .pull-left[ ```r starwars %>% filter(between(height, 120, 160)) ``` ``` > # A tibble: 5 × 4 > name height mass eye_color > <chr> <int> <dbl> <chr> > 1 Leia Organa 150 49 brown > 2 Mon Mothma 150 NA blue > 3 Nien Nunb 160 68 black > 4 Watto 137 NA yellow > 5 Gasgano 122 NA black ``` ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/filter3.jpg" alt="Flujo de https://tidydatatutor.com/" width="160%" /> <p class="caption">Flujo de https://tidydatatutor.com/</p> </div> ] --- # No aleatorio por condiciones: .orange[FILTER] Las condiciones también se pueden **.bg-purple_light[concatenar]**, pudiendo en pocas líneas realizar un filtro complejo. Por ejemplo, podemos filtrar los personajes con **.bg-purple_light[ojos marrones Y ADEMÁS NO humanos]**, o **.bg-purple_light[con más de 60 años]**. .pull-left[ ```r starwars %>% filter((eye_color == "brown" & species != "Human") | birth_year > 60) ``` ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/filter5.jpg" alt="Flujo de https://tidydatatutor.com/" width="100%" /> <p class="caption">Flujo de https://tidydatatutor.com/</p> </div> ] --- # Ejercicios (filter) .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 1**: selecciona del conjunto de `starwars` solo los personajes que sean humanos (`species == "Human"`) * 📝 **Ejercicio 2**: selecciona del conjunto de `starwars` solo los personajes cuyo peso esté entre 65 y 90 kg. * 📝 **Ejercicio 3**: selecciona del conjunto de `starwars` los personajes con ojos marrones o rojos. * 📝 **Ejercicio 4**: selecciona del conjunto de `starwars` los personajes no humanos, hombres y que midan más de 170 cm, o los personajes con ojos marrones o rojos. * 📝 **Ejercicio 5**: selecciona aquellos personajes de `starwars` que hayan pilotado más de 2 naves. ] .panel[.panel-name[Sol. Ej. 1] ```r starwars %>% filter(species == "Human") ``` ``` > # A tibble: 35 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywa… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 Darth Vader 202 136 none white yellow 41.9 male mascu… Tatooi… > 3 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 4 Owen Lars 178 120 brown,… light blue 52 male mascu… Tatooi… > 5 Beru White… 165 75 brown light blue 47 fema… femin… Tatooi… > 6 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 7 Obi-Wan Ke… 182 77 auburn… fair blue-g… 57 male mascu… Stewjon > 8 Anakin Sky… 188 84 blond fair blue 41.9 male mascu… Tatooi… > 9 Wilhuff Ta… 180 NA auburn… fair blue 64 male mascu… Eriadu > 10 Han Solo 180 80 brown fair brown 29 male mascu… Corell… > # … with 25 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` ] .panel[.panel-name[Sol. Ej. 2] ```r starwars %>% filter(between(mass, 65, 90)) ``` ``` > # A tibble: 32 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywa… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 C-3PO 167 75 <NA> gold yellow 112 none mascu… Tatooi… > 3 Beru White… 165 75 brown light blue 47 fema… femin… Tatooi… > 4 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 5 Obi-Wan Ke… 182 77 auburn… fair blue-g… 57 male mascu… Stewjon > 6 Anakin Sky… 188 84 blond fair blue 41.9 male mascu… Tatooi… > 7 Han Solo 180 80 brown fair brown 29 male mascu… Corell… > 8 Greedo 173 74 <NA> green black 44 male mascu… Rodia > 9 Wedge Anti… 170 77 brown fair hazel 21 male mascu… Corell… > 10 Palpatine 170 75 grey pale yellow 82 male mascu… Naboo > # … with 22 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` ] .panel[.panel-name[Sol. Ej. 3] ```r starwars %>% filter(eye_color %in% c("brown", "red")) ``` ``` > # A tibble: 26 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 R2-D2 96 32 <NA> white,… red 33 none mascu… Naboo > 2 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 3 R5-D4 97 32 <NA> white,… red NA none mascu… Tatooi… > 4 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 5 Han Solo 180 80 brown fair brown 29 male mascu… Corell… > 6 Yoda 66 17 white green brown 896 male mascu… <NA> > 7 Boba Fett 183 78.2 black fair brown 31.5 male mascu… Kamino > 8 IG-88 200 140 none metal red 15 none mascu… <NA> > 9 Bossk 190 113 none green red 53 male mascu… Trando… > 10 Lando Calr… 177 79 black dark brown 31 male mascu… Socorro > # … with 16 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` ] .panel[.panel-name[Sol. Ej. 4] ```r starwars %>% filter((species != "Human" & sex == "Male" & height > 170) | eye_color %in% c("brown", "red")) ``` ``` > # A tibble: 26 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 R2-D2 96 32 <NA> white,… red 33 none mascu… Naboo > 2 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 3 R5-D4 97 32 <NA> white,… red NA none mascu… Tatooi… > 4 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 5 Han Solo 180 80 brown fair brown 29 male mascu… Corell… > 6 Yoda 66 17 white green brown 896 male mascu… <NA> > 7 Boba Fett 183 78.2 black fair brown 31.5 male mascu… Kamino > 8 IG-88 200 140 none metal red 15 none mascu… <NA> > 9 Bossk 190 113 none green red 53 male mascu… Trando… > 10 Lando Calr… 177 79 black dark brown 31 male mascu… Socorro > # … with 16 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` ] .panel[.panel-name[Sol. Ej. 5] ```r library(purrr) # ya está en tidyverse per por si starwars$n_starships <- starwars$starships %>% map_int(length) starwars %>% filter(n_starships > 2) ``` ``` > # A tibble: 3 × 15 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Obi-Wan Ken… 182 77 auburn… fair blue-g… 57 male mascu… Stewjon > 2 Anakin Skyw… 188 84 blond fair blue 41.9 male mascu… Tatooi… > 3 Padmé Amida… 165 45 brown light brown 46 fema… femin… Naboo > # … with 5 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, n_starships <int>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` ] ] --- # Ejercicio extra Veamos un ejercicio extra para comprobar la **potencia y flexibilidad** de `{tidyverse}`, pudiendo hacer muchas cosas en dos líneas de código. * 📝 **Ejercicio extra**: selecciona aquellos personajes de `starwars` que hayan salido en la película de la saga "El ataque de los clones" (en inglés, "Attack of the Clones"). Busca información de la función `str_detect()` del paquete `stringr`. Consejo: prueba antes las funciones que vayas a usar con algún vector de prueba para poder comprobar su funcionamiento. --- # No aleatorio por posición: .orange[SLICE] El conocido como **.bg-purple_light[muestreo no aleatorio intencional o discreccional]** se basa en seleccionar (filtrar) individuos (registros) concretos por su posición, elementos «a dedo». .pull-left[ ```r datos %>% rebanada(posicion) ``` ] .pull-right[ ```r starwars %>% slice(posicion) ``` ] -- Normalmente filtraremos registros por alguna condición pero a veces nos puede interesar, por ejemplo, sacar las primeras n filas. Para podemos crear **.bg-purple_light[rebanadas de los datos]**, seleccionando filas por su posición con `slice()`. ```r *starwars %>% slice(1) ``` ``` > # A tibble: 1 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywal… 172 77 blond fair blue 19 male mascu… Tatooi… > # … with 4 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, and abbreviated variable names ¹hair_color, ²skin_color, > # ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` --- # No aleatorio por posición: .orange[SLICE] .pull-left[ ```r datos %>% rebanada(posicion) ``` ] .pull-right[ ```r starwars %>% slice(posicion) ``` ] Recuerda que todo lo que podemos hacer con un número (vector de longitud 1) podemos hacerlo con un vector de índices, así que podemos **.bg-purple_light[extraer varias rebanadas]**, a la vez. ```r # filas de la 1 a la 5 starwars %>% slice(1:5) ``` ``` > # A tibble: 5 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywal… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 C-3PO 167 75 <NA> gold yellow 112 none mascu… Tatooi… > 3 R2-D2 96 32 <NA> white,… red 33 none mascu… Naboo > 4 Darth Vader 202 136 none white yellow 41.9 male mascu… Tatooi… > 5 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > # … with 4 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, and abbreviated variable names ¹hair_color, ²skin_color, > # ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` --- # No aleatorio por posición: .orange[SLICE] También podríamos usar una **.bg-purple_light[secuencia de índices]** a extraer. ```r # filas 1, 2, 10, 13, 27 starwars %>% slice(c(1, 2, 10, 13, 27)) ``` ``` > # A tibble: 5 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywal… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 C-3PO 167 75 <NA> gold yellow 112 none mascu… Tatooi… > 3 Obi-Wan Ken… 182 77 auburn… fair blue-g… 57 male mascu… Stewjon > 4 Chewbacca 228 112 brown unknown blue 200 male mascu… Kashyy… > 5 Mon Mothma 150 NA auburn fair blue 48 fema… femin… Chandr… > # … with 4 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, and abbreviated variable names ¹hair_color, ²skin_color, > # ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` --- # No aleatorio por posición: .orange[SLICE] Disponemos además de opciones por defecto de operaciones habituales * `slice_head(n = ...)`: extraer las n **.bg-purple_light[primeras filas]**. ```r # las 2 primeras filas starwars %>% slice_head(n = 2) ``` ``` > # A tibble: 2 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywal… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 C-3PO 167 75 <NA> gold yellow 112 none mascu… Tatooi… > # … with 4 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, and abbreviated variable names ¹hair_color, ²skin_color, > # ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` --- # No aleatorio por posición: .orange[SLICE] * `slice_tail(n = ...)`: extraer las n **.bg-purple_light[últimas filas]**. ```r # los 3 últimas filas starwars %>% slice_tail(n = 3) ``` ``` > # A tibble: 3 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 BB8 NA NA none none black NA none mascu… <NA> > 2 Captain Pha… NA NA unknown unknown unknown NA <NA> <NA> <NA> > 3 Padmé Amida… 165 45 brown light brown 46 fema… femin… Naboo > # … with 4 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, and abbreviated variable names ¹hair_color, ²skin_color, > # ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` --- # No aleatorio por posición: .orange[SLICE] * `slice_min(var, n = ...)` y `slice_max(var, n = ...)`: extrae las n filas con **.bg-purple_light[menor/mayor de una variable]** (si hay empate, mostrará todas salvo que `with_ties = FALSE`). .pull-left[ ```r # los 3 más bajitos starwars %>% slice_min(height, n = 3) ``` ``` > # A tibble: 3 × 4 > name height mass hair_color > <chr> <int> <dbl> <chr> > 1 Yoda 66 17 white > 2 Ratts Tyerell 79 15 none > 3 Wicket Systri Warrick 88 20 brown ``` ] .pull-right[ ```r # los 3 más pesados starwars %>% slice_max(mass, n = 3) ``` ``` > # A tibble: 3 × 4 > name height mass hair_color > <chr> <int> <dbl> <chr> > 1 Jabba Desilijic Tiure 175 1358 <NA> > 2 Grievous 216 159 none > 3 IG-88 200 140 none ``` ] --- # Ejercicios (slice) .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 1**: selecciona solo los personajes que sean humanos y de ojos marrones. * 📝 **Ejercicio 2**: selecciona los 3 personajes más mayores. * 📝 **Ejercicio 3**: selecciona los 5 personajes más bajitos. ] .panel[.panel-name[Sol. Ej. 1] ```r # Podemos combinar varias acciones en pocas líneas starwars %>% filter(eye_color == "brown", species == "Human") ``` ``` > # A tibble: 17 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 2 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 3 Han Solo 180 80 brown fair brown 29 male mascu… Corell… > 4 Boba Fett 183 78.2 black fair brown 31.5 male mascu… Kamino > 5 Lando Calr… 177 79 black dark brown 31 male mascu… Socorro > 6 Arvel Cryn… NA NA brown fair brown NA male mascu… <NA> > 7 Shmi Skywa… 163 NA black fair brown 72 fema… femin… Tatooi… > 8 Mace Windu 188 84 none dark brown 72 male mascu… Haruun… > 9 Gregar Typ… 185 85 black dark brown NA male mascu… Naboo > 10 Cordé 157 NA brown light brown NA fema… femin… Naboo > 11 Dormé 165 NA brown light brown NA fema… femin… Naboo > 12 Dooku 193 80 white fair brown 102 male mascu… Serenno > 13 Bail Prest… 191 NA black tan brown 67 male mascu… Aldera… > 14 Jango Fett 183 79 black tan brown 66 male mascu… Concor… > 15 Raymus Ant… 188 79 brown light brown NA male mascu… Aldera… > 16 Poe Dameron NA NA brown light brown NA male mascu… <NA> > 17 Padmé Amid… 165 45 brown light brown 46 fema… femin… Naboo > # … with 4 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, and abbreviated variable names ¹hair_color, ²skin_color, > # ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` ] .panel[.panel-name[Sol. Ej. 2] ```r starwars %>% slice_max(birth_year, n = 3) ``` ``` > # A tibble: 3 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Yoda 66 17 white green brown 896 male mascu… <NA> > 2 Jabba Desil… 175 1358 <NA> green-… orange 600 herm… mascu… Nal Hu… > 3 Chewbacca 228 112 brown unknown blue 200 male mascu… Kashyy… > # … with 4 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, and abbreviated variable names ¹hair_color, ²skin_color, > # ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` ] .panel[.panel-name[Sol. Ej. 3] ```r starwars %>% slice_min(height, n = 5) ``` ``` > # A tibble: 6 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Yoda 66 17 white green brown 896 male mascu… <NA> > 2 Ratts Tyere… 79 15 none grey, … unknown NA male mascu… Aleen … > 3 Wicket Syst… 88 20 brown brown brown 8 male mascu… Endor > 4 Dud Bolt 94 45 none blue, … yellow NA male mascu… Vulpter > 5 R2-D2 96 32 <NA> white,… red 33 none mascu… Naboo > 6 R4-P17 96 NA none silver… red, b… NA none femin… <NA> > # … with 4 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, and abbreviated variable names ¹hair_color, ²skin_color, > # ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` ] ] --- # Ejercicio extra Veamos un ejercicio extra para comprobar la **potencia y flexibilidad** de `{tidyverse}`, pudiendo hacer muchas cosas en dos líneas de código. * 📝 **Ejercicio extra**: de los personajes que son humanos y miden más de 160 cm, selecciona los 5 más altos, y orden de mayor a menor peso. Devuelve la tabla. --- # Aleatorio simple: .orange[SLICE_SAMPLE] El conocido como **.bg-purple_light[muestreo aleatorio simple]** se basa en seleccionar individuos aleatoriamente, de forma que cada uno tenga las mismas probabilidades de ser seleccionado. .pull-left[ ```r datos %>% rebanada_aleatoria(n, probabilidades) ``` ] .pull-right[ ```r starwars %>% slice_sample(n = ..., weight_by = ..., replace = ...) ``` ] -- Con`slice_sample(n = ...)` podemos extraer n **.bg-purple_light[registros aleatoriamente]** (a priori equiprobables). ```r # 3 registros aleatorios starwars %>% slice_sample(n = 3) ``` ``` > # A tibble: 3 × 14 > name height mass hair_c…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Gasgano 122 NA none white,… black NA male mascu… Troiken > 2 Saesee Tiin 188 NA none pale orange NA male mascu… Iktotch > 3 Kit Fisto 196 87 none green black NA male mascu… Glee A… > # … with 4 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, and abbreviated variable names ¹hair_color, ²skin_color, > # ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` --- # Aleatorio simple: .orange[SLICE_SAMPLE] También podremos indicarle la **.bg-purple_light[proporción]** de datos a samplear (en lugar del número) y si queremos que sea con **.bg-purple_light[reemplazamiento]** (que se puedan repetir). ```r # 5% de registros aleatorios starwars %>% slice_sample(prop = 0.05, replace = TRUE) ``` ``` > # A tibble: 4 × 14 > name height mass hair_co…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Chewbacca 228 112 brown unknown blue 200 male mascu… Kashyy… > 2 Jango Fett 183 79 black tan brown 66 male mascu… Concor… > 3 Chewbacca 228 112 brown unknown blue 200 male mascu… Kashyy… > 4 Sly Moore 178 48 none pale white NA <NA> <NA> Umbara > # … with 4 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, and abbreviated variable names ¹hair_color, ²skin_color, > # ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` --- # Aleatorio simple: .orange[SLICE_SAMPLE] En `slice_sample()` podemos pasar un **.bg-purple_light[vector de probabilidades]** (no equiprobable). Vamos a forzar que sea muy improbable sacar una fila que no sean las dos primeras ```r starwars %>% slice_sample(n = 2, weight_by = c(0.495, 0.495, rep(0.01/85, 85))) ``` ``` > # A tibble: 2 × 9 > name height mass hair_color skin_color eye_c…¹ birth…² sex gender > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> > 1 Luke Skywalker 172 77 blond fair blue 19 male mascu… > 2 C-3PO 167 75 <NA> gold yellow 112 none mascu… > # … with abbreviated variable names ¹eye_color, ²birth_year ``` ```r starwars %>% slice_sample(n = 2, weight_by = c(0.495, 0.495, rep(0.01/85, 85))) ``` ``` > # A tibble: 2 × 9 > name height mass hair_color skin_color eye_c…¹ birth…² sex gender > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> > 1 Luke Skywalker 172 77 blond fair blue 19 male mascu… > 2 C-3PO 167 75 <NA> gold yellow 112 none mascu… > # … with abbreviated variable names ¹eye_color, ²birth_year ``` --- # Aleatorio .orange[ESTRATIFICADO] El conocido como **.bg-purple_light[muestreo aleatorio estratificado]** se basa en seleccionar (filtrar) individuos (registros) de forma que la seleccióna sea **.bg-purple_light[aleatoria PERO en diferentes estratos]**: crearemos grupos, de forma que **.bg-purple_light[muestreemos un porcentaje similar]** en cada estrato. -- Para ello, antes del muestreo, usaremos una opción muy potente de tidyverse: con `group_by()` no modificaremos los datos sino **.bg-purple_light[modificaremos la acción posterior]**, realizándose en paralelo en cada grupo o estrato. .pull-left[ ```r datos %>% agrupar(var_grupo1, var_grupo2, ...) %>% rebanada_aleatoria(n, probabilidades) %>% desagrupar() ``` ] .pull-right[ ```r starwars %>% group_by(var_grupo1, var_grupo2, ...) %>% slice_sample(n = ..., weight_by = ...) %>% ungroup() ``` ] --- # Aleatorio .orange[ESTRATIFICADO] Cuando apliquemos `group_by()` es importante entender que **.bg-purple_light[NO MODIFICA los datos]**: nos crea una variable de grupo que **.bg-purple_light[modificará las acciones futuras]** que apliquemos, generando una especie de generar **múltiples subtablas**, y las operaciones aplicadas después se **.bg-purple_light[aplicarán a cada una por separado]**. --- # Aleatorio .orange[ESTRATIFICADO] .pull-left[ Por ejemplo, imagina que queremos saber el **.bg-purple_light[número de registros por sexo]**: primero **.bg-purple_light[agruparemos]** por la variable `sex`, y después aplicaremos el **.bg-purple_light[conteo]** con `count()` (realiza la acción pedida en cada subtabla). ```r starwars %>% * group_by(sex) %>% count() %>% * ungroup() ``` ``` > # A tibble: 5 × 2 > sex n > <chr> <int> > 1 female 16 > 2 hermaphroditic 1 > 3 male 60 > 4 none 6 > 5 <NA> 4 ``` **IMPORTANTE**: siempre que agrupes, acuérdate de desagrupar con `ungroup()`. ] .pull-right[ <img src="./img/count_group_1.jpg" width="45%" style="display: block; margin: auto;" /> <div class="figure" style="text-align: center"> <img src="./img/count_group_2.jpg" alt="Flujo de https://tidydatatutor.com/" width="95%" /> <p class="caption">Flujo de https://tidydatatutor.com/</p> </div> ] --- # Aleatorio .orange[ESTRATIFICADO] .pull-left[ Podemos **.bg-purple_light[agrupar por variables]**, por ejemplo vamos a agrupar por `sex` y `gender`, y después aplicaremos `count()` (realiza la acción en cada subtabla). ```r starwars %>% * group_by(sex, gender) %>% count() %>% * ungroup() ``` ``` > # A tibble: 6 × 3 > sex gender n > <chr> <chr> <int> > 1 female feminine 16 > 2 hermaphroditic masculine 1 > 3 male masculine 60 > 4 none feminine 1 > 5 none masculine 5 > 6 <NA> <NA> 4 ``` **IMPORTANTE**: siempre que agrupes, acuérdate de desagrupar con `ungroup()`. ] .pull-right[ <img src="./img/group_1.jpg" width="150%" style="display: block; margin: auto;" /> <div class="figure" style="text-align: center"> <img src="./img/group_count.jpg" alt="Flujo de https://tidydatatutor.com/" width="150%" /> <p class="caption">Flujo de https://tidydatatutor.com/</p> </div> ] --- # Aleatorio .orange[ESTRATIFICADO] El **.bg-purple_light[muestreo aleatorio estratificado]** lo podremos realizar con un `slice_sample()` pero antes aplicando un `group_by()` para **.bg-purple_light[seleccionar por estratos]**. ¿Cómo **.bg-purple_light[muestrear el 50%]** pero tener la **.bg-purple_light[misma proporción de hombres que de mujeres]** que en los datos originales? -- Para el ejemplo, filtraremos solo los hombres y mujeres (76 registros) ```r starwars %>% filter(sex %in% c("female", "male")) ``` --- # Aleatorio .orange[ESTRATIFICADO] ¿Cómo **.bg-purple_light[muestrear el 50%]** pero tener la **.bg-purple_light[misma proporción de hombres que de mujeres]** que en los datos originales? Fíjate que tenemos 38 filas (el 50% de los 76 registros, redondeando hacia abajo) pero... ```r starwars %>% filter(sex %in% c("female", "male")) %>% * group_by(sex) %>% slice_sample(prop = 0.5) %>% ungroup() ``` ``` > # A tibble: 38 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Shaak Ti 178 57 none red, b… black NA fema… femin… Shili > 2 Taun We 213 NA none grey black NA fema… femin… Kamino > 3 Shmi Skywa… 163 NA black fair brown 72 fema… femin… Tatooi… > 4 Zam Wesell 168 55 blonde fair, … yellow NA fema… femin… Zolan > 5 Rey NA NA brown light hazel NA fema… femin… <NA> > 6 Mon Mothma 150 NA auburn fair blue 48 fema… femin… Chandr… > 7 Beru White… 165 75 brown light blue 47 fema… femin… Tatooi… > 8 Luminara U… 170 56.2 black yellow blue 58 fema… femin… Mirial > 9 Poggle the… 183 80 none green yellow NA male mascu… Geonos… > 10 Arvel Cryn… NA NA brown fair brown NA male mascu… <NA> > # … with 28 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # Aleatorio .orange[ESTRATIFICADO] Fíjate que seguimos teniendo 38 filas (el 50% de los 76 registros, redondeando hacia abajo) pero... .pull-left[ ```r starwars %>% filter(sex %in% c("female", "male")) %>% * group_by(sex) %>% slice_sample(prop = 0.5) %>% ungroup() %>% count(sex) ``` ``` > # A tibble: 2 × 2 > sex n > <chr> <int> > 1 female 8 > 2 male 30 ``` ] .pull-right[ ```r starwars %>% filter(sex %in% c("female", "male")) %>% count(sex) ``` ``` > # A tibble: 2 × 2 > sex n > <chr> <int> > 1 female 16 > 2 male 60 ``` ] ...**.bg-purple_light[asegurando una proporción similar]** de hombres que de mujeres que en la muestra original --- # .orange[CONTAR]: group_by() + count() Aunque lo veremos de nuevo en exploración y depuración, hemos visto ya como **.bg-purple_light[generar el resumen estadístico]** más sencillo: **.bg-purple_light[contar (frecuencias)]** .pull-left[ ```r datos %>% contar(var1, var2) ``` ] .pull-right[ ```r starwars %>% count(var1, var2) ``` ] -- Cuando lo usamos en solitario, `count()` nos devolverá simplemente el **.bg-purple_light[número de registros]** ```r starwars %>% count() ``` ``` > # A tibble: 1 × 1 > n > <int> > 1 87 ``` --- # .orange[CONTAR]: group_by() + count() Sin embargo, cuando lo usamos pasándole como **.bg-purple_light[argumento una o varias variables]**, `count()` nos cuenta lo que se conoce en estadística como **.bg-purple_light[frecuencias absolutas]**: el número de elementos pertenecientes a cada una de las **modalidades**. En nuestro caso, la variable `sex` tiene 4 modalidades: `female, hermaphroditic, male, none`. ```r *starwars %>% count(sex) ``` ``` > # A tibble: 5 × 2 > sex n > <chr> <int> > 1 female 16 > 2 hermaphroditic 1 > 3 male 60 > 4 none 6 > 5 <NA> 4 ``` --- # .orange[CONTAR]: group_by() + count() Además si pasamos **.bg-purple_light[varias variables]** nos calcula una **.bg-purple_light[tabla de contigencia]** con las frecuencias absolutas n-dimensionales ```r starwars %>% count(sex, gender) ``` ``` > # A tibble: 6 × 3 > sex gender n > <chr> <chr> <int> > 1 female feminine 16 > 2 hermaphroditic masculine 1 > 3 male masculine 60 > 4 none feminine 1 > 5 none masculine 5 > 6 <NA> <NA> 4 ``` --- # .orange[CONTAR]: group_by() + count() Además dentro del `count()` podemos añadir `sort = TRUE`, que nos devolverá el conteo de frecuencias con los **.bg-purple_light[elementos más frecuentes primero]** (sin necesidad de añadir un `arrange()` a la tabla de conteo generada). ```r starwars %>% count(sex, sort = TRUE) ``` ``` > # A tibble: 5 × 2 > sex n > <chr> <int> > 1 male 60 > 2 female 16 > 3 none 6 > 4 <NA> 4 > 5 hermaphroditic 1 ``` --- # Ejercicios (group_by() + count()) .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 1**: calcula cuántos personajes hay de cada especie de `starwars` haciendo uso de `group_by()` y `count()`. Determina el número de especies distintas. * 📝 **Ejercicio 2**: calcula cuántos personajes hay de cada sexo y género. * 📝 **Ejercicio 3**: tras eliminar ausentes en `birth_year`, obtén la edad mínima y máxima por sexo. * 📝 **Ejercicio 4**: obtén el personaje más viejo por cada sexo. * 📝 **Ejercicio 5**: selecciona aleatoriamente el 60% de los registros de `starwars` pero manteniendo el reparto original entre humanos y no humanos (recuerda limpiar antes de ausentes, con `filter()` o `drop_na()`) * 📝 **Ejercicio 6**: selecciona aleatoriamente un personaje de cada sexo. ] .panel[.panel-name[Sol. Ej. 1] ```r starwars %>% group_by(species) %>% count() %>% ungroup() ``` ``` > # A tibble: 38 × 2 > species n > <chr> <int> > 1 Aleena 1 > 2 Besalisk 1 > 3 Cerean 1 > 4 Chagrian 1 > 5 Clawdite 1 > 6 Droid 6 > 7 Dug 1 > 8 Ewok 1 > 9 Geonosian 1 > 10 Gungan 3 > # … with 28 more rows > # ℹ Use `print(n = ...)` to see more rows ``` ```r starwars %>% group_by(species) %>% count() %>% ungroup() %>% nrow() ``` ``` > [1] 38 ``` ] .panel[.panel-name[Sol. Ej. 2] ```r starwars %>% count(sex, gender) ``` ``` > # A tibble: 6 × 3 > sex gender n > <chr> <chr> <int> > 1 female feminine 16 > 2 hermaphroditic masculine 1 > 3 male masculine 60 > 4 none feminine 1 > 5 none masculine 5 > 6 <NA> <NA> 4 ``` ```r starwars %>% group_by(sex, gender) %>% count() %>% ungroup() ``` ``` > # A tibble: 6 × 3 > sex gender n > <chr> <chr> <int> > 1 female feminine 16 > 2 hermaphroditic masculine 1 > 3 male masculine 60 > 4 none feminine 1 > 5 none masculine 5 > 6 <NA> <NA> 4 ``` ] .panel[.panel-name[Sol. Ej. 3] ```r starwars %>% drop_na(birth_year) %>% group_by(sex) %>% slice_min(n = 1, birth_year) %>% ungroup() ``` ``` > # A tibble: 5 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 2 Jabba Desil… 175 1358 <NA> green-… orange 600 herm… mascu… Nal Hu… > 3 Wicket Syst… 88 20 brown brown brown 8 male mascu… Endor > 4 IG-88 200 140 none metal red 15 none mascu… <NA> > 5 Quarsh Pana… 183 NA black dark brown 62 <NA> <NA> Naboo > # … with 4 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, and abbreviated variable names ¹hair_color, ²skin_color, > # ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` ```r starwars %>% drop_na(birth_year) %>% group_by(sex) %>% slice_max(n = 1, birth_year) %>% ungroup() ``` ``` > # A tibble: 5 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Shmi Skywal… 163 NA black fair brown 72 fema… femin… Tatooi… > 2 Jabba Desil… 175 1358 <NA> green-… orange 600 herm… mascu… Nal Hu… > 3 Yoda 66 17 white green brown 896 male mascu… <NA> > 4 C-3PO 167 75 <NA> gold yellow 112 none mascu… Tatooi… > 5 Quarsh Pana… 183 NA black dark brown 62 <NA> <NA> Naboo > # … with 4 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, and abbreviated variable names ¹hair_color, ²skin_color, > # ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` ] .panel[.panel-name[Sol. Ej. 4] ```r starwars %>% group_by(sex) %>% slice_max(n = 1, birth_year) %>% ungroup() ``` ``` > # A tibble: 5 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Shmi Skywal… 163 NA black fair brown 72 fema… femin… Tatooi… > 2 Jabba Desil… 175 1358 <NA> green-… orange 600 herm… mascu… Nal Hu… > 3 Yoda 66 17 white green brown 896 male mascu… <NA> > 4 C-3PO 167 75 <NA> gold yellow 112 none mascu… Tatooi… > 5 Quarsh Pana… 183 NA black dark brown 62 <NA> <NA> Naboo > # … with 4 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, and abbreviated variable names ¹hair_color, ²skin_color, > # ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` ] .panel[.panel-name[Sol. Ej. 5] ```r starwars %>% drop_na(species) %>% group_by(species == "Human") %>% slice_sample(prop = 0.6) %>% ungroup() ``` ``` > # A tibble: 49 × 15 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 R2-D2 96 32 <NA> white,… red 33 none mascu… Naboo > 2 Lama Su 229 88 none grey black NA male mascu… Kamino > 3 Grievous 216 159 none brown,… green,… NA male mascu… Kalee > 4 Yarael Poof 264 NA none white yellow NA male mascu… Quermia > 5 Dud Bolt 94 45 none blue, … yellow NA male mascu… Vulpter > 6 Saesee Tiin 188 NA none pale orange NA male mascu… Iktotch > 7 Tarfful 234 136 brown brown blue NA male mascu… Kashyy… > 8 Bossk 190 113 none green red 53 male mascu… Trando… > 9 Eeth Koth 171 NA black brown brown NA male mascu… Iridon… > 10 San Hill 191 NA none grey gold NA male mascu… Muunil… > # … with 39 more rows, 5 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, `species == "Human"` <lgl>, and > # abbreviated variable names ¹hair_color, ²skin_color, ³eye_color, > # ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` ] .panel[.panel-name[Sol. Ej. 6] ```r starwars %>% group_by(sex) %>% slice_sample(n = 1) %>% ungroup() ``` ``` > # A tibble: 5 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Beru Whites… 165 75 brown light blue 47 fema… femin… Tatooi… > 2 Jabba Desil… 175 1358 <NA> green-… orange 600 herm… mascu… Nal Hu… > 3 Mas Amedda 196 NA none blue blue NA male mascu… Champa… > 4 R4-P17 96 NA none silver… red, b… NA none femin… <NA> > 5 Sly Moore 178 48 none pale white NA <NA> <NA> Umbara > # … with 4 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, and abbreviated variable names ¹hair_color, ²skin_color, > # ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` ] ] --- # Ejercicio extra * 📝 **Ejercicio extra** - Carga la tabla `billboard` del paquete `{tidyr}`. - Convierte el dataset a tidydata, ausentes incluidos (deberías obtener 5307 filas y 5 columnas). - Extrae la lista de artistas distintos que aparecen en la tabla. - Determina el artista que aparece más veces en la lista. - Determina el arista y canción que ha estado más semanas en la lista. - Realiza un muestreo extrayendo solo los registros de Enrique Iglesias y The Backstreet Boys. - Realiza un muestreo extrayendo los 5 artistas cuya canción haya estado más veces en el top5. - Realiza un muestreo aleatorio estratificado, extrayendo el 60% de los datos manteniendo la proporción de datos entre las distintas semanas. --- class: inverse center middle name: clase-5 # CLASE 5: primer algoritmo de clasificación (knn) ### [Depuración tidyverse](#preproc) ### [Introducción a la clasificación supervisada](#sup-class) ### [Clasificador Bayesiano](#bayes) ### [knn: algoritmo de los k-vecinos más cercanos](#knn) --- name: preproc # .orange[ELIMINAR] duplicados: distinct() Otra opción es **.bg-purple_light[eliminar filas duplicadas]** con `distinct()`, pasándole como argumentos las variables. Por defecto, solo extrae las columnas en base a las cuales hemos eliminado duplicados. Si queremos que nos **mantenga todas** deberemos explicitarlo con `.keep_all = TRUE`. .pull-left[ ```r # Elimina filas con igual (color_pelo, color_ojos) starwars %>% distinct(hair_color, eye_color) ``` ``` > # A tibble: 35 × 2 > hair_color eye_color > <chr> <chr> > 1 blond blue > 2 <NA> yellow > 3 <NA> red > 4 none yellow > 5 brown brown > 6 brown, grey blue > 7 brown blue > 8 black brown > 9 auburn, white blue-gray > 10 auburn, grey blue > # … with 25 more rows > # ℹ Use `print(n = ...)` to see more rows ``` ] .pull-left[ ```r # Elimina filas con igual (color_pelo, color_ojos) starwars %>% distinct(hair_color, eye_color, .keep_all = TRUE) ``` ``` > # A tibble: 35 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywa… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 C-3PO 167 75 <NA> gold yellow 112 none mascu… Tatooi… > 3 R2-D2 96 32 <NA> white,… red 33 none mascu… Naboo > 4 Darth Vader 202 136 none white yellow 41.9 male mascu… Tatooi… > 5 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 6 Owen Lars 178 120 brown,… light blue 52 male mascu… Tatooi… > 7 Beru White… 165 75 brown light blue 47 fema… femin… Tatooi… > 8 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 9 Obi-Wan Ke… 182 77 auburn… fair blue-g… 57 male mascu… Stewjon > 10 Wilhuff Ta… 180 NA auburn… fair blue 64 male mascu… Eriadu > # … with 25 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` ] --- # .orange[SELECCIONAR] columnas: select() .pull-left[ ```r datos %>% selecciono(col1, col2, ...) ``` ] .pull-right[ ```r starwars %>% select(col1, col2, ...) ``` ] -- La opción más sencilla para **.bg-purple_light[seleccionar variables]** es `select()`, dando como argumentos los nombres de columnas. Por ejemplo, vamos a seleccionar las variables `names` y `hair_color` ```r starwars %>% * select(name, hair_color) ``` ``` > # A tibble: 87 × 2 > name hair_color > <chr> <chr> > 1 Luke Skywalker blond > 2 C-3PO <NA> > 3 R2-D2 <NA> > 4 Darth Vader none > 5 Leia Organa brown > 6 Owen Lars brown, grey > 7 Beru Whitesun lars brown > 8 R5-D4 <NA> > 9 Biggs Darklighter black > 10 Obi-Wan Kenobi auburn, white > # … with 77 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # .orange[SELECCIONAR] columnas: select() .pull-left[ ```r starwars %>% select(name, hair_color) ``` ``` > # A tibble: 87 × 2 > name hair_color > <chr> <chr> > 1 Luke Skywalker blond > 2 C-3PO <NA> > 3 R2-D2 <NA> > 4 Darth Vader none > 5 Leia Organa brown > 6 Owen Lars brown, grey > 7 Beru Whitesun lars brown > 8 R5-D4 <NA> > 9 Biggs Darklighter black > 10 Obi-Wan Kenobi auburn, white > # … with 77 more rows > # ℹ Use `print(n = ...)` to see more rows ``` ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/select1.jpg" alt="Flujo de https://tidydatatutor.com/" width="140%" /> <p class="caption">Flujo de https://tidydatatutor.com/</p> </div> ] --- # .orange[SELECCIONAR] columnas: select() Como sucedía al filtrar, la función `select()` es bastante versatil y nos permite: * Seleccionar **.bg-purple_light[varias variables a la vez]** (concatenando sus nombres). ```r starwars %>% select(name:skin_color) ``` ``` > # A tibble: 87 × 5 > name height mass hair_color skin_color > <chr> <int> <dbl> <chr> <chr> > 1 Luke Skywalker 172 77 blond fair > 2 C-3PO 167 75 <NA> gold > 3 R2-D2 96 32 <NA> white, blue > 4 Darth Vader 202 136 none white > 5 Leia Organa 150 49 brown light > 6 Owen Lars 178 120 brown, grey light > 7 Beru Whitesun lars 165 75 brown light > 8 R5-D4 97 32 <NA> white, red > 9 Biggs Darklighter 183 84 black light > 10 Obi-Wan Kenobi 182 77 auburn, white fair > # … with 77 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # .orange[SELECCIONAR] columnas: select() * **.bg-purple_light[Deseleccionar]** columnas con `-` ```r starwars %>% select(-c(mass:eye_color), -species, -c(films:starships)) ``` ``` > # A tibble: 87 × 6 > name height birth_year sex gender homeworld > <chr> <int> <dbl> <chr> <chr> <chr> > 1 Luke Skywalker 172 19 male masculine Tatooine > 2 C-3PO 167 112 none masculine Tatooine > 3 R2-D2 96 33 none masculine Naboo > 4 Darth Vader 202 41.9 male masculine Tatooine > 5 Leia Organa 150 19 female feminine Alderaan > 6 Owen Lars 178 52 male masculine Tatooine > 7 Beru Whitesun lars 165 47 female feminine Tatooine > 8 R5-D4 97 NA none masculine Tatooine > 9 Biggs Darklighter 183 24 male masculine Tatooine > 10 Obi-Wan Kenobi 182 57 male masculine Stewjon > # … with 77 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # .orange[SELECCIONAR] columnas: select() * Seleccionar columnas que **.bg-purple_light[comiencen por un prefijo]** (`starts_with()`), **.bg-purple_light[terminen]** con un sufijo (`ends_with()`), **.bg-purple_light[contengan]** un texto (`contains()`) o cumplan una **.bg-purple_light[expresión regular]** (`matches()`) ```r # nombre acaba en "color" starwars %>% select(ends_with("color")) ``` ``` > # A tibble: 87 × 3 > hair_color skin_color eye_color > <chr> <chr> <chr> > 1 blond fair blue > 2 <NA> gold yellow > 3 <NA> white, blue red > 4 none white yellow > 5 brown light brown > 6 brown, grey light blue > 7 brown light blue > 8 <NA> white, red red > 9 black light brown > 10 auburn, white fair blue-gray > # … with 77 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # .orange[SELECCIONAR] columnas: select() * Seleccionar columnas que **.bg-purple_light[comiencen por un prefijo]** (`starts_with()`), **.bg-purple_light[terminen]** con un sufijo (`ends_with()`), **.bg-purple_light[contengan]** un texto (`contains()`) o cumplan una **.bg-purple_light[expresión regular]** (`matches()`) ```r # empiezan por new_sp who %>% select(country, year, starts_with("new_sp")) ``` ``` > # A tibble: 7,240 × 16 > country year new_s…¹ new_s…² new_s…³ new_s…⁴ new_s…⁵ new_s…⁶ new_s…⁷ new_s…⁸ > <chr> <int> <int> <int> <int> <int> <int> <int> <int> <int> > 1 Afghan… 1980 NA NA NA NA NA NA NA NA > 2 Afghan… 1981 NA NA NA NA NA NA NA NA > 3 Afghan… 1982 NA NA NA NA NA NA NA NA > 4 Afghan… 1983 NA NA NA NA NA NA NA NA > 5 Afghan… 1984 NA NA NA NA NA NA NA NA > 6 Afghan… 1985 NA NA NA NA NA NA NA NA > 7 Afghan… 1986 NA NA NA NA NA NA NA NA > 8 Afghan… 1987 NA NA NA NA NA NA NA NA > 9 Afghan… 1988 NA NA NA NA NA NA NA NA > 10 Afghan… 1989 NA NA NA NA NA NA NA NA > # … with 7,230 more rows, 6 more variables: new_sp_f1524 <int>, > # new_sp_f2534 <int>, new_sp_f3544 <int>, new_sp_f4554 <int>, > # new_sp_f5564 <int>, new_sp_f65 <int>, and abbreviated variable names > # ¹new_sp_m014, ²new_sp_m1524, ³new_sp_m2534, ⁴new_sp_m3544, ⁵new_sp_m4554, > # ⁶new_sp_m5564, ⁷new_sp_m65, ⁸new_sp_f014 > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # .orange[SELECCIONAR] columnas: select() * Seleccionar columnas que **.bg-purple_light[comiencen por un prefijo]** (`starts_with()`), **.bg-purple_light[terminen]** con un sufijo (`ends_with()`), **.bg-purple_light[contengan]** un texto (`contains()`) o cumplan una **.bg-purple_light[expresión regular]** (`matches()`) ```r tb <- tibble("edad" = c(30, 35, 40), "color_ojos" = c("azul", "amarillo", "negro"), "pelo_color" = c("negro", "marrón", "rubio")) tb %>% select(contains("color")) ``` ``` > # A tibble: 3 × 2 > color_ojos pelo_color > <chr> <chr> > 1 azul negro > 2 amarillo marrón > 3 negro rubio ``` --- # .orange[SELECCIONAR] columnas: select() Incluso podemos seleccionar por rango numérico si tenemos variables conun prefijo y números. ```r billboard %>% select(num_range("wk", 10:15)) ``` ``` > # A tibble: 317 × 6 > wk10 wk11 wk12 wk13 wk14 wk15 > <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> > 1 NA NA NA NA NA NA > 2 NA NA NA NA NA NA > 3 51 51 51 47 44 38 > 4 61 61 59 61 66 72 > 5 57 64 70 75 76 78 > 6 6 7 22 29 36 47 > 7 NA NA NA NA NA NA > 8 36 37 37 38 49 61 > 9 10 9 8 6 1 2 > 10 59 66 68 61 67 59 > # … with 307 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # .orange[SELECCIONAR] columnas: select() * Seleccionar columnas de un **.bg-purple_light[tipo]** haciendo uso de `where()`. ```r # Solo columnas numéricas o de trexto starwars %>% select(where(is.numeric) | where(is.character)) ``` ``` > # A tibble: 87 × 11 > height mass birth_year name hair_…¹ skin_…² eye_c…³ sex gender homew…⁴ > <int> <dbl> <dbl> <chr> <chr> <chr> <chr> <chr> <chr> <chr> > 1 172 77 19 Luke Sk… blond fair blue male mascu… Tatooi… > 2 167 75 112 C-3PO <NA> gold yellow none mascu… Tatooi… > 3 96 32 33 R2-D2 <NA> white,… red none mascu… Naboo > 4 202 136 41.9 Darth V… none white yellow male mascu… Tatooi… > 5 150 49 19 Leia Or… brown light brown fema… femin… Aldera… > 6 178 120 52 Owen La… brown,… light blue male mascu… Tatooi… > 7 165 75 47 Beru Wh… brown light blue fema… femin… Tatooi… > 8 97 32 NA R5-D4 <NA> white,… red none mascu… Tatooi… > 9 183 84 24 Biggs D… black light brown male mascu… Tatooi… > 10 182 77 57 Obi-Wan… auburn… fair blue-g… male mascu… Stewjon > # … with 77 more rows, 1 more variable: species <chr>, and abbreviated variable > # names ¹hair_color, ²skin_color, ³eye_color, ⁴homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # .orange[RECOLOCAR] columnas: relocate() Fíjate que con `select()` podrías además **.bg-purple_light[recolocar columnas]**, indícandole el orden, ayudándote también de `everything()` ```r starwars %>% select(c(species, name, birth_year, everything())) ``` ``` > # A tibble: 87 × 14 > species name birth…¹ height mass hair_…² skin_…³ eye_c…⁴ sex gender > <chr> <chr> <dbl> <int> <dbl> <chr> <chr> <chr> <chr> <chr> > 1 Human Luke Skywa… 19 172 77 blond fair blue male mascu… > 2 Droid C-3PO 112 167 75 <NA> gold yellow none mascu… > 3 Droid R2-D2 33 96 32 <NA> white,… red none mascu… > 4 Human Darth Vader 41.9 202 136 none white yellow male mascu… > 5 Human Leia Organa 19 150 49 brown light brown fema… femin… > 6 Human Owen Lars 52 178 120 brown,… light blue male mascu… > 7 Human Beru White… 47 165 75 brown light blue fema… femin… > 8 Droid R5-D4 NA 97 32 <NA> white,… red none mascu… > 9 Human Biggs Dark… 24 183 84 black light brown male mascu… > 10 Human Obi-Wan Ke… 57 182 77 auburn… fair blue-g… male mascu… > # … with 77 more rows, 4 more variables: homeworld <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹birth_year, ²hair_color, ³skin_color, ⁴eye_color > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # .orange[RECOLOCAR] columnas: relocate() .pull-left[ ```r datos %>% recolocar(col1, col2, .after = ...) ``` ] .pull-right[ ```r starwars %>% relocate(col1, col2, .after = ...) ``` ] -- Para facilitar la **.bg-purple_light[recolocación]** tenemos una función para ello, `relocate()`, indicándole en `.after` o `.before` detrás o delante de qué columnas queremos moverlas. ```r starwars %>% relocate(species, .before = name) ``` ``` > # A tibble: 87 × 14 > species name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender > <chr> <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> > 1 Human Luke Skywa… 172 77 blond fair blue 19 male mascu… > 2 Droid C-3PO 167 75 <NA> gold yellow 112 none mascu… > 3 Droid R2-D2 96 32 <NA> white,… red 33 none mascu… > 4 Human Darth Vader 202 136 none white yellow 41.9 male mascu… > 5 Human Leia Organa 150 49 brown light brown 19 fema… femin… > 6 Human Owen Lars 178 120 brown,… light blue 52 male mascu… > 7 Human Beru White… 165 75 brown light blue 47 fema… femin… > 8 Droid R5-D4 97 32 <NA> white,… red NA none mascu… > 9 Human Biggs Dark… 183 84 black light brown 24 male mascu… > 10 Human Obi-Wan Ke… 182 77 auburn… fair blue-g… 57 male mascu… > # … with 77 more rows, 4 more variables: homeworld <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # .orange[EXTRAER] columnas: pull() .pull-left[ ```r datos %>% retirar(variable) ``` ] .pull-right[ ```r starwars %>% pull(variable) ``` ] -- .pull-left[ Si observas la salida de los `select()`, sigue siendo una tabla `tibble`, nos preserva la naturaleza de nuestros datos. ```r starwars %>% select(name) ``` ``` > # A tibble: 87 × 1 > name > <chr> > 1 Luke Skywalker > 2 C-3PO > 3 R2-D2 > 4 Darth Vader > 5 Leia Organa > 6 Owen Lars > 7 Beru Whitesun lars > 8 R5-D4 > 9 Biggs Darklighter > 10 Obi-Wan Kenobi > # … with 77 more rows > # ℹ Use `print(n = ...)` to see more rows ``` ] .pull-right[ A veces no querremos dicha estructura sino **.bg-purple_light[extraer literalmente la columna]**, algo que podemos hacer con `pull()` ```r starwars %>% pull(name) ``` ``` > [1] "Luke Skywalker" "C-3PO" "R2-D2" > [4] "Darth Vader" "Leia Organa" "Owen Lars" > [7] "Beru Whitesun lars" "R5-D4" "Biggs Darklighter" > [10] "Obi-Wan Kenobi" "Anakin Skywalker" "Wilhuff Tarkin" > [13] "Chewbacca" "Han Solo" "Greedo" > [16] "Jabba Desilijic Tiure" "Wedge Antilles" "Jek Tono Porkins" > [19] "Yoda" "Palpatine" "Boba Fett" > [22] "IG-88" "Bossk" "Lando Calrissian" > [25] "Lobot" "Ackbar" "Mon Mothma" > [28] "Arvel Crynyd" "Wicket Systri Warrick" "Nien Nunb" > [31] "Qui-Gon Jinn" "Nute Gunray" "Finis Valorum" > [34] "Jar Jar Binks" "Roos Tarpals" "Rugor Nass" > [37] "Ric Olié" "Watto" "Sebulba" > [40] "Quarsh Panaka" "Shmi Skywalker" "Darth Maul" > [43] "Bib Fortuna" "Ayla Secura" "Dud Bolt" > [46] "Gasgano" "Ben Quadinaros" "Mace Windu" > [49] "Ki-Adi-Mundi" "Kit Fisto" "Eeth Koth" > [52] "Adi Gallia" "Saesee Tiin" "Yarael Poof" > [55] "Plo Koon" "Mas Amedda" "Gregar Typho" > [58] "Cordé" "Cliegg Lars" "Poggle the Lesser" > [61] "Luminara Unduli" "Barriss Offee" "Dormé" > [64] "Dooku" "Bail Prestor Organa" "Jango Fett" > [67] "Zam Wesell" "Dexter Jettster" "Lama Su" > [70] "Taun We" "Jocasta Nu" "Ratts Tyerell" > [73] "R4-P17" "Wat Tambor" "San Hill" > [76] "Shaak Ti" "Grievous" "Tarfful" > [79] "Raymus Antilles" "Sly Moore" "Tion Medon" > [82] "Finn" "Rey" "Poe Dameron" > [85] "BB8" "Captain Phasma" "Padmé Amidala" ``` ] --- # .orange[RENOMBRAR] columnas: rename() .pull-left[ ```r datos %>% renombrar(col1, col2) ``` ] .pull-right[ ```r starwars %>% rename(col1, col2) ``` ] -- A veces también podemos querer **modificar la «metainformación»** de los datos, **.bg-purple_light[renombrando columnas]**. Para ello usaremos la función `rename()` poniendo primero el nombre nuevo y luego el antiguo. ```r starwars %>% rename(nombre = name, altura = height, peso = mass) ``` ``` > # A tibble: 87 × 14 > nombre altura peso hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywa… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 C-3PO 167 75 <NA> gold yellow 112 none mascu… Tatooi… > 3 R2-D2 96 32 <NA> white,… red 33 none mascu… Naboo > 4 Darth Vader 202 136 none white yellow 41.9 male mascu… Tatooi… > 5 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 6 Owen Lars 178 120 brown,… light blue 52 male mascu… Tatooi… > 7 Beru White… 165 75 brown light blue 47 fema… femin… Tatooi… > 8 R5-D4 97 32 <NA> white,… red NA none mascu… Tatooi… > 9 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 10 Obi-Wan Ke… 182 77 auburn… fair blue-g… 57 male mascu… Stewjon > # … with 77 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # Ejercicios (columnas) .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 1**: filtra el conjunto de personajes y quédate solo con aquellos que en la variable `height` no tengan un dato ausente. * 📝 **Ejercicio 2**: con los datos obtenidos del filtro anterior, selecciona solo las variables `name`, `height`, así como todas aquellas variables que CONTENGAN la palabra `color` en su nombre. * 📝 **Ejercicio 3**: con los datos obtenidos del ejercicio anterior, traduce el nombre de las columnas a castellano * 📝 **Ejercicio 4**: con los datos obtenidos del ejercicio anterior, coloca la variable de color de pelo justo detrás de la variable de nombres. * 📝 **Ejercicio 5**: con los datos obtenidos del ejercicio, comprueba cuántas modalidades únicas hay en la variable de color de pelo. ] .panel[.panel-name[Sol. Ej. 1] **IMPORTANTE**: todo lo que hagas en la tabla original, si el resultado final no se lo asignas `<-` a otra variable, lo verás en consola pero no se guardará en ningún sitio. Lo que no guardes, no existe. ```r starwars_NA <- starwars %>% drop_na(height) starwars_NA ``` ``` > # A tibble: 81 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywa… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 C-3PO 167 75 <NA> gold yellow 112 none mascu… Tatooi… > 3 R2-D2 96 32 <NA> white,… red 33 none mascu… Naboo > 4 Darth Vader 202 136 none white yellow 41.9 male mascu… Tatooi… > 5 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 6 Owen Lars 178 120 brown,… light blue 52 male mascu… Tatooi… > 7 Beru White… 165 75 brown light blue 47 fema… femin… Tatooi… > 8 R5-D4 97 32 <NA> white,… red NA none mascu… Tatooi… > 9 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 10 Obi-Wan Ke… 182 77 auburn… fair blue-g… 57 male mascu… Stewjon > # … with 71 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` ] .panel[.panel-name[Sol. Ej. 2] ```r starwars %>% drop_na(height) %>% select(c(name, height, contains("color"))) ``` ``` > # A tibble: 81 × 5 > name height hair_color skin_color eye_color > <chr> <int> <chr> <chr> <chr> > 1 Luke Skywalker 172 blond fair blue > 2 C-3PO 167 <NA> gold yellow > 3 R2-D2 96 <NA> white, blue red > 4 Darth Vader 202 none white yellow > 5 Leia Organa 150 brown light brown > 6 Owen Lars 178 brown, grey light blue > 7 Beru Whitesun lars 165 brown light blue > 8 R5-D4 97 <NA> white, red red > 9 Biggs Darklighter 183 black light brown > 10 Obi-Wan Kenobi 182 auburn, white fair blue-gray > # … with 71 more rows > # ℹ Use `print(n = ...)` to see more rows ``` ] .panel[.panel-name[Sol. Ej. 3] ```r starwars %>% drop_na(height) %>% select(c(name, height, contains("color"))) %>% rename(nombre = name, altura = height, color_pelo = hair_color, color_piel = skin_color, color_ojos = eye_color) ``` ``` > # A tibble: 81 × 5 > nombre altura color_pelo color_piel color_ojos > <chr> <int> <chr> <chr> <chr> > 1 Luke Skywalker 172 blond fair blue > 2 C-3PO 167 <NA> gold yellow > 3 R2-D2 96 <NA> white, blue red > 4 Darth Vader 202 none white yellow > 5 Leia Organa 150 brown light brown > 6 Owen Lars 178 brown, grey light blue > 7 Beru Whitesun lars 165 brown light blue > 8 R5-D4 97 <NA> white, red red > 9 Biggs Darklighter 183 black light brown > 10 Obi-Wan Kenobi 182 auburn, white fair blue-gray > # … with 71 more rows > # ℹ Use `print(n = ...)` to see more rows ``` ] .panel[.panel-name[Sol. Ej. 4] ```r starwars %>% drop_na(height) %>% select(c(name, height, contains("color"))) %>% rename(nombre = name, altura = height, color_pelo = hair_color, color_piel = skin_color, color_ojos = eye_color) %>% relocate(color_pelo, .after = nombre) ``` ``` > # A tibble: 81 × 5 > nombre color_pelo altura color_piel color_ojos > <chr> <chr> <int> <chr> <chr> > 1 Luke Skywalker blond 172 fair blue > 2 C-3PO <NA> 167 gold yellow > 3 R2-D2 <NA> 96 white, blue red > 4 Darth Vader none 202 white yellow > 5 Leia Organa brown 150 light brown > 6 Owen Lars brown, grey 178 light blue > 7 Beru Whitesun lars brown 165 light blue > 8 R5-D4 <NA> 97 white, red red > 9 Biggs Darklighter black 183 light brown > 10 Obi-Wan Kenobi auburn, white 182 fair blue-gray > # … with 71 more rows > # ℹ Use `print(n = ...)` to see more rows ``` ] .panel[.panel-name[Sol. Ej. 5] ```r starwars %>% drop_na(height) %>% select(c(name, height, contains("color"))) %>% rename(nombre = name, altura = height, color_pelo = hair_color, color_piel = skin_color, color_ojos = eye_color) %>% relocate(color_pelo, .after = nombre) %>% distinct(color_pelo) ``` ``` > # A tibble: 12 × 1 > color_pelo > <chr> > 1 blond > 2 <NA> > 3 none > 4 brown > 5 brown, grey > 6 black > 7 auburn, white > 8 auburn, grey > 9 white > 10 grey > 11 auburn > 12 blonde ``` **IMPORTANTE**: recuerda que `distinct()` de mantener todas las columnas añadiendo `.keep_all = TRUE`. ] ] --- # Ejercicio extra Veamos un ejercicio extra para comprobar la **potencia y flexibilidad** de `{tidyverse}`, pudiendo hacer muchas cosas en dos líneas de código. * 📝 **Ejercicio extra**: selecciona solo las variables `name` y aquellas que sean de tipo numérico y la variable `homeworld`, y selecciona solo los personajes que no sean humanos y que pesen entre 70 y 90 kg. Tras ello elimina datos ausentes, y elimina duplicados con el mismo valor en `homeworld`. Tras ello, recoloca las variables para que el orden la primera columna sea `name` y la segunda `birth_year`. Para acabar, cambia el nombre a castellano de las variables. --- name: mutate # .orange[MODIFICAR] columnas: mutate() .pull-left[ ```r datos %>% modificar(nueva_var = ...) ``` ] .pull-right[ ```r starwars %>% mutate(nueva_var = ...) ``` ] -- En muchas ocasiones querremos **.bg-purple_light[modificar o crear variables]**. Para ello tenemos la función `mutate()`. Vamos a crear una **nueva variable** `height_m` con la altura en centímetros. ```r # altura en metros starwars %>% * mutate(height_m = height / 100) ``` ``` > # A tibble: 87 × 15 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywa… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 C-3PO 167 75 <NA> gold yellow 112 none mascu… Tatooi… > 3 R2-D2 96 32 <NA> white,… red 33 none mascu… Naboo > 4 Darth Vader 202 136 none white yellow 41.9 male mascu… Tatooi… > 5 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 6 Owen Lars 178 120 brown,… light blue 52 male mascu… Tatooi… > 7 Beru White… 165 75 brown light blue 47 fema… femin… Tatooi… > 8 R5-D4 97 32 <NA> white,… red NA none mascu… Tatooi… > 9 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 10 Obi-Wan Ke… 182 77 auburn… fair blue-g… 57 male mascu… Stewjon > # … with 77 more rows, 5 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, height_m <dbl>, and abbreviated variable > # names ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # .orange[MODIFICAR] columnas: mutate() ```r starwars %>% mutate(height_m = height / 100) ``` <div class="figure" style="text-align: center"> <img src="./img/mutate1.jpg" alt="Flujo de https://tidydatatutor.com/" width="90%" /> <p class="caption">Flujo de https://tidydatatutor.com/</p> </div> --- # .orange[MODIFICAR] columnas: mutate() Otra opción es **.bg-purple_light[quedarnos solo con las modificadas]** (por ejemplo, para ver si hace lo que debe) con `transmute()` ```r starwars %>% * transmute(height_m = height / 100) ``` ``` > # A tibble: 87 × 1 > height_m > <dbl> > 1 1.72 > 2 1.67 > 3 0.96 > 4 2.02 > 5 1.5 > 6 1.78 > 7 1.65 > 8 0.97 > 9 1.83 > 10 1.82 > # … with 77 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # .orange[MODIFICAR] columnas: mutate() También se pueden aplicar **.bg-purple_light[funciones más complejas]** o incluso **.bg-purple_light[funciones propias]** creadas por nosotros mismos (y varias a la vez). ```r calculo_IMC <- function(peso, estatura, unidades = "metros") { estatura <- ifelse(unidades == "metros", estatura, estatura / 100) IMC <- peso / (estatura^2) return(IMC) } ``` --- # .orange[MODIFICAR] columnas: mutate() También se pueden aplicar **.bg-purple_light[funciones más complejas]** o incluso **.bg-purple_light[funciones propias]** creadas por nosotros mismos (y varias a la vez). ```r starwars %>% mutate(IMC = calculo_IMC(mass, height, unidades = "centímetros"), height_m = height / 100) %>% relocate(IMC, height_m, .after = mass) ``` ``` > # A tibble: 87 × 16 > name height mass IMC heigh…¹ hair_…² skin_…³ eye_c…⁴ birth…⁵ sex gender > <chr> <int> <dbl> <dbl> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> > 1 Luke… 172 77 26.0 1.72 blond fair blue 19 male mascu… > 2 C-3PO 167 75 25.4 1.67 <NA> gold yellow 112 none mascu… > 3 R2-D2 96 32 10.8 0.96 <NA> white,… red 33 none mascu… > 4 Dart… 202 136 46.0 2.02 none white yellow 41.9 male mascu… > 5 Leia… 150 49 16.6 1.5 brown light brown 19 fema… femin… > 6 Owen… 178 120 40.6 1.78 brown,… light blue 52 male mascu… > 7 Beru… 165 75 25.4 1.65 brown light blue 47 fema… femin… > 8 R5-D4 97 32 10.8 0.97 <NA> white,… red NA none mascu… > 9 Bigg… 183 84 28.4 1.83 black light brown 24 male mascu… > 10 Obi-… 182 77 26.0 1.82 auburn… fair blue-g… 57 male mascu… > # … with 77 more rows, 5 more variables: homeworld <chr>, species <chr>, > # films <list>, vehicles <list>, starships <list>, and abbreviated variable > # names ¹height_m, ²hair_color, ³skin_color, ⁴eye_color, ⁵birth_year > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # .orange[MODIFICAR] columnas: mutate() También podemos combinarlo con la función `if_else()`, una modificación dentro de `{tidyverse}` para hacer un `if-else` vectorizado, que nos puede ayudar a **.bg-purple_light[recategorizaciones sencillas]**. ```r starwars %>% mutate(human = if_else(species == "Human", "Human", "Not Human")) %>% relocate(human, .after = name) ``` ``` > # A tibble: 87 × 15 > name human height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke… Human 172 77 blond fair blue 19 male mascu… Tatooi… > 2 C-3PO Not … 167 75 <NA> gold yellow 112 none mascu… Tatooi… > 3 R2-D2 Not … 96 32 <NA> white,… red 33 none mascu… Naboo > 4 Dart… Human 202 136 none white yellow 41.9 male mascu… Tatooi… > 5 Leia… Human 150 49 brown light brown 19 fema… femin… Aldera… > 6 Owen… Human 178 120 brown,… light blue 52 male mascu… Tatooi… > 7 Beru… Human 165 75 brown light blue 47 fema… femin… Tatooi… > 8 R5-D4 Not … 97 32 <NA> white,… red NA none mascu… Tatooi… > 9 Bigg… Human 183 84 black light brown 24 male mascu… Tatooi… > 10 Obi-… Human 182 77 auburn… fair blue-g… 57 male mascu… Stewjon > # … with 77 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # .orange[RECATEGORIZAR]: case_when() Para **.bg-purple_light[recategorizaciones más complejas]** tenemos a nuestra disposición `case_when()`. Supongamos por ejemplo que queremos crear una **categoría en función de su altura**. * Si `height > 180` –> serán `"alto"`. * Si `height <= 180` y `height > 120` –> serán `"bajo"` * Si `height <= 120` y `height > 0` –> serán `"enano"` * Si no se cumple lo anterior –> serán `"ausente"` -- ```r starwars %>% mutate(height = case_when(height > 180 ~ "alto", height > 120 ~ "bajo", height > 0 ~ "enano", TRUE ~ "ausente")) ``` ``` > # A tibble: 87 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <chr> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywa… bajo 77 blond fair blue 19 male mascu… Tatooi… > 2 C-3PO bajo 75 <NA> gold yellow 112 none mascu… Tatooi… > 3 R2-D2 enano 32 <NA> white,… red 33 none mascu… Naboo > 4 Darth Vader alto 136 none white yellow 41.9 male mascu… Tatooi… > 5 Leia Organa bajo 49 brown light brown 19 fema… femin… Aldera… > 6 Owen Lars bajo 120 brown,… light blue 52 male mascu… Tatooi… > 7 Beru White… bajo 75 brown light blue 47 fema… femin… Tatooi… > 8 R5-D4 enano 32 <NA> white,… red NA none mascu… Tatooi… > 9 Biggs Dark… alto 84 black light brown 24 male mascu… Tatooi… > 10 Obi-Wan Ke… alto 77 auburn… fair blue-g… 57 male mascu… Stewjon > # … with 77 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # .orange[RECATEGORIZAR]: case_when() Las condiciones de `case_when()` pueden combinar varias variables, cómo por ejemplo: * Si pesan mucho o miden mucho --> `"large"` * Si `species == "Droid"` --> `"robot"` * En caso contrario --> `"other"` ```r starwars %>% mutate(type = case_when(height > 200 | mass > 200 ~ "large", species == "Droid" ~ "robot", TRUE ~ "other")) ``` ``` > # A tibble: 87 × 15 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywa… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 C-3PO 167 75 <NA> gold yellow 112 none mascu… Tatooi… > 3 R2-D2 96 32 <NA> white,… red 33 none mascu… Naboo > 4 Darth Vader 202 136 none white yellow 41.9 male mascu… Tatooi… > 5 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 6 Owen Lars 178 120 brown,… light blue 52 male mascu… Tatooi… > 7 Beru White… 165 75 brown light blue 47 fema… femin… Tatooi… > 8 R5-D4 97 32 <NA> white,… red NA none mascu… Tatooi… > 9 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 10 Obi-Wan Ke… 182 77 auburn… fair blue-g… 57 male mascu… Stewjon > # … with 77 more rows, 5 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, type <chr>, and abbreviated variable > # names ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # Ejercicios (mutate) .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 1**: crea tres nuevas columnas que nos digan el número de películas en las que han salido, el número de vehículos y el número d naves (pero haciendo uso de mutate()). * 📝 **Ejercicio 2**: con las 3 columnas creadas, crea una nueva columna llamada `frequency` que nos ponga `almost_all` en personajes que salen en 5 o más películas, `many` en personajes que salen en más de 2 películas pero en menos de 5 y `some` en personajes que salen 1 o 2 películas. * 📝 **Ejercicio 3**: elimina registros con datos ausentes en la variable `birth_year` y filtra solo los 20 personajes más jóvenes. * 📝 **Ejercicio 4**: selecciona solo las variables numéricas y de tipo texto. Define una nueva variable llamada `under_18` que nos recategorice la variable `birth_year`: `TRUE` si es menor de edad y `FALSE` en caso contrario ] .panel[.panel-name[Sol. Ej. 1] ```r starwars_nueva <- starwars %>% mutate(n_films = films %>% map_int(length), n_vehicles = vehicles %>% map_int(length), n_starships = starships %>% map_int(length)) starwars_nueva ``` ``` > # A tibble: 87 × 17 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywa… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 C-3PO 167 75 <NA> gold yellow 112 none mascu… Tatooi… > 3 R2-D2 96 32 <NA> white,… red 33 none mascu… Naboo > 4 Darth Vader 202 136 none white yellow 41.9 male mascu… Tatooi… > 5 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 6 Owen Lars 178 120 brown,… light blue 52 male mascu… Tatooi… > 7 Beru White… 165 75 brown light blue 47 fema… femin… Tatooi… > 8 R5-D4 97 32 <NA> white,… red NA none mascu… Tatooi… > 9 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 10 Obi-Wan Ke… 182 77 auburn… fair blue-g… 57 male mascu… Stewjon > # … with 77 more rows, 7 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, n_films <int>, n_vehicles <int>, > # n_starships <int>, and abbreviated variable names ¹hair_color, ²skin_color, > # ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` ] .panel[.panel-name[Sol. Ej. 2] ```r starwars_nueva <- starwars_nueva %>% mutate(frequency = case_when(n_films >= 5 ~ "almost_all", n_films > 2 ~ "many", TRUE ~ "some")) starwars_nueva ``` ``` > # A tibble: 87 × 18 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywa… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 C-3PO 167 75 <NA> gold yellow 112 none mascu… Tatooi… > 3 R2-D2 96 32 <NA> white,… red 33 none mascu… Naboo > 4 Darth Vader 202 136 none white yellow 41.9 male mascu… Tatooi… > 5 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 6 Owen Lars 178 120 brown,… light blue 52 male mascu… Tatooi… > 7 Beru White… 165 75 brown light blue 47 fema… femin… Tatooi… > 8 R5-D4 97 32 <NA> white,… red NA none mascu… Tatooi… > 9 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 10 Obi-Wan Ke… 182 77 auburn… fair blue-g… 57 male mascu… Stewjon > # … with 77 more rows, 8 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, n_films <int>, n_vehicles <int>, > # n_starships <int>, frequency <chr>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` ] .panel[.panel-name[Sol. Ej. 3] ```r starwars_nueva <- starwars_nueva %>% drop_na(birth_year) %>% slice_min(n = 20, birth_year) starwars_nueva ``` ``` > # A tibble: 21 × 18 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Wicket Sys… 88 20 brown brown brown 8 male mascu… Endor > 2 IG-88 200 140 none metal red 15 none mascu… <NA> > 3 Luke Skywa… 172 77 blond fair blue 19 male mascu… Tatooi… > 4 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 5 Wedge Anti… 170 77 brown fair hazel 21 male mascu… Corell… > 6 Plo Koon 188 80 none orange black 22 male mascu… Dorin > 7 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 8 Han Solo 180 80 brown fair brown 29 male mascu… Corell… > 9 Lando Calr… 177 79 black dark brown 31 male mascu… Socorro > 10 Boba Fett 183 78.2 black fair brown 31.5 male mascu… Kamino > # … with 11 more rows, 8 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, n_films <int>, n_vehicles <int>, > # n_starships <int>, frequency <chr>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` ] .panel[.panel-name[Sol. Ej. 4] ```r starwars_nueva <- starwars_nueva %>% select(where(is.numeric) | where(is.character)) %>% mutate(under_18 = birth_year < 18) starwars_nueva ``` ``` > # A tibble: 21 × 16 > height mass birth_year n_films n_veh…¹ n_sta…² name hair_…³ skin_…⁴ eye_c…⁵ > <int> <dbl> <dbl> <int> <int> <int> <chr> <chr> <chr> <chr> > 1 88 20 8 1 0 0 Wick… brown brown brown > 2 200 140 15 1 0 0 IG-88 none metal red > 3 172 77 19 5 2 2 Luke… blond fair blue > 4 150 49 19 5 1 0 Leia… brown light brown > 5 170 77 21 3 1 1 Wedg… brown fair hazel > 6 188 80 22 3 0 1 Plo … none orange black > 7 183 84 24 1 0 1 Bigg… black light brown > 8 180 80 29 4 0 2 Han … brown fair brown > 9 177 79 31 2 0 1 Land… black dark brown > 10 183 78.2 31.5 3 0 1 Boba… black fair brown > # … with 11 more rows, 6 more variables: sex <chr>, gender <chr>, > # homeworld <chr>, species <chr>, frequency <chr>, under_18 <lgl>, and > # abbreviated variable names ¹n_vehicles, ²n_starships, ³hair_color, > # ⁴skin_color, ⁵eye_color > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` ] ] --- # Ejercicios (mutate) .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 5**: de la base de datos original, determina el número de modalidades que toma la variable `species` (elimina antes registros con ausente en dicha variable). Después elimina duplicados por dicha variable, dejando el representante más bajito. * 📝 **Ejercicio 6**: sobre la base de datos original, crea una nueva columna llamada `auburn` (cobrizo/caoba) que nos diga `TRUE` si el color de pelo contiene dicha palabra y `FALSE` en caso contrario. * 📝 **Ejercicio 7**: sobre la base de datos original, filtra solo aquellos personajes de la familia `"Skywalker"` o `"Antilles"`, selecciona solo las columnas de `name` y `specie`, y renombra a castellano. ] .panel[.panel-name[Sol. Ej. 5] ```r starwars %>% drop_na(species) %>% distinct(species) ``` ``` > # A tibble: 37 × 1 > species > <chr> > 1 Human > 2 Droid > 3 Wookiee > 4 Rodian > 5 Hutt > 6 Yoda's species > 7 Trandoshan > 8 Mon Calamari > 9 Ewok > 10 Sullustan > # … with 27 more rows > # ℹ Use `print(n = ...)` to see more rows ``` ```r starwars %>% drop_na(species) %>% arrange(height) %>% distinct(species, .keep_all = TRUE) ``` ``` > # A tibble: 37 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Yoda 66 17 white green brown 896 male mascu… <NA> > 2 Ratts Tyer… 79 15 none grey, … unknown NA male mascu… Aleen … > 3 Wicket Sys… 88 20 brown brown brown 8 male mascu… Endor > 4 Dud Bolt 94 45 none blue, … yellow NA male mascu… Vulpter > 5 R2-D2 96 32 <NA> white,… red 33 none mascu… Naboo > 6 Sebulba 112 40 none grey, … orange NA male mascu… Malast… > 7 Gasgano 122 NA none white,… black NA male mascu… Troiken > 8 Watto 137 NA black blue, … yellow NA male mascu… Toydar… > 9 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 10 Nien Nunb 160 68 none grey black NA male mascu… Sullust > # … with 27 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` ] .panel[.panel-name[Sol. Ej. 6] ```r starwars %>% drop_na(hair_color) %>% mutate(auburn = str_detect(hair_color, "auburn")) ``` ``` > # A tibble: 82 × 15 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywa… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 Darth Vader 202 136 none white yellow 41.9 male mascu… Tatooi… > 3 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 4 Owen Lars 178 120 brown,… light blue 52 male mascu… Tatooi… > 5 Beru White… 165 75 brown light blue 47 fema… femin… Tatooi… > 6 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 7 Obi-Wan Ke… 182 77 auburn… fair blue-g… 57 male mascu… Stewjon > 8 Anakin Sky… 188 84 blond fair blue 41.9 male mascu… Tatooi… > 9 Wilhuff Ta… 180 NA auburn… fair blue 64 male mascu… Eriadu > 10 Chewbacca 228 112 brown unknown blue 200 male mascu… Kashyy… > # … with 72 more rows, 5 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, auburn <lgl>, and abbreviated variable > # names ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` ] .panel[.panel-name[Sol. Ej. 6] ```r starwars %>% filter(str_detect(name, "Skywalker") | str_detect(name, "Antilles")) %>% select(name, species) %>% rename(nombre = name, especie = species) ``` ``` > # A tibble: 5 × 2 > nombre especie > <chr> <chr> > 1 Luke Skywalker Human > 2 Anakin Skywalker Human > 3 Wedge Antilles Human > 4 Shmi Skywalker Human > 5 Raymus Antilles Human ``` ] ] --- name: sup-class # Aprendizaje .green[SUPERVISADO] .pull-left[ * **.bg-purple_light[Aprendizaje supervisado]**: tendremos dos tipos de variables, la **.bg-orange[variable dependiente (output/target)]** que se quiere predecir/clasificar (con su valor conocido en el conjunto de entrenamiento) y las **.bg-orange[variables independientes (inputs)]** o variables explicativas, que contienen la información disponible. Todo lo que veremos en esta asignatura entra dentro de la idea de **aprendizaje supervisado** ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/esquema_supervised.jpg" alt="Extraída de https://realpython.com/knn-python/basics-of-machine-learning" width="110%" /> <p class="caption">Extraída de https://realpython.com/knn-python/basics-of-machine-learning</p> </div> ] --- # Fundamentos de la .orange[CLASIFICACIÓN] Como decíamos en diapositivas pasadas, un problema de **.bg-purple_light[clasificación]** constará de los siguientes elementos * Una **.bg-purple_light[variable objetivo]** `\(Y\)` que será **.bg-purple_light[cualitativa]** (o cuantitativa discreta recategorizada). -- * Dicha variable objetivo podrá tomar un **.bg-purple_light[número finito C de categorías]** denotadas como `\(G = \left\lbrace 1, 2, \ldots, C \right\rbrace\)`). -- * El **.bg-purple_light[conjunto de variables predictoras]** será denotada como `\(\left(X_1, \ldots, X_p \right)\)` -- * Nuestros datos formarán una **.bg-purple_light[muestra conjunta]** de tamaño `\(n\)` denotada como `\(\left\lbrace \left(x_{i, 1},...,x_{i, p}, y_i \right) \right\rbrace_{i=1,\ldots,n}\)` -- Si `\(C = 2\)` diremos que es un problema de **.bg-purple_light[clasificación binaria]** 📚 Ver «The elements of Statistical Learning» (Hastie et al., 2008): <https://github.com/dadosdelaplace/teaching/blob/main/data_mining/biblio/datamining_hastieetal_2008.pdf> --- # Objetivo de la .orange[CLASIFICACIÓN] Nuestro **.bg-purple_light[objetivo]** primario (no siempre) será conseguir que la mayor parte de etiquetas predichas `\(\hat{y}_i\)` coincidan con su categoría real `\(y_i\)`, siendo la tasa de bien clasificados una de las métrias más importantes (no la única). * **.bg-purple_light[Accuracy]** (tasa de bien clasificados): del total de datos de tu partición, la **.bg-purple_light[proporción o % de observaciones con una etiqueta correcta]** (al ser supervisado sabemos que está bien y que está mal). `$$ACC = \frac{1}{n} \sum_{i=1}^{n} I(y_i = \hat{y}_i)$$` A veces nos fijaremos en su complementario, la **.bg-purple_light[tasa de mal clasificados]**, siendo esta la proporción de individuos mal clasificados. --- # Métricas de .orange[CLASIFICACIÓN BINARIA] En la mayoría de ocasiones nuestros problemas serán de **.bg-purple_light[clasificación binaria]** (podemos entender las categorías como `\(G = \left\lbrace 0, 1\right\rbrace\)`), ya que todo problema de clasificacón multiclase se puede reducir a un conjunto de problemas binarios. En ese caso tendremos además un **.bg-purple_light[conjunto de métricas]** basadas en los conceptos de falso negativo/positivo y verdadero negativo/positivo * **.bg-purple_light[Verdadero positivo (TP)]**: todos aquellos individuos con clasificación positiva `\(\hat{y}_i = 1\)` y que efectivamente así lo eran `\(y_i = 1\)` * **.bg-purple_light[Falso positivo (FP)]**: todos aquellos individuos con clasificación positiva `\(\hat{y}_i = 1\)` pero que no lo eran `\(y_i = 0\)` -- * **.bg-purple_light[Verdadero negativo (TN)]**: todos aquellos individuos con clasificación negativa `\(\hat{y}_i = 0\)` y que efectivamente así lo eran `\(y_i = 0\)` * **.bg-purple_light[Falso negativo (FN)]**: todos aquellos individuos con clasificación negativa `\(\hat{y}_i = 0\)` pero que no lo eran `\(y_i = 1\)` --- # Métricas de .orange[CLASIFICACIÓN BINARIA] .pull-left[ * **.bg-purple_light[Verdadero positivo (TP)]**: individuos con clasificación positiva `\(\hat{y}_i = 1\)` y que efectivamente así lo eran `\(y_i = 1\)` * **.bg-purple_light[Falso positivo (FP)]**: individuos con clasificación positiva `\(\hat{y}_i = 1\)` pero que no lo eran `\(y_i = 0\)` * **.bg-purple_light[Verdadero negativo (TN)]**: individuos con clasificación negativa `\(\hat{y}_i = 0\)` y que efectivamente así lo eran `\(y_i = 0\)` * **.bg-purple_light[Falso negativo (FN)]**: individuos con clasificación negativa `\(\hat{y}_i = 0\)` pero que no lo eran `\(y_i = 1\)` ] .pull-right[ <div class="figure" style="text-align: left"> <img src="./img/contigency_table.jpg" alt="Tabla extraída de wikipedia" width="80%" /> <p class="caption">Tabla extraída de wikipedia</p> </div> ] En el futuro, en la fase de evaluación (assess) hablaremos de una herramienta conocida como **.bg-purple_light[curva ROC]**. --- # Métricas de .orange[CLASIFICACIÓN BINARIA] En base a dichos conceptos existen otras **.bg-purple_light[métricas habituales]** a tener en cuenta: * **.bg-purple_light[Accuracy (ACC)]**: definida en el caso binario como `\(ACC = \frac{TP + TN}{TP+TN+FP+FN} = \frac{TP + TN}{n}\)` -- * **.bg-purple_light[Sensibilidad (TPR)]**: también conocida como True Positive Rate o **.bg-purple_light[recall]**, es la proporción de positivos reales `\(y_i=1\)` que han sido clasificadas como positivo `\(\hat{y}_i = 1\)`, definida como `\(TPR = \frac{TP}{P}\)` (**.bg-purple_light[probabilidad]** empírica de **.bg-purple_light[detectar correctamente los positivos]**). Su complementario se conoce como **False Negative Rate (FNR)**. -- * **.bg-purple_light[Especificidad (TNR)]**: también conocida como True Negative Rate, es la proporción de negativos reales `\(y_i=0\)` que han sido clasificadas como negativos `\(\hat{y}_i = 0\)`, definida como `\(TNR = \frac{TN}{N}\)` (**.bg-purple_light[probabilidad]** empírica de **.bg-purple_light[detectar correctamente los negativos]**). Su complementario se conoce como **False Positive Rate (FPR)**. Desde lo teórico, ambas son maximizables de forma conjunta al 100% (aunque en la práctica, una mejora en una supondrá un coste en la otra). --- # Métricas de .orange[CLASIFICACIÓN BINARIA] Un ejemplo reciente son las **.bg-purple_light[pruebas de detección de covid]**. En el caso de las pruebas PCR comercializadas en España * la **.bg-purple_light[sensibilidad]** era en torno al 80-90%. ¿Qué implica el 10-20% restante? * la **.bg-purple_light[especificidad]** era en torno al 99%. ¿Qué implica el 1% restante? -- Otras métricas habituales que pueden ayudarnos a tomar decisiones son la **.bg-purple_light[prevalencia]**, definida como `\(P / (P + N)\)` (la proporción de positivos en tu población) y la conocida como **.bg-purple_light[precisión (PPV)]** o Positive Predictive Value, definida como `\(TP / PP\)` (siendo `\(PP\)` los positivos predichos, del total de clasificados como positivos cuantos son verdaderos positivos) 📚 Ver <https://www.aemps.gob.es/la-aemps/ultima-informacion-de-la-aemps-acerca-del-covid%E2%80%9119/informacion-general-sobre-tests-de-diagnostico-de-covid-19/> --- name: bayes # Clasificador .orange[BAYESIANO] Más allá de la comparación que podamos hacer entre distintos métodos, ¿existe **.bg-purple_light[algún clasificador de referencia]** contra el que compararnos? La buena noticia es que sí existe, la mala noticia es que en la mayoría de casos no vamos a poder conocerlo. -- Dicho clasificador se conoce como **.bg-purple_light[clasificador Bayesiano]**, y es el **.bg-purple_light[clasificador óptimo]** en el sentido de que nos devuelve como clase predicha aquella que sea más probable, haciendo uso de la distribución de probabilidad teórica de nuestros datos (algo que normalmente no conoceremos). `$$\hat{y_i} = j \quad \text{si} \quad P(Y = j | X = \left(x_{i,1}, \ldots, x_{i,p} \right) = \max_{g \in G} P(Y = g | X = \left(x_{i,1}, \ldots, x_{i,p} \right)$$` En el **.bg-purple_light[caso binario]**, se asignará la clase 1 si `\(P(Y = 1|X) > 0.5\)`, y la clase 0 en otro caso. --- # Clasificador .orange[BAYESIANO] .pull-left[ Fíjate que el criterio óptimo no es seguramente el perfecto, ni el que mejor tasa de bien clasificados proporcione: es aquel que es capaz de entender los patrones de los datos. El **.bg-purple_light[clasificador Bayesiano solo es posible si conocemos la distribución conjunta]** de probabilidad (algo que por desgracia, no suele ser). ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/bayes_rule.jpg" alt="Hastie et al. (2008)" width="99%" /> <p class="caption">Hastie et al. (2008)</p> </div> ] --- name: knn # Algoritmo .orange[KNN]: k-vecinos más cercanos **.bg-purple_light[Motivación]**: imagina que quieres dedicir si vas al cine para ver o no una película. **.bg-purple_light[¿Qué proceso seguirías?]** -- Parece lógico que el proceso sea **.bg-purple_light[considerar opiniones]** de tu entorno y/o de las críticas que puedas buscar en internet. **.bg-purple_light[¿Qué decisiones tomarías? ¿Cómo «algoritmizarías» el proceso?]** -- 1. **.bg-purple_light[Número de vecinos]**: decidir el número `\(k\)` de opiniones (**.bg-purple_light[k-vecinos]**) que vas a tomar cuenta (no puedes preguntar a todo el mundo ni leer todas las críticas, pero tampoco fiarte de una sola persona). -- 2. **.bg-purple_light[¿Qué es «entorno cercano»?]** Tendremos que decidir quién entra y quién no en nuestro entorno más cercano. ¿Cuál es la definición de cercano? Deberemos definir el **.bg-purple_light[concepto de cercanía con una distancia]** que nos permita decidir los **.bg-purple_light[k-vecinos más cercanos]** -- 3. **.bg-purple_light[Ponderación]**: deberemos por último decidir si **.bg-purple_light[todas las opiniones valen lo mismo o no]**. ¿Vale lo mismo la opinión de alguien muy afín a ti que la de Boyero (crítico de cine)? ¿Te fías igual de todas ellas? Deberemos decidir si estas distancias son **.bg-purple_light[ponderadas]**. --- # Algoritmo .orange[KNN] Tu decisión final será por tanto aquella **.bg-purple_light[opinión mayoritaria (moda)]** de las opiniones de tus **.bg-purple_light[k-vecinos]** **.bg-orange[más cercanos]**, una vez que dichas opiniones han sido o no **.bg-green_light[ponderadas]**: * **.bg-purple_light[Sin poderar]**: para cada individuo, su clasificación será asignada como la **.bg-purple_light[moda de sus k-vecinos]** más cercanos. * **.bg-purple_light[Con ponderación]**: para cada individuo, su clasificación será asignada como la **.bg-purple_light[moda ponderada de sus k-vecinos]** más cercanos, por ejemplo tomando como peso el inverso de la distancia (cuánto más cerca, más pesa). -- Matemáticamente, dado un registro `\(x_i = (x_{i,1},\ldots,x_{i,p})\)`, un número `\(k\)` de vecinos y una métrica `\(d()\)`, la **.bg-purple_light[probabilidad de pertenencia]** de `\(y_i\)` a la **.bg-purple_light[clase j]** será `$$P(y_i = j | X = x_i) = \frac{1}{k} \sum_{l=1}^{k} w_l I(y_l = j)$$` donde `\(x_l\)`, con `\(l=1,...,k\)`, son los k-vecinos más cercanos en función de `\(d()\)` y `\(w_l\)` es el peso de vécino l-ésimo (pudiendo ser todos uno si no ponderamos, o `\(w_l = \frac{1}{d(x_i, x_l)}\)`) --- # Algoritmo .orange[KNN] En el caso de que tengamos un problema de **.bg-purple_light[clasificación binaria]**, el problema será mucho más sencillo. Dado un registro `\(x_i = (x_{i,1},\ldots,x_{i,p})\)`, un número `\(k\)` de vecinos y una métrica `\(d()\)`, la **.bg-purple_light[probabilidad de ser 1]** de `\(y_i\)` será `$$P(y_i = 1 | X = x_i) = \frac{1}{k} \sum_{l=1}^{k} w_l I(y_l = 1)$$` y la **.bg-purple_light[probabilidad de ser 0]** de `\(y_i\)` será `\(P(y_i = 0 | X = x_i) = 1- P(y_i = 1 | X = x_i)\)` (su complementario). La **.bg-purple_light[clase predicha]** será aquella cuya probabilidad sea mayor. --- # Decisiones KNN: .orange[K] vecinos .pull-left[ * **.bg-purple_light[Pocos vecinos]**: regla de decisión extremadamente flexible, creando incluso «islas» de un solo individuo. **.bg-purple_light[Poco sesgo y enorme varianza]** (con un dato nuevo que tuviéramos, ya cambiaría todo). * **.bg-purple_light[Muchos vecinos]**: regla de decisión extremadamente rígida. **.bg-purple_light[Mucho sesgo y poca varianza]** (dado que aunque tengamos inputs nuevos, apenas cambiará) ] .pull-right[ <img src="./img/knn_1.jpg" width="70%" style="display: block; margin: auto auto auto 0;" /> <img src="./img/knn_todos.jpg" width="70%" style="display: block; margin: auto auto auto 0;" /> ] Será por tanto crucial **.bg-purple_light[probar un rango de vecinos lo suficientemente amplio]** como para encontrar lo óptimo. --- # Decisiones KNN: .orange[DISTANCIA] Lo segundo a elegir será la **.bg-purple_light[distancia]** con la que se decidirá qué está **.bg-purple_light[cerca o lejos]**.Cuando tenemos **.bg-purple_light[variables numéricas]** tenemos dos opciones: * **.bg-purple_light[Distancias geométricas]**: miden distancias en un plano/espacio/espacio de dimensión p. * **.bg-purple_light[Distancias probabilísticas]**: miden distancias en base parámetros estadísticos como la media o la desviación típica. --- # Decisiones KNN: .orange[DISTANCIA] En el caso de las **.bg-purple_light[distancias geométricas]** la más habitual es la conocida como **.bg-purple_light[distancia euclídea]**, la que usamos de forma habitual. .pull-left[ En el plano, se define como `$$d(x, y) = \sqrt{(x_1 - y_1)^2 + (x_2 - y_2)^2}$$` En el caso general en el que tengamos `\(p\)` predictoras numéricas se calculará como `$$d(x, y) = \sqrt{\displaystyle \sum_{j=1}^{p} (x_j - y_j)^2}$$` ] .pull-right[ <img src="./img/circulo_distancia_euclidea.jpg" width="80%" style="display: block; margin: auto auto auto 0;" /> Círculo euclídeo: conjunto de puntos a la misma distancia del centro, haciendo uso de la distancia Euclídea (el radio). ] --- # Decisiones KNN: .orange[DISTANCIA] Existen otro tipo de distancias geométricas como la **.bg-purple_light[distancia Manhattan]**, la distancia que usas cuando caminas por la calle (dado que no puedes atravesar manzanas), definida como `$$d(x, y) = \sqrt{\displaystyle \sum_{j=1}^{p} |x_j - y_j|}$$` Otra métrica es la **.bg-purple_light[distancia de Chebyshev]** `\(d(x, y) = \max_i \left(|x_i - y_i| \right)\)` <img src="./img/minkowski.jpeg" width="40%" style="display: block; margin: auto;" /> -- ¿Cómo se definirían los círculos (lugares a la misma distancia de un centro) en dichas métricas? --- # Decisiones KNN: .orange[DISTANCIA] Todas estas métricas en realidad son casos particulares de las conocidas como **.bg-purple_light[distancias de Minkowski]**, definidas en función de un parámetro `\(r\)` `$$d(x, y) = \left(\displaystyle \sum_{j=1}^{p} |x_j - y_j|^r\right)^{1/r}$$` .pull-left[ <img src="./img/minkowski_1.jpg" width="100%" style="display: block; margin: auto auto auto 0;" /> ] .pull-right[ <img src="./img/minkowski_2.jpg" width="100%" style="display: block; margin: auto auto auto 0;" /> ] Cuando `\(p=1\)` estamos ante la distancia Manhattan, cuando `\(p=2\)` es la distancia Euclídea, cuando `\(p=\infty\)` es la distancia de Chebyshev. --- # .orange[PREPROCESAMIENTO] en KNN En el caso en el que tengamos **.bg-purple_light[predictoras numéricas]** y que decidamos optar por una **.bg-purple_light[distancia geométrica]**, en un ejemplo bidimensional, si `\(x_1\)` toma valores entre 10 000 y 100 000 y `\(x_2\)` toma valores entre 0 y 0.001, a la hora de calcular las distancias en realidad la **.bg-purple_light[segunda variable no está participando]** en el aprendizaje (ya que es tan pequeña que da igual lo que valga). ¿Qué **.bg-purple_light[preprocesamiento/depuración]** de los datos deberíamos hacer para que eso no suceda? -- Cuando usamos las distancias geométricas debemos **.bg-purple_light[reescalar o estandarizar por rango]**, de forma que **.bg-purple_light[todas las variables estén en un rango común]** (por ejempo, `\([0,1]\)`) `$$\tilde{x}_{i,j} = \frac{x_{i,j} - min(x_j)}{max(x_j) - min(x_j)}$$` -- Además necesitamos **.bg-purple_light[tratar los datos ausentes]** (lo veremos en futuras clases, si imputarles un valor o si eliminarlos). --- # Decisiones KNN: .orange[DISTANCIA] En el caso de las **.bg-purple_light[distancias probabilísticas]** la más habitual es la conocida como **.bg-purple_light[distancia de Mahalanobis]**, que tiene en cuenta las características probabilísticas de los datos. En el caso **.bg-purple_light[bidimensional (con variables independientes)]** `$$d(x, y) = \sqrt{\left(\frac{x_1 - y_1}{\sigma_1} \right)^2 + \left(\frac{x_2 - y_2}{\sigma_2} \right)^2}$$` -- En el caso **.bg-purple_light[multidimensional (con variables independientes)]** `$$d(x, y) = \sqrt{\displaystyle \sum_{j=1}^{p} \left(\frac{x_j - y_j}{\sigma_j} \right)^2 }$$` --- # Decisiones KNN: .orange[DISTANCIA] En el caso general de tener un problema **.bg-purple_light[multidimensional (con variables dependientes)]**, la idea es promediar las observaciones por la **.bg-purple_light[matriz de varianzas y covarianzas]** `$$d(x, y) = \sqrt{\displaystyle \sum_{j=1}^{p} \left(x_j - y_j \right)^{T} \Sigma^{-1} \left(x_j - y_j \right) }$$` Donde `\(\Sigma^{-1}\)` es la **.bg-purple_light[matriz de varianzas y covarianzas]** (matriz simétrica) `$$\Sigma = \begin{pmatrix} \sigma_{1}^2 & cov(x_1, x_2) & \ldots & cov(x_1, x_p) \\ cov(x_2, x_1) & \sigma_{2}^2 & \ldots & cov(x_2, x_p) \\ \vdots & \vdots & \ddots & \vdots \\ cov(x_p, x_1) & cov(x_p, x_2) & \ldots & \sigma_{p}^2 \end{pmatrix}$$` --- # .orange[PREPROCESAMIENTO] en KNN En el caso en el que tengamos **.bg-purple_light[predictoras numéricas]** y que decidamos optar por una **.bg-purple_light[distancia probabilística]**, ya no será tan importante los valores en sí literales sino las **.bg-purple_light[características probabilísticas de nuestras variables]** ¿Qué **.bg-purple_light[preprocesamiento/depuración]** de los datos deberíamos hacer para que eso no suceda? -- Cuando usamos las distancias probabilísticas debemos **.bg-purple_light[normalizar o estandarizar por media/varianza)]**, de forma que **.bg-purple_light[todas las variables tengan media 0 y desv. típica 1]** `$$\tilde{x}_{i,j} = \frac{x_{i,j} - \overline{x}_j}{\sigma_j}$$` --- class: inverse center middle name: clase-6 # CLASE 6: depuración para KNN ### [Factores](#factores) ### [Fase 1: muestreo](#sample-iris) ### [Fase 2: exploración](#exploracion-iris) ### [Fase 3: modificación/depuración](#depuracion-iris) --- # Primer conjunto: iris Para empezar con la implementación de nuestro primer **.bg-purple_light[algoritmo de clasificación]** vamos a usar un conjunto simple y conocido: el iris. ```r iris <- as_tibble(iris) iris ``` ``` > # A tibble: 150 × 5 > Sepal.Length Sepal.Width Petal.Length Petal.Width Species > <dbl> <dbl> <dbl> <dbl> <fct> > 1 5.1 3.5 1.4 0.2 setosa > 2 4.9 3 1.4 0.2 setosa > 3 4.7 3.2 1.3 0.2 setosa > 4 4.6 3.1 1.5 0.2 setosa > 5 5 3.6 1.4 0.2 setosa > 6 5.4 3.9 1.7 0.4 setosa > 7 4.6 3.4 1.4 0.3 setosa > 8 5 3.4 1.5 0.2 setosa > 9 4.4 2.9 1.4 0.2 setosa > 10 4.9 3.1 1.5 0.1 setosa > # … with 140 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # .orange[EXPLORACIÓN] inicial Dentro de esa metodología SEMMMA hay una fase muy importante: la **.bg-purple_light[fase exploratoria]**. Aunque más adelante podemos volver a realizarla, una vez realizado el muestro, lo conveniente sería una **.bg-purple_light[análisis exploratorio previo]** a los datos en bruto. -- * `View()`: el primer paso debería ser ver nuestra tabla para tener una idea preliminar de nuestros datos. ```r iris %>% View() ``` --- # .orange[EXPLORACIÓN] inicial * `glimpse()`: también podemos ejecutar algunos comandos que nos permiten saber rápidamente el **.bg-purple_light[número de registros y variables]** que tenemos, así como el **.bg-purple_light[tipo de variables]** que tenemos. En nuestro caso tenemos **.bg-purple_light[5 variables]**: 4 variables numéricas (cuantitativas continuas) y una **.bg-purple_light[variable categórica]** (de tipo factor). ```r dim(iris) ``` ``` > [1] 150 5 ``` ```r iris %>% glimpse() ``` ``` > Rows: 150 > Columns: 5 > $ Sepal.Length <dbl> 5.1, 4.9, 4.7, 4.6, 5.0, 5.4, 4.6, 5.0, 4.4, 4.9, 5.4, 4.… > $ Sepal.Width <dbl> 3.5, 3.0, 3.2, 3.1, 3.6, 3.9, 3.4, 3.4, 2.9, 3.1, 3.7, 3.… > $ Petal.Length <dbl> 1.4, 1.4, 1.3, 1.5, 1.4, 1.7, 1.4, 1.5, 1.4, 1.5, 1.5, 1.… > $ Petal.Width <dbl> 0.2, 0.2, 0.2, 0.2, 0.2, 0.4, 0.3, 0.2, 0.2, 0.1, 0.2, 0.… > $ Species <fct> setosa, setosa, setosa, setosa, setosa, setosa, setosa, s… ``` --- name: factores # Variables cuali: .orange[FACTORES] .pull-left[ Las variables cualitativas se conocen en `R` como **.bg-purple_light[factores]**. Y el paquete fundamental para tratarlos es `{forcats}` (del entorno `{tidyverse}`). ] .pull-right[ <img src="./img/factors.jpg" width="100%" style="display: block; margin: auto auto auto 0;" /> ] --- # Variables cuali: .orange[FACTORES] Este paquete nos permite fijar los **.bg-purple_light[niveles/modalidades]** (guardados internamente como `levels`) que toma una determinada variable categórica para que no puedan generarse errores. Además hace que su análisis sea menos costoso computacionalmente a la hora de hacer búsquedas y comparativas, dándoles un **.bg-purple_light[tratamiento diferente que a las cadena de texto normales]**. -- Veamos un ejempo sencillo definiendo una variable `estado` que tome los valores `"sano"`, `"leve"` y `"grave"` de la siguiente manera. ```r estado <- c("leve", "grave", "sano", "sano", "leve", "sano", "sano", "grave", "grave", "leve", "grave", "sano", "sano") estado ``` ``` > [1] "leve" "grave" "sano" "sano" "leve" "sano" "sano" "grave" "grave" > [10] "leve" "grave" "sano" "sano" ``` La variable `estado` actualmente es de **.bg-purple_light[tipo texto]**, de tipo `chr`, algo que podemos comprobar con `class(estado)`. ```r class(estado) ``` ``` > [1] "character" ``` --- # Variables cuali: .orange[FACTORES] Desde un punto de vista estadístico y computacional, para `R` esta variable ahora mismo sería equivalente una variable de nombres. Pero estadísticamente **.bg-purple_light[no es lo mismo una variable con nombres]** (que identifican muchas veces el registro) que una variable categórica como estado que **.bg-purple_light[solo puede tomar esos 3 niveles]**. ¿Cómo **.bg-purple_light[convertir a factor]**? Haciendo uso de la función `as_factor()` del paquete `{forcats}`. -- ```r library(tidyverse) estado_fct <- tibble(paciente = 1:length(estado), estado = as_factor(estado)) estado_fct ``` ``` > # A tibble: 13 × 2 > paciente estado > <int> <fct> > 1 1 leve > 2 2 grave > 3 3 sano > 4 4 sano > 5 5 leve > 6 6 sano > 7 7 sano > 8 8 grave > 9 9 grave > 10 10 leve > 11 11 grave > 12 12 sano > 13 13 sano ``` --- # Variables cuali: .orange[FACTORES] No solo ha cambiado la clase de la variable sino que ahora, debajo del valor guardado, nos aparece la frase `Levels: grave leve sano`: son las **.bg-purple_light[modalidades o niveles]** de nuestra cualitativa. Imagina que ese día en el hospital no tuviésemos a **nadie en estado grave**: aunque ese día nuestra variable no tome dicho valor, el estado `grave` es un **.bg-purple_light[nivel permitido en la base de datos]**, así que aunque lo eliminemos, por ser un factor, el nivel permanece (no lo tenemos ahora pero es un nivel permitido). ```r estado_fct %>% filter(estado %in% c("sano", "leve")) %>% pull(estado) ``` ``` > [1] leve sano sano leve sano sano leve sano sano > Levels: leve grave sano ``` --- # Variables cuali: .orange[FACTORES] Con `factor()` podemos **.bg-purple_light[especificar explícitamente]** los nombres de las modalidades, incluso si son nominales u **.bg-purple_light[ordinales]** ```r estado_fct <- tibble(paciente = 1:length(estado), estado = factor(estado, ordered = TRUE)) estado_fct %>% pull(estado) ``` ``` > [1] leve grave sano sano leve sano sano grave grave leve grave sano > [13] sano > Levels: grave < leve < sano ``` --- # Variables cuali: .orange[FACTORES] Con `levels = ...` podemos indicarle explícitamente el **.bg-purple_light[orden de las modalidades]** ```r estado_fct <- tibble(paciente = 1:length(estado), estado = factor(estado, levels = c("sano", "leve", "grave"), ordered = TRUE)) estado_fct %>% pull(estado) ``` ``` > [1] leve grave sano sano leve sano sano grave grave leve grave sano > [13] sano > Levels: sano < leve < grave ``` --- # Variables cuali: .orange[FACTORES] .pull-left[ Si queremos indicarle que **.bg-purple_light[elimine un nivel no usado]** en ese momento (y que queremos excluir de la definición) podemos hacerlo con `fct_drop()` ] .pull-right[ <img src="./img/drop_factor.jpg" width="100%" style="display: block; margin: auto auto auto 0;" /> ] ```r estado_fct %>% filter(estado %in% c("sano", "leve")) %>% mutate(estado = fct_drop(estado)) %>% pull(estado) ``` ``` > [1] leve sano sano leve sano sano leve sano sano > Levels: sano < leve ``` --- # Variables cuali: .orange[FACTORES] .pull-left[ Al igual que podemos eliminar niveles podemos **.bg-purple_light[ampliar los niveles existentes]** (aunque no existan datos de ese nivel en ese momento) con `fct_expand()` ] .pull-right[ <img src="./img/factor_expand.jpg" width="100%" style="display: block; margin: auto auto auto 0;" /> ] ```r estado_fct %>% mutate(estado = fct_expand(estado, c("UCI", "fallecido"))) %>% pull(estado) ``` ``` > [1] leve grave sano sano leve sano sano grave grave leve grave sano > [13] sano > Levels: sano < leve < grave < UCI < fallecido ``` --- # Variables cuali: .orange[FACTORES] .pull-left[ Además con `fct_explicit_na()` podemos **.bg-purple_light[asignar un nivel a los valores]** para que sea incluido dicho nivel en los análisis y visualizaciones. ] .pull-right[ <img src="./img/factor_explicit.jpg" width="100%" style="display: block; margin: auto auto auto 0;" /> ] ```r fct_explicit_na(factor(c("a", "b", NA))) ``` ``` > [1] a b (Missing) > Levels: a b (Missing) ``` --- # Variables cuali: .orange[FACTORES] Incluso una vez definidos podemos **.bg-purple_light[reordenar los níveles]** con `fct_relevel()` ```r estado_fct_expand <- estado_fct %>% mutate(estado = fct_expand(estado, c("UCI", "fallecido"))) %>% pull(estado) estado_fct_expand %>% fct_relevel(c("fallecido", "leve", "sano", "grave", "UCI")) ``` ``` > [1] leve grave sano sano leve sano sano grave grave leve grave sano > [13] sano > Levels: fallecido < leve < sano < grave < UCI ``` --- # Variables cuali: .orange[FACTORES] .pull-left[ Esta forma de trabajar con variables cualitativas nos permite dar una **.bg-purple_light[definición teórica]** de nuestra base de datos, pudiendo incluso contar valores que aún no existen (pero que podrían), haciendo uso de `fct_count()` ] .pull-right[ <img src="./img/fct_count.jpg" width="70%" style="display: block; margin: auto auto auto 0;" /> ] ```r estado_fct %>% mutate(estado = fct_expand(estado, c("UCI", "fallecido"))) %>% pull(estado) %>% fct_count() ``` ``` > # A tibble: 5 × 2 > f n > <fct> <int> > 1 sano 6 > 2 leve 3 > 3 grave 4 > 4 UCI 0 > 5 fallecido 0 ``` --- # Variables cuali: .orange[FACTORES] Los níveles también podemos **.bg-purple_light[ordenarlos por frecuencia]** con `fct_infreq()` ```r estado_fct %>% mutate(estado = fct_infreq(estado)) %>% pull(estado) %>% fct_count() ``` ``` > # A tibble: 3 × 2 > f n > <fct> <int> > 1 sano 6 > 2 grave 4 > 3 leve 3 ``` --- # Variables cuali: .orange[FACTORES] A veces querremos **.bg-purple_light[agrupar niveles]**, por ejemplo, no permitiendo niveles que **.bg-purple_light[no sucedan un mínimo de veces]** con `fct_lump_min(.., min = ..)` (las observaciones que no lo cumplan irán a un **nivel genérico** llamado `Other`, aunque se puede cambiar con el argumento `other_level`). .pull-left[ ```r estado_fct %>% pull(estado) %>% fct_lump_min(min = 4) ``` ``` > [1] Other grave sano sano Other sano sano grave grave Other grave sano > [13] sano > Levels: sano < grave < Other ``` ] .pull-right[ ```r estado_fct %>% pull(estado) %>% fct_lump_min(min = 4, other_level = "otros") ``` ``` > [1] otros grave sano sano otros sano sano grave grave otros grave sano > [13] sano > Levels: sano < grave < otros ``` ] --- # Variables cuali: .orange[FACTORES] Podemos hacer algo equivalente pero en función de su **.bg-purple_light[frecuencia relativa]** con `fct_lump_prop()`. ```r estado_fct %>% pull(estado) %>% fct_lump_prop(prop = 0.4, other_level = "otros") ``` ``` > [1] otros otros sano sano otros sano sano otros otros otros otros sano > [13] sano > Levels: sano < otros ``` --- # Variables cuali: .orange[FACTORES] Con `fct_reorder()` podemos también indicar que queremos **.bg-purple_light[ordenar los factores]** en función de una función aplicada a otra variable. ```r starwars_factor <- starwars %>% drop_na(height, species) %>% mutate(species = fct_lump_min(species, min = 3, other_level = "Otras")) ``` .pull-left[ ```r starwars_factor %>% pull(species) ``` ``` > [1] Human Droid Droid Human Human Human Human Droid Human Human > [11] Human Human Otras Human Otras Otras Human Human Otras Human > [21] Human Droid Otras Human Human Otras Human Otras Otras Human > [31] Otras Human Gungan Gungan Gungan Otras Otras Human Otras Otras > [41] Otras Otras Otras Otras Human Otras Otras Otras Otras Otras > [51] Otras Otras Otras Human Human Human Otras Otras Otras Human > [61] Human Human Human Otras Otras Otras Otras Human Otras Droid > [71] Otras Otras Otras Otras Otras Human Otras Human > Levels: Droid Gungan Human Otras ``` ] .pull-right[ ```r starwars_factor %>% mutate(species = fct_reorder(species, height, mean)) %>% pull(species) ``` ``` > [1] Human Droid Droid Human Human Human Human Droid Human Human > [11] Human Human Otras Human Otras Otras Human Human Otras Human > [21] Human Droid Otras Human Human Otras Human Otras Otras Human > [31] Otras Human Gungan Gungan Gungan Otras Otras Human Otras Otras > [41] Otras Otras Otras Otras Human Otras Otras Otras Otras Otras > [51] Otras Otras Otras Human Human Human Otras Otras Otras Human > [61] Human Human Human Otras Otras Otras Otras Human Otras Droid > [71] Otras Otras Otras Otras Otras Human Otras Human > Levels: Droid Otras Human Gungan ``` ] --- # Ejercicios (factores) .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 1**: dada la variable `meses` definida debajo (definida como un vector de caracteres), convierte dicha variable a factor (solo eso) ```r meses <- c("Ene", "Feb", "Mar", "Abr") ``` * 📝 **Ejercicio 2**: dada la variable `meses` definida debajo convierte dicha variable a factor pero indicando los niveles de forma correcta. ```r meses <- c(NA, "Abr", "Ene", "Oct", "Jul", "Ene", "Sep", NA, "Feb", "Dic", "Jul", "Mar", "Ene", "Mar", "Feb", "Abr", "May", "Oct", "Sep", NA, "Dic", "Jul", "Nov", "Feb", "Oct", "Jun", "Sep", "Oct", "Oct", "Sep") ``` * 📝 **Ejercicio 3**: cuenta cuantos valores hay de cada mes pero teniendo en cuenta que son factores (quizás haya niveles sin ser usados y de los que debería obtener un 0). ] .panel[.panel-name[Sol. ej. 1] ```r meses <- c("Ene", "Feb", "Mar", "Abr") meses_fct <- as_factor(meses) meses_fct ``` ``` > [1] Ene Feb Mar Abr > Levels: Ene Feb Mar Abr ``` ] .panel[.panel-name[Sol. ej. 2] ```r meses <- c(NA, "Abr", "Ene", "Oct", "Jul", "Ene", "Sep", NA, "Feb", "Dic", "Jul", "Mar", "Ene", "Mar", "Feb", "Abr", "May", "Oct", "Sep", NA, "Dic", "Jul", "Nov", "Feb", "Oct", "Jun", "Sep", "Oct", "Oct", "Sep") # Orden de niveles correcto e incluimos agosto aunque no haya meses_fct <- factor(meses, levels = c("Ene", "Feb", "Mar", "Abr", "May", "Jun", "Jul", "Ago", "Sep", "Oct", "Nov", "Dic")) meses_fct ``` ``` > [1] <NA> Abr Ene Oct Jul Ene Sep <NA> Feb Dic Jul Mar Ene Mar Feb > [16] Abr May Oct Sep <NA> Dic Jul Nov Feb Oct Jun Sep Oct Oct Sep > Levels: Ene Feb Mar Abr May Jun Jul Ago Sep Oct Nov Dic ``` ] .panel[.panel-name[Sol. ej. 3] ```r meses_fct %>% fct_count() ``` ``` > # A tibble: 13 × 2 > f n > <fct> <int> > 1 Ene 3 > 2 Feb 3 > 3 Mar 2 > 4 Abr 2 > 5 May 1 > 6 Jun 1 > 7 Jul 3 > 8 Ago 0 > 9 Sep 4 > 10 Oct 5 > 11 Nov 1 > 12 Dic 2 > 13 <NA> 3 ``` ] ] --- # Ejercicios (factores) .panelset[ .panel[.panel-name[Ejercicios] * 📝 **Ejercicio 4**: dado que hay ausentes, indica que los ausentes sea un decimotercer nivel etiquetado como "ausente". * 📝 **Ejercicio 5**: elimina los niveles no usados. * 📝 **Ejercicio 6**: ordena los niveles por frecuencia de aparición. * 📝 **Ejercicio 7**: agrupa niveles de forma que todo nivel que no aparezca al menos el 7% de las veces se agrupe en un nivel llamado "otros meses" ] .panel[.panel-name[Sol. ej. 4] ```r meses_fct <- meses_fct %>% fct_explicit_na(na_level = "ausente") meses_fct ``` ``` > [1] ausente Abr Ene Oct Jul Ene Sep ausente Feb > [10] Dic Jul Mar Ene Mar Feb Abr May Oct > [19] Sep ausente Dic Jul Nov Feb Oct Jun Sep > [28] Oct Oct Sep > Levels: Ene Feb Mar Abr May Jun Jul Ago Sep Oct Nov Dic ausente ``` ] .panel[.panel-name[Sol. ej. 4] ```r meses_fct <- meses_fct %>% fct_drop() meses_fct ``` ``` > [1] ausente Abr Ene Oct Jul Ene Sep ausente Feb > [10] Dic Jul Mar Ene Mar Feb Abr May Oct > [19] Sep ausente Dic Jul Nov Feb Oct Jun Sep > [28] Oct Oct Sep > Levels: Ene Feb Mar Abr May Jun Jul Sep Oct Nov Dic ausente ``` ] .panel[.panel-name[Sol. ej. 6] ```r meses_fct %>% fct_infreq() ``` ``` > [1] ausente Abr Ene Oct Jul Ene Sep ausente Feb > [10] Dic Jul Mar Ene Mar Feb Abr May Oct > [19] Sep ausente Dic Jul Nov Feb Oct Jun Sep > [28] Oct Oct Sep > Levels: Oct Sep Ene Feb Jul ausente Mar Abr Dic May Jun Nov ``` ] .panel[.panel-name[Sol. ej. 7] ```r meses_fct <- meses_fct %>% fct_lump_prop(prop = 0.07, other_level = "otros") meses_fct ``` ``` > [1] ausente otros Ene Oct Jul Ene Sep ausente Feb > [10] otros Jul otros Ene otros Feb otros otros Oct > [19] Sep ausente otros Jul otros Feb Oct otros Sep > [28] Oct Oct Sep > Levels: Ene Feb Jul Sep Oct ausente otros ``` ] ] --- name: exploracion-inicial # .orange[EXPLORACIÓN] inicial * `skim()`: con el paquete `{skimr}` podemos realizar un **.bg-purple_light[primer análisis numérico]** muy sencillo, haciendo uso de la función `skim()` ```r library(skimr) iris %>% skim() ``` --- # ¿Cuál es nuestra variable .orange[OBJETIVO]? Una vez que hemos echado un vistazo a qué tenemos (de forma muy muy preliminar), lo primero a hacer en un **.bg-purple_light[problema de clasificación]** es determinar **.bg-purple_light[cuál es nuestra variable objetivo]**: nuestra variable `\(Y\)` que vamos a clasificar, y que debe ser categórica. -- En este caso nuestra variable objetivo será la **.bg-purple_light[variable Species]**: vamos a intentar clasificar las flores, siendo la variable objetivo una variable que puede tomar 3 categorías (algo que podemos ver y resumir con `count()`). ```r iris %>% count(Species) ``` ``` > # A tibble: 3 × 2 > Species n > <fct> <int> > 1 setosa 50 > 2 versicolor 50 > 3 virginica 50 ``` En nuestro caso la variable objetivo está **.bg-purple_light[balanceada]**: tenemos proporciones similares para cada una de las modalidades. --- name: sample-iris # Fase 1: .orange[MUESTREO] La primera fase de la **.bg-purple_light[metodología SEMMA]** será decidir si es necesario realizar un **.bg-purple_light[muestreo]** previo (una submuestra de la muestra). ¿Cómo haríamos un **.bg-purple_light[muestro aleatorio estratificado del 50%]**, respetando la proporción de cada clase de la variable objetivo? -- ```r iris_sample <- iris %>% group_by(Species) %>% slice_sample(prop = 0.5) %>% ungroup() iris_sample %>% count(Species) ``` ``` > # A tibble: 3 × 2 > Species n > <fct> <int> > 1 setosa 25 > 2 versicolor 25 > 3 virginica 25 ``` En nuestro caso: ¿es necesario? No parece dado que tenemos **.bg-purple_light[muy pocas observaciones]**, así que trabajaremos con la tabla iris original. --- name: exploracion-iris # Fase 2: .orange[EXPLORACIÓN] Como ya hemos comentado, una **.bg-purple_light[primera fase exploratoria]** la podemos realizar con `skim()` (del paquete `{skimr}`). ```r library(skimr) iris %>% skim() ``` <img src="./img/skim.jpg" width="75%" style="display: block; margin: auto;" /> --- # Fase 2: .orange[EXPLORACIÓN] * No parece que tengamos **.bg-purple_light[problemas de codificación o rango]**: los valores parecen valores permitidos según lo que representa la variable. -- * No tenemos **.bg-purple_light[datos ausentes]** (no hace falta decidir que hacemos con ellos), ya que `complete_rate` sale en todas 1 (`n_missing` está a cero). -- * A la vista de los pequeños histogramas y los percentiles, no parece que tengamos **.bg-purple_light[excesivos valores atípicos (outliers)]** (al menos muy evidentes, además la mediana y media se parecen entre sí). Quizás la **.bg-purple_light[variable con mayor dispersión]** sea `Petal.Length`. -- * Todas las **.bg-purple_light[variables predictoras son numéricas]**: recordemos que para aplicar las métricas que conocemos en el KNN **.bg-purple_light[necesitamos que sean numéricas]**. En caso contrario nos tocaría **.bg-purple_light[recategorizar]** --- # Fase 2: .orange[EXPLORACIÓN] Otra de las acciones clave será analizar cómo se **.bg-purple_light[comporta la variable objetivo en función de los valores de cada variable]**. ¿La longitud del sépalo media es similar en cada especie de planta? ¿Y la anchura del pétalo? Con ello podremos tener una idea preliminar de la **.bg-purple_light[importancia de las variables]** en la clasificación. Para ello combinaremos `group_by()` con `summarise()` (nos construye resúmenes numéricos, con la función que le pidamos). -- ```r iris %>% group_by(Species) %>% summarise("mean_long_sep" = mean(Sepal.Length)) %>% ungroup() ``` ``` > # A tibble: 3 × 2 > Species mean_long_sep > <fct> <dbl> > 1 setosa 5.01 > 2 versicolor 5.94 > 3 virginica 6.59 ``` --- # Fase 2: .orange[EXPLORACIÓN] Podemos hacer varias a la vez usando `across()`: le tendremos que indicar las variables a recorrer, y la función a aplicar en todas ellas. ```r iris %>% group_by(Species) %>% summarise(mean = across(Sepal.Length:Petal.Width, mean)) %>% ungroup() ``` ``` > # A tibble: 3 × 2 > Species mean$Sepal.Length $Sepal.Width $Petal.Length $Petal.Width > <fct> <dbl> <dbl> <dbl> <dbl> > 1 setosa 5.01 3.43 1.46 0.246 > 2 versicolor 5.94 2.77 4.26 1.33 > 3 virginica 6.59 2.97 5.55 2.03 ``` --- # Fase 2: .orange[EXPLORACIÓN] ```r iris %>% group_by(Species) %>% summarise(mean = across(Sepal.Length:Petal.Width, mean)) %>% ungroup() ``` ``` > # A tibble: 3 × 2 > Species mean$Sepal.Length $Sepal.Width $Petal.Length $Petal.Width > <fct> <dbl> <dbl> <dbl> <dbl> > 1 setosa 5.01 3.43 1.46 0.246 > 2 versicolor 5.94 2.77 4.26 1.33 > 3 virginica 6.59 2.97 5.55 2.03 ``` Si nos fijamos en cada una de ellas: * Las **.bg-purple_light[variables relacionadas con el sépalo]** no parece que cambien mucho de una especie a otra: seguramente **.bg-purple_light[no sean influyentes]** en nuestra clasificación. * Las **.bg-purple_light[variables relacionadas con el pétalo]** si parecen ser determinantes ya que la especie setosa tiene valores muy pequeños. Seguramente lo más complicado sea clasificar entre versicolor y virginica (se diferencia muy ligeramente) --- # Fase 2: .orange[EXPLORACIÓN] Otro de los aspectos a considerar antes de tomar decisiones será **.bg-purple_light[analizar la relación entre las variables]**, empezando por la posible relación lineal, calculando la matriz de correlaciones con las herramientas de la librería `{corrr}`. **.bg-red_light[Importante]**: solo podemos pasarle las variables numéricas de la tabla. ```r library(corrr) correlate(iris %>% select(where(is.numeric))) ``` ``` > # A tibble: 4 × 5 > term Sepal.Length Sepal.Width Petal.Length Petal.Width > <chr> <dbl> <dbl> <dbl> <dbl> > 1 Sepal.Length NA -0.118 0.872 0.818 > 2 Sepal.Width -0.118 NA -0.428 -0.366 > 3 Petal.Length 0.872 -0.428 NA 0.963 > 4 Petal.Width 0.818 -0.366 0.963 NA ``` --- # Fase 2: .orange[EXPLORACIÓN] ```r library(corrr) correlate(iris %>% select(where(is.numeric))) ``` ``` > # A tibble: 4 × 5 > term Sepal.Length Sepal.Width Petal.Length Petal.Width > <chr> <dbl> <dbl> <dbl> <dbl> > 1 Sepal.Length NA -0.118 0.872 0.818 > 2 Sepal.Width -0.118 NA -0.428 -0.366 > 3 Petal.Length 0.872 -0.428 NA 0.963 > 4 Petal.Width 0.818 -0.366 0.963 NA ``` La matriz de correlaciones será **siempre simétrica** y en la diagonal siempre será 1 (podemos indicarle que queremos que nos muestre con el argumento `diagonal = ...`) --- # Fase 2: .orange[EXPLORACIÓN] La matriz de correlaciones será **siempre simétrica** y en la diagonal siempre será 1 (podemos indicarle que queremos que nos muestre con el argumento `diagonal = ...`) ```r correlate(iris %>% select(where(is.numeric)), diagonal = "*") ``` ``` > # A tibble: 4 × 5 > term Sepal.Length Sepal.Width Petal.Length Petal.W…¹ > <chr> <chr> <chr> <chr> <chr> > 1 Sepal.Length * -0.117569784133002 0.871753775886583 0.817941… > 2 Sepal.Width -0.117569784133002 * -0.42844010433054 -0.36612… > 3 Petal.Length 0.871753775886583 -0.42844010433054 * 0.962865… > 4 Petal.Width 0.817941126271576 -0.366125932536439 0.962865431402796 * > # … with abbreviated variable name ¹Petal.Width ``` --- # Fase 2: .orange[EXPLORACIÓN] También podemos mostrarla algo más estética **.bg-red_light[redondeando los valores]** con `fashion()` ```r correlate(iris %>% select(where(is.numeric))) %>% fashion() ``` ``` > term Sepal.Length Sepal.Width Petal.Length Petal.Width > 1 Sepal.Length -.12 .87 .82 > 2 Sepal.Width -.12 -.43 -.37 > 3 Petal.Length .87 -.43 .96 > 4 Petal.Width .82 -.37 .96 ``` --- # Fase 2: .orange[EXPLORACIÓN] Incluso visualizarla con el paquete `{corrplot}` .pull-left[ ```r library(corrplot) cor_matrix <- cor(iris %>% select(where(is.numeric))) corrplot(cor_matrix) ``` ] .pull-right[ <img src="./img/corrplot_1.jpg" width="100%" style="display: block; margin: auto;" /> ] --- # Fase 2: .orange[EXPLORACIÓN] .pull-left[ ```r corrplot(cor_matrix, method = "number") ``` ] .pull-right[ <img src="./img/corrplot_2.jpg" width="100%" style="display: block; margin: auto;" /> ] --- # Fase 2: .orange[EXPLORACIÓN] .pull-left[ ```r corrplot(cor_matrix, method = "color") ``` ] .pull-right[ <img src="./img/corrplot_3.jpg" width="100%" style="display: block; margin: auto;" /> ] --- # Fase 2: .orange[EXPLORACIÓN] .pull-left[ ```r corrplot(cor_matrix, method = "ellipse") ``` ] .pull-right[ <img src="./img/corrplot_4.jpg" width="100%" style="display: block; margin: auto;" /> ] --- # Fase 2: .orange[EXPLORACIÓN] En este caso tenemos dos variables muy correlacionadas: `Petal.Length` y `Petal.Width`, con una correlación de casi 1, lo que nos indica que nos van a aportar **.bg-red_light[información redundante]** una de la otra, provocando **.bg-red_light[problemas de colinealidad]**. -- Nuestro caso ideal sería aquel en el que todas fuesen independientes (o al menos incorreladas entre sí, sin dependencia lineal), para **.bg-purple_light[maximizar la información de los datos]**. Si dos variables nos aportan lo mismo, una seguramente sobre (ya que solo nos va a aportar ruido). Veremos más adelante otras herramientas para cuantificar la dependencia (no solo lineal, y no solo de variables cuanti) -- También aprenderemos a **.bg-purple_light[visualizar los datos]**, un paso CLAVE en el análisis exploratorio y la depuración, pero más adelante. --- class: inverse center middle name: clase-7 # CLASE 7: modelizando KNN con tidymodels ### [Depuración iris](#depuracion-iris) ### [Tratamiento de outliers](#outliers) ### [Resumen knn](#knn-steps) ### [¿Qué es tidymodels?](#tidymodels) --- name: depuracion-iris # Fase 3: .orange[MODIFICACIÓN/DEPURACIÓN] Con la información obtenida de la anterior fase, en la **.bg-purple_light[fase de modificación o depuración]** es donde tendremos que tomar decisiones para **.bg-purple_light[preparar nuestros datos]** de manera adecuada. Y para ello será **.bg-purple_light[fundamental conocer el algoritmo]** que vamos a aplicar. ¿Qué necesitaremos en el caso del KNN? * **.bg-purple_light[Tipología de las variables]**. ¿Todas mis variables **.bg-orange[predictoras son numéricas]** o debo? ¿Mi **.bg-orange[variable objetivo]** es categórica? * **.bg-purple_light[Codificación de las variables]**. ¿Todas mis variables tienen un **.bg-orange[rango coherente]** (por ejemplo, que una variable de peso no sea negativa)? ¿Están **.bg-orange[bien codificadas]**? * **.bg-purple_light[Atípicos y ausentes]**. ¿Tengo **.bg-orange[valores atípicos (outliers)]**? En caso afirmativo, ¿cómo tratarlos? Tras tratar atípicos, ¿tengo **.bg-orange[datos ausentes]**? * **.bg-purple_light[Selección de variables]**. ¿Necesito seleccionar variables? ¿Tengo alguna de varianza cero (es decir, sin información)? ¿Tengo **.bg-orange[problemas de dependencia o colinealidad]**? ¿Puedo resumir mi info con un conjunto nuevo de variables incorreladas (componentes principales)? --- # Fase 3: .orange[MODIFICACIÓN/DEPURACIÓN] * **.bg-purple_light[Variables dummy]**. ¿Debo **.bg-orange[recategorizar]** variables que no sean numéricas? Recuerda que el kNN de momento solo sabemos hacerlo con numéricas (en caso contrario, veremos como «dummificar» variables: crear 0-1 para tener números) * **.bg-purple_light[Añadir info]**. ¿Debo **.bg-orange[crear nuevas variables]** que nos aporte info extra? * **.bg-purple_light[Normalizar variables]**. ¿Tengo ya mis variables preparadas (tras tratar lo anterior) para la métrica que vaya usar (**.bg-orange[estandarizadas]** por rango o **.bg-orange[tipificadas]** por media-varianza)? --- name: outliers # Tratamiento de .orange[OUTLIERS] Una de las partes más importantes de la fase de exploración y modificación es la **.bg-purple_light[detección de outliers]**, pudiendo tener diferentes definiciones de valor atípico: * **.bg-purple_light[Atípico respecto a media]**: será un dato muy alejado de la **.bg-purple_light[media de la variable]**. ¿Cuánto de alejado? Una definición habitual es definir un dato atípico como aquel que se aleja de la media `\(k\)` veces la desviación típica (un valor habitual es `\(k = 2.5\)`). `$$x_i > \overline{x} + k* s_{j} \quad \text{ o bien } \quad x_i < \overline{x} - k *s_{j}$$` Dicha definición de atípico solo tendrá sentido cuando la **.bg-purple_light[media sea representativa]** de tu distribución, es decir, siempre y cuando tengamos cierta simetría (ya que sino, la media al ser poco robusta se perturbará fácilmente). --- # Tratamiento de .orange[OUTLIERS] Para detectarlos usaremos el paquete `{outliers}` y su función `scores()`, que nos dará en cada caso una **.bg-purple_light["puntuación" de cada observación]**. En caso de que queramos **.bg-purple_light[detectarlos respecto a la media]**, le indicaremos que `type = "z"`: nos devolverá precisamente el valor `\(k\)` (si aplicamos valor absoluto), ya que hará cada observación menos la media y la dividirá entre la desviación típica. ```r library(outliers) abs(scores(c(1, -1, 0, 5, 2, 1.5, 0.5, -0.3, 0, 2, 1.7, 0.2, -0.8), type = "z")) ``` ``` > [1] 0.05794825 1.19759725 0.56982450 2.56903925 0.68572100 0.37183463 > [7] 0.25593812 0.75815632 0.56982450 0.68572100 0.49738918 0.44426995 > [13] 1.07204270 ``` De forma que podamos detectar muy fácil los outliers en función de los estrictos que queramos ser con ese `\(k\)`. El tipo `type = "chisq"` nos hace algo parecido pero elevando las desviaciones al cuadrado y diviendo por la varianza. --- # Tratamiento de .orange[OUTLIERS] En el caso de nuestros datos, usaremos `\(k = 2.5\)`, y detectaremos aquellos datos que son outliers para luego pasarlos a un **.bg-purple_light[valor ausente]**. ```r iris_na_outliers <- iris %>% mutate(Sepal.Width = ifelse(abs(scores(Sepal.Width, type = "z")) > 2.5, NA, Sepal.Width)) iris_na_outliers ``` ``` > # A tibble: 150 × 5 > Sepal.Length Sepal.Width Petal.Length Petal.Width Species > <dbl> <dbl> <dbl> <dbl> <fct> > 1 5.1 3.5 1.4 0.2 setosa > 2 4.9 3 1.4 0.2 setosa > 3 4.7 3.2 1.3 0.2 setosa > 4 4.6 3.1 1.5 0.2 setosa > 5 5 3.6 1.4 0.2 setosa > 6 5.4 3.9 1.7 0.4 setosa > 7 4.6 3.4 1.4 0.3 setosa > 8 5 3.4 1.5 0.2 setosa > 9 4.4 2.9 1.4 0.2 setosa > 10 4.9 3.1 1.5 0.1 setosa > # … with 140 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Tratamiento de .orange[OUTLIERS] ```r iris_na_outliers %>% filter(is.na(Sepal.Width)) ``` ``` > # A tibble: 2 × 5 > Sepal.Length Sepal.Width Petal.Length Petal.Width Species > <dbl> <dbl> <dbl> <dbl> <fct> > 1 5.7 NA 1.5 0.4 setosa > 2 5.5 NA 1.4 0.2 setosa ``` Tras ello tendremos **.bg-purple_light[dos opciones]**: **.bg-orange[eliminar]** dichas observaciones o **.bg-orange[imputar la media]** sin los ausentes (dado que los hemos detectado con la media) ```r # opción 1 iris_outliers <- iris_na_outliers %>% mutate(Sepal.Width = ifelse(is.na(Sepal.Width), mean(Sepal.Width, na.rm = TRUE), Sepal.Width)) ``` ```r # opción 2 iris_outliers <- iris_na_outliers %>% drop_na(Sepal.Width) ``` --- # Tratamiento de .orange[OUTLIERS] Si queremos hacer esto con varias variables a la vez, tendremos que usar de nuevo `across()` ```r iris_na_outliers <- iris %>% mutate(across(Sepal.Length:Petal.Width, function(x) { ifelse(abs(scores(x, type = "z")) > 2.5, NA, Sepal.Length) })) ``` -- Con `if_any()` dentro del `filter()` podemos mostrar todo los registros detectados como outlier en alguna variable. ```r iris_na_outliers %>% filter(if_any(Sepal.Length:Petal.Width, is.na)) ``` ``` > # A tibble: 2 × 5 > Sepal.Length Sepal.Width Petal.Length Petal.Width Species > <dbl> <dbl> <dbl> <dbl> <fct> > 1 5.7 NA 5.7 5.7 setosa > 2 5.5 NA 5.5 5.5 setosa ``` --- # Tratamiento de .orange[OUTLIERS] Trassu detección y análisis podemos o imputarles a todos la media (de la variable en cuestión) o eliminarlos. ```r # opción 1 iris_outliers <- iris_na_outliers %>% mutate(across(Sepal.Length:Petal.Width, function(x) { ifelse(is.na(x), mean(x, na.rm = TRUE), x) })) ``` ```r # opción 2 iris_outliers <- iris_na_outliers %>% drop_na() ``` --- # Tratamiento de .orange[OUTLIERS] * **.bg-purple_light[Atípico respecto a mediana]**: será un dato muy alejado de la **.bg-purple_light[mediana de la variable]**. ¿Cuánto de alejado? Una definición habitual (conocido como **filtro de Hampel**) es definir un dato atípico como aquel que se aleja de la mediana `\(k\)` veces la mediana de las desviaciones absolutas (conocida como `\(MAD = Me \left(\left| x_i - Me_x \right| \right)\)`). Un valor habitual es `\(k = 3\)`. `$$x_i > Me_{x} + k*MAD\quad \text{ o bien } \quad x_i< Me_{x} - k*MAD$$` Para ello nos bastará usar `scores()` con `type = "mad"` (y nos devolverá de nuevo ese `\(k\)`). ```r abs(scores(c(1, -1, 0, 5, 2, 1.5, 0.5, -0.3, 0, 2, 1.7, 0.2, -0.8), type = "mad")) ``` ``` > [1] 0.3372454 1.0117361 0.3372454 3.0352084 1.0117361 0.6744908 0.0000000 > [8] 0.5395926 0.3372454 1.0117361 0.8093889 0.2023472 0.8768380 ``` El **.bg-purple_light[valor a imputar sería la mediana]** --- # Tratamiento de .orange[OUTLIERS] * **.bg-purple_light[Atípico respecto a percentiles]**: será un dato muy alejado de los **.bg-purple_light[cuartiles de la variable]**. ¿Cuánto de alejado? Una definición habitual es definir un dato atípico como aquel que se aleja de los cuartiles 1 y 3 (percentiles 25 y 75) `\(k\)` veces el rango intercuartílico ($IQR = Q_3 - Q_1$). Un valor habitual es `\(k = 1.5\)`). `$$x_i > Q_3 + k* IQR \quad \text{ o bien } \quad x_i < Q_1 - k*IQR$$` Para ello nos bastará usar `scores()` con `type = "iqr"` (y nos devolverá de nuevo ese `\(k\)`, siendo `\(k = 0\)` para lo que esté dentro del IQR). ```r abs(scores(c(1, -1, 0, 5, 2, 1.5, 0.5, -0.3, 0, 2, 1.7, 0.2, -0.8), type = "iqr")) ``` ``` > [1] 0.0000000 0.5882353 0.0000000 1.9411765 0.1764706 0.0000000 0.0000000 > [8] 0.1764706 0.0000000 0.1764706 0.0000000 0.0000000 0.4705882 ``` El **.bg-purple_light[valor a imputar sería la mediana]** --- # Tratamiento de .orange[OUTLIERS] Existen otros procedimientos **.bg-purple_light[basados en inferencia estadística]** (muchos de ellos en el paquete `{outliers}`) * **.bg-purple_light[Tests de Grubbs y Dixon]**: ambos test nos permiten **.bg-purple_light[detectar si el valor más alto (o bajo)]** de una varibale es un outlier, pudiendo detectar un solo outlier en cada iteración (en caso de detectarlo, deberíamos tratarlo y volver a ejecutar el test) `\(\mathcal{H}_0: \text{valor más alto/bajo no es outlier}\)` `\(\mathcal{H}_1: \text{ valor más alto/bajo sí es outlier}\)` El test de Dixon (basado en una ordenación) suele funcionar mejor cuando tenemos poca muestra que el test de Grubbs (basado en la media). 📚 Ver más documentación de su funcionamiento en <https://www.itl.nist.gov/div898/handbook/eda/section3/eda35h1.htm> y <https://www.statisticshowto.com/dixons-q-test/> --- # Tratamiento de .orange[OUTLIERS] Por ejemplo, para el de Dixon existe `dixon.test()` ```r x <- c(1, -1, 0, 5, 2, 1.5, 0.5, -0.3, 0, 2, 1.7, 0.2, -0.8) dixon.test(x, opposite = TRUE) # valor más bajo ``` ``` > > Dixon test for outliers > > data: x > Q = 0.23333, p-value = 0.8072 > alternative hypothesis: lowest value -1 is an outlier ``` ```r x <- c(1, -1, 0, 5, 2, 1.5, 0.5, -0.3, 0, 2, 1.7, 0.2, -0.8) dixon.test(x, opposite = FALSE) # valor más alto ``` ``` > > Dixon test for outliers > > data: x > Q = 0.51724, p-value = 0.1055 > alternative hypothesis: highest value 5 is an outlier ``` --- # Tratamiento de .orange[OUTLIERS] * **.bg-purple_light[Test de Rosner]**: al contrario que los anteriores, nos permite **.bg-purple_light[detectar varios outliers]** a la vez, especialmente diseñado para evitar que un valor atípico nos perturbe tanto que nos enmascare otro (basado en la media). Podemos ejecutarlo con la función `rosnerTest()` del paquete `{EnvStats}`. **.bg-red_light[IMPORTANTE]**: la detección de outliers deberá combinar el análisis numérico y la visualización. 📚 Ver más documentación de su funcionamiento en <https://vsp.pnnl.gov/help/vsample/rosners_outlier_test.htm> --- # Tratamiento de .orange[OUTLIERS] En el caso de que tengamos **.bg-purple_light[variables categoricas (factores)]** la detección más inmediata sería haciendo uso de la tabla de frecuencias proporcionada por `fct_count()` ```r datos <- tibble("estado" = c(rep("grave", 18), rep("sano", 10), "muerto", "UCI")) datos <- datos %>% mutate(estado = factor(estado, levels = c("sano", "grave", "UCI", "muerto"), ordered = TRUE)) datos$estado %>% fct_count() %>% mutate(f = 100 * n/sum(n)) ``` ``` > # A tibble: 4 × 2 > f n > <dbl> <int> > 1 33.3 10 > 2 60 18 > 3 3.33 1 > 4 3.33 1 ``` --- # Tratamiento de .orange[OUTLIERS] Con `fct_lump_prop()` podemos **.bg-purple_light[agrupar niveles que no aparezcan un mínimo]** de veces, por ejemplo que representen menos del 5% de los datos, con `prop = 0.05`. Y ese nivel "otros" podremos **.bg-purple_light[asignarle la moda]** del resto de valores. ```r datos <- datos %>% mutate(estado = fct_lump_prop(estado, prop = 0.05, other_level = "otros")) datos ``` ``` > # A tibble: 30 × 1 > estado > <ord> > 1 grave > 2 grave > 3 grave > 4 grave > 5 grave > 6 grave > 7 grave > 8 grave > 9 grave > 10 grave > # … with 20 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Modificación: .orange[reescalado/tipificación] Por último, antes de poder aplicar nuestra métrica necesitaremos **.bg-purple_light[reescalar por rango]** (para distancias geométricas, con `rescale()` del paquete `{scales}`) o **.bg-purple_light[tipificar]** (para distancias probabilísticas, con `scale()`) ```r # Escalado library(scales) iris_final <- iris_outliers %>% mutate(across(Sepal.Length:Petal.Width, rescale)) ``` ```r # Tipificado iris_final <- iris_outliers %>% mutate(across(Sepal.Length:Petal.Width, scale)) ``` --- name: knn-steps # .orange[EXPLORACIÓN] y .green[MODIFICACIÓN] * **.bg-purple_light[Muestreo]**: - ¿Hace falta? ¿Estratificado? ¿Tenemos la variable objetivo balanceada? * **.bg-purple_light[Exploración]**: - Resúmenes numéricos (¿simetría? ¿dispersión? ¿ausentes? ¿codificación?) - Dependencia entre variables (correlación, dependencia, predictoras vs objetivo) - Visualización de datos (pendiente) * **.bg-purple_light[Depuración/modificación]**: - Análisis de outliers (¿se imputan? ¿se mandan a NA? ¿se eliminan?) - Tratamiento de ausentes (¿se imputan? ¿se eliminan?) - Selección de variables (¿colinealidad? ¿varianza cero? ¿necesitamos tener solo numéricas?) - Recategorizar (dummy,cuanti a cuali, codificación etc) - Estandarizar para métricas (rango y media-varianza) - Crear nuevas variables --- # Caso concreto: .orange[KNN EN IRIS] * **.bg-purple_light[Muestreo]**: - **¿Hace falta?** --> En el caso del `iris` no necesitamos hacerlo ya que tenemos pocas observaciones y además la variable objetivo está balanceada, algo que podemos comprobar fácil con `count()` (podemos usar `mutate()` para construir la tabla de frecuencias). ```r iris %>% count(Species) %>% mutate(porc = 100 * n/sum(n)) ``` ``` > # A tibble: 3 × 3 > Species n porc > <fct> <int> <dbl> > 1 setosa 50 33.3 > 2 versicolor 50 33.3 > 3 virginica 50 33.3 ``` --- # Caso concreto: .orange[KNN EN IRIS] * **.bg-purple_light[Exploración]**: - Resúmenes numéricos (¿simetría? ¿dispersión? ¿ausentes? ¿codificación?) .pull-left[ ```r library(skimr) iris %>% skim() ``` ] .pull-right[ <img src="./img/skim.jpg" width="100%" style="display: block; margin: auto;" /> ] No parece que tengamos **.bg-purple_light[problemas de codificación o rango]** y tampoco tenemos **.bg-purple_light[datos ausentes]** (`complete_rate` sale en todas 1). La **.bg-purple_light[variable con mayor dispersión]** es `Petal.Length`. --- # Caso concreto: .orange[KNN EN IRIS] * **.bg-purple_light[Exploración]**: - Dependencia entre variables (correlación, dependencia, **predictoras vs objetivo**) ```r iris %>% group_by(Species) %>% summarise(mean = across(Sepal.Length:Petal.Width, mean)) %>% ungroup() ``` ``` > # A tibble: 3 × 2 > Species mean$Sepal.Length $Sepal.Width $Petal.Length $Petal.Width > <fct> <dbl> <dbl> <dbl> <dbl> > 1 setosa 5.01 3.43 1.46 0.246 > 2 versicolor 5.94 2.77 4.26 1.33 > 3 virginica 6.59 2.97 5.55 2.03 ``` Las **.bg-purple_light[variables relacionadas con el sépalo]** no parece que cambien mucho de una especie a otra. Las **.bg-purple_light[variables relacionadas con el pétalo]** si parecen ser determinantes ya que la especie setosa tiene valores muy pequeños. Seguramente lo más complicado sea clasificar entre versicolor y virginica (se diferencian muy ligeramente) --- # Caso concreto: .orange[KNN EN IRIS] * **.bg-purple_light[Exploración]**: - Dependencia entre variables (**correlación**, dependencia, predictoras vs objetivo) ```r library(corrr) library(corrplot) correlate(iris %>% select(where(is.numeric))) ``` ``` > # A tibble: 4 × 5 > term Sepal.Length Sepal.Width Petal.Length Petal.Width > <chr> <dbl> <dbl> <dbl> <dbl> > 1 Sepal.Length NA -0.118 0.872 0.818 > 2 Sepal.Width -0.118 NA -0.428 -0.366 > 3 Petal.Length 0.872 -0.428 NA 0.963 > 4 Petal.Width 0.818 -0.366 0.963 NA ``` ```r # corrplot(iris %>% %>% select(where(is.numeric)) %>% cor()) ``` Parece que hay una **.bg-purple_light[altísima correlación]** entre la anchura y la longitud del sépalo (alguna habrá que eliminar en la siguiente fase para evitar problemas de colinealidad) --- # Caso concreto: .orange[KNN EN IRIS] * **.bg-purple_light[Depuración/modificación]**: - **Análisis de outliers** --> en este caso a las dos primeras variables (muy simétricas) detectaremos por la media, en las dos últimas por mediana y lo pasamos a ausente. ```r iris_na_outliers <- iris %>% mutate(across(Sepal.Length:Sepal.Width, function(x) { ifelse(abs(scores(x, type = "z")) > 2.5, NA, x) }), across(Petal.Length:Petal.Width, function(x) { ifelse(abs(scores(x, type = "mad")) > 3, NA, x) })) iris_na_outliers %>% filter(if_any(Sepal.Length:Petal.Width, is.na)) ``` ``` > # A tibble: 2 × 5 > Sepal.Length Sepal.Width Petal.Length Petal.Width Species > <dbl> <dbl> <dbl> <dbl> <fct> > 1 5.7 NA 1.5 0.4 setosa > 2 5.5 NA 1.4 0.2 setosa ``` --- # Caso concreto: .orange[KNN EN IRIS] * **.bg-purple_light[Depuración/modificación]**: - Tratamiento de **ausentes** --> en este caso los imputaremos por media en las dos primeras y por mediana en las dos segundas. ```r iris_outliers <- iris_na_outliers %>% mutate(across(Sepal.Length:Sepal.Width, function(x) { ifelse(is.na(x), mean(x, rm.na = TRUE), x) }), across(Petal.Length:Petal.Width, function(x) { ifelse(is.na(x), median(x, rm.na = TRUE), x) })) ``` --- # Caso concreto: .orange[KNN EN IRIS] * **.bg-purple_light[Depuración/modificación]**: - Selección de variables (¿colinealidad? ¿varianza cero? ¿necesitamos tener solo numéricas?) --> en este caso ya tenemos solo predictoras numéricas y no tenemos varianza cero (variables de constantes), así que solo necesitamos **.bg-purple_light[volver a mirar correlación]** ```r correlate(iris_outliers %>% select(where(is.numeric))) ``` ``` > # A tibble: 4 × 5 > term Sepal.Length Sepal.Width Petal.Length Petal.Width > <chr> <dbl> <dbl> <dbl> <dbl> > 1 Sepal.Length NA -0.113 0.872 0.818 > 2 Sepal.Width -0.113 NA -0.406 -0.344 > 3 Petal.Length 0.872 -0.406 NA 0.963 > 4 Petal.Width 0.818 -0.344 0.963 NA ``` Seguimos observando una alta correlación entre `Petal.Length` y `Petal.Width`: eliminaremos la primera ya que es la que tiene una correlación más alta (en valor absoluto) con las demás ```r iris_colin <- iris_outliers %>% select(-Petal.Length) ``` --- # Caso concreto: .orange[KNN EN IRIS] * **.bg-purple_light[Depuración/modificación]**: - **Recategorizar** --> no necesitamos hacerlo en este caso - Crear **nuevas variables** --> no necesitamos hacerlo en este caso - **Estandarizar** para métricas --> vamos a usar distancias geométricas así que habrá que normalizar por rango. ```r library(scales) iris_final <- iris_colin %>% mutate(across(c(everything(), -Species), rescale)) iris_final ``` ``` > # A tibble: 150 × 4 > Sepal.Length Sepal.Width Petal.Width Species > <dbl> <dbl> <dbl> <fct> > 1 0.222 0.714 0.0417 setosa > 2 0.167 0.476 0.0417 setosa > 3 0.111 0.571 0.0417 setosa > 4 0.0833 0.524 0.0417 setosa > 5 0.194 0.762 0.0417 setosa > 6 0.306 0.905 0.125 setosa > 7 0.0833 0.667 0.0833 setosa > 8 0.194 0.667 0.0417 setosa > 9 0.0278 0.429 0.0417 setosa > 10 0.167 0.524 0 setosa > # … with 140 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Caso concreto: .orange[KNN EN IRIS] Este sería el **.bg-purple_light[código completo de nuestra depuración]** ```r iris_final <- iris %>% mutate(across(Sepal.Length:Sepal.Width, function(x) { ifelse(abs(scores(x, type = "z")) > 2.5, mean(x, rm.na = TRUE), x) }), across(Petal.Length:Petal.Width, function(x) { ifelse(abs(scores(x, type = "mad")) > 3, median(x, rm.na = TRUE), x) })) %>% select(-Petal.Length) %>% mutate(across(c(everything(), -Species), rescale)) iris_final ``` ``` > # A tibble: 150 × 4 > Sepal.Length Sepal.Width Petal.Width Species > <dbl> <dbl> <dbl> <fct> > 1 0.222 0.714 0.0417 setosa > 2 0.167 0.476 0.0417 setosa > 3 0.111 0.571 0.0417 setosa > 4 0.0833 0.524 0.0417 setosa > 5 0.194 0.762 0.0417 setosa > 6 0.306 0.905 0.125 setosa > 7 0.0833 0.667 0.0833 setosa > 8 0.194 0.667 0.0417 setosa > 9 0.0278 0.429 0.0417 setosa > 10 0.167 0.524 0 setosa > # … with 140 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- name: tidymodels # Modelando con .orange[TIDYMODELS] Una vez que sabemos que proceso necesitamos aplicar a los datos, vamos a introducirnos en la idea del **.bg-purple_light[tidymodels]**: un marco de trabajo, bajo los principios de tidyverse, para aplicar **.bg-purple_light[modelos Machine Learning]**. Puedes ver documentación en <https://www.tidymodels.org/> .pull-left[ ```r install.packages("tidymodels") library(tidymodels) ``` ] .pull-right[ <img src="./img/tidymodels.jpg" width="80%" style="display: block; margin: auto auto auto 0;" /> ] --- # Modelando con .orange[TIDYMODELS] En uno de los paquetes de `{tidymodels}`, el paquete `{rsample}`, nos proporciona **.bg-purple_light[herramientas para generar particiones]** de train-validación-test al inicio de nuestro proceso. -- Usaremos la función `initial_split()`, de forma estratificada por la variable objetivo con * `strata = Species` indicándole la variable por la que estratificar * `prop = 0.7` indicándole que el 70% será train y el 30% test (de momento sin validación). ```r library(tidymodels) iris_split <- initial_split(iris, strata = Species, prop = 0.7) ``` **.bg-red_light[IMPORTANTE]**: la partición deberá hacer siempre DESPUÉS de un posible muestreo (si fuese necesario). --- # Modelando con .orange[TIDYMODELS] En `iris_split` no se **.bg-purple_light[ejecutado nada]**: solo están guaradas las **.bg-purple_light[instrucciones]**. .pull-left[ ```r iris_split ``` ``` > <Analysis/Assess/Total> > <105/45/150> ``` ] .pull-right[ ```r iris_train <- training(iris_split) iris_test <- testing(iris_split) ``` ] -- Tras aplicar las instrucciones, comprobamos la estratificación. ```r iris_train %>% count(Species) %>% mutate(porc = n / sum(n)) ``` ``` > # A tibble: 3 × 3 > Species n porc > <fct> <int> <dbl> > 1 setosa 35 0.333 > 2 versicolor 35 0.333 > 3 virginica 35 0.333 ``` --- # Modelando con .orange[TIDYMODELS] La idea detrás de la filosofía de `{tidymodels}` es tratar por separado la **.bg-purple_light[depuración]** de los datos, el **.bg-purple_light[modelo]** o paradigma de aprendizaje que se quiere aplicar, la **.bg-purple_light[optimización de los parámetros]** de dicho modelo, el **ajuste**, la **evaluación** y la **predicción** correspondiente. El objetivo será crear un **.bg-purple_light[flujo de trabajo flexible]**, con una filosofía similar a la que hay detrás de cocinar un plato: * **.bg-purple_light[Escribimos la receta]**: una lista de pasos e instrucciones. * **.bg-purple_light[Preparamos los utensilios de cocina]**: en nuestro caso, el modelo. * **.bg-purple_light[Cocinamos]**: con la receta + utensilios podemos **.bg-purple_light[cocinar el plato muchas veces]**, con **.bg-purple_light[distintos lotes de ingredientes (datos)]**. También podemos aplicar una **.bg-purple_light[receta distinta a distintos ingredientes]**, o incluso **.bg-purple_light[combinar partes de dos recetas]**. --- # Modelando con .orange[TIDYMODELS] El primer paso en nuestra receta será indicarle en `recipe()` los **.bg-purple_light[datos]** y la **.bg-purple_light[«fórmula»]** de nuestro modelo (en nuestro caso le indicaremos que vamos la objetivo será `Species` frente al resto de predictoras numéricas). La receta **.bg-purple_light[guardará los roles]**: 4 predictoras y 1 objetivo ```r iris_rec <- recipe(data = iris_train, Species ~ .) ``` .pull-left[ ```r iris_rec ``` ``` > Recipe > > Inputs: > > role #variables > outcome 1 > predictor 4 ``` ] .pull-right[ ```r summary(iris_rec) ``` ``` > # A tibble: 5 × 4 > variable type role source > <chr> <chr> <chr> <chr> > 1 Sepal.Length numeric predictor original > 2 Sepal.Width numeric predictor original > 3 Petal.Length numeric predictor original > 4 Petal.Width numeric predictor original > 5 Species nominal outcome original ``` ] --- # Modelando con .orange[TIDYMODELS] Una receta puede **.bg-purple_light[asignar varios roles]** a cada variable: una variable puede ser `predictor`, `outcome` o cualquier otro rol no predefinido. * `update_role()`: **.bg-purple_light[modifica]** el rol (lo crea si no tiene, borra si lo tenía). ```r iris_rec <- recipe(data = iris_train, Species ~ .) %>% update_role(starts_with("Sepal"), new_role = "sepal") %>% update_role(starts_with("Petal"), new_role = "petal") ``` .pull-left[ ```r iris_rec ``` ``` > Recipe > > Inputs: > > role #variables > outcome 1 > petal 2 > sepal 2 ``` ] .pull-right[ ```r summary(iris_rec) ``` ``` > # A tibble: 5 × 4 > variable type role source > <chr> <chr> <chr> <chr> > 1 Sepal.Length numeric sepal original > 2 Sepal.Width numeric sepal original > 3 Petal.Length numeric petal original > 4 Petal.Width numeric petal original > 5 Species nominal outcome original ``` ] --- # Modelando con .orange[TIDYMODELS] * `add_role()`: **.bg-purple_light[añade]** un rol a una variable que ya tiene uno (no borra el ya existente) ```r iris_rec <- iris_rec %>% add_role(ends_with("Length"), new_role = "length") %>% add_role(ends_with("Width"), new_role = "width") ``` .pull-left[ ```r iris_rec ``` ``` > Recipe > > Inputs: > > role #variables > length 2 > outcome 1 > petal 2 > sepal 2 > width 2 ``` ] .pull-right[ ```r summary(iris_rec) ``` ``` > # A tibble: 9 × 4 > variable type role source > <chr> <chr> <chr> <chr> > 1 Sepal.Length numeric sepal original > 2 Sepal.Length numeric length original > 3 Sepal.Width numeric sepal original > 4 Sepal.Width numeric width original > 5 Petal.Length numeric petal original > 6 Petal.Length numeric length original > 7 Petal.Width numeric petal original > 8 Petal.Width numeric width original > 9 Species nominal outcome original ``` ] --- # Modelando con .orange[TIDYMODELS] * `remove_role()`: **.bg-purple_light[elimina]** un rol ya existente ```r iris_rec <- iris_rec %>% remove_role(ends_with("Length"), old_role = "length") %>% remove_role(ends_with("Width"), old_role = "width") %>% remove_role(starts_with("Sepal"), old_role = "sepal") %>% remove_role(starts_with("Petal"), old_role = "petal") ``` .pull-left[ ```r iris_rec ``` ``` > Recipe > > Inputs: > > role #variables > outcome 1 > > 4 variables with undeclared roles ``` ] .pull-right[ ```r summary(iris_rec) ``` ``` > # A tibble: 5 × 4 > variable type role source > <chr> <chr> <chr> <chr> > 1 Sepal.Length numeric <NA> original > 2 Sepal.Width numeric <NA> original > 3 Petal.Length numeric <NA> original > 4 Petal.Width numeric <NA> original > 5 Species nominal outcome original ``` ] --- # Modelando con .orange[TIDYMODELS] La idea es que las acciones que hagamos de depuración podremos **.bg-purple_light[personalizarlas para cada tipo de rol]**. La idea es **.bg-purple_light[añadir pasos]** la `recipe()`, algo así como la receta escrita que tenemos guardada en un cajón para preparar un plato: la receta por sí sola no te cocina, simplemente es una lista de instrucciones, lista para cuando la necesites. Las funciones que empiezan por `step_...()` tienen **.bg-purple_light[implementadas muchas de las funcionalidades tidyverse]**: la diferencia al incluirlo en la receta es que se **.bg-purple_light[ejecutará en todas las particiones]** cada vez que dicha receta se aplique (pudiéndose aplicar a diferentes modelos). * `step_arrange()` * `step_filter()` * `step_count()` * `step_mutate()` * `step_select()` --- # Modelando con .orange[TIDYMODELS] En nuestro caso, en la receta indicaremos la **.bg-purple_light[lista de acciones que hemos decidido]** en diapositivas anteriores (con `step_...()`) ```r iris_rec <- recipe(data = iris_train, Species ~ .) %>% step_mutate(across(Sepal.Length:Sepal.Width, function(x) { ifelse(abs(scores(x, type = "z")) > 2.5, mean(x, rm.na = TRUE), x) }), across(Petal.Length:Petal.Width, function(x) { ifelse(abs(scores(x, type = "mad")) > 3, median(x, rm.na = TRUE), x) })) %>% step_select(-Petal.Length) %>% step_mutate(across(c(everything(), -Species), rescale)) ``` --- # Modelando con .orange[TIDYMODELS] ```r iris_rec ``` ``` > Recipe > > Inputs: > > role #variables > outcome 1 > predictor 4 > > Operations: > > Variable mutation for across(Sepal.Length:Sepal.Width, function(... > Variables selected -Petal.Length > Variable mutation for across(c(everything(), -Species), rescale) ``` --- # .orange[TIDYMODELS]: .green[RECIPE] Lo hecho anteriormente es una traducción literal (con `step_...()`) de lo que sabíamos hacer con tidyverse. Pero además de todo eso tendremos **.bg-purple_light[muchas funciones concretas para facilitar]** la depuración de nuestras variables (por roles). -- Dado que el tratamiento de outliers lo estamos haciendo de manera distinta en las variables de sépalo que en las de pétalo, lo primero que haremos es **.bg-purple_light[asignar]** roles (sin eliminar el rol de predictor que ya tiene, así que lo haremos con `add_role()`) ```r iris_rec <- recipe(data = iris_train, Species ~ .) %>% add_role(starts_with("Sepal"), new_role = "sepal") %>% add_role(starts_with("Petal"), new_role = "petal") ``` --- # .orange[TIDYMODELS]: .green[RECIPE] Tras ello **.bg-purple_light[detectaremos outliers]** (transformando a `NA`) ```r iris_rec <- iris_rec %>% step_mutate(across(starts_with("Sepal"), function(x) { ifelse(abs(scores(x, type = "z")) > 2.5, NA, x) }), across(starts_with("Petal"), function(x) { ifelse(abs(scores(x, type = "mad")) > 3, NA, x) })) ``` -- Y decidiremos cómo **.bg-purple_light[tratar los ausentes]** (los existentes y los generados al detectar los outliers). Tenemos muchísimas funciones para ello (ver `step_impute_...()`): .pull-left[ * `step_impute_mean()`, `step_impute_median()` y `step_impute_mode()`: imputamos por media, mediana o moda. * `step_impute_knn()`: usaremos un knn previo para imputar los ausentes. ] .pull-right[ ```r iris_rec <- iris_rec %>% step_impute_mean(has_role("sepal")) %>% step_impute_median(has_role("petal")) ``` Fíjate la **.bg-purple_light[utilidad de los roles]**: con `has_role()` podemos indicarle a qué variables aplicar la acción. ] --- # .orange[TIDYMODELS]: .green[RECIPE] Para tratar los **.bg-purple_light[problemas de colinealidad]** usaremos directamente `step_corr()`, al que le tendremos que pasar un umbral en `threshold`: se queda solo con una variable de todo par de variables cuya **.bg-purple_light[correlación en valor absoluto supere el umbral]** (en este caso usaremos `all_numeric_predictors()` para considerar solo las predictoras numéricas) ```r iris_rec <- iris_rec %>% step_corr(all_numeric_predictors(), threshold = 0.9) ``` -- Por último, le indicaremos con `step_range()` que nos **.bg-purple_light[normalice por rango]** las variables predictoras que sean numéricas, y añadimos siempre un último **.bg-purple_light[filtro de cero varianza]** para que nos elimine las variables con varianza constante. ```r iris_rec <- iris_rec %>% step_range(all_numeric_predictors()) %>% step_zv(all_predictors()) ``` --- # .orange[TIDYMODELS]: .green[RECIPE] Esta será por tanto nuestra **receta completa**: ```r iris_rec <- # Fórmula y datos recipe(data = iris_train, Species ~ .) %>% # Roles add_role(starts_with("Sepal"), new_role = "sepal") %>% add_role(starts_with("Petal"), new_role = "petal") %>% # Detectar outliers step_mutate(across(starts_with("Sepal"), function(x) { ifelse(abs(scores(x, type = "z")) > 2.5, NA, x) }), across(starts_with("Petal"), function(x) { ifelse(abs(scores(x, type = "mad")) > 3, NA, x) })) %>% # Imputar ausentes step_impute_mean(has_role("sepal")) %>% step_impute_median(has_role("petal")) %>% # Filtro de correlación step_corr(all_numeric_predictors(), threshold = 0.9) %>% # Normalizar por rango step_range(all_numeric_predictors()) %>% # Filtro de cero varianza step_zv(all_predictors()) ``` --- # .orange[TIDYMODELS]: .green[RECIPE] ```r iris_rec ``` ``` > Recipe > > Inputs: > > role #variables > outcome 1 > petal 2 > predictor 4 > sepal 2 > > Operations: > > Variable mutation for across(starts_with("Sepal"), function(x) {... > Mean imputation for has_role("sepal") > Median imputation for has_role("petal") > Correlation filter on all_numeric_predictors() > Range scaling to [0,1] for all_numeric_predictors() > Zero variance filter on all_predictors() ``` --- # .orange[TIDYMODELS]: .green[RECIPE] Tras «redactar» la receta **.bg-purple_light[hornear la receta]** a unos datos, haciiendo uso de `bake()`, y en `new_data` le podemos indicar el dataset al que aplicaremos la receta (si `new_data = NULL`, se hará con el conjunto de entrenamiento). ```r bake(iris_rec %>% prep(), new_data = NULL) ``` ``` > # A tibble: 105 × 4 > Sepal.Length Sepal.Width Petal.Width Species > <dbl> <dbl> <dbl> <fct> > 1 0.222 0.684 0.0417 setosa > 2 0.167 0.421 0.0417 setosa > 3 0.111 0.526 0.0417 setosa > 4 0.0833 0.474 0.0417 setosa > 5 0.194 0.737 0.0417 setosa > 6 0.306 0.895 0.125 setosa > 7 0.0833 0.632 0.0833 setosa > 8 0.167 0.474 0 setosa > 9 0.306 0.789 0.0417 setosa > 10 0.139 0.632 0.0417 setosa > # … with 95 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Fase 4: .orange[MODELIZACIÓN] Tras la receta vamos a **.bg-purple_light[definir el modelo en abstracto]**, sin pasarle aún datos * `nearest_neighbor()`: definimos el modelo KNN - `mode = ...`: puede ser **"classification"** o **"regression"** - `neighbors = ...`: número k de vecinos. - `weight_func = ...`: método de ponderación de distancias. Las diferentes opciones de las puedes ver en <https://epub.ub.uni-muenchen.de/1769/> - `dist_power = ...`: exponente a usar en nuestra familia de métricas de Minkowski * `set_engine("kknn")`: motor interno que usa para optimizar el modelo. ```r knn_model <- nearest_neighbor(mode = "classification", neighbors = 10, weight_func = "inv", dist_power = 2) %>% set_engine("kknn") # «motor interno» que realiza el ajuste ``` --- # Fase 4: .orange[MODELIZACIÓN] ```r knn_model <- nearest_neighbor(mode = "classification", neighbors = 10, weight_func = "inv", dist_power = 2) %>% set_engine("kknn") # «motor interno» que realiza el ajuste knn_model ``` ``` > K-Nearest Neighbor Model Specification (classification) > > Main Arguments: > neighbors = 10 > weight_func = inv > dist_power = 2 > > Computational engine: kknn ``` --- # .orange[TIDYMODELS]: .green[FLUJO] * Tenemos una **.bg-purple_light[receta]** para preprocesar los datos, una lista de instrucciones. * Tenemos los **.bg-purple_light[utensilios de cocina]** (modelo). * Tenemos los **.bg-purple_light[ingredientes (datos)]** Todo ello lo **.bg-purple_light[juntaremos en un flujo de trabajo]** con `workflow()` ```r iris_wflow <- workflow() %>% add_recipe(iris_rec) %>% add_model(knn_model) iris_wflow ``` ``` > ══ Workflow ════════════════════════════════════════════════════════════════════ > Preprocessor: Recipe > Model: nearest_neighbor() > > ── Preprocessor ──────────────────────────────────────────────────────────────── > 6 Recipe Steps > > • step_mutate() > • step_impute_mean() > • step_impute_median() > • step_corr() > • step_range() > • step_zv() > > ── Model ─────────────────────────────────────────────────────────────────────── > K-Nearest Neighbor Model Specification (classification) > > Main Arguments: > neighbors = 10 > weight_func = inv > dist_power = 2 > > Computational engine: kknn ``` --- # .orange[TIDYMODELS]: .green[AJUSTE] El siguiente paso, una vez que tenemos construido el flujo de trabajo, es **.bg-purple_light[aplicarlo al conjunto de entrenamiento]** con `fit(data = iris_train)` (es aquí donde el algoritmo aprenderá del conjunto de entrenamiento, aunque en el caso de knn deberá calcular siempre la distancia de cada punto al resto) ```r iris_knn_fit <- iris_wflow %>% fit(data = iris_train) iris_knn_fit ``` ``` > ══ Workflow [trained] ══════════════════════════════════════════════════════════ > Preprocessor: Recipe > Model: nearest_neighbor() > > ── Preprocessor ──────────────────────────────────────────────────────────────── > 6 Recipe Steps > > • step_mutate() > • step_impute_mean() > • step_impute_median() > • step_corr() > • step_range() > • step_zv() > > ── Model ─────────────────────────────────────────────────────────────────────── > > Call: > kknn::train.kknn(formula = ..y ~ ., data = data, ks = min_rows(10, data, 5), distance = ~2, kernel = ~"inv") > > Type of response variable: nominal > Minimal misclassification: 0.07619048 > Best kernel: inv > Best k: 10 ``` --- # Fase 5: .orange[PREDICCIÓN Y EVALUACIÓN] Tras realizar el ajuste, con `predict()` podremos **.bg-purple_light[obtener las predicciones]** de `Species` de nuestro **.bg-purple_light[conjunto de test]** (en este caso concreto del knn, lo que hará será calcular los vecinos de cada registro de test usando los registros de train) ```r predict(iris_knn_fit, iris_test) ``` ``` > # A tibble: 45 × 1 > .pred_class > <fct> > 1 setosa > 2 setosa > 3 setosa > 4 setosa > 5 setosa > 6 setosa > 7 setosa > 8 setosa > 9 setosa > 10 setosa > # … with 35 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Fase 5: .orange[PREDICCIÓN Y EVALUACIÓN] Recuerda que el objetivo de estos algoritmos es **.bg-purple_light[estimar aquellas probabilidades de pertenencia]** teóricas del clasificador Bayesiano (y que desconocemos), algo que podemos obtener añadiendo `type = "prob"` ```r predict(iris_knn_fit, iris_test, type = "prob") ``` ``` > # A tibble: 45 × 3 > .pred_setosa .pred_versicolor .pred_virginica > <dbl> <dbl> <dbl> > 1 1 0 0 > 2 1 0 0 > 3 1 0 0 > 4 1 0 0 > 5 1 0 0 > 6 1 0 0 > 7 1 0 0 > 8 1 0 0 > 9 1 0 0 > 10 1 0 0 > # … with 35 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Fase 5: .orange[PREDICCIÓN Y EVALUACIÓN] En muchas ocasiones querremos tener una **.bg-purple_light[visión conjunta]**: ver la clasificación realizada de cada registro pero también ver los valores de cada registro, juntando en una sola tabla los datos originales y las predicciones con `augment()` ```r prob_test <- augment(iris_knn_fit, iris_test) prob_test ``` ``` > # A tibble: 45 × 9 > Sepal.Length Sepal.…¹ Petal…² Petal…³ Species .pred…⁴ .pred…⁵ .pred…⁶ .pred…⁷ > <dbl> <dbl> <dbl> <dbl> <fct> <fct> <dbl> <dbl> <dbl> > 1 5 3.4 1.5 0.2 setosa setosa 1 0 0 > 2 4.4 2.9 1.4 0.2 setosa setosa 1 0 0 > 3 4.8 3 1.4 0.1 setosa setosa 1 0 0 > 4 5.8 4 1.2 0.2 setosa setosa 1 0 0 > 5 5.7 3.8 1.7 0.3 setosa setosa 1 0 0 > 6 5.1 3.8 1.5 0.3 setosa setosa 1 0 0 > 7 5.1 3.7 1.5 0.4 setosa setosa 1 0 0 > 8 4.6 3.6 1 0.2 setosa setosa 1 0 0 > 9 5.1 3.3 1.7 0.5 setosa setosa 1 0 0 > 10 4.8 3.1 1.6 0.2 setosa setosa 1 0 0 > # … with 35 more rows, and abbreviated variable names ¹Sepal.Width, > # ²Petal.Length, ³Petal.Width, ⁴.pred_class, ⁵.pred_setosa, > # ⁶.pred_versicolor, ⁷.pred_virginica > # ℹ Use `print(n = ...)` to see more rows ``` --- # Fase 5: .orange[PREDICCIÓN Y EVALUACIÓN] La **.bg-purple_light[matriz confusión]** de verdaderos positivos y negativos, y falsos positivos y negativos, de la que saldrán todas las métricas que usemos para **.bg-purple_light[evaluar nuestro modelo]** se podrán obtener con `conf_mat(truth = ..., estimate = ...)`, indicándole la **.bg-purple_light[columna con la clase real]** y la **.bg-purple_light[columna con la clase predicha]** (que como ves le podemos cambiar el nombre si queremos, por defecto es `.pred_class`) ```r conf_mat_test <- prob_test %>% rename(pred_species = .pred_class) %>% conf_mat(truth = Species, estimate = pred_species) conf_mat_test ``` ``` > Truth > Prediction setosa versicolor virginica > setosa 15 0 0 > versicolor 0 13 0 > virginica 0 2 15 ``` --- # Fase 5: .orange[PREDICCIÓN Y EVALUACIÓN] Por último podemos **.bg-purple_light[obtener la mayoría de métricas]** haciendo uso de `summary()`, aplicado a dicha matriz de confusión ```r conf_mat_test %>% summary() ``` ``` > # A tibble: 13 × 3 > .metric .estimator .estimate > <chr> <chr> <dbl> > 1 accuracy multiclass 0.956 > 2 kap multiclass 0.933 > 3 sens macro 0.956 > 4 spec macro 0.978 > 5 ppv macro 0.961 > 6 npv macro 0.979 > 7 mcc multiclass 0.936 > 8 j_index macro 0.933 > 9 bal_accuracy macro 0.967 > 10 detection_prevalence macro 0.333 > 11 precision macro 0.961 > 12 recall macro 0.956 > 13 f_meas macro 0.955 ``` --- # Fase 5: .orange[PREDICCIÓN Y EVALUACIÓN] ```r conf_mat_test %>% summary() %>% filter(.metric %in% c("accuracy", "sens", "spec")) ``` ``` > # A tibble: 3 × 3 > .metric .estimator .estimate > <chr> <chr> <dbl> > 1 accuracy multiclass 0.956 > 2 sens macro 0.956 > 3 spec macro 0.978 ``` Fíjate que aunque no sea un problema de clasificación binaria nos proporciona métricas como la sensibilidad y especificidad: lo que es, **.bg-purple_light[para cada clase, construir una matriz de confusión]** (ser setosa vs no serlo, ser virginica vs no serlo, ser versicolor vs no serlo), y devuelve la **.bg-purple_light[media de las tres sensibilidad o especificidades]** --- class: inverse center middle name: clase-8 # CLASE 8: profundizando en tidymodels ### [Repaso knn en iris](#repaso-knn-iris) ### [Complicamos el asunto: hoteles](#knn-hoteles) ### [Fase 2: exploratorio](#fase2-hoteles) ### [Fase 3: modificación](#fase3-hoteles) ### [Fase 4: modelización](#fase4-hoteles) ### [Fase 5: evaluación](#fase5-hoteles) --- # Fase 1: .orange[¿MUESTREO?] ```r iris %>% count(Species) %>% mutate(porc = 100 * n/sum(n)) ``` ``` > # A tibble: 3 × 3 > Species n porc > <fct> <int> <dbl> > 1 setosa 50 33.3 > 2 versicolor 50 33.3 > 3 virginica 50 33.3 ``` En el caso del `iris` no necesitamos hacerlo ya que tenemos pocas observaciones y, además, la **.bg-purple_light[variable objetivo está balanceada]** --- # Fase 2: .orange[EXPLORACIÓN] * **.bg-purple_light[Resumen numérico]**: ausentes, medidas de centralización, medidas de dispersión, problemas de codificación, etc. .pull-left[ ```r library(skimr) iris %>% skim() ``` ] .pull-right[ <img src="./img/skim.jpg" width="100%" style="display: block; margin: auto;" /> ] --- # Fase 2: .orange[EXPLORACIÓN] * **.bg-purple_light[Dependencia]**: correlación entre predictoras, **predictoras vs objetivo** ```r iris %>% group_by(Species) %>% summarise(mean = across(where(is.numeric), mean)) %>% ungroup() ``` ``` > # A tibble: 3 × 2 > Species mean$Sepal.Length $Sepal.Width $Petal.Length $Petal.Width > <fct> <dbl> <dbl> <dbl> <dbl> > 1 setosa 5.01 3.43 1.46 0.246 > 2 versicolor 5.94 2.77 4.26 1.33 > 3 virginica 6.59 2.97 5.55 2.03 ``` ```r library(corrplot) cor_matrix <- iris %>% select(where(is.numeric)) %>% cor() cor_matrix ``` ``` > Sepal.Length Sepal.Width Petal.Length Petal.Width > Sepal.Length 1.0000000 -0.1175698 0.8717538 0.8179411 > Sepal.Width -0.1175698 1.0000000 -0.4284401 -0.3661259 > Petal.Length 0.8717538 -0.4284401 1.0000000 0.9628654 > Petal.Width 0.8179411 -0.3661259 0.9628654 1.0000000 ``` ```r # corrplot(iris %>% %>% select(where(is.numeric)) %>% cor()) ``` --- # .orange[PARTICIONES] ```r # Partición 70-30% de train y test (solo instrucciones) iris_split <- initial_split(iris, strata = Species, prop = 0.7) iris_split ``` ``` > <Analysis/Assess/Total> > <105/45/150> ``` ```r # Aplicamos partición (ejecuta instrucciones) iris_train <- training(iris_split) iris_test <- testing(iris_split) # Comprobamos estratos iris_train %>% count(Species) %>% mutate(porc = 100 * n / sum(n)) ``` ``` > # A tibble: 3 × 3 > Species n porc > <fct> <int> <dbl> > 1 setosa 35 33.3 > 2 versicolor 35 33.3 > 3 virginica 35 33.3 ``` ```r iris_test %>% count(Species) %>% mutate(porc = 100 * n / sum(n)) ``` ``` > # A tibble: 3 × 3 > Species n porc > <fct> <int> <dbl> > 1 setosa 15 33.3 > 2 versicolor 15 33.3 > 3 virginica 15 33.3 ``` --- # Fase 3: .orange[MODIFICACIÓN] * **.bg-purple_light[Receta y roles]**: lo primero es **.bg-orange[definir la receta]** (indicando la partición de train y la objetivo vs todas) y los **.bg-orange[roles]** de las variables (permitiendo una depuración personalizada) ```r # Receta iris_rec <- recipe(data = iris_train, Species ~ .) %>% # Roles add_role(starts_with("Sepal"), new_role = "simétrica") %>% add_role(starts_with("Petal"), new_role = "no simétrica") iris_rec ``` ``` > Recipe > > Inputs: > > role #variables > no simétrica 2 > outcome 1 > predictor 4 > simétrica 2 ``` --- # Fase 3: .orange[MODIFICACIÓN] * **.bg-purple_light[Tipología de las variables]** --> todas las predictoras son numéricas (no necesito recategorizar o dummys) * **.bg-purple_light[Codificación de las variables]** --> todas mis variables tienen un **.bg-orange[rango coherente]** * **.bg-purple_light[Atípicos y ausentes]**. ¿Tengo **.bg-orange[valores atípicos (outliers)]**? ```r iris_rec <- iris_rec %>% # Detectar outliers step_mutate(across(starts_with("Sepal"), function(x) { ifelse(abs(scores(x, type = "z")) > 2.5, NA, x) }), across(starts_with("Petal"), function(x) { ifelse(abs(scores(x, type = "mad")) > 3, NA, x) })) ``` --- # Fase 3: .orange[MODIFICACIÓN] * **.bg-purple_light[Ausentes]**: ¿tengo **.bg-orange[datos ausentes]**? ¿Cómo los imputo? ```r iris_rec <- iris_rec %>% # Imputar ausentes step_impute_mean(has_role("simétrica")) %>% step_impute_median(has_role("no simétrica")) ``` * **.bg-purple_light[Añadir info]** --> en este caso no necesito **crear nuevas variables** que nos aporte info extra --- # Fase 3: .orange[MODIFICACIÓN] * **.bg-purple_light[Selección de variables]**. ¿Necesito seleccionar variables? ¿Tengo **.bg-orange[problemas de dependencia o colinealidad]**? ¿Tengo alguna de varianza cero (es decir, sin información)? * **.bg-purple_light[Normalizar variables]**. ¿Tengo ya mis variables preparadas (tras tratar lo anterior) para la métrica que vaya usar? ```r iris_rec <- iris_rec %>% # Filtro de correlación step_corr(all_numeric_predictors(), threshold = 0.9)%>% # Filtro de cero varianza step_zv(all_predictors()) %>% # Normalizar por rango step_range(all_numeric_predictors()) ``` --- # .orange[HORNEADO] **.bg-purple_light[Horneamos la receta]** sobre las particiones para comprobar que la fase 3 se ha realizado correctamente ```r bake(iris_rec %>% prep(), new_data = NULL) ``` ``` > # A tibble: 105 × 4 > Sepal.Length Sepal.Width Petal.Width Species > <dbl> <dbl> <dbl> <fct> > 1 0.111 0.545 0.0417 setosa > 2 0.0833 0.5 0.0417 setosa > 3 0.306 0.864 0.125 setosa > 4 0.194 0.636 0.0417 setosa > 5 0.167 0.5 0 setosa > 6 0.306 0.773 0.0417 setosa > 7 0.139 0.636 0.0417 setosa > 8 0.139 0.455 0 setosa > 9 0 0.455 0 setosa > 10 0.417 0.909 0.0417 setosa > # … with 95 more rows > # ℹ Use `print(n = ...)` to see more rows ``` ```r bake(iris_rec %>% prep(), new_data = iris_test) ``` ``` > # A tibble: 45 × 4 > Sepal.Length Sepal.Width Petal.Width Species > <dbl> <dbl> <dbl> <fct> > 1 0.222 0.682 0.0417 setosa > 2 0.167 0.455 0.0417 setosa > 3 0.194 0.727 0.0417 setosa > 4 0.0833 0.636 0.0833 setosa > 5 0.0278 0.409 0.0417 setosa > 6 0.389 0.818 0.0833 setosa > 7 0.194 0.455 0.0417 setosa > 8 0.25 0.682 0.0417 setosa > 9 0.139 0.5 0.0417 setosa > 10 0.194 0.545 0.0417 setosa > # … with 35 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Fase 4: .orange[MODELADO] Definimos los **.bg-purple_light[parámetros de nuestro modelo]** ```r # Modelo knn knn_model <- nearest_neighbor(mode = "classification", neighbors = 10, weight_func = "inv", dist_power = 2) %>% set_engine("kknn") # el «motor» que realiza el ajuste knn_model ``` ``` > K-Nearest Neighbor Model Specification (classification) > > Main Arguments: > neighbors = 10 > weight_func = inv > dist_power = 2 > > Computational engine: kknn ``` --- # .orange[FLUJO Y AJUSTE]: receta (fase 3) + modelo (fase 4) ```r # Flujo iris_wflow <- workflow() %>% add_recipe(iris_rec) %>% add_model(knn_model) # Ajuste iris_knn_fit <- iris_wflow %>% fit(data = iris_train) ``` --- # Fase 5: .orange[PREDICCIÓN/EVALUACIÓN] Usando `predict()` obtenemos las predicciones (usando el ajuste, y le proporcionamos un archivo a clasificar, en este caso test). Nos **.bg-purple_light[devuelve la clase predicha]** ```r # Predecir el conjunto test: devuelve la clase predict(iris_knn_fit, iris_test) ``` ``` > # A tibble: 45 × 1 > .pred_class > <fct> > 1 setosa > 2 setosa > 3 setosa > 4 setosa > 5 setosa > 6 setosa > 7 setosa > 8 setosa > 9 setosa > 10 setosa > # … with 35 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Fase 5: .orange[PREDICCIÓN/EVALUACIÓN] Con `type = prob` obtenemos la **.bg-purple_light[probabilidad estimada de pertenencia]** a cada clase predicha (recuerda que nuestro objetivo es estimar las probabilidades de pertenencia teóricas que nos daría el clasificador Bayesiano) ```r # Predecir las probabilidades (las necesitamos para la ROC) predict(iris_knn_fit, iris_test, type = "prob") ``` ``` > # A tibble: 45 × 3 > .pred_setosa .pred_versicolor .pred_virginica > <dbl> <dbl> <dbl> > 1 1 0 0 > 2 1 0 0 > 3 1 0 0 > 4 1 0 0 > 5 1 0 0 > 6 1 0 0 > 7 1 0 0 > 8 1 0 0 > 9 1 0 0 > 10 1 0 0 > # … with 35 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Fase 5: .orange[PREDICCIÓN/EVALUACIÓN] Con `augment()` podemos obtener **.bg-purple_light[predicciones y datos en una sola tabla]** ```r # Incluir predicciones en tabla prob_test <- augment(iris_knn_fit, iris_test) prob_test ``` ``` > # A tibble: 45 × 9 > Sepal.Length Sepal.…¹ Petal…² Petal…³ Species .pred…⁴ .pred…⁵ .pred…⁶ .pred…⁷ > <dbl> <dbl> <dbl> <dbl> <fct> <fct> <dbl> <dbl> <dbl> > 1 5.1 3.5 1.4 0.2 setosa setosa 1 0 0 > 2 4.9 3 1.4 0.2 setosa setosa 1 0 0 > 3 5 3.6 1.4 0.2 setosa setosa 1 0 0 > 4 4.6 3.4 1.4 0.3 setosa setosa 1 0 0 > 5 4.4 2.9 1.4 0.2 setosa setosa 1 0 0 > 6 5.7 3.8 1.7 0.3 setosa setosa 1 0 0 > 7 5 3 1.6 0.2 setosa setosa 1 0 0 > 8 5.2 3.5 1.5 0.2 setosa setosa 1 0 0 > 9 4.8 3.1 1.6 0.2 setosa setosa 1 0 0 > 10 5 3.2 1.2 0.2 setosa setosa 1 0 0 > # … with 35 more rows, and abbreviated variable names ¹Sepal.Width, > # ²Petal.Length, ³Petal.Width, ⁴.pred_class, ⁵.pred_setosa, > # ⁶.pred_versicolor, ⁷.pred_virginica > # ℹ Use `print(n = ...)` to see more rows ``` --- # Fase 5: .orange[PREDICCIÓN/EVALUACIÓN] * **.bg-purple_light[Matriz de confusión]**: matriz con los valores enfrentando **.bg-orange[etiqueta real vs predicha]** (hay que pasarle la salida del `augment` e indicarle como `truth = ...` la clase real y como `estimate = ...` la clase predicha, que por defecto sale como `.pred_class` ```r # Matriz de confusión: etiqueta real vs etiqueta predicha conf_mat_test <- prob_test %>% conf_mat(truth = Species, estimate = .pred_class) conf_mat_test ``` ``` > Truth > Prediction setosa versicolor virginica > setosa 15 0 0 > versicolor 0 15 1 > virginica 0 0 14 ``` --- # Fase 5: .orange[PREDICCIÓN/EVALUACIÓN] * **.bg-purple_light[Métricas]**: las obtenemos haciendo un `summary()` a la matriz de confusión ```r # Métricas en test metricas <- conf_mat_test %>% summary() metricas ``` ``` > # A tibble: 13 × 3 > .metric .estimator .estimate > <chr> <chr> <dbl> > 1 accuracy multiclass 0.978 > 2 kap multiclass 0.967 > 3 sens macro 0.978 > 4 spec macro 0.989 > 5 ppv macro 0.979 > 6 npv macro 0.989 > 7 mcc multiclass 0.967 > 8 j_index macro 0.967 > 9 bal_accuracy macro 0.983 > 10 detection_prevalence macro 0.333 > 11 precision macro 0.979 > 12 recall macro 0.978 > 13 f_meas macro 0.978 ``` --- # ¿Y AHORA? ¿Basta con esto? -- En realidad no: recuerda que nuestro objetivo es minimizar el error, y para saber si estamos en un modelo óptimo, sobreajustado o bajoajustado, necesitamos **.bg-purple_light[ejecutar el paradigma de aprendizaje con diferentes parámetros]**. * Diferentes k (`neighbors = ...`), * Diferentes métricas (`dist_power = ...`) * Diferentes ponderaciones (`weight_func = ...`) Dicha evaluación la deberíamos hacer en **.bg-purple_light[validación]** pero vamos a pasar a un ejemplo más complicado con más filas para ello. --- name: knn-hoteles # Ejemplo real: .orange[HOTELES] Vamos ir a **ejemplo real**, haciendo uso de un **.bg-purple_light[dataset de reservas de hotel]** ```r hoteles_bruto <- read_csv(file = "./datos/hoteles.csv") ``` Los datos forman parte de un **.bg-purple_light[conjunto de reservas de hotel]** elaborado por Antonio et al., 2019 con 50 000 registros de reservas 📚 **Detalle de variables**: <https://linkinghub.elsevier.com/retrieve/pii/S2352340918315191> --- # Ejemplo real: .orange[HOTELES] Lo primero es conocer las variables. ```r glimpse(hoteles_bruto) ``` -- * `hotel`: tipo de hotel (urbano o resort) * `lead_time`: número de días entre la reserva y la estancia. * `stays_in_weekend_nights, stays_in_week_nights`: noches en fin de semana y entre semana * `adults`: número de adultos * `children`: ¿la reserva tiene niños? * `meal`: régimen de comidas * `country`: país de origen * `market_segment`: segmento de mercado de la reserva * `distribution_channel`: canal de distribución de la oferta * `is_repeated_guest`: ¿repite como huésped? --- # Ejemplo real: .orange[HOTELES] Lo primero es conocer las variables. ```r glimpse(hoteles_bruto) ``` * `previous_cancellations`: cancelaciones previas * `previous_bookings_not_canceled`: reservas previas (no canceladas) * `reserved_room_type, assigned_room_type`: tipo de habitación reservada/asignada * `booking_changes`: cambios en la reserva * `deposit_type`: tipo de depósito * `days_in_waiting_list`: días en lista de espera * `customer_type`: tipo de cliente * `average_daily_rate`: tarifa media diaria * `required_car_parking_spaces`: ¿parking? * `total_of_special_requests`: número de requisitos especiales demandados * `arrival_date`: fecha de llegada --- # Ejemplo real: .orange[HOTELES] ```r glimpse(hoteles_bruto) ``` El objetivo será **.bg-purple_light[predecir si una reserva incluye niños/as o no]**, por lo que `children` será nuestra variable objetivo. Primer paso: conocer cómo se **.bg-purple_light[distribuyen los niveles de la objetivo]** (es binaria) ```r hoteles_bruto %>% count(children) %>% mutate(porc = 100*n/sum(n)) ``` ``` > # A tibble: 2 × 3 > children n porc > <chr> <int> <dbl> > 1 children 4038 8.08 > 2 none 45962 91.9 ``` --- name: fase2-hoteles # Fases 1-2-3: .orange[HOTELES] Examina los datos y apunta las **.bg-purple_light[decisiones que deberíamos adoptar]**: * ¿Necesitamos **.bg-orange[muestreo]**? ¿De qué forma? ¿Podremos permitirnos crear esta vez un dataset de **.bg-orange[validación]**? * ¿De qué **.bg-orange[tipo]** es cada variable? ¿Tenemos **.bg-orange[problemas de codificación o rango]**? * ¿Cómo **.bg-orange[afectan las predictoras]** a los niveles de la variable objetivo? * ¿Hay problemas de **.bg-orange[dependencia]** entre las variables? * ¿Necesitamos **.bg-orange[recategorizar]** las variables? ¿Tenemos variables de **.bg-orange[fecha]**? * ¿Tenemos **.bg-orange[datos atípicos]**? ¿Tenemos **.bg-orange[datos ausentes]**? ¿Cómo imputarlos? * ¿Todas las variables son **.bg-orange[numéricas]** para poder aplicar la métrica? **.bg-purple_light[Filosofía]**: las modificaciones «estructurales» las hacemos fuera de la receta (modificando la base de datos), las modificaciones más concretas para un algoritmo dentro de la receta (sin modificar la base de datos). --- # Factores * **.bg-purple_light[Factores]**: lo primero que debemos decidir es si las variables de tipo texto son **.bg-purple_light[variables cualitativas]** (factores) o meros id's. ```r hoteles_bruto %>% select(where(is.character)) %>% glimpse() ``` ``` > Rows: 50,000 > Columns: 11 > $ hotel <chr> "City_Hotel", "City_Hotel", "Resort_Hotel"… > $ children <chr> "none", "none", "none", "none", "none", "n… > $ meal <chr> "BB", "BB", "BB", "HB", "HB", "SC", "BB", … > $ country <chr> "DEU", "PRT", "GBR", "ROU", "PRT", "GBR", … > $ market_segment <chr> "Offline_TA/TO", "Direct", "Online_TA", "O… > $ distribution_channel <chr> "TA/TO", "Direct", "TA/TO", "TA/TO", "Dire… > $ reserved_room_type <chr> "A", "D", "A", "A", "F", "A", "C", "B", "D… > $ assigned_room_type <chr> "A", "K", "A", "A", "F", "A", "C", "A", "D… > $ deposit_type <chr> "No_Deposit", "No_Deposit", "No_Deposit", … > $ customer_type <chr> "Transient-Party", "Transient", "Transient… > $ required_car_parking_spaces <chr> "none", "none", "none", "none", "none", "n… ``` --- # Factores Todas las variables de tipo texto representan **.bg-purple_light[categorías de una cualitativa]** así que las convertimos todas ellas a factor. -- ```r hoteles <- hoteles_bruto %>% mutate(across(where(is.character), as_factor)) hoteles ``` ``` > # A tibble: 50,000 × 23 > hotel lead_…¹ stays…² stays…³ adults child…⁴ meal country marke…⁵ distr…⁶ > <fct> <dbl> <dbl> <dbl> <dbl> <fct> <fct> <fct> <fct> <fct> > 1 City_Ho… 217 1 3 2 none BB DEU Offlin… TA/TO > 2 City_Ho… 2 0 1 2 none BB PRT Direct Direct > 3 Resort_… 95 2 5 2 none BB GBR Online… TA/TO > 4 Resort_… 143 2 6 2 none HB ROU Online… TA/TO > 5 Resort_… 136 1 4 2 none HB PRT Direct Direct > 6 City_Ho… 67 2 2 2 none SC GBR Online… TA/TO > 7 Resort_… 47 0 2 2 childr… BB ESP Direct Direct > 8 City_Ho… 56 0 3 0 childr… BB ESP Online… TA/TO > 9 City_Ho… 80 0 4 2 none BB FRA Online… TA/TO > 10 City_Ho… 6 2 2 2 childr… BB FRA Online… TA/TO > # … with 49,990 more rows, 13 more variables: is_repeated_guest <dbl>, > # previous_cancellations <dbl>, previous_bookings_not_canceled <dbl>, > # reserved_room_type <fct>, assigned_room_type <fct>, booking_changes <dbl>, > # deposit_type <fct>, days_in_waiting_list <dbl>, customer_type <fct>, > # average_daily_rate <dbl>, required_car_parking_spaces <fct>, > # total_of_special_requests <dbl>, arrival_date <date>, and abbreviated > # variable names ¹lead_time, ²stays_in_weekend_nights, … > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # Factores * **.bg-purple_light[Ordinales]**: ¿existe alguna variable que pueda ser ordinal? -- La variable `meal` si sigue una jerarquía: `SC` (sin nada) < `BB` (Bed & Breakfast) < `HB` (Half board, media pensión) < `FB` (Full board, pensión completa). Además tenemos un nivel para los desconocidos llamado `Undefined` ```r hoteles %>% count(meal) %>% mutate(porc = 100*n/sum(n)) ``` ``` > # A tibble: 5 × 3 > meal n porc > <fct> <int> <dbl> > 1 BB 38316 76.6 > 2 HB 6399 12.8 > 3 SC 4494 8.99 > 4 Undefined 580 1.16 > 5 FB 211 0.422 ``` --- # Factores * **.bg-purple_light[Ordinales]**: convertimos `meal` a cualitativa pero ordinal. ```r hoteles <- hoteles %>% mutate(meal = factor(meal, levels = c("Undefined", "SC", "BB", "HB", "FB"), ordered = TRUE)) ``` -- Ahora podremos hacer **.bg-purple_light[operaciones asociadas a una jerarquía]** como comparar registros ```r hoteles %>% * group_by(meal < "HB") %>% count() %>% ungroup() ``` ``` > # A tibble: 2 × 2 > `meal < "HB"` n > <lgl> <int> > 1 FALSE 6610 > 2 TRUE 43390 ``` --- # Variable hotel Una vez convertidas en cualitativas analicemos cada una de ellas. La variable `hotel` es **.bg-purple_light[binaria]**: urbanos vs resort (60% vs 40% aprox) ```r hoteles %>% count(hotel, sort = TRUE) %>% mutate(porc = 100*n/sum(n)) ``` ``` > # A tibble: 2 × 3 > hotel n porc > <fct> <int> <dbl> > 1 City_Hotel 30752 61.5 > 2 Resort_Hotel 19248 38.5 ``` --- # Variable hotel Parece que cuando hay **.bg-purple_light[niños en la reserva]** se opta ligeramente **.bg-purple_light[más por los resort]** ```r hoteles %>% group_by(hotel) %>% count(children) %>% mutate(porc = 100*n/sum(n)) %>% ungroup() ``` ``` > # A tibble: 4 × 4 > hotel children n porc > <fct> <fct> <int> <dbl> > 1 City_Hotel none 28383 92.3 > 2 City_Hotel children 2369 7.70 > 3 Resort_Hotel none 17579 91.3 > 4 Resort_Hotel children 1669 8.67 ``` --- # Variable meal La variable `meal` toma **.bg-purple_light[5 modalidades]**: quizás para algunos algoritmos haga falta reagrupar niveles (por ejemplo `Undefined` con `SC`) ```r hoteles %>% count(meal, sort = TRUE) %>% mutate(porc = 100*n/sum(n)) ``` ``` > # A tibble: 5 × 3 > meal n porc > <ord> <int> <dbl> > 1 BB 38316 76.6 > 2 HB 6399 12.8 > 3 SC 4494 8.99 > 4 Undefined 580 1.16 > 5 FB 211 0.422 ``` --- # Variable meal Parece que **.bg-purple_light[cuando hay niños]** en la reserva hay el **.bg-purple_light[doble de reservas con pensión completa]**: aunque haya pocos registros de `meal = "FB"` pueden ser determinantes. El 11% de la reservas sin niños van sin nada, mientras que solo el 3% de las reservas con niños. .pull-left[ ```r hoteles %>% group_by(meal) %>% count(children) %>% mutate(porc = 100*n/sum(n)) %>% ungroup() ``` ``` > # A tibble: 10 × 4 > meal children n porc > <ord> <fct> <int> <dbl> > 1 Undefined none 548 94.5 > 2 Undefined children 32 5.52 > 3 SC none 4388 97.6 > 4 SC children 106 2.36 > 5 BB none 35071 91.5 > 6 BB children 3245 8.47 > 7 HB none 5782 90.4 > 8 HB children 617 9.64 > 9 FB none 173 82.0 > 10 FB children 38 18.0 ``` ] .pull-right[ ```r hoteles %>% group_by(children) %>% count(meal) %>% mutate(porc = 100*n/sum(n)) %>% ungroup() ``` ``` > # A tibble: 10 × 4 > children meal n porc > <fct> <ord> <int> <dbl> > 1 none Undefined 548 1.19 > 2 none SC 4388 9.55 > 3 none BB 35071 76.3 > 4 none HB 5782 12.6 > 5 none FB 173 0.376 > 6 children Undefined 32 0.792 > 7 children SC 106 2.63 > 8 children BB 3245 80.4 > 9 children HB 617 15.3 > 10 children FB 38 0.941 ``` ] --- # Variable country La variable `country` toma **.bg-purple_light[155 modalidades]** pero tan solo **.bg-purple_light[21 modalidades aparecen en más del 0.5% de registros]** (una de ellas es NULL): quizás sea más práctico reagrupar niveles de esos países (representan juntos aprox el 10% del total). ```r hoteles %>% count(country, sort = TRUE) %>% mutate(porc = 100*n/sum(n), cumul = cumsum(porc)) ``` ``` > # A tibble: 155 × 4 > country n porc cumul > <fct> <int> <dbl> <dbl> > 1 PRT 14046 28.1 28.1 > 2 GBR 6405 12.8 40.9 > 3 FRA 5627 11.3 52.2 > 4 ESP 4298 8.60 60.8 > 5 DEU 4047 8.09 68.8 > 6 IRL 1691 3.38 72.2 > 7 ITA 1607 3.21 75.4 > 8 BEL 1250 2.5 77.9 > 9 NLD 1123 2.25 80.2 > 10 USA 1059 2.12 82.3 > # … with 145 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Variable country Aunque hay países que representa muy poco de los datos, parece que **.bg-purple_light[algunos son más propensos a reservas con niños]**. ```r hoteles %>% group_by(country) %>% count(children) %>% mutate(porc_children = 100*n/sum(n)) %>% ungroup() ``` ``` > # A tibble: 237 × 4 > country children n porc_children > <fct> <fct> <int> <dbl> > 1 DEU none 3863 95.5 > 2 DEU children 184 4.55 > 3 PRT none 12895 91.8 > 4 PRT children 1151 8.19 > 5 GBR none 5997 93.6 > 6 GBR children 408 6.37 > 7 ROU none 216 88.5 > 8 ROU children 28 11.5 > 9 ESP none 3824 89.0 > 10 ESP children 474 11.0 > # … with 227 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Variable market_segment La variable `market_segment` toma **.bg-purple_light[7 modalidades]** aunque algunas representan menos del 1% del total. ```r hoteles %>% count(market_segment, sort = TRUE) %>% mutate(porc = 100*n/sum(n), cumul = cumsum(porc)) ``` ``` > # A tibble: 7 × 4 > market_segment n porc cumul > <fct> <int> <dbl> <dbl> > 1 Online_TA 23760 47.5 47.5 > 2 Offline_TA/TO 10604 21.2 68.7 > 3 Direct 7131 14.3 83.0 > 4 Groups 5124 10.2 93.2 > 5 Corporate 2832 5.66 98.9 > 6 Complementary 427 0.854 99.8 > 7 Aviation 122 0.244 100 ``` --- # Variable market_segment Fíjate que aunque `market_segment = "Aviation"` representa muy pocos registros, el 100% son sin niños (casi similar con `market_segment = "Corporate"` y `market_segment = "Groups"`) ```r hoteles %>% group_by(market_segment) %>% count(children) %>% mutate(porc = 100*n/sum(n)) %>% ungroup() ``` ``` > # A tibble: 13 × 4 > market_segment children n porc > <fct> <fct> <int> <dbl> > 1 Offline_TA/TO none 10202 96.2 > 2 Offline_TA/TO children 402 3.79 > 3 Direct none 6138 86.1 > 4 Direct children 993 13.9 > 5 Online_TA none 21227 89.3 > 6 Online_TA children 2533 10.7 > 7 Corporate none 2799 98.8 > 8 Corporate children 33 1.17 > 9 Groups none 5084 99.2 > 10 Groups children 40 0.781 > 11 Aviation none 122 100 > 12 Complementary none 390 91.3 > 13 Complementary children 37 8.67 ``` --- # Variable distribution_channel La variable `distribution_channel` toma **.bg-purple_light[5 modalidades]** pero solo **.bg-purple_light[3 de ellas agrupan ya más del 99%]** de los registros. ```r hoteles %>% count(distribution_channel, sort = TRUE) %>% mutate(porc = 100*n/sum(n), cumul = cumsum(porc)) ``` ``` > # A tibble: 5 × 4 > distribution_channel n porc cumul > <fct> <int> <dbl> <dbl> > 1 TA/TO 38349 76.7 76.7 > 2 Direct 8083 16.2 92.9 > 3 Corporate 3459 6.92 99.8 > 4 GDS 108 0.216 100. > 5 Undefined 1 0.002 100 ``` --- # Variable distribution_channel Fíjate que de `distribution_channel = "Undefined"` y `distribution_channel = "GDS"` representan **.bg-purple_light[muy pocos registros]**, y todos con una sola modalidad en la objetivo (pero solo pesan el 0.2% de los datos) ```r hoteles %>% group_by(distribution_channel) %>% count(children) %>% mutate(porc = 100*n/sum(n)) %>% ungroup() ``` ``` > # A tibble: 8 × 4 > distribution_channel children n porc > <fct> <fct> <int> <dbl> > 1 TA/TO none 35388 92.3 > 2 TA/TO children 2961 7.72 > 3 Direct none 7045 87.2 > 4 Direct children 1038 12.8 > 5 Corporate none 3421 98.9 > 6 Corporate children 38 1.10 > 7 GDS none 108 100 > 8 Undefined children 1 100 ``` --- # Variable reserved_room_type La variable `reserved_room_type` toma **.bg-purple_light[9 modalidades]** (no nos especifican si hay jerarquía) pero **.bg-purple_light[solo 5 de ellas tienen un peso superior al 1%]** de los registros. ```r hoteles %>% count(reserved_room_type, sort = TRUE) %>% mutate(porc = 100*n/sum(n), cumul = cumsum(porc)) ``` ``` > # A tibble: 9 × 4 > reserved_room_type n porc cumul > <fct> <int> <dbl> <dbl> > 1 A 34889 69.8 69.8 > 2 D 8675 17.4 87.1 > 3 E 3096 6.19 93.3 > 4 F 1299 2.60 95.9 > 5 G 899 1.80 97.7 > 6 B 488 0.976 98.7 > 7 C 417 0.834 99.5 > 8 H 235 0.47 100. > 9 L 2 0.004 100 ``` --- # Variable reserved_room_type Fíjate que `reserved_room_type` será **.bg-purple_light[tremendamente importante]**: si la habitación es de tipo F, el 47% viene con niños (frente al 8% global), del 70% incluso si es de tipo C ```r hoteles %>% group_by(reserved_room_type) %>% count(children) %>% mutate(porc = 100*n/sum(n)) %>% ungroup() ``` ``` > # A tibble: 17 × 4 > reserved_room_type children n porc > <fct> <fct> <int> <dbl> > 1 A none 33364 95.6 > 2 A children 1525 4.37 > 3 D none 8210 94.6 > 4 D children 465 5.36 > 5 F none 677 52.1 > 6 F children 622 47.9 > 7 C none 125 30.0 > 8 C children 292 70.0 > 9 B none 353 72.3 > 10 B children 135 27.7 > 11 E none 2828 91.3 > 12 E children 268 8.66 > 13 G none 341 37.9 > 14 G children 558 62.1 > 15 H none 62 26.4 > 16 H children 173 73.6 > 17 L none 2 100 ``` --- # Variable assigned_room_type La variable `assigned_room_type` toma **.bg-purple_light[10 modalidades]** (no nos especifican si hay jerarquía) pero solo 7 de ellas tienen un peso superior al 1% de los registros. ```r hoteles %>% count(assigned_room_type, sort = TRUE) %>% mutate(porc = 100*n/sum(n), cumul = cumsum(porc)) ``` ``` > # A tibble: 10 × 4 > assigned_room_type n porc cumul > <fct> <int> <dbl> <dbl> > 1 A 27357 54.7 54.7 > 2 D 12577 25.2 79.9 > 3 E 3924 7.85 87.7 > 4 F 1839 3.68 91.4 > 5 C 1305 2.61 94.0 > 6 G 1185 2.37 96.4 > 7 B 1079 2.16 98.5 > 8 H 313 0.626 99.2 > 9 I 239 0.478 99.6 > 10 K 182 0.364 100 ``` Como sucedía antes `assigned_room_type` será tremendamente importante --- # Variable reserved_room_type vs assigned_room_type Quizás sea interesante, al margen del tipo de habitación, ver que sucede cuando la **.bg-purple_light[asignada es distinta de la reservada]**. ```r hoteles %>% mutate(same_room = as.character(reserved_room_type) == as.character(assigned_room_type)) %>% group_by(same_room) %>% count(children) %>% mutate(porc = 100*n/sum(n)) %>% ungroup() ``` ``` > # A tibble: 4 × 4 > same_room children n porc > <lgl> <fct> <int> <dbl> > 1 FALSE none 8601 91.5 > 2 FALSE children 794 8.45 > 3 TRUE none 37361 92.0 > 4 TRUE children 3244 7.99 ``` No parece que influya significativamente --- # Variable deposit_type La variable `deposit_type` toma **.bg-purple_light[3 modalidades]** pero el 99.6% de los registros es la misma. ```r hoteles %>% count(deposit_type, sort = TRUE) %>% mutate(porc = 100*n/sum(n), cumul = cumsum(porc)) ``` ``` > # A tibble: 3 × 4 > deposit_type n porc cumul > <fct> <int> <dbl> <dbl> > 1 No_Deposit 49839 99.7 99.7 > 2 Refundable 92 0.184 99.9 > 3 Non_Refund 69 0.138 100 ``` --- # Variable deposit_type Además de ser **.bg-purple_light[muy pocos]** los registros que no sean `No_Deposit`, prácticamente su totalidad son **.bg-purple_light[sin niños]** (clase ya mayoritaria en los datos). ```r hoteles %>% group_by(deposit_type) %>% count(children) %>% mutate(porc = 100*n/sum(n)) %>% ungroup() ``` ``` > # A tibble: 6 × 4 > deposit_type children n porc > <fct> <fct> <int> <dbl> > 1 No_Deposit none 45803 91.9 > 2 No_Deposit children 4036 8.10 > 3 Refundable none 91 98.9 > 4 Refundable children 1 1.09 > 5 Non_Refund none 68 98.6 > 6 Non_Refund children 1 1.45 ``` --- # Variable deposit_type La variable `customer_type` toma **.bg-purple_light[4 modalidades]** pero **.bg-purple_light[dos de ellas representan más del 95%]** de los registros. ```r hoteles %>% count(customer_type, sort = TRUE) %>% mutate(porc = 100*n/sum(n), cumul = cumsum(porc)) ``` ``` > # A tibble: 4 × 4 > customer_type n porc cumul > <fct> <int> <dbl> <dbl> > 1 Transient 35343 70.7 70.7 > 2 Transient-Party 12430 24.9 95.5 > 3 Contract 1864 3.73 99.3 > 4 Group 363 0.726 100 ``` --- # Variable deposit_type El 88% de las reservas con niños son de tipo `"Transient"` ```r hoteles %>% group_by(children) %>% count(customer_type) %>% mutate(porc = 100*n/sum(n)) %>% ungroup() ``` ``` > # A tibble: 8 × 4 > children customer_type n porc > <fct> <fct> <int> <dbl> > 1 none Transient-Party 12075 26.3 > 2 none Transient 31779 69.1 > 3 none Contract 1762 3.83 > 4 none Group 346 0.753 > 5 children Transient-Party 355 8.79 > 6 children Transient 3564 88.3 > 7 children Contract 102 2.53 > 8 children Group 17 0.421 ``` --- # Variable required_car_parking_spaces La variable `required_car_parking_spaces` es binaria (muy desbalanceada). ```r hoteles %>% count(required_car_parking_spaces, sort = TRUE) %>% mutate(porc = 100*n/sum(n), cumul = cumsum(porc)) ``` ``` > # A tibble: 2 × 4 > required_car_parking_spaces n porc cumul > <fct> <int> <dbl> <dbl> > 1 none 45019 90.0 90.0 > 2 parking 4981 9.96 100 ``` --- # Variable required_car_parking_spaces El % de las reservas con niños es el doble cuando hay parking solicitado. ```r hoteles %>% group_by(children) %>% count(required_car_parking_spaces) %>% mutate(porc = 100*n/sum(n)) %>% ungroup() ``` ``` > # A tibble: 4 × 4 > children required_car_parking_spaces n porc > <fct> <fct> <int> <dbl> > 1 none none 41708 90.7 > 2 none parking 4254 9.26 > 3 children none 3311 82.0 > 4 children parking 727 18.0 ``` --- # Dependencia entre variables cualitativas Más allá del análisis exploratorio numérico, podemos ejecutar un **.bg-purple_light[contraste de independencia]** (prueba `\(\chi^2\)` de independencia) para tener mayor certeza de si la predictora es dependiente o no de la variable objetivo (si fuera independiente, no tendría sentido mantenerla) ```r chisq.test(hoteles$children, hoteles$hotel) ``` ``` > > Pearson's Chi-squared test with Yates' continuity correction > > data: hoteles$children and hoteles$hotel > X-squared = 14.796, df = 1, p-value = 0.0001198 ``` Si fijamos `\(\alpha = 0.05\)` (nivel de significación), si p-valor < 0.05 deberíamos rechazar la **.bg-purple_light[hipótesis nula de independencia]** (bajo dicho nivel). --- # Dependencia entre variables cualitativas Podemos hacerlo con **.bg-purple_light[todas las variables a la vez]** enfrentándola a la objetivo ```r chisq <- tibble("variable" = hoteles %>% select(where(is.factor)) %>% names(), "p_value" = hoteles %>% select(where(is.factor)) %>% map_dbl(.f = function(x) { chisq.test(hoteles$children, x)$p.value})) chisq %>% arrange(desc(p_value)) ``` ``` > # A tibble: 11 × 2 > variable p_value > <chr> <dbl> > 1 deposit_type 6.20e- 3 > 2 hotel 1.20e- 4 > 3 country 1.60e- 40 > 4 meal 4.23e- 55 > 5 required_car_parking_spaces 1.22e- 70 > 6 distribution_channel 3.17e-107 > 7 customer_type 4.39e-145 > 8 market_segment 8.40e-292 > 9 children 0 > 10 reserved_room_type 0 > 11 assigned_room_type 0 ``` --- # Dependencia entre variables cualitativas ```r chisq %>% filter(p_value > 0.05) ``` ``` > # A tibble: 0 × 2 > # … with 2 variables: variable <chr>, p_value <dbl> > # ℹ Use `colnames()` to see all variable names ``` **.bg-purple_light[No hay evidencia suficiente para decir que existe predictora independiente de la objetivo]** (al 95% de confianza) según la prueba de independencia realizada --- # Resumen de las variables cuali * `hotel` --> **.bg-purple_light[no hacer nada]**. * `meal`: aunque haya pocos registros de `meal = "FB"`, parece que pueden ser determinantes --> **.bg-purple_light[reagrupar "Undefined" con "SC" y dejar "FB"]**. * `country`: tan solo 21 de ellas aparecen en más del 0.5% de registros (una de ellas es NULL) --> **.bg-purple_light[reagrupar niveles de países minoritarios]** (representan juntos aprox el 10% del total) quedándonos con aquellos que superen en un mínimo de representatividad (más fino: incluir también los que sean más propensos que otros a reservas con niños). * `market_segment`: algunas representan menos del 1% del total, aunque para `market_segment = "Aviation"` el 100% son sin niños (casi similar con `market_segment = "Corporate"` y `market_segment = "Groups"`) --> **.bg-purple_light[agrupar los 3 junto con "complementary"]** (pesan muy poco estos últimos) en un `"others"`. * `distribution_channel`: solo 3 de ellas agrupan ya más del 99% de los registros --> **.bg-purple_light[reagrupar "Corporate" (98.9% no children), "GDS" (100% no children) y "Undefined" (solo 1 dato)]** en `"others"` (aprox. el 7% de los datos). --- # Resumen de las variables cuali * `reserved_room_type`: solo 5 de ellas tienen un peso superior al 1% de los registros, si es de tipo **.bg-purple_light[C, H o L]** (juntas suman el 1.3% de los datos aprox.), con niños superan el 70% --> **.bg-purple_light[reagrupamos las 3]** en un `"others"` * `assigned_room_type`: con el mismo razonamiento que antes podemos **.bg-purple_light[reaagupar las categorías H-I-K]** en `"others"` * `deposit_type`: el 99.6% de registros es la misma --> muy poca varianza y además casi todos de esas clases minoritarias son de la clase mayoritaria de la objetivo --> **.bg-purple_light[eliminar]** * `customer_type` --> **.bg-purple_light[reagrupar "Transient" y "others"]** * `required_car_parking_spaces` --> **.bg-purple_light[no hacer nada]** --- # Variables de tipo de fecha Solo tenemos una `arrival_date`: ¿qué parte de la fecha exactamente influye más? ¿El año? ¿El mes? ¿El día como número en sí o el día de la semana? Tras extraer info la eliminaremos. ```r hoteles <- hoteles %>% mutate(m_arr = month(arrival_date), y_arr = year(arrival_date), wday_arr = wday(arrival_date)) hoteles %>% group_by(y_arr) %>% count(children) %>% mutate(porc = 100*n/sum(n)) ``` ``` > # A tibble: 6 × 4 > # Groups: y_arr [3] > y_arr children n porc > <dbl> <fct> <int> <dbl> > 1 2015 none 8623 93.9 > 2 2015 children 562 6.12 > 3 2016 none 22161 91.8 > 4 2016 children 1981 8.21 > 5 2017 none 15178 91.0 > 6 2017 children 1495 8.97 ``` No parece que el año influya mucho (veremos si influyen los días festivos en sí) --- # Variables de tipo de fecha Parece que los meses de julio, agosto y diciembre influye mucho al tener más niños --> podemos agrupar los meses en `"month_holy"` y `"month_no_holy"` ```r hoteles %>% group_by(m_arr) %>% count(children) %>% mutate(porc = 100*n/sum(n)) ``` ``` > # A tibble: 24 × 4 > # Groups: m_arr [12] > m_arr children n porc > <dbl> <fct> <int> <dbl> > 1 1 none 2586 94.5 > 2 1 children 150 5.48 > 3 2 none 3261 91.5 > 4 2 children 302 8.48 > 5 3 none 4195 94.7 > 6 3 children 237 5.35 > 7 4 none 4022 92.4 > 8 4 children 331 7.60 > 9 5 none 4538 94.8 > 10 5 children 249 5.20 > # … with 14 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Variables de tipo de fecha Parece que los viernes, sábados y domingos hay más reservas con niños --> podemos agrupar los meses en `"weekend"` y `"workday"` ```r hoteles %>% group_by(wday_arr) %>% count(children) %>% mutate(porc = 100*n/sum(n)) ``` ``` > # A tibble: 14 × 4 > # Groups: wday_arr [7] > wday_arr children n porc > <dbl> <fct> <int> <dbl> > 1 1 none 5768 91.5 > 2 1 children 537 8.52 > 3 2 none 7324 92.1 > 4 2 children 628 7.90 > 5 3 none 5777 92.7 > 6 3 children 456 7.32 > 7 4 none 6468 93.7 > 8 4 children 432 6.26 > 9 5 none 6969 92.3 > 10 5 children 579 7.67 > 11 6 none 7094 92.0 > 12 6 children 620 8.04 > 13 7 none 6562 89.3 > 14 7 children 786 10.7 ``` --- # Variables numéricas * `lead_time`: variable con una alta concentración a la izquierda (cola pesada a la derecha), con un máximo de días muy elevado. ```r hoteles %>% summarise(min_lead = min(lead_time), max_lead = max(lead_time)) ``` ``` > # A tibble: 1 × 2 > min_lead max_lead > <dbl> <dbl> > 1 0 709 ``` -- Quizas no tenga sentido tanto número de días entre la reserva y la estancia --> todo lo que **.bg-purple_light[supere 365, imputarle 366]** (representan además el 1.35% solo) ```r hoteles %>% group_by(lead_time > 365) %>% count() ``` ``` > # A tibble: 2 × 2 > # Groups: lead_time > 365 [2] > `lead_time > 365` n > <lgl> <int> > 1 FALSE 49326 > 2 TRUE 674 ``` --- # Variables numéricas * `stays_in_weekend_nights`: en realidad es una variable cualitativa más que cuantitativa, y a partir de 2 noches en festivo representa menos de 1% --> podríamos probar a **.bg-purple_light[dejarla tal cual o recategorizarla en 4 categorías]** (ninguna - 1 - 2 - más de 2) ```r hoteles %>% count(stays_in_weekend_nights, sort = TRUE) %>% mutate(porc = 100*n/sum(n), cumul = cumsum(porc)) ``` ``` > # A tibble: 17 × 4 > stays_in_weekend_nights n porc cumul > <dbl> <int> <dbl> <dbl> > 1 0 21640 43.3 43.3 > 2 2 13840 27.7 71.0 > 3 1 13031 26.1 97.0 > 4 4 826 1.65 98.7 > 5 3 564 1.13 99.8 > 6 6 41 0.082 99.9 > 7 5 22 0.044 99.9 > 8 8 18 0.036 100. > 9 10 4 0.008 100. > 10 7 2 0.004 100. > 11 9 2 0.004 100. > 12 12 2 0.004 100. > 13 13 2 0.004 100. > 14 14 2 0.004 100. > 15 16 2 0.004 100. > 16 18 1 0.002 100. > 17 19 1 0.002 100 ``` --- # Variables numéricas * `stays_in_week_nights`: en realidad es una variable cualitativa más que cuantitativa, y a partir de 5 noches representa menos del 5% --> podríamos probar a **.bg-purple_light[dejarla tal cual o recategorizarla en 7 categorías]** (ninguna - 1 - 2 - 3 - 4 - 5 - más de 5) ```r hoteles %>% count(stays_in_week_nights, sort = TRUE) %>% mutate(porc = 100*n/sum(n), cumul = cumsum(porc)) ``` ``` > # A tibble: 31 × 4 > stays_in_week_nights n porc cumul > <dbl> <int> <dbl> <dbl> > 1 1 13619 27.2 27.2 > 2 2 12513 25.0 52.3 > 3 3 9161 18.3 70.6 > 4 5 4779 9.56 80.1 > 5 4 4020 8.04 88.2 > 6 0 3818 7.64 95.8 > 7 6 616 1.23 97.1 > 8 10 488 0.976 98.0 > 9 7 481 0.962 99.0 > 10 8 303 0.606 99.6 > # … with 21 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Variables numéricas * `adults`: en realidad es una variable cualitativa más que cuantitativa --> podríamos probar a **.bg-purple_light[dejarla tal cual o recategorizarla en 4 categorías]** (ninguno - 1 - 2 - más de 2) ```r hoteles %>% count(adults, sort = TRUE) %>% mutate(porc = 100*n/sum(n), cumul = cumsum(porc)) ``` ``` > # A tibble: 5 × 4 > adults n porc cumul > <dbl> <int> <dbl> <dbl> > 1 2 36271 72.5 72.5 > 2 1 10831 21.7 94.2 > 3 3 2675 5.35 99.6 > 4 0 194 0.388 99.9 > 5 4 29 0.058 100 ``` --- # Variables numéricas * `is_repeated_guest`: en realidad es **.bg-purple_light[binaria]** --> hay que convertirla a cualitativa (factor) ```r hoteles %>% count(is_repeated_guest, sort = TRUE) %>% mutate(porc = 100*n/sum(n)) ``` ``` > # A tibble: 2 × 3 > is_repeated_guest n porc > <dbl> <int> <dbl> > 1 0 47840 95.7 > 2 1 2160 4.32 ``` ```r hoteles %>% group_by(is_repeated_guest) %>% count(children) %>% mutate(porc = 100*n/sum(n)) %>% ungroup() ``` ``` > # A tibble: 4 × 4 > is_repeated_guest children n porc > <dbl> <fct> <int> <dbl> > 1 0 none 43863 91.7 > 2 0 children 3977 8.31 > 3 1 none 2099 97.2 > 4 1 children 61 2.82 ``` --- # Variables numéricas * `previous_cancellations`: el 99.238% son 0 (y la mayoría de 1, sin niños) --> **.bg-purple_light[eliminar]** * `previous_bookings_not_canceled`: el 95.47% son 0, el 1.9% son 1 --> se podría probar a **.bg-purple_light[dejarla tal cual o recategorizar en 3 categorías]** ```r hoteles %>% count(previous_cancellations == 0, sort = TRUE) ``` ``` > # A tibble: 2 × 2 > `previous_cancellations == 0` n > <lgl> <int> > 1 TRUE 49619 > 2 FALSE 381 ``` ```r hoteles %>% count(previous_bookings_not_canceled, sort = TRUE) %>% mutate(porc = 100*n/sum(n), cumul = cumsum(porc)) ``` ``` > # A tibble: 57 × 4 > previous_bookings_not_canceled n porc cumul > <dbl> <int> <dbl> <dbl> > 1 0 47735 95.5 95.5 > 2 1 956 1.91 97.4 > 3 2 370 0.74 98.1 > 4 3 210 0.42 98.5 > 5 4 148 0.296 98.8 > 6 5 112 0.224 99.1 > 7 6 76 0.152 99.2 > 8 7 50 0.1 99.3 > 9 9 42 0.084 99.4 > 10 8 39 0.078 99.5 > # … with 47 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Variables numéricas * `booking_changes`: el 94.194% son 0 o 1 --> se podría probar a **.bg-purple_light[dejarla numérica o recategorizar en 3 categorías]** ```r hoteles %>% count(booking_changes, sort = TRUE) %>% mutate(porc = 100*n/sum(n), cumul = cumsum(porc)) ``` ``` > # A tibble: 19 × 4 > booking_changes n porc cumul > <dbl> <int> <dbl> <dbl> > 1 0 39823 79.6 79.6 > 2 1 7274 14.5 94.2 > 3 2 2018 4.04 98.2 > 4 3 523 1.05 99.3 > 5 4 212 0.424 99.7 > 6 5 71 0.142 99.8 > 7 6 31 0.062 99.9 > 8 7 13 0.026 99.9 > 9 8 11 0.022 100. > 10 9 6 0.012 100. > 11 10 4 0.008 100. > 12 13 3 0.006 100. > 13 15 3 0.006 100. > 14 11 2 0.004 100. > 15 17 2 0.004 100. > 16 12 1 0.002 100. > 17 16 1 0.002 100. > 18 18 1 0.002 100. > 19 21 1 0.002 100 ``` --- # Variables numéricas * `days_in_waiting_list`: el 98% de los registros son 0 (y de los que no son casi todos no tienen niños) --> **.bg-purple_light[eliminar variable]** ```r hoteles %>% count(days_in_waiting_list, sort = TRUE) %>% mutate(porc = 100*n/sum(n), cumul = cumsum(porc)) ``` ``` > # A tibble: 92 × 4 > days_in_waiting_list n porc cumul > <dbl> <int> <dbl> <dbl> > 1 0 49116 98.2 98.2 > 2 58 114 0.228 98.5 > 3 87 47 0.094 98.6 > 4 38 34 0.068 98.6 > 5 63 34 0.068 98.7 > 6 122 33 0.066 98.8 > 7 65 26 0.052 98.8 > 8 223 26 0.052 98.9 > 9 77 25 0.05 98.9 > 10 44 22 0.044 99.0 > # … with 82 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Variables numéricas * `average_daily_rate`: es la única numérica continua pero tiene **.bg-purple_light[valores negativos o cero]** (deberían ser estrictamente positivo) --> el 2.33% tiene **.bg-purple_light[problemas de codificación o rango]** que deberemos pasar a ausentes e imputarles un valores luego. ```r hoteles %>% count(average_daily_rate <= 0) %>% mutate(porc = 100*n/sum(n)) ``` ``` > # A tibble: 2 × 3 > `average_daily_rate <= 0` n porc > <lgl> <int> <dbl> > 1 FALSE 48833 97.7 > 2 TRUE 1167 2.33 ``` --- # Variables numéricas * `total_of_special_requests`: más del 96% son 0-1-2 --> se podría **.bg-purple_light[dejar numérica o recategorizarla en 4 categorías]**. ```r hoteles %>% count(total_of_special_requests, sort = TRUE) %>% mutate(porc = 100*n/sum(n), cumul = cumsum(porc)) ``` ``` > # A tibble: 6 × 4 > total_of_special_requests n porc cumul > <dbl> <int> <dbl> <dbl> > 1 0 24493 49.0 49.0 > 2 1 17234 34.5 83.5 > 3 2 6679 13.4 96.8 > 4 3 1358 2.72 99.5 > 5 4 213 0.426 100. > 6 5 23 0.046 100 ``` --- # .orange[COLINEALIDAD] Por último, nos falta comprobar los **.bg-purple_light[problemas de colinealidad]** entre las predictoras numéricas. Podemos tratar las **.bg-orange[numéricas por separado]** (aunque tengamos muchas que en realidad hacen más de cuali que de cuanti) ```r library(corrr) cor_matrix <- hoteles %>% select(where(is.numeric)) %>% cor() %>% round(2) cor_matrix ``` ``` > lead_time stays_in_weekend_nights > lead_time 1.00 0.19 > stays_in_weekend_nights 0.19 1.00 > stays_in_week_nights 0.28 0.51 > adults 0.14 0.13 > is_repeated_guest -0.15 -0.10 > previous_cancellations -0.04 -0.02 > previous_bookings_not_canceled -0.08 -0.05 > booking_changes 0.09 0.07 > days_in_waiting_list 0.18 -0.05 > average_daily_rate 0.02 0.04 > total_of_special_requests 0.04 0.07 > m_arr 0.10 0.03 > y_arr 0.11 0.01 > wday_arr 0.05 -0.14 > stays_in_week_nights adults is_repeated_guest > lead_time 0.28 0.14 -0.15 > stays_in_weekend_nights 0.51 0.13 -0.10 > stays_in_week_nights 1.00 0.13 -0.11 > adults 0.13 1.00 -0.21 > is_repeated_guest -0.11 -0.21 1.00 > previous_cancellations -0.03 -0.06 0.25 > previous_bookings_not_canceled -0.06 -0.15 0.44 > booking_changes 0.12 -0.07 0.00 > days_in_waiting_list 0.01 -0.01 -0.02 > average_daily_rate 0.05 0.33 -0.16 > total_of_special_requests 0.06 0.20 0.00 > m_arr 0.03 0.04 -0.05 > y_arr 0.01 0.04 0.06 > wday_arr -0.01 0.06 -0.05 > previous_cancellations > lead_time -0.04 > stays_in_weekend_nights -0.02 > stays_in_week_nights -0.03 > adults -0.06 > is_repeated_guest 0.25 > previous_cancellations 1.00 > previous_bookings_not_canceled 0.52 > booking_changes 0.00 > days_in_waiting_list -0.01 > average_daily_rate -0.04 > total_of_special_requests 0.02 > m_arr -0.03 > y_arr 0.01 > wday_arr -0.01 > previous_bookings_not_canceled booking_changes > lead_time -0.08 0.09 > stays_in_weekend_nights -0.05 0.07 > stays_in_week_nights -0.06 0.12 > adults -0.15 -0.07 > is_repeated_guest 0.44 0.00 > previous_cancellations 0.52 0.00 > previous_bookings_not_canceled 1.00 0.00 > booking_changes 0.00 1.00 > days_in_waiting_list -0.01 0.00 > average_daily_rate -0.09 0.01 > total_of_special_requests 0.03 0.00 > m_arr -0.03 0.00 > y_arr 0.04 0.03 > wday_arr -0.04 0.01 > days_in_waiting_list average_daily_rate > lead_time 0.18 0.02 > stays_in_weekend_nights -0.05 0.04 > stays_in_week_nights 0.01 0.05 > adults -0.01 0.33 > is_repeated_guest -0.02 -0.16 > previous_cancellations -0.01 -0.04 > previous_bookings_not_canceled -0.01 -0.09 > booking_changes 0.00 0.01 > days_in_waiting_list 1.00 -0.03 > average_daily_rate -0.03 1.00 > total_of_special_requests -0.07 0.22 > m_arr 0.05 0.11 > y_arr -0.06 0.17 > wday_arr 0.01 0.01 > total_of_special_requests m_arr y_arr wday_arr > lead_time 0.04 0.10 0.11 0.05 > stays_in_weekend_nights 0.07 0.03 0.01 -0.14 > stays_in_week_nights 0.06 0.03 0.01 -0.01 > adults 0.20 0.04 0.04 0.06 > is_repeated_guest 0.00 -0.05 0.06 -0.05 > previous_cancellations 0.02 -0.03 0.01 -0.01 > previous_bookings_not_canceled 0.03 -0.03 0.04 -0.04 > booking_changes 0.00 0.00 0.03 0.01 > days_in_waiting_list -0.07 0.05 -0.06 0.01 > average_daily_rate 0.22 0.11 0.17 0.01 > total_of_special_requests 1.00 0.03 0.12 0.01 > m_arr 0.03 1.00 -0.53 0.00 > y_arr 0.12 -0.53 1.00 -0.03 > wday_arr 0.01 0.00 -0.03 1.00 ``` --- # .orange[COLINEALIDAD] ```r cor_matrix %>% corrplot(method = "number", tl.cex = 0.55, number.cex = 0.7, type = "lower") ``` <img src="./img/cor_hoteles.jpg" width="40%" style="display: block; margin: auto;" /> No parece existir una correlación elevada entre ninguna. --- name: fase3-hoteles # Fase 3: .orange[MODIFICACIÓN] Con lo observado en la fase de exploración deberemos tomar **.bg-purple_light[dos tipos decisiones]**: * las que afectan a la **.bg-orange[base de datos en general]**: pasar a factores, problemas de codificación o rango, variables que no aportan, creación de variables en general, etc * las que afectan a un **.bg-orange[algoritmo en concreto]**: normalización para la métrica, recategorización, tratamiento de outliers/ausentes, dummyficación, etc. --- # Fase 1: .orange[MUESTREO] Pero antes...¿hace falta **.bg-purple_light[muestreo]**? Parece que sí dado que tenemos muchas filas (al menos para hacer pruebas) --> muestreo **.bg-purple_light[estratificado]** (por ej., del 10%) ```r hoteles_sample <- hoteles %>% group_by(children) %>% slice_sample(prop = 0.10) %>% ungroup() hoteles_sample %>% count(children) %>% mutate(porc = 100*n/sum(n)) ``` ``` > # A tibble: 2 × 3 > children n porc > <fct> <int> <dbl> > 1 none 4596 91.9 > 2 children 403 8.06 ``` --- # Fase 3: .orange[MODIFICACIÓN] (fuera receta) * **.bg-purple_light[Selección de variables]**: eliminamos aquellas cuya varianza es tan ínfima (y sin influencia real en la variable objetivo a nivel globla) que solo nos aporta ruido ```r # Eliminar variables hoteles_sample <- hoteles_sample %>% * select(-c(deposit_type, days_in_waiting_list, previous_cancellations)) ``` --- # Fase 3: .orange[MODIFICACIÓN] (fuera receta) * **.bg-purple_light[Convertimos a cuali]**: debemos siempre de tratar a cada variable como lo que es, así que toda variable de tipo texto que sea una variable estadística cualitativa deberá ser convertida a factor (y de manera ordinal en caso de lo que sean) ```r # Convertir a cuali hoteles_sample <- hoteles_sample %>% mutate(across(where(is.character), as_factor)) %>% mutate(meal = factor(meal, levels = c("Undefined", "SC", "BB", "HB", "FB"), ordered = TRUE)) ``` --- # Fase 3: .orange[MODIFICACIÓN] (fuera receta) * **.bg-purple_light[Modificamos variables existentes]**: resolvemos fuera de la receta problemas de codificación o rango ya que son errores intrínsecos de la tabla. ```r # Modificaciones de variables existentes hoteles_sample <- hoteles_sample %>% mutate(lead_time = ifelse(lead_time > 365, 366, lead_time), average_daily_rate = ifelse(average_daily_rate <= 0, NA, average_daily_rate), is_repeated_guest = as_factor(is_repeated_guest)) ``` --- # .orange[RECETA]: .green[PARTICIÓN] Tras resolver esos problemas fuera de la receta dividimos en **.bg-purple_light[test y lo demás]**, con `initial_split()` ```r # Partición 10% de test hoteles_split <- initial_split(hoteles_sample, strata = children, prop = 0.9) hoteles_split ``` ``` > <Analysis/Assess/Total> > <4499/500/4999> ``` ```r # Aplicamos partición hoteles_train <- training(hoteles_split) hoteles_test <- testing(hoteles_split) ``` --- # .orange[RECETA]: .green[PARTICIÓN] Podemos comprobar que los estratos se han mantenido. ```r # Comprobamos estratos hoteles_train %>% count(children) %>% mutate(porc = 100 * n / sum(n)) ``` ``` > # A tibble: 2 × 3 > children n porc > <fct> <int> <dbl> > 1 none 4135 91.9 > 2 children 364 8.09 ``` ```r hoteles_test %>% count(children) %>% mutate(porc = 100 * n / sum(n)) ``` ``` > # A tibble: 2 × 3 > children n porc > <fct> <int> <dbl> > 1 none 461 92.2 > 2 children 39 7.8 ``` --- # .orange[RECETA]: .green[PARTICIÓN] Tras ello usamos `validation_split()` para **.bg-purple_light[dividir en train-validación]** lo que teníamos en `hoteles_train` (75% del 90% = 67.5% vs 22.5%) ```r # Validación hoteles_val <- validation_split(hoteles_train, strata = children, prop = 0.75) hoteles_val ``` ``` > # Validation Set Split (0.75/0.25) using stratification > # A tibble: 1 × 2 > splits id > <list> <chr> > 1 <split [3374/1125]> validation ``` --- # .orange[RECETA]: .green[ROLES] ```r # Receta hoteles_rec <- # Fórmula y datos recipe(data = hoteles_train, children ~ .)%>% # Roles add_role(contains("date"), new_role = "date") %>% add_role(where(is.factor), new_role = "cuali") %>% add_role(where(is.numeric), new_role = "cuanti") %>% add_role(c(hotel, required_car_parking_spaces, is_repeated_guest), new_role = "binary") %>% add_role(where(is.numeric) & !average_daily_rate, new_role = "maybe_cuali") ``` --- # .orange[RECETA]: .green[FECHAS] * Con `step_date()` podemos indicarle directamente que extraiga de la fecha los elementos que le pidamos (en nuestro caso mes, día de la semana y año). * Con `listHolidays()` del paquete `{timeDate}` seleccionaremos festivos relevantes internacionalmente, y con `step_holiday()` marcaremos las fechas que lo sean. Tras ello eliminaremos la fecha original con `step_rm()`. ```r library(timeDate) # Receta hoteles_rec <- hoteles_rec %>% step_date(arrival_date, features = c("month", "dow", "year")) %>% step_holiday(arrival_date, holidays = c(listHolidays("\\Mary"), listHolidays("\\Easter"), listHolidays("\\Christ"), "NewYearsDay")) %>% # Eliminamos la variable step_rm(arrival_date) ``` --- # .orange[RECETA]: .green[OUTLIERS/AUSENTE] Tras ello de momento vamos a **.bg-purple_light[detectar outliers a lo bruto]**: detectando por la media e imputando por la media, pero solo de `has_role("cuanti")`, para no incluir a las binarias. Las cuali por la moda en caso de haber ausentes. ```r library(outliers) # Receta hoteles_rec <- hoteles_rec %>% # Detectar outliers step_mutate(across(where(is.numeric), function(x) { ifelse(abs(scores(x, type = "z")) > 2.5 & !is.na(x), NA, x) })) %>% # Imputar ausentes step_impute_mean(has_role("cuanti")) %>% step_impute_mode(has_role("cuali")) ``` --- # .orange[RECETA]: .green[TRANSFORMACIONES] * Aplicamos un filtro de correlación para **.bg-purple_light[prevenir problemas de colinealidad]**. * **.bg-purple_light[Normalizamos por rango]** para la métrica. * **.bg-purple_light[Dummyficamos]** las cualitativas: crea k-1 variables binarias por de cada cualitativa de k niveles. * **.bg-purple_light[Filtro de cero varianza]**. ```r # Receta hoteles_rec <- hoteles_rec %>% # Filtro de correlación step_corr(has_role("cuanti"), threshold = 0.9) %>% # Normalizar por rango step_range(all_numeric_predictors()) %>% # Dummyficamos step_dummy(all_nominal(), -all_outcomes()) %>% # Filtro de cero varianza step_zv(all_predictors()) ``` --- name: fase4-hoteles # Fase 4: .orange[MODELO Y FLUJO] Una vez definida la receta, definimos el **.bg-purple_light[modelo]** y unimos con la receta creando un **.bg-purple_light[flujo de clasificación]** ```r # Modelo knn_model <- nearest_neighbor(mode = "classification", neighbors = 15, weight_func = "inv", dist_power = 2) %>% set_engine("kknn") # Flujo de trabajo hoteles_wflow <- workflow() %>% add_recipe(hoteles_rec) %>% add_model(knn_model) ``` --- name: fase5-hoteles # Fase 5: .orange[EVALUACIÓN/PREDICCIÓN] (validación) En este caso tenemos un conjunto de validación guardado en `hoteles_val`. Para realizar el **.bg-purple_light[ajuste en train y después obtener las métricas en validación]** usaremos `fit_resamples()`, pasándole como argumento los conjuntos de validación que tengamos y las **.bg-purple_light[métricas]** que queremos que evaluar (con `metric_set()` y el nombre de la métrica) ```r # Solo contra un conjunto de validación hoteles_knn_fit_val <- hoteles_wflow %>% fit_resamples(hoteles_val, metrics = metric_set(accuracy, sensitivity, specificity, roc_auc)) ``` --- # Fase 5: .orange[EVALUACIÓN/PREDICCIÓN] (validación) Con `collect_metrics()` obtenemos las métricas pedidas (dado que solo tenemos un conjunto de validación `n = 1` y `std_err = NA`, ya que no tiene con qué promediar al solor tener uno) ```r collect_metrics(hoteles_knn_fit_val) ``` ``` > # A tibble: 4 × 6 > .metric .estimator mean n std_err .config > <chr> <chr> <dbl> <int> <dbl> <fct> > 1 accuracy binary 0.928 1 NA Preprocessor1_Model1 > 2 roc_auc binary 0.776 1 NA Preprocessor1_Model1 > 3 sensitivity binary 0.987 1 NA Preprocessor1_Model1 > 4 specificity binary 0.230 1 NA Preprocessor1_Model1 ``` --- # Fase 5: .orange[EVALUACIÓN] con .green[CURVA ROC] Si te has fijado amén de la sensibilidad y la especificidad (y la tasa de bien de clasificados o accuracy), le hemos pedido una métrica llamada `roc_auc`: el **.bg-purple_light[área bajo la curva ROC]** ```r collect_metrics(hoteles_knn_fit_val) ``` ``` > # A tibble: 4 × 6 > .metric .estimator mean n std_err .config > <chr> <chr> <dbl> <int> <dbl> <fct> > 1 accuracy binary 0.928 1 NA Preprocessor1_Model1 > 2 roc_auc binary 0.776 1 NA Preprocessor1_Model1 > 3 sensitivity binary 0.987 1 NA Preprocessor1_Model1 > 4 specificity binary 0.230 1 NA Preprocessor1_Model1 ``` -- ¿Qué es la **.bg-purple_light[curva ROC]**? Si recuerdas, aunque la salida que usamos normalmente es la clase predicha directamente, nuestro objetivo subyacente es **.bg-purple_light[calcular la probabilidad estimada de pertenencia]** --- # Fase 5: .orange[EVALUACIÓN] con .green[CURVA ROC] En clasificación binaria, por defecto, estamos estableciendo que la **.bg-purple_light[predicción es 1]** si la probabilidad estimada de serlo es **.bg-purple_light[superior a 0.5]**. Imagina que el objetivo es clasificar si una vacuna puede salir al mercado. ¿Es **.bg-purple_light[suficiente exigirle un umbral del 50%]** para asignar un 1? -- La idea detrás de la curva ROC es **.bg-purple_light[mover dicho umbral de probabilidad]**, desde el 0 hasta el 1, para **.bg-purple_light[cada uno de esos umbrales]** calcular * **sensibilidad** (% de 1's reales que han sido clasificados como tal) * **especificidad** (% de 0's reales que han sido clasificados como tal) Y pintarlos en un gráfico (eje x = 1 - especificidad, eje y = sensibilidad) --- # Fase 5: .orange[EVALUACIÓN] con .green[CURVA ROC] .pull-left[ * Eje X: **.bg-purple_light[1 - especificidad]**, conocido como False Positive Rate (FPR), ya que es el % de 0's reales que han sido mal clasificados (como falsos positivos). * Eje Y: **.bg-purple_light[sensibilidad]**, conocido como True Positive Rate (TPR), ya que es el % de 1's reales que han sido clasificados como tal (verdaders positivos). * **.bg-purple_light[AUC ROC]**: área bajo la curva ROC, medida que oscila entre 0 (no hay curva) y 1 (la curva es el cuadrado entero). Clasificador dummy aleatorio: 0.5. ] .pull-right[ <img src="./img/roc_curve.jpg" width="110%" style="display: block; margin: auto auto auto 0;" /> ] --- # Fase 5: .orange[EVALUACIÓN] con .green[CURVA ROC] <img src="./img/pcr_roc_curve.jpg" width="50%" style="display: block; margin: auto;" /> --- class: inverse center middle name: clase-9 # CLASE 9: validación y ggplot ### [Resumen](#resumen) ### [Validación con tune y paralelizada](#tune) ### [Sobremuestreo](#oversampling) ### [Validación cruzada y bootstrap](#cv-hoteles) ### [Visualización de datos](#dataviz) --- name: resumen # .orange[RESUMEN] * **.bg-purple_light[Fase 1: muestreo]** (si fuese necesario) ```r # Muestreo data_sample <- raw_data %>% group_by(var_outcome) %>% slice_sample(prop = ...) %>% ungroup() ``` -- * **.bg-purple_light[Fase 2: exploración]**: analizar problemas, relaciones entre variables y modificaciones a llevar a cabo (outliers, ausentes, colinealidad, variables independientes de la objetivo, recategorizaciones, problemas de codificación y rango, dummyficación si se necesita, nuevas variables, etc) -- * **.bg-purple_light[Particiones otros-test]** ```r # por ejemplo 10% para test data_split <- initial_split(data, strata = var_outcome, prop = 0.9) data_train <- training(data_split) data_test <- testing(data_split) ``` --- # .orange[RESUMEN] * **.bg-purple_light[Particiones train-validacion]**: sobre lo que no es test, volvemos a dividir (se guardará en dicho conjunto las instrucciones para cuando hagamos a futuro el ajuste) ```r # Validación data_val <- validation_split(data_train, strata = var_outcome, prop = 0.75) ``` -- * **.bg-purple_light[Inicio de receta]**: definir la objetivo y roles para usarlos a futiro ```r # Receta model_rec <- # Fórmula y datos recipe(data = data_train, var_outcome ~ .)%>% # Roles add_role(..., new_role = ...) %>% # Añade rol (a otros existentes) update_role(..., new_role = ...) %>% # Modifica (machaca) rol remove_role(..., old_role = ...) # Eliminar roles ``` --- # .orange[RESUMEN] * **.bg-purple_light[Fase 3: modificación]** ```r model_rec <- model_rec %>% step_...(...) %>% # funciones a usar step_mutate(...) %>% # equivalente a mutate step_rm(...) %>% # eliminar variables step_impute_...(...) %>% # imputar ausentes step_corr(...) %>% # Filtro correlaciones step_range(...) %>% # Estandarizar por rango step_other(...) %>% # Colapsar niveles poco representados step_dummy(...) %>% # Dummyficar step_zv(...) # Filtro cero varianza ``` --- # .orange[RESUMEN] * **.bg-purple_light[Fase 4: modelización]** ```r # Modelo knn_model <- nearest_neighbor(mode = "classification", neighbors = ..., weight_func = ..., dist_power = ...) %>% set_engine("kknn") # Flujo de trabajo wflow <- workflow() %>% add_recipe(rec) %>% add_model(knn_model) ``` --- # .orange[RESUMEN] * **.bg-purple_light[Fase 5: evaluación]** (en validación) ```r data_model_fit_val <- wflow %>% fit_resamples(data_val, metrics = metric_set(accuracy, sensitivity, specificity, roc_auc)) # Recopilamos métricas (EN VALIDACIÓN) dadas en metrics collect_metrics(data_model_fit_val) ``` --- # .orange[RESUMEN] **.bg-purple_light[Testeo]** * `predict()`: nos permite obtener las predicciones, bien de la clase que ha asignado a cada registro, bien la probabilidad estimada de pertenencia a cada clase ```r predict(data_model_fit_val, new_data) predict(data_model_fit_val, new_data, type = "prob") ``` * `augment()`: nos permite juntar en una sola tabla los datos originales y las predicciones con `augment()` ```r prob_data <- augment(data_model_fit_val, new_data) ``` --- # .orange[RESUMEN] **.bg-purple_light[Testeo]** * `conf_mat()`: matriz de confusión (realidad vs predicción), indicándole la columna con la clase real y la columna con la clase predicha (por defecto es `.pred_class`). Con `summary()` obtenemos las métricas. ```r conf_mat <- prob_data %>% conf_mat(truth = ..., estimate = .pred_class) conf_mat %>% summary() ``` * `roc_curve()`: curva roc (debemos indicarle las probabilidades de pertenencia, no la clase predicha. ```r roc_data <- prob_data %>% roc_curve(truth = ..., ...) roc_data %>% autoplot() # ya aprenderemos a hacerlo mejor ``` --- name: tune # .orange[TUNE] Hasta ahora solo hemos probado un modelo pero la idea es **.bg-purple_light[entrenar varios modelos]** y **.bg-purple_light[evaluar en validación]** su calidad o conveniencia. Para ello lo que vamos a hacer al definir el modelo es **.bg-purple_light[no asignar una constante a los parámetros]** sino que los vamos a dejar libres, asignándoles `tune()`, para luego indicarle los «diales» en los que queremos que «sintonice» * `neighbors = tune("k")`: dejamos libre el parámetro y asignamos la etiqueta `"k"` * `weight_func = tune("weight")`: dejamos libre y asignamos la etiqueta `"weight"` * `dist_power = tune("dist")`: dejamos libre y asignamos la etiqueta `"dist"` ```r # Modelo con tune knn_model_tune <- nearest_neighbor(mode = "classification", neighbors = tune("k"), weight_func = tune("weight"), dist_power = tune("dist")) %>% set_engine("kknn") ``` --- # .orange[TUNE] La ventaja de tener receta y modelo por separado es que solo necesitamos **.bg-purple_light[unir el nuevo modelo a la anterior receta]** ```r # Nuevo flujo (con tune) hoteles_wflow <- workflow() %>% add_recipe(hoteles_rec) %>% add_model(knn_model_tune) ``` El anterior modelo **.bg-purple_light[no tiene parámetros fijados]** a priori: vamos a definir un **.bg-purple_light[grid de parámetros]** posibles, de forma que ejecutaremos todos ellos para entrenar en train y validar en validación. --- # .orange[TUNE]: .green[GRID MANUAL] Por ejemplo, vamos definir **.bg-purple_light[manualmente]** un grid de 7 valores de `k` (el resto de parámetros los dejamos constantes) ```r grid_knn <- tibble("k" = seq(20, 140, by = 20), "weight" = rep("inv", 7), "dist" = rep(2, 7)) grid_knn ``` ``` > # A tibble: 7 × 3 > k weight dist > <dbl> <chr> <dbl> > 1 20 inv 2 > 2 40 inv 2 > 3 60 inv 2 > 4 80 inv 2 > 5 100 inv 2 > 6 120 inv 2 > 7 140 inv 2 ``` --- # .orange[TUNE]: .green[GRID MANUAL] Una vez definido el grid manual, con `tune_grid()` le indicaremos que **.bg-purple_light[en lugar de entrenar un solo modelo]** entre uno por cada fila que tenemos en `grid_knn` (cada fila representa una configuración de parámetros), y con `control_grid(verbose = TRUE)` le indicamos que nos informe del proceso. .pull-left[ **.bg-orange[ANTES]** (solo un modelo) ```r metricas <- metric_set(accuracy, sensitivity, specificity, roc_auc) hoteles_knn_fit_tune <- hoteles_wflow %>% fit_resamples(hoteles_val, metrics = metricas) ``` ] .pull-right[ **.bg-green_light[AHORA]** (muchos modelos a la vez) ```r # Entrenamos y evaluamos los 7 modelos hoteles_knn_fit_tune <- hoteles_wflow %>% * tune_grid(resamples = hoteles_val, * grid = grid_knn, control = control_grid(verbose = TRUE), metrics = metricas) ``` ] --- # .orange[TUNE]: .green[GRID MANUAL] Tras ello, con `collect_metrics()` obtendremos de una sola vez la métrica (en validación) de todos ellos. ```r hoteles_knn_fit_tune %>% collect_metrics() ``` --- # .orange[TUNE]: .green[GRID EXPANDIDO] Ese grid también podemos definirlo para el resto de parámetros, definiendo los **.bg-purple_light[posibles valores para cada parámetro]** y probar **.bg-purple_light[todas las combinaciones]** entre ellos. Para eso haremos uso de `expand_grid()` ```r expand_grid("x" = 1:3, "y" = 8:9) ``` --- # .orange[TUNE]: .green[GRID EXPANDIDO] Con dicha herramienta vamos a **.bg-purple_light[crear 18 modelos]**: 3 valores diferentes de vecinos, 2 tipos de promedios y 3 métricas. ```r grid_knn <- expand_grid("k" = c(10, 50, 100), "weight" = c("inv", "gaussian"), "dist" = c(0.01, 2, 10)) grid_knn ``` --- # .orange[TUNE]: .green[GRID EXPANDIDO] La forma de definir el grid cambia pero una vez definido, todo es igual que el ejemplo anterior ```r # Entrenamos y evaluamos los 18 modelos hoteles_knn_fit_tune <- hoteles_wflow %>% * tune_grid(resamples = hoteles_val, grid = grid_knn, control = control_grid(verbose = TRUE), metrics = metric_set(accuracy, sensitivity, specificity, roc_auc)) hoteles_knn_fit_tune %>% collect_metrics() ``` --- # .orange[TUNE]: .green[GRID AUTOMÁTICO] Incluso podemos generar ese grid de una manera más **.bg-purple_light[automática]**: primero extraemos los parámetros con `extract_parameter_set_dials()`, luego los actualizamos con `update()` indicándole solo los rangos máximos y mínimos, y con `grid_regular()` le indicamos cuantos niveles queremos en cada parámetro (fijo en todos). ```r grid_knn <- extract_parameter_set_dials(hoteles_wflow) %>% # Actualizamos update(k = neighbors(range = c(5, 70)), weight = weight_func(values = c("inv", "gaussian")), dist = dist_power(range = c(0.1, 10))) %>% grid_regular(levels = 3) grid_knn # 18 modelos (3 x 2 x 3) ``` --- # .orange[TUNE]: .green[GRID AUTOMÁTICO] La forma de definir el grid cambia pero una vez definido, todo es igual que el ejemplo anterior ```r # Entrenamos y evaluamos los 18 modelos hoteles_knn_fit_tune <- hoteles_wflow %>% tune_grid(resamples = hoteles_val, grid = grid_knn, control = control_grid(verbose = TRUE), metrics = metric_set(accuracy, sensitivity, specificity, roc_auc)) hoteles_knn_fit_tune %>% collect_metrics() ``` --- name: show-best # .orange[SELECCIÓN DEL MEJOR] No solo vamos a poder trastear con tidyverse en esos resultados en validación sino que tenemos **.bg-purple_light[dos funciones especialmente pensadas]** para ello: `show_best()` nos devuelve los mejores modelos según la métrica pedida, `select_best()` nos selecciona el mejor ```r hoteles_knn_fit_tune %>% show_best("roc_auc") hoteles_knn_fit_tune %>% select_best("accuracy") ``` --- # .orange[SELECCIÓN DEL MEJOR] Una vez elegido **.bg-purple_light[finalizamos flujo con el mejor modelo]** (según una métrica) ```r best_knn_model_acc <- hoteles_knn_fit_tune %>% select_best("accuracy") final_wf <- hoteles_wflow %>% finalize_workflow(best_knn_model_acc) final_wf ``` --- # Fase 5: .orange[EVALUACIÓN EN TEST] Con `last_fit()` **.bg-purple_light[ajustamos a test]** con ese mejor modelo seleccionado en validación, y calculamos métricas en test. ```r final_knn_fit <- final_wf %>% last_fit(hoteles_split) # Calculamos métricas en test (las indicadas) final_knn_fit %>% collect_metrics() ``` --- # Fase 5: .orange[PREDICCIÓN EN TEST] Podemos volver a usar `predict()`, extrayendo antes el flujo de ese ajuste final con `extract_workflow(final_knn_fit)`, para calcular las **.bg-purple_light[clases predichas]** en test. ```r # Predecir el conjunto test: devuelve la clase predict(extract_workflow(final_knn_fit), hoteles_test) ``` --- # Fase 5: .orange[PREDICCIÓN EN TEST] ```r # Predecir las probabilidades (las necesitamos para la ROC) predict(extract_workflow(final_knn_fit), hoteles_test, type = "prob") ``` --- # Fase 5: .orange[PREDICCIÓN EN TEST] Con `augment()` podemos incluir en una sola tabla los datos en test y las predicciones, y con `conf_mat()` obtenemos la **.bg-purple_light[matriz de confusión]** ```r # Incluir predicciones en tabla prob_test <- augment(extract_workflow(final_knn_fit), hoteles_test) # Matriz de confusión: etiqueta real vs etiqueta predicha conf_mat_test <- prob_test %>% conf_mat(truth = children, estimate = .pred_class) conf_mat_test ``` --- # Fase 5: .orange[PREDICCIÓN EN TEST] ```r # todas las métricas en test conf_mat_test %>% * summary() ``` --- # Fase 5: .orange[PREDICCIÓN EN TEST] Podemos **.bg-purple_light[dibujar la curva ROC]** haciendo uso de `roc_curve()` pasándole el archivo con las predicciones, y usando las probabilidades de ser 1 (guardadas en `.pred_children` en nuestro conjunto). Aprenderemos a dibujarla mejor pero podemos mientras hacerlo con `autoplot()` ```r roc_data <- prob_test %>% roc_curve(truth = children, .pred_children) roc_data ``` --- name: parallel # Computación .orange[EN PARALELO] Si queremos probar muchos modelos y/o nuestro volumen de datos es elevado, quizás nos lleve demasiado tiempo: vamos a hacer una incursión a la **.bg-purple_light[programación paralelizada]**. ```r library(parallel) library(doParallel) ``` -- Ambos paquetes serán los que nos permitan paralelizar de forma sencilla. La idea es **.bg-purple_light[mandar tareas independientes a procesadores distintos]**, de forma que si una tarea tarda 6 minutos en un pc, al mandarlo a otros dos procesadores, el tiempo pueda bajar hasta los 2 minutos (no es del todo lineal ya que hay un tiempo mínimo necesario en cada paso). --- # Computación .orange[EN PARALELO] En muchas empresas u organismos de investigación se suele tener a disposición de los usuarios un conjunto de ordenadores (un clúster) común a todos de forma que cada persona pueda mandar sus hilos en paralelo. Pero…no tenemos de eso. ¿Entonces? Vamos a **.bg-purple_light[paralelizar en NUESTRO PROPIO ORDENADOR]**: un ordenador suele tener **.bg-purple_light[varios procesadores o cores]** que pueden funcionar de manera «independiente» uno de otro. Vamos a detectar la cantidad de núcleos de los que podemos disponer con `detectCores()`. ```r # Detectamos los cores que tenemos detectCores() ``` --- # Computación .orange[EN PARALELO] A la hora de paralelizar es importante que lo hagamos con cuidado ya que puede que nuestro ordenador se quede colgado: mi consejo es que definas el número de cores a usar como los que tienes menos uno. Con `makeCluster()` montamos los **.bg-purple_light[clúster en cada nodo]** y con `registerDoParallel()` registramos la paralelización (puedes ver los hilos abiertos con `showConnections()`). ```r # Iniciamos la paralelización clusters <- detectCores() - 1 make_cluster <- makeCluster(clusters) registerDoParallel(make_cluster) showConnections() ``` --- # Computación .orange[EN PARALELO] El único cambio respecto a antes es indicarle `tune_grid()` que queremos la **.bg-purple_light[validación paralelizada]**, con `control = control_grid(allow_par = TRUE)`. Es importante que al **.bg-purple_light[acabar la paralelización le indiquemos que cerramos los clúster]**. ```r hoteles_knn_fit_tune <- hoteles_wflow %>% tune_grid(resamples = hoteles_val, grid = grid_knn, * control = control_grid(verbose = TRUE, allow_par = TRUE, pkgs = c("outliers")), metrics = metric_set(accuracy, sensitivity, specificity, roc_auc)) # finalizamos clusters stopCluster(make_cluster) registerDoSEQ() # Métricas hoteles_knn_fit_tune %>% collect_metrics() ``` --- # Computación .orange[EN PARALELO] Es importante que si necesitamos **.bg-purple_light[algún paquete]** se lo indiquemos en `pkgs = ...` para que lo cargue en cada cluster, y si **.bg-purple_light[necesitamos alguna función propia]** que hayamos creado lo hagamos con `clusterExport(make_cluster, "nombre_funcion")` ```r hoteles_knn_fit_tune <- hoteles_wflow %>% tune_grid(resamples = hoteles_val, grid = grid_knn, * control = control_grid(verbose = TRUE, allow_par = TRUE, pkgs = c("outliers")), metrics = metric_set(accuracy, sensitivity, specificity, roc_auc)) # finalizamos clusters stopCluster(make_cluster) registerDoSEQ() # Métricas hoteles_knn_fit_tune %>% collect_metrics() ``` --- name: oversampling # .orange[SOBREMUESTREO] .green[BAJOMUESTREO] Un paso que hemos obviado: si tenemos la **.bg-purple_light[variable objetivo desbalanceada]** solo aprenderá de la clase mayoritaria. Este desbalanceamiento podemos mitigarlo realizando **.bg-purple_light[sobremuestro/bajomuestreo]**, añadiendo `step_upsample()` (del paquete `{themis}`) a la receta (el parámetro `over_ratio` nos cuantifica el % de la clase minoritaria entre la mayoritaria). ```r hoteles_rec_oversampling <- hoteles_rec %>% * themis::step_upsample(children, over_ratio = 0.5) bake(hoteles_rec_oversampling %>% prep(), new_data = NULL) %>% count(children) %>% mutate(porc = 100*n/sum(n)) ``` --- # .orange[SOBREMUESTREO] .green[BAJOMUESTREO] Es importante advertir que por defecto `themis::step_upsample()` tiene un parámetro opcional `skip` puesto en `TRUE` (si te fijas en el resto de funciones tipo `step_...()` la mayoría lo tienen en `FALSE`). Si `skip = TRUE`, lo que indicamos ese que ese **.bg-purple_light[paso de la receta lo ignore cuando lo vayamos a aplicar a test]** (recuerda que la ventaja de tidymodels es que cuando le pides predecir en test, el solo aplica la receta de train a test, para calcular la predicción). De esta manera, el conjunto de test no será sobre/bajomuestreado, ya que sería incorrecto "modificar" el conjunto de test dado (recuerda siempre que simula un conjunto nuevo que alguien te da). Puedes poder `skip = TRUE` siempre que quieras que un paso se lo salte luego en test. --- # .orange[SOBREMUESTREO] .green[BAJOMUESTREO] Basta con repetir el proceso con la **receta con sobremuestreo** ```r clusters <- detectCores() - 1 make_cluster <- makeCluster(clusters) registerDoParallel(make_cluster) # Flujo de trabajo hoteles_wflow_oversampling <- workflow() %>% add_recipe(hoteles_rec_oversampling) %>% add_model(knn_model_tune) # Ajuste hoteles_knn_fit_tune_oversampling <- hoteles_wflow_oversampling %>% tune_grid(resamples = hoteles_val, grid = grid_knn, control = control_grid(verbose = TRUE, allow_par = TRUE, pkgs = c("outliers")), metrics = metric_set(accuracy, sensitivity, specificity, roc_auc)) # finalizamos clusters stopCluster(make_cluster) registerDoSEQ() ``` --- # .orange[SOBREMUESTREO] .green[BAJOMUESTREO] Tras ello volvemos a elegir el mejor modelo según accuracy para compararlo ```r best_knn_model_over_acc <- hoteles_knn_fit_tune_oversampling %>% select_best("accuracy") ``` Y con ese modelo seleccionado finalizamos flujo y ajustamos a test ```r # Finalizamos flujo con el mejor modelo (según una métrica) final_wf_over <- hoteles_wflow %>% finalize_workflow(best_knn_model_over_acc) # Ajustamos a test con ese modelo seleccionado en validación final_knn_fit_over <- final_wf_over %>% last_fit(hoteles_split) ``` --- # .orange[SOBREMUESTREO] .green[BAJOMUESTREO] ```r # Calculamos métricas en test (las indicadas) final_knn_fit_over %>% collect_metrics() ``` --- names: cv-hoteles # Validación .orange[CRUZADA] Hasta ahora, hemos probado **.bg-purple_light[varios modelos]** sobre el **.bg-orange[mismo conjunto de validación]**. Ese conjunto de validación se ha hecho de manera aleatoria, así que nuestro resultado podría estar condicionado a la **buena o mala suerte** de esa partición. En realidad cuando hemos hablado de **.bg-purple_light[sesgo y varianza]** no era exactamente esto, ya que para tener una media de lo que nos equivocamos y una varianza de las predicciones, necesitaremos no solo varios modelos sino, en cada una, **.bg-purple_light[varios conjuntos de validación]** **.bg-red_light[Problema]**: si necesitamos hacer muchas particiones de los datos, puede que nos quedemos sin tamaño muestral suficiente. --- # Validación .orange[CRUZADA] aleatoria * **.bg-purple_light[Validación cruzada aleatoria]**: la forma más simple (pero menos eficiente) es generar un «bucle» de k iteraciones, de forma que repitamos el proceso k veces, con conjuntos de validación distintos, promediando las métricas. <img src="./img/val_cruzada_aleatoria.jpg" width="55%" style="display: block; margin: auto;" /> La **.bg-red_light[principal crítica]** a este método no solo es la ineficiencia sino que además en cada iteración podemos tener solapamiento: nada nos garantiza que el conjunto de validación sea el mismo en dos iteraciones. --- # Validación .orange[CRUZADA] v-folds * **.bg-purple_light[Validación cruzada v-folds]**: la forma más habitual es mediante validación cruzada v-folds, basada en **.bg-purple_light[generar artificialmente conjuntos de validación]** a partir de los datos originales. <img src="./img/val_cruzad_vfolds.jpg" width="51%" style="display: block; margin: auto;" /> Los datos se dividen en **.bg-purple_light[v subsubconjuntos de igual tamaño]**: en cada iteración i (de 1 a v) se usa como **.bg-purple_light[conjunto train todo menos el subconjunto i-ésimo]**, el cual es usado para validar (obteniendo un promedio de v iteraciones). --- # Validación .orange[CRUZADA] v-folds * **Iteración i**: entrenamos el modelo con los **conjuntos {1,...,i-1, i+1, ..., v}** y validamos con el **conjunto i-ésimo**. En muchas ocasiones ese proceso se **.bg-purple_light[repite un número k de veces]** con el objetivo de **.bg-purple_light[eliminar el efecto de la forma de subdivisión]** en v subconjuntos, obteniendo un promedio de `\(k*v\)` conjuntos de validación, y tomar decisiones sobre los parámetros. ```r hoteles_split <- initial_split(hoteles_sample, strata = children, prop = 0.9) hoteles_train <- training(hoteles_split) hoteles_test <- testing(hoteles_split) *hoteles_cv_folds <- vfold_cv(data = hoteles_train, v = 4, repeats = 2, strata = children) hoteles_cv_folds ``` --- # Validación .orange[CRUZADA] v-folds Todo igual salvo el conjunto de `resamples` que le pasamos ```r clusters <- detectCores() - 1 make_cluster <- makeCluster(clusters) registerDoParallel(make_cluster) hoteles_knn_fit_tune <- hoteles_wflow %>% * tune_grid(resamples = hoteles_cv_folds, grid = grid_knn, * control = control_grid(verbose = TRUE, allow_par = TRUE, pkgs = c("outliers")), metrics = metric_set(accuracy, sensitivity, specificity, roc_auc)) # finalizamos clusters stopCluster(make_cluster) registerDoSEQ() ``` --- # Validación .orange[CRUZADA] v-folds Ahora tendremos una métrica media con su desviación típica. ```r hoteles_knn_fit_tune ``` --- # Validación .orange[CRUZADA] v-folds Incluso podemos usar `select_by_one_std_err()` para elegir el **.bg-purple_light[mejor modelo según sesgo-varianza]**, siguiendo la one-standard error rule propuesta por Breiman et al. (1984). Ver <https://www.cs.ubc.ca/~murphyk/Teaching/CS340-Fall07/L4_knn.pdf> ```r hoteles_knn_fit_tune %>% select_by_one_std_err(metric = "accuracy", k) hoteles_knn_fit_tune %>% collect_metrics() ``` --- names: bootstrap-val-hoteles # Validación .orange[BOOTSTRAP] Cuando los **.bg-purple_light[datos son tan escasos que incluso la validación v-folds]** nos dejaría conjuntos muy poco representativos por su tamaño, podemos aplicar un **.bg-purple_light[remuestreo con reemplazamiento (bootstrap)]**. En este caso, en cada iteración, realizaremos un **.bg-purple_light[remuestreo con reemplazamiento pero SOLO de una parte de los datos]**, obteniendo un conjunto de igual tamaño al inicial. Con los datos que no entraron en el remuestreo con reemplazamiento anterior construimos el **.bg-purple_light[conjunto para la validación (Out-of-Bag - OOB - sample)]**. ```r hoteles_boots <- bootstraps(hoteles_train, times = 7) hoteles_boots ``` ``` > # Bootstrap sampling > # A tibble: 7 × 2 > splits id > <list> <chr> > 1 <split [4499/1656]> Bootstrap1 > 2 <split [4499/1674]> Bootstrap2 > 3 <split [4499/1647]> Bootstrap3 > 4 <split [4499/1673]> Bootstrap4 > 5 <split [4499/1676]> Bootstrap5 > 6 <split [4499/1678]> Bootstrap6 > 7 <split [4499/1647]> Bootstrap7 ``` --- name: dataviz # .orange[DATAVIZ]: .green[HISTORIA] La aparición de gráficos estadísticos es **.bg-purple_light[relativamente reciente en la ciencia]** ya que hasta la Edad Media la única visualización de datos estaba en los **.bg-purple_light[mapas]** (representación de nuestra realidad en superficies bidimensionales). De hecho las propias palabras _chart_ y _cartography_ derivan del mismo origen latino, _charta_, aunque el primer uso datado de coordenadas parece venir de los egipcios. <sup>2,3</sup> .footnote[[1] [«Gramática de las gráficas: pistas para mejorar las representaciones de datos» de Joaquín Sevilla](http://academica-e.unavarra.es/bitstream/handle/2454/15785/Gram%C3%A1tica.pdf) [2] [«Presentation Graphics» de Leland Wilkinson. International Encyclopedia of the Social & Behavioral Sciences](https://www.cs.uic.edu/~wilkinson/Publications/iesbs.pdf) [3] [«Quantitative Graphics in Statistics: A Brief History» de James R. Beniger y Dorothy L. Robyn. The American Statistician (1978)](https://www.jstor.org/stable/2683467)] --- # .orange[NAVEGACIÓN] y .green[ASTRONOMÍA] .pull-left[ No es hasta la Edad Media, cuando la **.bg-purple_light[navegación y la astronomía]** empezaban a tomar relevancia científica, cuando aparece la que se considera la primera gráfica (aunque no propiamente estadística) <sup>3</sup>, representando el **movimiento cíclico de los planetas** (entre los siglos X y XI) ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/dataviz_historico_1.png" alt="Gráfica extraída de Beniger y Robyn (1978)" width="110%" /> <p class="caption">Gráfica extraída de Beniger y Robyn (1978)</p> </div> ] [3] [«Quantitative Graphics in Statistics: A Brief History» de James R. Beniger y Dorothy L. Robyn. The American Statistician (1978)](https://www.jstor.org/stable/2683467) --- # .orange[PRIMER] gráfico estadístico La mayoría de expertos, como Tufte <sup>6,7</sup>, consideran este gráfico casi longitudinal como la **.bg-purple_light[primera visualización de datos]** de la historia, hecha por **Van Langren** en 1644, representando la **.bg-purple_light[distancia entre Toledo y Roma]** (un poco mal medida ya que la distancia real es de 16.5º). .pull-left[ <div class="figure" style="text-align: center"> <img src="./img/longitud_dataviz.jpg" alt="Extraída de Friendly y Valero-Mora (2010)" width="100%" /> <p class="caption">Extraída de Friendly y Valero-Mora (2010)</p> </div> ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/dataviz_historico_3.jpeg" alt="Extraída de Friendly y Valero-Mora (2010)" width="100%" /> <p class="caption">Extraída de Friendly y Valero-Mora (2010)</p> </div> ] [6] [«Visual explanations: images and quantities, evidence and narrative» de E. Tufte](https://archive.org/details/visualexplanatio00tuft) [7] [«PowerPoint is evil» de E. Tufte](https://www.wired.com/2003/09/ppt2/) --- # ¿Qué es una .orange[GRÁFICA] estadística? ¿Por qué ese gráfico se considera la primera visualización estadística de la historia? ¿Qué es lo que hace que una visualización sea una gráfica estadística y no las anteriores? ¿Cuál es la **.bg-purple_light[frontera entre una ilustración y una gráfica]** (de datos)? .pull-left[ ¿Es una gráfica estadística? ¿Por qué sí o por qué no? ] .pull-right[ <img src="./img/cuadro_dataviz.jpg" width="45%" style="display: block; margin: auto;" /> ] -- No hay **.bg-purple_light[ninguna INFORMACIÓN]** representada --- # ¿Qué es una .orange[GRÁFICA] estadística? ¿Por qué ese gráfico se considera la primera visualización estadística de la historia? ¿Qué es lo que hace que una visualización sea una gráfica estadística y no las anteriores? ¿Cuál es la **.bg-purple_light[frontera entre una ilustración y una gráfica]** (de datos)? .pull-left[ ¿Es una gráfica estadística? ¿Por qué sí o por qué no? ] .pull-right[ <img src="./img/horoscopo_dataviz.jpg" width="65%" style="display: block; margin: auto;" /> ] -- No hay **.bg-purple_light[ningún PROCESO DE MEDIDA]** representado, no cuantifica nada (real). --- # ¿Qué es una .orange[GRÁFICA] estadística? ¿Por qué ese gráfico se considera la primera visualización estadística de la historia? ¿Qué es lo que hace que una visualización sea una gráfica estadística y no las anteriores? ¿Cuál es la **.bg-purple_light[frontera entre una ilustración y una gráfica]** (de datos)? .pull-left[ ¿Es una gráfica estadística? ¿Por qué sí o por qué no? ] .pull-right[ <img src="./img/celsius_dataviz.jpg" width="110%" style="display: block; margin: auto;" /> ] -- No hay **.bg-purple_light[ningún DATO]** representado en él, es una magnitud física teórica, no un dato (medido empíricamente o simulado). --- # ¿Qué es una .orange[GRÁFICA] estadística? ¿Por qué ese gráfico se considera la primera visualización estadística de la historia? ¿Qué es lo que hace que una visualización sea una gráfica estadística y no las anteriores? ¿Cuál es la **.bg-purple_light[frontera entre una ilustración y una gráfica]** (de datos)? .pull-left[ ¿Es una gráfica estadística? ¿Por qué sí o por qué no? ] .pull-right[ <img src="./img/mapa_infografia_dataviz.jpg" width="60%" style="display: block; margin: auto;" /> ] -- El proceso de representación **.bg-purple_light[no es REVERSIBLE]** ni comparable (al menos no fácilmente): es una infografía, no un gráfico estadístico. --- # ¿Qué es una .orange[GRÁFICA] estadística? Esas mismas preguntas se hizo **Joaquín Sevilla** <sup>1</sup>, proporcionando **.bg-purple_light[3 requisitos]**: .pull-left[ 1. Que se base en el esquema de composición de **.bg-purple_light[eje métrico]** (proceso de medida): debe **.bg-orange[medir algo]**. 2. Debe incluir **.bg-purple_light[información (datos)]** 3. La **.bg-purple_light[relación de representatividad]** debe ser **.bg-purple_light[reversible]**: los datos deberían poder «recuperarse» a partir de la gráfica (es un tipo particular de **.bg-orange[«aplicación» matemática]**). ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/grafica_dinero_sevilla.jpg" alt="Ejemplo de metáfora visual bien ejecutada (extraída del manual de J. Sevilla)" width="70%" /> <p class="caption">Ejemplo de metáfora visual bien ejecutada (extraída del manual de J. Sevilla)</p> </div> ] [1] [«Gramática de las gráficas: pistas para mejorar las representaciones de datos» de Joaquín Sevilla](http://academica-e.unavarra.es/bitstream/handle/2454/15785/Gram%C3%A1tica.pdf) --- # Abolición de .orange[DIAGRAMAS DE TARTAS] Hay muchas formas de hacer una gráfica estadística, y no suele pasar por hacer un **.bg-purple_light[gráfico de tartas o sectores]** ya que tienen un grave **.bg-purple_light[problema de reversibilidad]**: .pull-left[ * Si hay **muchas variables**: salvo que conozcas el montante total y tengas un transportador de ángulos a mano, es **.bg-purple_light[imposible que tus ojos midan ángulos]** * Si hay **pocas variables**: ¿aporta algo distinto (y/o mejor) que una tabla? ] .pull-right[ <img src="./img/sectores_3D.jpg" width="99%" style="display: block; margin: auto;" /> ] --- # .orange[VIZFAILS]: ejempos mal <div class="figure" style="text-align: center"> <img src="./img/persona_dataviz.jpg" alt="Ejemplo de metáfora visual mal ejecutada" width="50%" /> <p class="caption">Ejemplo de metáfora visual mal ejecutada</p> </div> --- # .orange[VIZFAILS]: ejempos mal .pull-left[ <div class="figure" style="text-align: center"> <img src="./img/persona_dataviz.jpg" alt="Ejemplo de metáfora visual mal ejecutada" width="99%" /> <p class="caption">Ejemplo de metáfora visual mal ejecutada</p> </div> ] .pull-right[ * La figura elegida (persona caminando) sin relación con lo visualizado: **.bg-purple_light[mala metáfora visual]**. * Los **.bg-purple_light[sectores señalados sin relación con el ítem]** a representar, lo que dificulta su interpretación. * Los **.bg-purple_light[colores sin codificar]**: no dan información de ningún tipo. * Las **.bg-purple_light[formas irregulares impiden la comparación]** de las áreas (amén de que la suma total supera el 100%). * **.bg-purple_light[Sin fuente]** de la procedencia de los datos. ] --- # .orange[VIZFAILS]: ejempos mal <div class="figure" style="text-align: center"> <img src="./img/viz_fail_covid.jpg" alt="Ejemplo de una buena idea mal ejecutada (de un vicerrector de tecnología...)" width="50%" /> <p class="caption">Ejemplo de una buena idea mal ejecutada (de un vicerrector de tecnología...)</p> </div> --- # .orange[VIZFAILS]: ejempos mal .pull-left[ <div class="figure" style="text-align: center"> <img src="./img/viz_fail_covid.jpg" alt="Ejemplo de una buena idea mal ejecutada (de un vicerrector de tecnología...)" width="100%" /> <p class="caption">Ejemplo de una buena idea mal ejecutada (de un vicerrector de tecnología...)</p> </div> ] .pull-right[ * **.bg-purple_light[Uso de dos ejes]** (a izquierda para mortalidad, a derecha para letalidad) **.bg-purple_light[sin indicarlo]** adecuadamente. Cuidado con los dos ejes: puede ser confuso. * **.bg-purple_light[Leyenda mal referenciada]** y muy pequeña. * **.bg-purple_light[Tamaño de la línea desproporcionado]** que impide la reversibilidad y la comparación. * **.bg-purple_light[Compara celdas geográficas incomparables]** por tamaño y contexto: ¿Galicia vs Alemania? ] --- # .orange[VIZFAILS]: ejempos mal <div class="figure" style="text-align: center"> <img src="./img/viz_fail_uk.jpg" alt="Ejemplo de una mala codificación" width="40%" /> <p class="caption">Ejemplo de una mala codificación</p> </div> --- # .orange[VIZFAILS]: ejempos mal .pull-left[ <div class="figure" style="text-align: center"> <img src="./img/viz_fail_uk.jpg" alt="Ejemplo de una mala codificación" width="60%" /> <p class="caption">Ejemplo de una mala codificación</p> </div> ] .pull-right[ * **.bg-purple_light[Desagregación incorrecta]**: distritos geográficos muy grandes que se podrían representar en una tabla de 9 filas. * **.bg-purple_light[Leyenda desproporcionada]** que atrae la atención más que el propio gráfico. * Ejemplo de los **.bg-purple_light[colores no son algo meramente estético]**: hay que codificarlos adecuadamente. El gradiente de una paleta de colores puede convertir una buena idea en una pésima visualización. ] --- # La importancia del .orange[CONTEXTO] Una **buena idea** puede estar mal ejecutada: la forma de llevarla a cabo es importante <div class="figure" style="text-align: center"> <img src="./img/semaforos.jpg" alt="Ejemplo de buena idea mal ejecutada" width="28%" /> <p class="caption">Ejemplo de buena idea mal ejecutada</p> </div> --- # Dataviz: .orange[HISTORIA] En el siglo XVII hubo un boom de la estadística al empezar a aplicarse en **.bg-purple_light[demografía]**. Uno de los autores más importantes fue **.bg-purple_light[J. Graunt]**, autor de «Natural and Political Observations Made upon the Bills of Mortality» (1662), estimando la población de Londres con las **.bg-purple_light[primeras tablas de natalidad y mortalidad]**. .pull-left[ Son precisamente las tablas de Graunt las que usó **.bg-purple_light[Christiaan Huygens]** para generar la **.bg-purple_light[primera gráfica de densidad]** de una distribución continua (esperanza de vida vs edad). ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/primera_densidad.jpg" alt="Primera función de densidad, extraída de https://omeka.lehigh.edu/exhibits/show/data_visualization/vital_statistics/huygen" width="100%" /> <p class="caption">Primera función de densidad, extraída de https://omeka.lehigh.edu/exhibits/show/data_visualization/vital_statistics/huygen</p> </div> ] --- # Los gráficos de .orange[Playfair] La figura que cambió el dataviz fue, sin lugar a dudas, el economista y político **.bg-purple_light[William Playfair (1759-1823)]**, publicando en 1786 el **«Atlas político y comercial»** con 44 gráficas (43 series temporales y el diagrama de barras más famoso de la historia). .pull-left[ <div class="figure" style="text-align: center"> <img src="./img/playfair_1.jpg" alt="Extraídas de Funkhouser y Walker (1935)" width="70%" /> <p class="caption">Extraídas de Funkhouser y Walker (1935)</p> </div> ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/playfair_2.jpg" alt="Extraídas de Funkhouser y Walker (1935)" width="25%" /> <p class="caption">Extraídas de Funkhouser y Walker (1935)</p> </div> ] [10] [«Atlas político y comercial» de William Playfair (1786)](https://www.amazon.es/Playfairs-Commercial-Political-Statistical-Breviary/dp/0521855543) [11] [«Playfair and his charts» de H. Gray Funkhouser and Helen M. Walker (1935)](https://www.jstor.org/stable/45366440) --- # Los gráficos de .orange[Playfair] Playfair no solo fue el primero en usar el dataviz para entender (y no solo describir): fue el primero en usar **.bg-purple_light[conceptos modernos]** como _grid_, tema o color .pull-left[ <div class="figure" style="text-align: center"> <img src="./img/playfair_3.jpg" alt="Extraída de https://friendly.github.io/HistDataVis" width="90%" /> <p class="caption">Extraída de https://friendly.github.io/HistDataVis</p> </div> ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/playfair_4.png" alt="Extraída de la wikipedia." width="90%" /> <p class="caption">Extraída de la wikipedia.</p> </div> ] --- # Los gráficos de .orange[Playfair] Playfair es además el autor del **.bg-purple_light[gráfico de barras más famoso]** (no fue el primero pero sí quien lo hizo _mainstream_). .pull-left[ <div class="figure" style="text-align: center"> <img src="./img/playfair_5.jpg" alt="Gráficas de Playfair de importaciones (barras grises) y exportaciones (negras) de Escocia en 1781, extraídas de la wikipedia." width="90%" /> <p class="caption">Gráficas de Playfair de importaciones (barras grises) y exportaciones (negras) de Escocia en 1781, extraídas de la wikipedia.</p> </div> ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/playfair_6.jpg" alt="Primer diagrama de barras (P. Buache y G. de L’Isle), visualizando los niveles del Sena (1732 - 1766), extraída de https://friendly.github.io/HistDataVis" width="90%" /> <p class="caption">Primer diagrama de barras (P. Buache y G. de L’Isle), visualizando los niveles del Sena (1732 - 1766), extraída de https://friendly.github.io/HistDataVis</p> </div> ] --- # Los gráficos de .orange[Playfair] Playfair además fue el primero en **.bg-purple_light[combinar gráficos en la misma visualización]** .pull-left[ <div class="figure" style="text-align: center"> <img src="./img/playfair_7.jpg" alt="Visualiza 3 series temporales: precios (barras) del trigo, salarios (línea) y time-line con reinados, extraída de https://friendly.github.io/HistDataVis." width="85%" /> <p class="caption">Visualiza 3 series temporales: precios (barras) del trigo, salarios (línea) y time-line con reinados, extraída de https://friendly.github.io/HistDataVis.</p> </div> ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/playfair_8.png" alt="Time-line histórico, extraída de https://friendly.github.io/HistDataVis." width="85%" /> <p class="caption">Time-line histórico, extraída de https://friendly.github.io/HistDataVis.</p> </div> ] [12] [«A Letter on Our Agricultural Distresses, Their Causes and Remedies» de W. Playfair (1821)](http://onlinebooks.library.upenn.edu/webbin/book/lookupid?key=ha009726110) [13] [«An Inquiry Into the Permanent Causes of the Decline and Fall of Powerful and Wealthy Nations» de William Playfair (1821)](https://www.amazon.com/Permanent-Powerful-Nations-Prosperity-Prolonged/dp/140691830X) --- # Mapas de .orange[Minard] Otro pionero en **.bg-purple_light[combinar visualizaciones]** fue Minard, autor del famoso «Carte figurative des pertes successives en hommes de l'Armée Française dans la campagne de Russie 1812-1813», según Tufte **.bg-purple_light[«el mejor gráfico estadístico jamás dibujado»]**, publicado en 1869 sobre la desastrosa campaña rusa de Napoleón en 1812 (3 variables en un gráfico bidimensional) <div class="figure" style="text-align: center"> <img src="./img/minard_2.png" alt="Extraída de https://friendly.github.io/HistDataVis." width="60%" /> <p class="caption">Extraída de https://friendly.github.io/HistDataVis.</p> </div> --- # Primer .orange[SCATTER PLOT] Según Sevilla <sup>1</sup>, se considera al astrónomo británico **John Frederick William Herschel** el autor del **.bg-purple_light[primer diagrama de dispersión o scatterplot]** en 1833, visualizando el movimiento de la estrella doble Virginis (tiempo en el eje horizontal, posición angular en el eje vertical) <div class="figure" style="text-align: center"> <img src="./img/herschel.jpg" alt="Extraído de https://friendly.github.io/HistDataVis." width="35%" /> <p class="caption">Extraído de https://friendly.github.io/HistDataVis.</p> </div> --- # Primera .orange[PIRÁMIDE POBLACIONAL] La **.bg-purple_light[primera pirámide de población]** (doble histograma de población), fue publicada por **Francis Amasa Walker**, superintendente del censo de EE.UU., en 1874. <div class="figure" style="text-align: center"> <img src="./img/walker_piramide.jpg" alt="Extraída de https://www.depauw.edu/learn/dew/wpaper/workingpapers/DePauw2016-02-Barreto-DemographyEconomics.pdf" width="45%" /> <p class="caption">Extraída de https://www.depauw.edu/learn/dew/wpaper/workingpapers/DePauw2016-02-Barreto-DemographyEconomics.pdf</p> </div> --- # .orange[FLORENCE NIGTHINGALE] .pull-left[ * El 21 de octubre de 1854 **.bg-purple_light[Florence Nigthingale]** fue enviada para mejorar las **condiciones sanitarias** de los soldados británicos en la guerra de Crimea. * A su regreso se dedicó a demostrar que los **.bg-purple_light[soldados fallecían por las condiciones sanitarias]**: eran **muertes evitables**. Nigthingale es la creadora del famoso y pionero **.bg-purple_light[diagrama de rosa]**, permitiendo pintar tres variables a la vez y su estacionalidad. * El 8 de febrero de 1955, The Times la describió como la **«ángel guardián» de los hospitales**, y al finalizar la contienda, fue recibida como una heroína, conocida como **.bg-purple_light[«The Lady with the Lamp»]**. ] .pull-right[ <img src="./img/the_lady_with_the_lamp.png" width="75%" style="display: block; margin: auto;" /> ] --- # .orange[DIAGRAMA DE ROSA] Florence Nigthingale es la creadora del famoso **.bg-purple_light[diagrama de rosa]**, permitiendo pintar **.bg-purple_light[tres variables a la vez y su estacionalidad]**: **tiempo** (cada **gajo** es un mes), **nº de muertes** (**área** del gajo) y **causa** de la muerte (**color** del gajo: azules enfermedades infecciosas, rojas por heridas, negras otras causas). <img src="./img/rosa_nightingale.jpg" width="60%" style="display: block; margin: auto;" /> --- # .orange[RECURSOS] de dataviz 📚 [«The Functional Art: an introduction to information graphics and visualization» de Alberto Cairo](https://www.amazon.es/Functional-Art-Voices-That-Matter/dp/0321834739) 📚 [«Gramática de las gráficas: pistas para mejorar las representaciones de datos» de Joaquín Sevilla](https://academica-e.unavarra.es/bitstream/handle/2454/15785/Gram%C3%A1tica.pdf) 📚 [«A Brief History of Visualization» de Friendly et al. (2008)](https://www.researchgate.net/publication/226400313_A_Brief_History_of_Data_Visualization) 📚 [«Quantitative Graphics in Statistics: A Brief History» de James R. Beniger y Dorothy L. Robyn. The American Statistician (1978)](https://www.jstor.org/stable/2683467)] 📚 [«Presentation Graphics» de Leland Wilkinson. International Encyclopedia of the Social & Behavioral Sciences](https://www.cs.uic.edu/~wilkinson/Publications/iesbs.pdf) 📚 [«The Grammar of Graphics» de Leland Wilkinson](https://www.amazon.es/Grammar-Graphics-Statistics-Computing/dp/0387245448) 📚 [«The Minard System: The Graphical Works of Charles-Joseph Minard» de Sandra Rendgen](https://www.amazon.es/gp/product/1616896337/ref=sw_img_1?smid=A1AT7YVPFBWXBL&psc=1) 📚 [«The Visual Display of Quantitative Information» de E. W. Tufte](https://www.amazon.es/Visual-Display-Quantitative-Information/dp/0961392142) --- name: intro-ggplot2 # Dataviz en R: .orange[ggplot2] .pull-left[ El paquete `{ggplot2}` se basa en la idea propuesta por Wilkinson en **.bg-purple_light[«Grammar of graphics»]**: dotar a los gráficos de una gramática propia. Una de las principales fortalezas de `R` no solo es la flexibilidad y rapidez de `{tidyverse}`, también la **.bg-purple_light[visualización]** con el paquete `{ggplot2}`. ```r library(ggplot2) ``` La **.bg-purple_light[visualización de datos]** debería ser una parte fundamental de todo análisis de datos. No es solo una cuestión estética, es fundamental para **.bg-purple_light[convertir el dato en información]**. ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/telling_dataviz.jpg" alt="Imagen extraída de Reddit" width="71%" /> <p class="caption">Imagen extraída de Reddit</p> </div> ] --- # Dataviz en R: .orange[ggplot2] .pull-left[ La filosofía detrás de `{ggplot2}` es entender los **.bg-purple_light[gráficos como parte del flujo]** de trabajo, dotándoles de una **.bg-purple_light[gramática]**, basándose en la idea de Wilkinson. El objetivo es empezar con un lienzo en blanco e ir **.bg-purple_light[añadiendo capas a tu gráfico]**. La ventaja de `{ggplot2}` es poder **.bg-purple_light[mapear atributos estéticos]** (color, forma, tamaño) de objetos geométricos (puntos, barras, líneas) en función de los datos. La **documentación** del paquete puedes consultarla en <https://ggplot2-book.org/introduction.html> ] .pull-right[ <div class="figure" style="text-align: center"> <img src="./img/grammar_ggplot2.jpg" alt="Idea detrás de la «Grammar of graphics» de Wilkinson" width="100%" /> <p class="caption">Idea detrás de la «Grammar of graphics» de Wilkinson</p> </div> ] --- # Dataviz en R: .orange[ggplot2] <div class="figure" style="text-align: center"> <img src="./img/tarta_ggplot2.png" alt="Extraída de https://twitter.com/tanya_shapiro" width="75%" /> <p class="caption">Extraída de https://twitter.com/tanya_shapiro</p> </div> --- # Dataviz en R: .orange[ggplot2] .pull-left[ <div class="figure" style="text-align: center"> <img src="./img/tarta_recortada_ggplot2.jpg" alt="Extraída de https://twitter.com/tanya_shapiro" width="80%" /> <p class="caption">Extraída de https://twitter.com/tanya_shapiro</p> </div> ] .pull-right[ Un gráfico se podrá componer de las siguientes **.bg-purple_light[capas]** * **.bg-purple_light[Datos (data)]** * **.bg-purple_light[Mapeado (aesthetics)]** de elementos estéticos: ejes, color, forma, tamaño, etc (en función de los datos) * **.bg-purple_light[Geometría (geom)]**: puntos, líneas, barras, polígonos, etc. * **.bg-purple_light[Componer gráficas (facet)]**: visualizar varias gráficas a la vez. * **.bg-purple_light[Transformaciones (stat)]**: ordenar, resumir, agrupar, etc. * **.bg-purple_light[Coordenadas (coord)]**: coordenadas cartesianas, polares, grids, etc. * **.bg-purple_light[Temas (theme)]**: fuente, tamaño de letra, subtítulos, captions, leyenda, ejes, etc. ] --- # Primer intento: .orange[SCATTER PLOT] Veamos un **primer intento** para entender la filosofía ggplot. Imagina que queremos dibujar un **.bg-purple_light[scatter plot]** (diagrama de dispersión de puntos). Para ello vamos a usar el conjunto de datos `gapminder`, del paquete homónimo: un fichero con **datos de esperanzas de vida, poblaciones y renta per cápita** de distintos países en distintos momentos temporales. ```r library(gapminder) gapminder ``` ``` > # A tibble: 1,704 × 6 > country continent year lifeExp pop gdpPercap > <fct> <fct> <int> <dbl> <int> <dbl> > 1 Afghanistan Asia 1952 28.8 8425333 779. > 2 Afghanistan Asia 1957 30.3 9240934 821. > 3 Afghanistan Asia 1962 32.0 10267083 853. > 4 Afghanistan Asia 1967 34.0 11537966 836. > 5 Afghanistan Asia 1972 36.1 13079460 740. > 6 Afghanistan Asia 1977 38.4 14880372 786. > 7 Afghanistan Asia 1982 39.9 12881816 978. > 8 Afghanistan Asia 1987 40.8 13867957 852. > 9 Afghanistan Asia 1992 41.7 16317921 649. > 10 Afghanistan Asia 1997 41.8 22227415 635. > # … with 1,694 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Primer intento: .orange[SCATTER PLOT] El fichero consta de 1704 registros y 6 variables: `country`, `continent`, `year`, `lifeExp` (esperanza de vida), `pop` (población) y `gdpPercap` (renta per cápita). ```r glimpse(gapminder) ``` ``` > Rows: 1,704 > Columns: 6 > $ country <fct> "Afghanistan", "Afghanistan", "Afghanistan", "Afghanistan", … > $ continent <fct> Asia, Asia, Asia, Asia, Asia, Asia, Asia, Asia, Asia, Asia, … > $ year <int> 1952, 1957, 1962, 1967, 1972, 1977, 1982, 1987, 1992, 1997, … > $ lifeExp <dbl> 28.801, 30.332, 31.997, 34.020, 36.088, 38.438, 39.854, 40.8… > $ pop <int> 8425333, 9240934, 10267083, 11537966, 13079460, 14880372, 12… > $ gdpPercap <dbl> 779.4453, 820.8530, 853.1007, 836.1971, 739.9811, 786.1134, … ``` Para empezar con algo sencillo **.bg-purple_light[filtraremos solo los datos de 1997]** -- ```r gapminder_1997 <- gapminder %>% filter(year == 1997) ``` --- # .orange[INGREDIENTES]: .green[(x, y)] ¿Qué **.bg-purple_light[elementos necesitamos]** para realizar un diagrama de puntos? Para iniciar el lienzo necesitamos una base de datos y dos variables a representar. -- .pull-left[ * **.bg-purple_light[Datos (data)]**: conjunto `gapminder_1997`. * **.bg-purple_light[Mapeado (aes)]**: indicarle dentro de `aes()` (aesthetics) las variables en cada coordenada. Todo lo que esté **.bg-purple_light[dentro de aes() serán mapeados de los datos]** ```r ggplot(data = gapminder_1997, * aes(x = gdpPercap, y = pop)) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-812-1.png" width="80%" /> ] --- # .orange[PRIMERA GEOMETRÍA]: .green[geom_point()] .pull-left[ * **.bg-purple_light[Geometría (geom)]**: optaremos por **.bg-orange[puntos]** usando `geom_point()`. ```r ggplot(gapminder_1997, aes(x = gdpPercap, y = pop)) + * geom_point() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-814-1.png" width="93%" /> ] --- # .orange[ROL DE LOS EJES]: .green[(x, y)] .pull-left[ Vamos a profundizar en ese mapeado: ¿cómo **.bg-purple_light[cambiar el rol]** de los ejes (población en el eje X y renta per cápita en el eje Y)? * **Eje X**: población (variable `pop`) * **Eje Y**: renta per cápita (variable `gdpPercap`) ```r ggplot(gapminder_1997, * aes(y = gdpPercap, x = pop)) + geom_point() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-816-1.png" width="93%" /> ] --- # .orange[ROL DE LOS EJES]: .green[(x, y)] .pull-left[ ¿Y un scatter plot con **esperanza de vida** en eje X frente a **renta per cápita**? * **Eje X**: esperanza de vida (variable `lifeExp`) * **Eje Y**: renta per cápita (variable `gdpPercap`) ```r ggplot(gapminder_1997, * aes(y = gdpPercap, x = lifeExp)) + geom_point() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-818-1.png" width="91%" /> ] --- # .orange[COLOR], .green[SIZE], .purple[SHAPE]: fijos .pull-left[ Dentro de `geom_point()` tenemos varios argumentos a usar: * `na.rm = ...`: si queremos que nos quite ausentes. * `color = ...`: color (si tiene dimensión, color del contorno) * `fill = ...`: color el relleno. Empezaremos por un **color fijo**, por ejemplo `"red"` (existen otros como `"blue"`, `"black"`, `"yellow"`, etc) ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp)) + * geom_point(color = "red") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-820-1.png" width="91%" /> ] --- # .orange[COLOR], .green[SIZE], .purple[SHAPE]: fijos .pull-left[ * `size = ...`: tamaño de la geometría (en este caso el **tamaño de los punto**), cuanto mayor sea el número, mayor será el tamaño de la geometría. ```r # Color con palabra reservada ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp)) + geom_point(color = "red", * size = 7) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-822-1.png" width="91%" /> ] --- # .orange[COLOR], .green[SIZE], .purple[SHAPE]: fijos .pull-left[ * `alpha = ...`: grado de opacidad del color (1 totalmente opaco, 0 totalmente transparente) ```r # Color con palabra reservada ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp)) + geom_point(color = "red", size = 7, * alpha = 0.4) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-824-1.png" width="91%" /> ] --- # .orange[COLOR], .green[SIZE], .purple[SHAPE]: fijos .pull-left[ * `shape = ...`: forma de la geometría, en este caso del «punto» (ver todas las opciones en `vignette("ggplot2-specs")`) <img src="./img/shape_ggplot.jpg" width="32%" style="display: block; margin: auto;" /> ```r # Color con palabra reservada ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp)) + geom_point(color = "red", size = 7, * alpha = 0.4, shape = 5) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-827-1.png" width="91%" /> ] --- # .orange[COLOR], .green[SIZE], .purple[SHAPE]: fijos .pull-left[ * `shape = ...`: forma de la geometría, en este caso del «punto» (ver todas las opciones en `vignette("ggplot2-specs")`) <img src="./img/shape_ggplot.jpg" width="32%" style="display: block; margin: auto;" /> ```r # Color con palabra reservada ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp)) + geom_point(color = "red", size = 7, alpha = 0.4, * shape = 22, fill = "black") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-830-1.png" width="91%" /> ] --- # .orange[COLOR], .green[SIZE], .purple[SHAPE]: fijos .pull-left[ * `stroke = ...`: tamaño del contorno ```r # Color con palabra reservada ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp)) + geom_point(color = "red", size = 7, * alpha = 0.4, stroke = 0) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-832-1.png" width="91%" /> ] --- # .orange[COLOR], .green[SIZE], .purple[SHAPE]: fijos .pull-left[ Los colores también podemos asignárselos por su **código hexadecimal**, consultando en la página <https://htmlcolorcodes.com/es/>, eligiendo el color que queramos. El código hexadecimal siempre comenzará con `#` ```r # Color en hexadecimal # https://htmlcolorcodes.com/es/ ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp)) + * geom_point(color = "#A02B85", alpha = 0.4, size = 7) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-834-1.png" width="91%" /> ] --- # Mapeado de atributos estéticos: .orange[aes()] .pull-left[ Hasta ahora los **atributos estéticos** se los hemos pasado fijos y **constantes**. Pero la verdadera potencia y versatilidad de `ggplot` es que podemos **.bg-purple_light[mapear los atributos estéticos en función de los datos]** en `aes()` para que dependan de variables de los datos Por ejemplo, vamos a asignar un **.bg-purple_light[color a cada dato en función de su continente]** con `aes(color = continent)` ```r # Tamaño fijo # Color por continentes ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, * color = continent)) + geom_point(size = 7) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-836-1.png" width="91%" /> ] --- # Mapeado de atributos estéticos: .orange[aes()] .pull-left[ Podemos combinarlo con lo que hemos hecho anteriormente: * **.bg-purple_light[color]** en función del **.bg-orange[continente]**. * **.bg-purple_light[tamaño]** en función de la **.bg-orange[población]**. * **.bg-purple_light[transparencia]** la fijamos **.bg-orange[constante]** del 50%. ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.7) ``` A este scatter plot particular se le conoce **.bg-purple_light[bubble chart]** ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-838-1.png" width="91%" /> ] --- # Visualización .orange[MULTIVARIANTE] .pull-left[ Reflexionemos sobre el gráfico anterior: * **color** en función del **continente**. * **tamaño** en función de la **población** * **transparencia** fija del 50% Usando los datos hemos conseguido dibujar en un **.bg-purple_light[gráfico bidimensional 4 variables]**: `lifeExp` y `gdpPercap` en los ejes , `continent` como color y `pop` como tamaño de la geometría, con muy pocas líneas de código. ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.7) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-840-1.png" width="91%" /> ] --- # .orange[GEOMETRÍA]: .green[geom()] Vamos a modificar la **.bg-purple_light[capa de geometría]** (al igual que hemos usado `geom_point()`) .pull-left[ * **.bg-purple_light[líneas]**: la geometrías como línea con `geom_line()`. ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp)) + geom_line(alpha = 0.8, size = 1.5) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-842-1.png" width="85%" /> ] --- # .orange[GEOMETRÍA]: .green[geom()] Vamos a modificar la **.bg-purple_light[capa de geometría]** (al igual que hemos usado `geom_point()`) .pull-left[ Asignado los **.bg-purple_light[colores a la variable continent]**, automáticamente obtenemos automáticamente una **.bg-purple_light[curva por continente]**. * **.bg-purple_light[líneas]**: la geometrías como línea con `geom_line()`. ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent)) + geom_line(alpha = 0.8, size = 1.5) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-844-1.png" width="85%" /> ] --- # .orange[GEOMETRÍA]: .green[geom()] Vamos a modificar la **.bg-purple_light[capa de geometría]** (al igual que hemos usado `geom_point()`) .pull-left[ * **.bg-purple_light[hexágonos]**: la geometrías como hexágonos con `geom_hex()`. Dado que ahora nuestra geometría tiene **.bg-purple_light[volumen]** tendremos dos parámetros: `color` para el contorno y `fill` para el relleno. ```r ggplot(gapminder_1997 %>% filter(continent != "Oceania"), aes(y = gdpPercap, x = lifeExp, fill = continent, size = pop)) + geom_hex(alpha = 0.8) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-846-1.png" width="85%" /> ] --- # .orange[GEOMETRÍA]: .green[geom()] Vamos a modificar la **.bg-purple_light[capa de geometría]** (al igual que hemos usado `geom_point()`) .pull-left[ * **.bg-purple_light[textos]**: la geometrías como textos con `geom_text()` (aparezcan textos que tengamos en alguna variable, que mapearemos en `aes()` por el parámetro `label = ...` ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop, * label = country)) + geom_text(alpha = 0.8) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-848-1.png" width="85%" /> ] --- # .orange[ESCALAS (scale)]: .green[coordenadas] A veces querremos representar alguna de las variables usando **.bg-purple_light[escalas que no sean la lineal]**. .pull-left[ Una muy habitual es la **.bg-purple_light[escala logarítmica]** (importante indicarlo en el gráfico), lo que podemos hacer facilmente con `scale_x_log10()` y `scale_y_log10()`. ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + # Eje Y con escala logarítmica * scale_y_log10() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-850-1.png" width="85%" /> ] --- # .orange[ESCALAS (scale)]: .green[coordenadas] A veces querremos mantener la escala pero **.bg-purple_light[fijar límites en los ejes]**. .pull-left[ Eso lo podemos hacer dentro de las funciones `scale_x_...()` y `scale_y_...()` con `limits = ...` ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_x_continuous( * limits = c(0, 100)) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-852-1.png" width="85%" /> ] --- # .orange[ESCALAS (scale)]: .green[coordenadas] La capa de escalas también nos sirve para **.bg-purple_light[formatear los ejes]** .pull-left[ Por ejemplo, con `breaks = ...` podemos determinar el **.bg-purple_light[espaciado exacto]** que queremos en la gráfica. ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_x_continuous( * breaks = seq(35, 85, by = 5)) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-854-1.png" width="85%" /> ] --- # .orange[ESCALAS (scale)]: .green[coordenadas] La capa de escalas también nos sirve para **.bg-purple_light[formatear los ejes]** .pull-left[ Haciendo uso del paquete `{scales}` podemos añadir **.bg-purple_light[prefijo/sufijo a las etiquetas]** mostradas en los ejes, asignándoselo al parámetro `labels = ...` ```r library(scales) ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_x_continuous( breaks = seq(35, 85, by = 5), labels = * label_number(suffix = " años")) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-856-1.png" width="85%" /> ] --- # .orange[ESCALAS (scale)]: .green[coordenadas] .pull-left[ Tenemos funciones concretas para **.bg-purple_light[formatear ejes]** como fechas (`scale_x_date()`), porcentajes (`labels = label_percent()`) o incluso **unidades monetarias** (`labels = label_dollar()`). ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10( labels = label_dollar(big.mark = ".", accuracy = 3, prefix = "", suffix = "$")) + scale_x_continuous( breaks = seq(35, 85, by = 5), labels = * label_number(suffix = " años")) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-858-1.png" width="85%" /> ] --- # .orange[ESCALAS (scale)]: .green[colores] La capa de escalas también nos sirve para **.bg-purple_light[proporcionar una paleta de colores]** .pull-left[ ggplot selecciona automáticamente una paleta de colores, pero podemos indicarle alguna concreta. La primera y más inmediata es indicarle los **.bg-purple_light[colores manualmente]** con `scale_color_manual()`. ```r pal <- c("#A02B85", "#2DE86B", "#4FB2CA", "#E8DA2D", "#E84C2D") ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + * scale_color_manual(values = pal) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-860-1.png" width="85%" /> ] --- # .orange[ESCALAS (scale)]: .green[colores] La capa de escalas también nos sirve para **.bg-purple_light[proporcionar una paleta de colores]** .pull-left[ Otra opción es elegir alguna de las **.bg-purple_light[paletas de colores diseñadas]** en el paquete `{ggthemes}`: * `scale_color_economist()`: paleta de colores basada en los colores de **.bg-purple_light[The Economist]**. ```r library(ggthemes) ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + * scale_color_economist() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-862-1.png" width="85%" /> ] --- # .orange[ESCALAS (scale)]: .green[colores] La capa de escalas también nos sirve para **.bg-purple_light[proporcionar una paleta de colores]** .pull-left[ Otra opción es elegir alguna de las **.bg-purple_light[paletas de colores diseñadas]** en el paquete `{ggthemes}`: * `scale_color_excel()`: paleta de colores basada en los colores del **.bg-purple_light[Excel]**. ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + * scale_color_excel() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-864-1.png" width="85%" /> ] --- # .orange[ESCALAS (scale)]: .green[colores] La capa de escalas también nos sirve para **.bg-purple_light[proporcionar una paleta de colores]** .pull-left[ Otra opción es elegir alguna de las **.bg-purple_light[paletas de colores diseñadas]** en el paquete `{ggthemes}`: * `scale_color_tableau()`: paleta de colores basada en los colores de **.bg-purple_light[Tableau]**. ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + * scale_color_tableau() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-866-1.png" width="85%" /> ] --- # .orange[ESCALAS (scale)]: .green[colores] También existen **múltiples paquetes** que nos proporcionan **paletas de colores** .pull-left[ * **.bg-purple_light[películas]**: paquete `{harrypotter}` (repositorio de Github `aljrico/harrypotter`) usando `scale_color_hp_d()`. ```r library(devtools) repo <- "aljrico/harrypotter" *install_github(repo = repo) library(harrypotter) ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.9) + scale_y_log10() + scale_color_hp_d( * option = "ravenclaw") ``` ] .pull-right[ <div class="figure" style="text-align: center"> <img src="https://raw.githubusercontent.com/aljrico/harrypotter/master/readme_raw_files/palettes/ravenclaw.png" alt="Paleta basada en la casa Ravenclaw" width="15%" /> <p class="caption">Paleta basada en la casa Ravenclaw</p> </div> <img src="index_files/figure-html/unnamed-chunk-869-1.png" width="70%" /> ] --- # .orange[ESCALAS (scale)]: .green[colores] .pull-left[ * **.bg-purple_light[cuadros]**: paquete `{MetBrewer}` (repositorio de Github `BlakeRMills/MetBrewer`) usando `scale_colour_manual(values = met.brewer(...))`. ```r repo <- "BlakeRMills/MetBrewer" *install_github(repo = repo) library(MetBrewer) ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.9) + scale_y_log10() + scale_color_manual( * values = met.brewer("Hokusai")) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-871-1.png" width="85%" /> ] --- # .orange[ESCALAS (scale)]: .green[colores] .pull-left[ * **.bg-purple_light[discos]**: paquete `{peRReo}` (repositorio de Github `jbgb13/peRReo`) usando `scale_colour_manual(values = latin_palette())`. ```r library(devtools) repo <- "jbgb13/peRReo" *install_github(repo = repo) library(peRReo) ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.9) + scale_y_log10() + scale_color_manual( * values = latin_palette("rosalia")) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-873-1.png" width="85%" /> ] --- # .orange[COMPONER]: .green[facet()] También podemos **.bg-purple_light[dividir/desagregar los gráficos (facetar)]** por variables. .pull-left[ Por ejemplo, vamos a crear un **.bg-purple_light[gráfico por continente]**, mostrando todos los gráficos a la vez pero por separado, con `facet_wrap(~continent)`. ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp)) + geom_point(alpha = 0.9) + scale_y_log10() + * facet_wrap(~continent) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-875-1.png" width="85%" /> ] --- # .orange[COMPONER]: .green[facet()] También podemos **.bg-purple_light[dividir/desagregar los gráficos (facetar)]** por variables. .pull-left[ También le podemos pasar argumentos opcionales para indicarle el **.bg-purple_light[número de columnas o filas]** que queremos. ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp)) + geom_point(alpha = 0.9) + scale_y_log10() + * facet_wrap(~continent, nrow = 3) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-877-1.png" width="85%" /> ] --- # .orange[COMPONER]: .green[facet()] También podemos **.bg-purple_light[dividir/desagregar los gráficos (facetar)]** por variables. .pull-left[ También le podemos pasar dos argumentos (variables) para formar un **.bg-purple_light[grid de gráficas]** ```r *ggplot(gapminder, aes(y = gdpPercap, x = lifeExp)) + geom_point(alpha = 0.9) + scale_y_log10() + * facet_grid(continent ~ year) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-879-1.png" width="85%" /> ] --- # .orange[ESTADÍSTICA]: .green[stat_...()] También podemos añadir **.bg-purple_light[capas estadísticas]** .pull-left[ * `stat_smooth()`: visualiza un **.bg-purple_light[ajuste suavizado]** (con glm, loess, o regresión lineal por ejemplo). ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp)) + geom_point(alpha = 0.7, size = 5) + scale_y_log10() + scale_color_tableau() + * stat_smooth(method = "lm") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-881-1.png" width="85%" /> ] --- # .orange[ESTADÍSTICA]: .green[stat_...()] También podemos añadir **.bg-purple_light[capas estadísticas]** .pull-left[ Podemos indicarle en `se = FALSE` que no pinte los intervalos de confianza. ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp)) + geom_point(alpha = 0.7, size = 5) + scale_y_log10() + scale_color_tableau() + stat_smooth(method = "lm", * se = FALSE) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-883-1.png" width="85%" /> ] --- # .orange[ESTADÍSTICA]: .green[stat_...()] También podemos añadir **.bg-purple_light[capas estadísticas]** .pull-left[ Si las trazas están separadas realizada el suavizado de todas ellas. ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent)) + geom_point(alpha = 0.7, size = 5) + scale_y_log10() + scale_color_tableau() + stat_smooth(method = "lm", se = FALSE) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-885-1.png" width="85%" /> ] --- # .orange[ETIQUETAR]: .green[geom_text()] .pull-left[ Podemos combinarlo con `geom_text()` para **.bg-purple_light[añadir la ecuación del ajuste]** ```r lm_fit <- lm(data = gapminder_1997, formula = gdpPercap ~ lifeExp) a <- round(coef(lm_fit)[1], 2) b <- round(coef(lm_fit)[2], 2) ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp)) + geom_point(alpha = 0.7, size = 5) + scale_y_log10() + stat_smooth(method = "lm", se = FALSE) + geom_text(x = 45, y = log10(30000), label = glue("Y = {a} + {b}X"), size = 5) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-887-1.png" width="85%" /> ] --- # .orange[ESTADÍSTICA]: .green[stat_...()] También podemos añadir **.bg-purple_light[capas estadísticas]** .pull-left[ Con `stat_summary()` podemos incluso añadir estadísticas por grupos, como la media o mediana. ```r ggplot(gapminder, aes(y = gdpPercap, x = year)) + geom_point(alpha = 0.7, size = 3) + stat_summary(fun = "mean", size = 0.3, color = "coral") + stat_summary(fun = "median", size = 0.3, color = "darkcyan") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-889-1.png" width="85%" /> ] --- # .orange[ESTADÍSTICA]: .green[stat_...()] También podemos añadir **.bg-purple_light[capas estadísticas]** .pull-left[ Fíjate que si no tenemos una variable cuali, la media la hace con `n = 1` (es decir, es el propio punto). ```r ggplot(gapminder, aes(y = gdpPercap, x = lifeExp, color = continent)) + geom_point(alpha = 0.7, size = 3) + stat_summary(fun = "mean", size = 0.2, color = "black") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-891-1.png" width="85%" /> ] --- # .orange[TEMA]: .green[theme()] Por último podemos **.bg-purple_light[personalizar el tema]** de los gráficos. .pull-left[ Por ejemplo, podemos **.bg-purple_light[añadir títulos, subtítulos y pie de gráfica]** con `labs()`, ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_color_tableau() + labs( title = "Primer scatter plot", subtitle = "Datos de 1997", caption = "Autor: J. Álvarez") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-893-1.png" width="85%" /> ] --- # .orange[TEMA]: .green[theme()] También podemos personalizar el **.bg-purple_light[título de los ejes]** o el **.bg-purple_light[título de las leyendas]**. .pull-left[ ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_color_tableau() + labs( title = "Primer scatter plot", subtitle = "Datos de 1997", caption = "Autor: J. Álvarez", x = "Esperanza de vida", y = "Renta per cápita", color = "Continente", size = "Población") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-895-1.png" width="85%" /> ] --- # .orange[TEMA]: .green[theme()] También podemos **.bg-purple_light[ocultar el nombre de la leyenda]** asignándole un `NULL`. .pull-left[ ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_color_tableau() + labs( title = "Primer scatter plot", subtitle = "Datos de 1997", caption = "Autor: J. Álvarez", x = "Esperanza de vida", y = "Renta per cápita", color = NULL, size = "Población") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-897-1.png" width="85%" /> ] --- # .orange[TEMA]: .green[theme()] Incluso podemos **.bg-purple_light[ocultar la leyenda]** de alguna de las variables con `guides()` .pull-left[ ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_color_tableau() + * guides(size = "none") + labs( title = "Primer scatter plot", subtitle = "Datos de 1997", caption = "Autor: J. Álvarez", x = "Esperanza de vida", y = "Renta per cápita", color = NULL) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-899-1.png" width="85%" /> ] --- # .orange[TEMA]: .green[theme()] Tenemos además algunos temas ya predefinidos en el paquete `{ggthemes}` .pull-left[ ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_color_tableau() + guides(size = "none") + labs( title = "Primer scatter plot", subtitle = "Datos de 1997", caption = "Autor: J. Álvarez", x = "Esperanza de vida", y = "Renta per cápita", color = NULL) + * theme_excel() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-901-1.png" width="85%" /> ] --- # .orange[TEMA]: .green[theme()] Tenemos además algunos temas ya predefinidos en el paquete `{ggthemes}` .pull-left[ ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_color_tableau() + guides(size = "none") + labs( title = "Primer scatter plot", subtitle = "Datos de 1997", caption = "Autor: J. Álvarez", x = "Esperanza de vida", y = "Renta per cápita", color = NULL) + * theme_fivethirtyeight() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-903-1.png" width="85%" /> ] --- # .orange[TEMA]: .green[theme()] Tenemos además algunos temas ya predefinidos en el paquete `{ggthemes}` .pull-left[ ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_color_tableau() + guides(size = "none") + labs( title = "Primer scatter plot", subtitle = "Datos de 1997", caption = "Autor: J. Álvarez", x = "Esperanza de vida", y = "Renta per cápita", color = NULL) + * theme_economist() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-905-1.png" width="85%" /> ] --- # .orange[TEMA]: .green[theme()] Tenemos además algunos temas ya predefinidos en el paquete `{ggthemes}` .pull-left[ ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_color_tableau() + guides(size = "none") + labs( title = "Primer scatter plot", subtitle = "Datos de 1997", caption = "Autor: J. Álvarez", x = "Esperanza de vida", y = "Renta per cápita", color = NULL) + * theme_bw() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-907-1.png" width="85%" /> ] --- # .orange[TEMA]: .green[theme()] Una opción muy habitual es usar `theme_minimal()`, ya que es un tema muy limpio, y luego con `theme_update()` configurarlo a nuestro gusto. .pull-left[ ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_color_tableau() + guides(size = "none") + labs( title = "Primer scatter plot", subtitle = "Datos de 1997", caption = "Autor: J. Álvarez", x = "Esperanza de vida", y = "Renta per cápita", color = NULL) + * theme_minimal() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-909-1.png" width="83%" /> ] --- # .orange[TEMA]: .green[theme()] * `sysfonts::font_add_google()`: le indicaremos la tipografía de <https://fonts.google.com/> * `showtext_auto()` del paquete `{showtext}` nos permite su posterior uso. * `theme_set()`: inicializamos el tema con la fuente * `theme_update()`: configuramos cada elemento a nuestro gusto (mira `? theme`). ```r sysfonts::font_add_google(name = "Roboto") # Fuente de google # Usar fuentes a futuro library(showtext) showtext_auto() theme_set(theme_minimal(base_family = "Roboto")) # Definir tema base # Configurar tema theme_update( plot.title = element_text(color = "#C34539", face = "bold", size = 27), plot.subtitle = element_text(color = "#3E6FCB", face = "bold", size = 17)) ``` --- # .orange[TEMA]: .green[theme()] Una vez definido el tema, **.bg-purple_light[todas las gráficas que hagas lo tendrán incluido]**, y así evitas programarlo en cada una .pull-left[ ```r ggplot(gapminder_1997, aes(y = gdpPercap, x = lifeExp, color = continent, size = pop)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_color_tableau() + guides(size = "none") + labs( title = "Primer scatter plot", subtitle = "Datos de 1997", caption = "Autor: J. Álvarez", x = "Esperanza de vida", y = "Renta per cápita", color = NULL) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-912-1.png" width="85%" /> ] --- # .orange[UNIR] gráficas Con el paquete `{patchwork}` podremos **.bg-purple_light[combinar varias gráficas]** (ver documentación en <https://patchwork.data-imaginist.com/>) Por ejemplo, vamos a combinar en una gráfica los datos de 1987, de 2007 y la media en todos los años -- ```r gapminder_1987 <- gapminder %>% filter(year == 1987) gapminder_2007 <- gapminder %>% filter(year == 2007) gapminder_mean <- gapminder %>% group_by(continent, country) %>% summarise(gdpPercap = mean(gdpPercap), lifeExp = mean(lifeExp), pop = pop) %>% ungroup() ``` --- # .orange[UNIR] gráficas Tras ello vamos a definir cada gráfica por separado ```r plot_1987 <- ggplot(gapminder_1987, aes(y = gdpPercap, x = lifeExp, color = continent)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_color_tableau() + labs(x = "Esperanza de vida", y = "Renta per cápita", subtitle = "1987") plot_2007 <- ggplot(gapminder_2007, aes(y = gdpPercap, x = lifeExp, color = continent)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_color_tableau() + labs(x = "Esperanza de vida", y = "Renta per cápita", subtitle = "2007") plot_mean <- ggplot(gapminder_mean, aes(y = gdpPercap, x = lifeExp, color = continent)) + geom_point(alpha = 0.8) + scale_y_log10() + scale_color_tableau() + labs(x = "Esperanza de vida", y = "Renta per cápita", subtitle = "Media (1952-2007)") ``` --- # .orange[UNIR] gráficas Por último con `{patchwork}` podemos combinar las gráficas sumándolas `+` (con `|` podremos poner una al lado de la otra), y con `&` podremos modificar aspectos de las mismas, de todas ellas a la vez. .pull-left[ Con `plot_layout(guides = "collect")` le indicamos que unifique leyenda y con `plot_annotation()` anotaciones globales. ```r library(patchwork) plot_combined <- (plot_mean | (plot_1987 + plot_2007)) & theme(legend.position = "bottom") & labs(color = "continente") plot_combined + plot_annotation( title = "Unión de gráficas", caption = "Autor: J. Álvarez") + plot_layout(guides = "collect") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-916-1.png" width="85%" /> ] --- # .orange[EXPORTAR] gráficas Con `ggsave()` podemos además **.bg-purple_light[exportar nuestros gráficos]** ```r plot_combined <- (plot_mean | (plot_1987 + plot_2007)) & theme(legend.position = "bottom") & labs(color = "continente") plot_combined <- plot_combined + plot_annotation( title = "Unión de gráficas", caption = "Autor: J. Álvarez") + plot_layout(guides = "collect") *ggsave("./gapminder.pdf") *ggsave("./gapminder.png") ``` --- # .orange[SCATTER PLOT] .green[MÚLTIPLE] El paquete `facet_matrix()` nos proporciona `geom_autodensity()` junto con `facet_matrix()` para que **.bg-purple_light[podemos pintar todas las variables frente a todos]** con un scatter plot,, poniendo en la diagonal las **.bg-purple_light[funciones de densidad de cada variable]** (se indica `x = .panel_x` y `y = .panel_y` y el se encarga de seleccionar todas ellas) .pull-left[ ```r library(ggforce) ggplot(iris, aes(x = .panel_x, y = .panel_y, color = Species, fill = Species)) + geom_point(alpha = 0.4, size = 3) + geom_autodensity(alpha = 0.4) + facet_matrix(vars(-Species), layer.diag = 2) + scale_color_brewer(palette = "Dark2") + scale_fill_brewer(palette = "Dark2") + labs(title = "Scatter plot de iris", subtitle = "Todas vs todas") + theme_minimal() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-919-1.png" width="90%" /> ] --- # .orange[HISTOGRAMAS] .pull-left[ En el caso **.bg-purple_light[variables continas]** también podremos representar un **.bg-purple_light[histograma]**, con la capa geométrica `geom_histogram()` * `alpha = ...`: transparencia del color. * `bins = ...`: número de barras a construir. * `color = ...`: color del contorno. * `fill = ...`: relleno del histograma. ```r ggplot(iris, aes(x = Sepal.Length)) + geom_histogram(alpha = 0.3, bins = 25, color = "white", fill = "blue") + labs(title = "Histograma de iris", subtitle = "Variable Sepal.Length", x = "Longitud sépalo", y = "Frec.") + theme_minimal() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-921-1.png" width="90%" /> ] --- # .orange[HISTOGRAMAS] .pull-left[ Con la **.bg-purple_light[capa de escalas]** `scale_x_continuous()` le indicamos dónde queremos las marcas en los ejes y las etiquetas de las unidades, usando `scales::label_number()`. ```r library(scales) ggplot(iris, aes(x = Sepal.Length)) + geom_histogram(alpha = 0.3, bins = 25, color = "white", fill = "blue") + scale_x_continuous(breaks = seq(4, 8, by = 0.5), label = label_number(suffix = " cm")) + labs(title = "Histograma de iris", subtitle = "Variable Sepal.Length", x = "Longitud sépalo", y = "Frec.") + theme_minimal() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-923-1.png" width="90%" /> ] --- # .orange[HISTOGRAMAS] Podemos pintarlos todos juntos, preparando antes los datos y convirtiéndolos a tidy ```r iris_tidy <- iris %>% pivot_longer(cols = Sepal.Length:Petal.Width, names_to = "variable", values_to = "values") iris_tidy ``` ``` > # A tibble: 600 × 3 > Species variable values > <fct> <chr> <dbl> > 1 setosa Sepal.Length 5.1 > 2 setosa Sepal.Width 3.5 > 3 setosa Petal.Length 1.4 > 4 setosa Petal.Width 0.2 > 5 setosa Sepal.Length 4.9 > 6 setosa Sepal.Width 3 > 7 setosa Petal.Length 1.4 > 8 setosa Petal.Width 0.2 > 9 setosa Sepal.Length 4.7 > 10 setosa Sepal.Width 3.2 > # … with 590 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # .orange[HISTOGRAMAS] .pull-left[ Tras ello, pintamos lo mismo (ahora `x = values`) pero añadimos `facet_wrap()` vista antes (mira `facet_wrap()` y `facet_grid()` para dos variables) ```r ggplot(iris_tidy, aes(x = values)) + geom_histogram(alpha = 0.3, bins = 25, color = "white", fill = "blue") + facet_wrap(~variable, scales = "free") + labs(title = "Histogramas de iris", subtitle = "Con bins = 25 (nº barras)", x = "Longitud sépalo", y = "Frec.") + theme_minimal() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-926-1.png" width="90%" /> ] --- # .orange[HISTOGRAMAS] .pull-left[ ```r ggplot(iris_tidy, aes(x = values, bins = 25, * color = Species, * fill = Species)) + geom_histogram(alpha = 0.3) + scale_color_brewer(palette = "Dark2") + scale_fill_brewer(palette = "Dark2") + facet_wrap(~variable, scales = "free") + labs(title = "Histogramas iris (por colores)", subtitle = "Con bins = 25 (nº barras)", x = "Longitud sépalo", y = "Frec.") + theme_minimal() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-928-1.png" width="90%" /> ] --- # .orange[DIAGRAMA DE BARRAS] .pull-left[ Con `geom_bar()` construimos **.bg-purple_light[diagramas de barras]**. Fíjate que ggplot solo hace el conteo, no tenemos que hacer nosotros `count()` antes del gráfico. ```r ggplot(starwars, aes(x = sex, fill = sex)) + geom_bar(color = "white", alpha = 0.3) + scale_fill_brewer(palette = "Dark2") + labs(title = "Diagrama de barras (starwars)", subtitle = "Conteo del sexo", x = "Sexo", y = "Frecuencia") + theme_minimal() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-930-1.png" width="80%" /> ] --- # .orange[DIAGRAMA DE BARRAS] .pull-left[ Podemos usar lo que sabemos de **.bg-purple_light[factores para ordenarlos por frecuencia]**. ```r ggplot(starwars, aes(x = fct_infreq(sex), fill = sex)) + geom_bar(color = "white", alpha = 0.3) + scale_fill_brewer(palette = "Dark2") + labs(title = "Diagrama de barras (starwars)", subtitle = "Conteo del sexo", x = "Sexo", y = "Frecuencia") + theme_minimal() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-932-1.png" width="80%" /> ] --- class: inverse center middle name: clase-10 # CLASE 10: árboles ### [Introducción teórica](#intro-teoria) ### [Criterios de parada/mejora](#criterios-parada-arbol) ### [Criterios de mejora/división](#criterios-division) ### [Poda](#poda) --- # .orange[RESUMEN] * Fase 1: muestreo (si fuese necesario) -> `group_by() + slice_sample()` * Fase 2: exploración * Fase 3: modificación (tidyverse + receta) -> `recipe()`, `step_...(..)` * Fase 4: modelización con validación cruzada - Partición train/test: `initial_split()` --> `training()` y `testing()` - Validación (v subconjuntos, repetidas): `cv_folds <- vfold_cv(data = ..., v = ..., repeats = ..., strata = ...)` - Creación de un grid de modelos - Iniciar paralelización (finalizarla después) ```r fit_tune <- wflow %>% tune_grid(resamples = cv_folds, grid = grid_modelos, control = control_grid(verbose = TRUE, allow_par = TRUE), metrics = metric_set(accuracy, sensitivity, specificity, roc_auc)) ``` * Fase 5: predicción/evaluación en test --- name: intro-teoria # .orange[ÁRBOLES]: divide and conquer Los **.bg-purple_light[arboles de clasificación y regresión]** (empezaremos por los primeros), conocidos como CART, fueron propuestos por Breiman et al. en 1984. <div class="figure" style="text-align: center"> <img src="./img/arboles_segmentar.jpg" alt="Extraída de https://bookdown.org/content/2031/arboles-de-decision-parte-i.htmlque-son-los-arboles-de-decision30" width="63%" /> <p class="caption">Extraída de https://bookdown.org/content/2031/arboles-de-decision-parte-i.htmlque-son-los-arboles-de-decision30</p> </div> **.bg-orange[Idea]**: segmentar el espacio de predictores (variables independientes) en **.bg-purple_light[regiones distintas y no solapadas]** a partir de un conjunto de reglas de decisión simples aplicadas de forma secuencial. --- # .orange[ÁRBOLES]: introducción teórica Un árbol estará formado por los siguientes elementos: .pull-left[ * **.bg-purple_light[Nodos]**: segmentos del árbol que contienen subconjuntos de la muestra. * **.bg-purple_light[Nodo raíz]**: segmento original (arranque inicial del árbol) que contiene a la **.bg-purple_light[totalidad]** de los datos. * **.bg-purple_light[Nodo padre/hijo]**: nodos predecesor/sucesor de otro nodo. * **.bg-purple_light[Rama]**: nodo y el conjunto de sus sucesores * **.bg-purple_light[Hojas]**: nodos sin hijos em los que **.bg-purple_light[finaliza una rama]** y que usaremos para asignar las clases predichas. ] .pull-right[ <img src="./img/arbol_colesterol.jpg" width="100%" style="display: block; margin: auto;" /> ] --- # .orange[ÁRBOLES]: construcción .pull-left[ * **.bg-purple_light[Paso 1]**: partimos de un nodo raíz con todas las observaciones. * **.bg-purple_light[Paso 2]**: decidir la **.bg-purple_light[regla de decisión óptima]** (tomaremos decisiones binarias) - Decidir el **.bg-purple_light[mejor punto de corte de todas]** las variables a elegir. - Una vez que tenemos calculado el punto de corte óptimo de todas, nos quedamos con la mejor variable (¿qué es mejor?) * **.bg-purple_light[Paso 3]**: repetimos proceso anterior hasta criterio de parada ] .pull-right[ <img src="./img/arboles_cortes.jpg" width="110%" style="display: block; margin: auto;" /> Esta forma de construcción de árbol **.bg-purple_light[no asegura obtener el mejor árbol posible]**: no se evalúan todas las combinaciones posibles, es **.bg-purple_light[algoritmo greedy o voraz]**. ] --- name: criterios-parada-arbol # Criterios de .orange[PARADA] Existen muchos criterios de parada pero los más habituales son los siguientes: * **.bg-purple_light[Mejora insuficiente]**: ninguna de las variables y cortes posibles produce una mejora suficiente que compense sobreajustar el modelo. * **.bg-purple_light[Tamaño de hoja]**: los posibles hijos tienen pocas observaciones (tamaño inferior a un valor/porcentaje de la muestra fijado) para seguir dividiendo. * **.bg-purple_light[Tamaño de división]**: número de observaciones en la hoja actual (nodo susceptible de ser segmentado) demasiado pequeño. Tendrá relación con el criterio anterior. * **.bg-purple_light[Profundidad del árbol]**: distancia (en número de nodos entre raíz y hoja más alejada) que supere un umbral predefinido para evitar el sobreajuste. --- # .orange[ASIGNACIÓN] de clase .pull-left[ * **.bg-purple_light[Árbol de clasificación]**: para variables objetivo cualitativa se calcularán las **.bg-purple_light[probabilidades estimadas]** como la proporción de eventos en dicho nodo. Lo habitual es asignar al nodo la **.bg-purple_light[categoría modal]**. * **.bg-purple_light[Árbol de regresión]**: para variables objetivo cuantitativa se calculará la **.bg-purple_light[estimación de continua]** como la media de los valores en dicho nodo. ] .pull-right[ <img src="./img/arbol_colesterol.jpg" width="100%" style="display: block; margin: auto;" /> ] --- name: criterios-division # Criterios de .orange[MEJORA/DIVISIÓN] * **.bg-purple_light[Criterios basados en la impureza]**: llamaremos impureza a la cantidad de **.bg-purple_light[«ruido»]** que quedaría en nuestros nodos en caso de realizar la división. Un **.bg-orange[nodo puro tendrá impureza nula]** (solo elementos de una clase) . <img src="./img/impureza.jpg" width="70%" style="display: block; margin: auto;" /> * **.bg-purple_light[Criterios basados en inferencia]**: los conocidos como **.bg-purple_light[árboles condicionados o inferenciales]** la selección de ramas se realiza en base a un **.bg-purple_light[contraste de independencia]**. Si el contraste nos pide rechazar la hipótresis nula de independencia, significa hay una dependencia entre el corte y el reparto de clases de la objetivo (corte útil para segmentar). --- # Impureza: .orange[ÍNDICE DE GINI] * **.bg-purple_light[Criterio del índice de Gini]**: criterio basado en la impureza, definida como la **.bg-purple_light[probabilidad]** de, **.bg-purple_light[extraídos dos elementos de un nodo]** (con remplazamiento), que **.bg-purple_light[no sean de la misma clase]**. Si tenemos una objetivo con `\(k\)` categorías entonces, llamaremos `\(P(C_i)\)` a la probabilidad de que los dos elementos sean de la categoría `\(C_i\)`, con `\(i=1, \ldots, C\)` Para cada nodo, la **.bg-purple_light[probabilidad de que ambos sean de la misma categoría]** (clases no solapadas, la intersección es nula) será por tanto `$$P(C_1 \cup C_2 \cup \ldots \cup C_k) = \sum_{i=1}^{k}P(C_i) = \sum_{i=1}^{k} \left(\frac{n(C_i)}{n(nodo)}\right)^2$$` -- La impureza entonces queda definida como su complementario `$$Gini(nodo) = 1 - \sum_{i=1}^{k} \left(\frac{n(C_i)}{n(nodo)}\right)^2$$` --- # Impureza: .orange[ÍNDICE DE GINI] La impureza entonces queda definida como `$$Gini(nodo) = 1 - \sum_{i=1}^{k} \left(\frac{n(C_i)}{n(nodo)}\right)^2$$` * **.bg-purple_light[Mejor caso]**: que todos sean de la misma clase, por ejemplo `\(C_1\)`, tal que `\(Gini(nodo) = 1 - \left(\frac{n(C_1)}{n(nodo)}\right)^2 = 0\)` * **.bg-purple_light[Peor caso]**: que tengas las clases igual de repartidas tal que `\(Gini(nodo) = 1 - \sum_{i=1}^{k} \left(\frac{n(nodo) / k}{n(nodo)}\right)^2 = 1-\sum_{i=1}^{k} \frac{1}{k^2} = 1 - \frac{1}{k}\)` (0.5 en el caso de que tengamos `\(k=2\)`) -- La **.bg-purple_light[impureza total del árbol]** se calculará como la suma de las impurezas de cada nodo ponderadas por su tamaño (número de observaciones de cada nodo). --- # Impureza: .orange[ENTROPÍA] * **.bg-purple_light[Criterio de entropía]**: criterio basado en la impureza, definida como la **.bg-purple_light[cantidad de información necesaria para «explicar» el nodo]**. La entropía en teoría de la información se define como `\(H = -\sum_{i=1}^{k}p_i log_2(pi)\)`, donde `\(p_i\)` es la probabilidad de cada uno de los posibles evenetos (se usa log en base 2 porque se asume que la información será representada en código binario) -- Para cada nodo, la **.bg-purple_light[entropía]** será definida por tanto como `$$H(nodo) = -\sum_{i=1}^{k}\frac{n(C_i)}{n(nodo)} log_2\left( \frac{n(C_i)}{n(nodo)} \right)$$` --- # Impureza: .orange[ENTROPÍA] Para cada nodo, la **.bg-purple_light[entropía]** será definida por tanto como `$$H(nodo) = -\sum_{i=1}^{k}\frac{n(C_i)}{n(nodo)} log_2\left( \frac{n(C_i)}{n(nodo)} \right)$$` * **.bg-purple_light[Mejor caso]**: que todos sean de la misma clase, por ejemplo `\(C_1\)`, tal que `\(H(nodo) =-\frac{n(C_1)}{n(nodo)} log_2\left(\frac{n(C_1)}{n(nodo)} \right) = -log_2(1) = 0\)` * **.bg-purple_light[Peor caso]**: que tengas las clases igual de repartidas tal que `\(H(nodo) = -\sum_{i=1}^{k}\frac{n(nodo)/k}{n(nodo)} log_2\left( \frac{n(nodo)/k}{n(nodo)} \right) = -\sum_{i=1}^{k}\frac{1}{k} log_2\left( \frac{1}{k} \right)\)` (1 en el caso de que tengamos `\(k=2\)`) -- La **.bg-purple_light[impureza total del árbol]** se calculará como la suma de las entropías de cada nodo ponderadas por su tamaño (número de observaciones de cada nodo). --- # Impureza: .orange[caso práctico] Determina la impureza según ambos criterios en el ejemplo de la imagen, para cada uno de los posibles cortes, con la variable objetivo definida como «juega al cricket» (binaria) <img src="./img/ej_impureza.jpg" width="100%" style="display: block; margin: auto;" /> --- # Árboles .orange[INFERENCIALES] * **.bg-purple_light[Criterios basados en inferencia]**: los conocidos como **.bg-purple_light[árboles condicionados o inferenciales]** la selección de ramas se realiza en base a un **.bg-purple_light[contraste de independencia]**. `$$\sum_{i=1}^{2}\sum_{j=1}^{k} \frac{\left(O_{ij} - E_{ij}\right)^2}{E_{ij}} \sim \chi_{1, k-1}^{2}$$` Tendremos una variable predictora (la que usamos para ejecutar el corte) con 2 modalidades (cortes binarias) y una objetivo de `\(k\)` clases tal que * `\(O_{ij}\)`: frecuencias observadas, número de veces que `\((X=x_i, Y=y_j)\)`, donde `\(x_1\)` y `\(x_2\)` son las opciones de corte. * `\(E_{ij}\)`: frecuencias esperadas si el corte fuese independiente de la objetivo, es decir, `\(E_{ij} = \frac{E_{i, \cdot} * E_{\cdot,j}}{N}\)`. Si el contraste nos pide rechazar la hipótesis nula de independencia, significa que hay una dependencia entre el corte y el reparto de clases de la objetivo -> **.bg-purple_light[corte útil]** para segmentar --- name: poda # Validación: .orange[PODA] Los árboles son modelos **.bg-purple_light[muy interpretables]** pero tienen una gran desventaja: tienen **.bg-purple_light[tendencia al sobreajuste]**, ya que es un algoritmo voraz. El modelo encontrado no necesariamente tiene que ser el mejor (solo era el mejor en cada paso, sin ver el árbol en su conjunto, al igual que la mejor decisión del coche amarillo sería cambiarse de carril con la información que tiene en ese momento, aunque no fuese la mejor global). <img src="./img/poda_coche.jpg" width="80%" style="display: block; margin: auto;" /> Para evitarlo una táctica habitual es **.bg-purple_light[usar el conjunto de validación]** para realizar una poda (con las reglas de decisión obtenidas en entrenamiento). --- # Validación: .orange[PODA] La idea de la **.bg-purple_light[poda]** es la siguiente: * **.bg-purple_light[Paso 1: construir subárboles]**. Dado un árbol final (un árbol maximal de N hojas), construimos todos los subárboles posibles de N-1 hojas. * **.bg-purple_light[Paso 2: evaluación]**. Calculamos la tasa de mal clasificados para todos los subárboles y marcamos el que obtenga mejor métrica (incluido el árbol maximal). * **.bg-purple_light[Paso 3: recursividad]**. Repetimos los pasos 1-2 hasta llegar al nodo raíz inicial. * **.bg-purple_light[Paso 4: criterio de selección]**. Con todos los subárboles evaluados, seleccionamos como solución final el subárbol para el que un incremento de sus hojas no produza una mejora significativa. **.bg-green_light[Ventajas]**: amén de no tener hipótesis teóricas (tampoco el knn), **.bg-purple_light[no dummyficar]** (podremos introducir cuali vs cuanti), nos aportará al final una **.bg-purple_light[jerarquía de importancia]** de variables y nos crea una **.bg-purple_light[partición de nuestro espacio de predictores]**. --- # .orange[ÁRBOLES] en .green[TIDYMODELS] La única diferencia con knn es la forma de definir el modelo (con sus parámetros)y la adaptación de la receta que debamos hacer. Para ello usaremos `decision_tree()` * `mode = ...`: si queremos clasificación o regresión. * `tree_depth = ...`: **.bg-purple_light[máxima profundidad]** del árbol. * `min_n`: **.bg-purple_light[número mínimo de elementos en nodos padres]** para dividirse en hijos. * `cost_complexity`: número positivo que nos modelizará la penalización por complicar el modelo (valores altos harán podas más extremas). ```r decision_tree <- decision_tree(mode = "classification", tree_depth = tune("depth"), min_n = tune("min_n"), cost_complexity = tune("cost")) ``` --- # .orange[ÁRBOLES] en .green[TIDYMODELS] Con `set_engine()` le especificaremos en concreto el «motor» (el paquete) que contiene las herramientas matemáticas necesarias con el que realizaremos el ajuste. En este caso tendremos 3: * `set_engine("rpart")`: sirve tanto para clasificación como para regresión, e implementa el algoritmo CART (Clasification and Regression Trees, Breiman et al., 1984), cuya **.bg-purple_light[construcción se basa en la impureza de Gini]**. * `set_engine("C5.0")`: sirve solo para clasificación, e implementa el algoritmo C5.0 (Quinlan, 1996) cuya **.bg-purple_light[construcción se basa en la entropía]**. * `set_engine("spark")`: sirve tanto para clasificación como para regresión, e implementa un algoritmo de árboles basado en el paquete `{sparklyr}`, enfocado a la **.bg-purple_light[aplicación de técnicas Machine Learning en el contexto Big Data]**. Para aprender Spark: <https://www.datacamp.com/community/tutorials/apache-spark-tutorial-machine-learning> ```r decision_tree_gini <- decision_tree %>% set_engine("rpart") decision_tree_entropy <- decision_tree %>% set_engine("C5.0") ``` --- # Caso práctico: .orange[IRIS] ```r # Partición 80-20% de train y test (solo instrucciones) iris_split <- initial_split(iris, strata = Species, prop = 0.8) iris_train <- training(iris_split) iris_test <- testing(iris_split) # Validación iris_cv_folds <- vfold_cv(data = iris_train, v = 4, repeats = 8, strata = Species) ``` Vamos a definir además una **.bg-purple_light[función para detectar outliers]** genérica que podamos aplicarla de forma flexible ```r outlier_detection <- function(x, method = "z", k = 2.5) { output <- ifelse(is.na(x) | abs(scores(x, type = method)) > k, NA, x) return(output) } x <- c(1, 1.5, 2, 0, -1, -0.5, 0.3, 1, 0.1, 10, -12, 0, 1) outlier_detection(x, method = "z", k = 2) ``` ``` > [1] 1.0 1.5 2.0 0.0 -1.0 -0.5 0.3 1.0 0.1 NA NA 0.0 1.0 ``` ```r outlier_detection(x, method = "mad", k = 3) ``` ``` > [1] 1.0 1.5 2.0 0.0 -1.0 -0.5 0.3 1.0 0.1 NA NA 0.0 1.0 ``` --- # Caso práctico: .orange[IRIS] Aplicamos la receta para completar esa fase 3. ```r # Receta iris_rec <- recipe(data = iris_train, Species ~ .) %>% # Roles add_role(starts_with("Sepal"), new_role = "simétrica") %>% add_role(starts_with("Petal"), new_role = "no simétrica") %>% # Detectar outliers step_mutate(across(has_role("simétrica"), outlier_detection), across(has_role("no simétrica"), outlier_detection, "mad", 3)) %>% # Filtro de correlación step_corr(all_numeric_predictors(), threshold = 0.9)%>% # Filtro de cero varianza step_zv(all_predictors()) ``` --- # Caso práctico: .orange[IRIS] Probaremos **.bg-purple_light[120 modelos diferentes]** ```r grid_tree <- expand_grid("depth" = c(1, 2, 3, 4), "min_n" = c(2, 5, 7, 10, 20), "cost" = c(0.001, 0.01, 0.1, 0.5, 1, 2)) grid_tree ``` ``` > # A tibble: 120 × 3 > depth min_n cost > <dbl> <dbl> <dbl> > 1 1 2 0.001 > 2 1 2 0.01 > 3 1 2 0.1 > 4 1 2 0.5 > 5 1 2 1 > 6 1 2 2 > 7 1 5 0.001 > 8 1 5 0.01 > 9 1 5 0.1 > 10 1 5 0.5 > # … with 110 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Caso práctico: .orange[IRIS] Tras ello **.bg-purple_light[definimos nuestro modelo]** ```r decision_tree <- decision_tree(mode = "classification", tree_depth = tune("depth"), min_n = tune("min_n"), cost_complexity = tune("cost")) decision_tree_gini <- decision_tree %>% set_engine("rpart") decision_tree_entropy <- decision_tree %>% set_engine("C5.0") ``` .pull-left[ ```r iris_tree_gini_wflow <- workflow() %>% add_recipe(iris_rec) %>% add_model(decision_tree_gini) ``` ] .pull-right[ ```r iris_tree_gini_entropy <- workflow() %>% add_recipe(iris_rec) %>% add_model(decision_tree_entropy) ``` ] --- # Caso práctico: .orange[IRIS] A la hora de inicializar la paralelización, en este caso como tenemos definida una **.bg-purple_light[función que vamos a querer usar]** en cada hilo de la paralelización, vamos a **.bg-purple_light[exportarla a todos los clústers]** con `clusterExport()`. ```r library(doParallel) library(parallel) clusters <- detectCores() - 1 make_cluster <- makeCluster(clusters) registerDoParallel(make_cluster) *clusterExport(make_cluster, "outlier_detection") ``` --- # Caso práctico: .orange[IRIS] * `pkgs`: paquetes que necesite importar en cada cor * `save_pred = TRUE` que nos guarde las predicciones de cada conjunto de validación ```r iris_fit_tree_gini <- iris_tree_gini_wflow %>% tune_grid(resamples = iris_cv_folds, grid = grid_tree, control = control_grid(verbose = TRUE, allow_par = TRUE, * pkgs = c("outliers"), save_pred = TRUE), metrics = metric_set(accuracy, sensitivity, specificity, roc_auc)) stopCluster(make_cluster) registerDoSEQ() ``` --- # Caso práctico: .orange[IRIS] Para calcular las **.bg-purple_light[métricas en validación (ya podados)]** basta de nuevo con usar `collect_metrics()` ```r # Métricas iris_fit_tree_gini %>% collect_metrics() ``` --- # Caso práctico: .orange[IRIS] Dado que el resultado es un `tibble` podemos aplicar lo que sabemos de `{tidyverse}` para filtrar, ordenar, etc. Las **métricas son muy parecidas porque tenemos muy pocas observaciones** de forma que nuestras validación son muy muy poco representativas. ```r resultados <- iris_fit_tree_gini %>% collect_metrics() resultados %>% filter(.metric == "roc_auc") %>% arrange(desc(mean), std_err) ``` --- # .orange[VISUALIZACIÓN] de resultados Lo primero es preparar los datos para visualizarlos, y para ello usaremos `pivot_longer()` para tener una columna de `parameter` (coste, profundad y min_n) y otra de `value` (con su valor). Tras prepararlos calcularemos la media de la métrica (que ya es una media en los 48 conjuntos de validación) por cada uno de los valores de los parámetros, para todos los modelos en los que coincida. ```r resultados_tidy <- resultados %>% pivot_longer(cols = c("cost", "depth", "min_n"), names_to = "parameter", values_to = "value") media_resultados <- resultados_tidy %>% group_by(parameter, value) %>% summarise(mean = mean(mean), .metric = .metric) %>% ungroup() resultados_tidy ``` --- # .orange[VISUALIZACIÓN] de resultados .pull-left[ ```r theme_set(theme_minimal()) ggplot(media_resultados, aes(x = value, y = mean)) + geom_line() + geom_point(size = 2) + facet_grid(.metric ~ parameter, scales = "free") + labs(x = "Parámetros", y = "Media (en todos los conjuntos de validación", title = "Resumen de las métricas en validación", caption = "Autor: Javier Álvarez Liébana") ``` ] .pull-right[ ```r theme_set(theme_minimal()) ggplot(media_resultados, aes(x = value, y = mean)) + geom_line() + geom_point(size = 2) + facet_grid(.metric ~ parameter, scales = "free") + labs(x = "Parámetros", y = "Media (en todos los conjuntos de validación", title = "Resumen de las métricas en validación", caption = "Autor: Javier Álvarez Liébana") ``` ] --- # Seleccionamos .orange[EL MEJOR] Como sucedía en knn, podemos **.bg-purple_light[ver los mejores]** con `show_best()` (e indicándole la métrica) ```r iris_fit_tree_gini %>% show_best("roc_auc", n = 10) iris_fit_tree_gini %>% show_best("accuracy", n = 10) ``` --- # Seleccionamos .orange[EL MEJOR] Con `select_best()` podemos **.bg-purple_light[seleccionar el mejor respecto a una métrica]** y con `select_by_one_std_err()` podemos seleccionar el mejor no solo por una métrica dada sino buscar el que tiene menor varianza (dado un parámetro), buscando ese **.bg-purple_light[equilibrio sesgo-varianza]**. ```r best_tree_gini_iris_roc <- iris_fit_tree_gini %>% select_best("roc_auc") best_tree_gini_iris_acc <- iris_fit_tree_gini %>% select_best("accuracy") best_tree_gini_iris_roc_std <- iris_fit_tree_gini %>% select_by_one_std_err("roc_auc", cost) best_tree_gini_iris_acc_std <- iris_fit_tree_gini %>% select_by_one_std_err("accuracy", cost) ``` Con el modelo ganador que queramos tras validación, **.bg-purple_light[finalizamos el flujo]** ```r final_wf <- iris_tree_gini_wflow %>% finalize_workflow(best_tree_gini_iris_roc) ``` --- # .orange[EVALUACIÓN] Con ese flujo finalizado lo usamos para **.bg-purple_light[ajustar a test ese modelo ganador seleccionado en validación]** ```r final_tree_fit <- final_wf %>% last_fit(iris_split) final_tree_fit %>% collect_metrics() ``` --- # .orange[PREDICCIÓN] Con `predict()` podemos **.bg-purple_light[predecir tanto la clase como la probabilidad estimada]** de pertenencia a cada clase ```r # Predecir el conjunto test: devuelve la clase predict(extract_workflow(final_tree_fit), iris_test) ``` --- # .orange[PREDICCIÓN] Con `predict()` podemos **.bg-purple_light[predecir tanto la clase como la probabilidad estimada]** de pertenencia a cada clase ```r # Predecir las probabilidades (las necesitamos para la ROC) predict(extract_workflow(final_tree_fit), iris_test, type = "prob") ``` --- # .orange[PREDICCIÓN] Con `augment()` incluimos predicciones al conjunto de test y con `conf_mat()` construimos la **.bg-purple_light[matriz de confusión]** ```r # Incluir predicciones en tabla prob_test <- augment(extract_workflow(final_tree_fit), iris_test) # Matriz de confusión: etiqueta real vs etiqueta predicha conf_mat_test <- prob_test %>% conf_mat(truth = Species, estimate = .pred_class) conf_mat_test # todas las métricas en test conf_mat_test %>% summary() ``` --- # .orange[VISUALIZACIÓN] de árboles En el caso de los árboles, amén de todo lo que podíamos hacer con knn, podemos además **.bg-purple_light[visualizar el árbol]** con `rpart.plot()` del paquete `{rpart.plot}` (el parámetro `extra` nos cambia la forma de visualizarlo) .pull-left[ ```r library(rpart.plot) final_tree_fit %>% extract_fit_engine() %>% rpart.plot(roundint = FALSE, extra = 1) ``` ] .pull-right[ ] --- # .orange[VISUALIZACIÓN] de árboles En el caso de los árboles, amén de todo lo que podíamos hacer con knn, podemos además **.bg-purple_light[visualizar el árbol]** con `rpart.plot()` del paquete `{rpart.plot}` (el parámetro `extra` nos cambia la forma de visualizarlo) .pull-left[ ```r library(rpart.plot) final_tree_fit %>% extract_fit_engine() %>% rpart.plot(roundint = FALSE, extra = 3) ``` ] .pull-right[ ] --- # .orange[VISUALIZACIÓN] de árboles En el caso de los árboles, amén de todo lo que podíamos hacer con knn, podemos además **.bg-purple_light[visualizar el árbol]** con `rpart.plot()` del paquete `{rpart.plot}` (el parámetro `extra` nos cambia la forma de visualizarlo) .pull-left[ ```r library(rpart.plot) final_tree_fit %>% extract_fit_engine() %>% rpart.plot(roundint = FALSE, extra = 4) ``` ] .pull-right[ ] --- # .orange[IMPORTANCIA] de las variables Con `vi()` del paquete `{vip}` podemos **.bg-purple_light[ver la importancia relativa de las variables]**. Para detalles del cálculo ver <https://rdrr.io/cran/vip/man/vi_model.html> y <https://koalaverse.github.io/vip/articles/vip.html> ```r library(vip) fit_gini <- final_tree_fit %>% extract_fit_engine() fit_gini$variable.importance vi(fit_gini) ``` --- # .orange[IMPORTANCIA] de las variables Con `vip()` podemos **.bg-purple_light[visualizar la importancia de las variables]**. .pull-left[ ```r fit_gini %>% vip() + labs(x = "Importancia", y = "Variables", title = "IMPORTANCIA DE VARIABLES", subtitle = "Con el paquete {vip}", caption = paste0("Autor: Javier Álvarez Liébana | ", "Datos: iris")) ``` ] .pull-right[ ] --- # .orange[ENSAMBLAJE] de modelos En general, **.bg-purple_light[árboles pequeños]** tendrán una baja varianza y un sesgo alto, **.bg-purple_light[árboles grandes]** tendrán una alta varianza y un sesgo bajo. Una forma de reducir la varianza es usar **.bg-purple_light[ensamblaje de modelos]** * **.bg-purple_light[Bagging]**: de los términos **.bg-purple_light[bootstrap aggregating]**, consiste en obtener como clasificación final un **.bg-purple_light[promedio de clasificadores]** (un meta-modelo, un modelo que promedio que modelos) construidos a partir de **.bg-purple_light[submuestras aleatorias]** de la muestra original **.bg-purple_light[con reemplazamiento]**: <img src="./img/bagging.jpg" width="40%" style="display: block; margin: auto;" /> --- # .orange[RANDOM FOREST] En el caso de los árboles, si los árboles agregados están correlacionados (por ejemplo, porque exista un predictor muy influyente que acabe siendo elegidos en todos), el bagging puede no funcionar. Una solución son los conocidos como **.bg-purple_light[random forest]**. Es un ejemplo de **bagging** muy particular ya que no solo aplica múltiples árboles a diferentes submuestras, sino que en cada iteración de división se **.bg-purple_light[seleccionan m variables aleatorias]** (del total de p variables, por eje,plo `\(m = \sqrt{p}\)`), ignorando las demás. La idea es **.bg-purple_light[combinar muchos modelos «tontos»]** para que, agregados, nos de un **.bg-purple_light[modelo robusto]**. --- # .orange[BOOSTING] En el caso del **.bg-purple_light[bagging]** la idea era crear submuestras (con reemplazamiento), aplicar a cada una un modelo, para luego promediarlos. En el caso del **.bg-purple_light[boosting]** la idea es partir con todos los datos, aplicar un clasificador (un árbol por ejemplo), y **.bg-purple_light[reponderar las observaciones]**, de forma que aquellos registros **.bg-purple_light[peor clasificados pasen a tener un peso mayor]**. Tras ello, se vuelve a aplicar un clasificador, pero de forma que no todas las observaciones cuentan por igual, para **.bg-purple_light[construir secuencialmente]** un clasificador fuerte a partir de clasificadores débiles. <img src="./img/boosting.jpg" width="40%" style="display: block; margin: auto;" /> --- # .orange[RANDOM FOREST] Para implementar un **.bg-purple_light[random forest]** usaremos la función `rand_forest()` con tres argumentos: * `mtry`: **.bg-purple_light[número de predictores]** que el árbol puede ver en cada decisión (si es igual a p, es equivalenteun bagging clásico) * `min_n`: como antes, es el **.bg-purple_light[número mínimo de observaciones]** que se permite tener a un nodo para dividirse. * `trees`: **.bg-purple_light[árboles que prueba]**. Vamos a lanzar 100 árboles, que seleccione **21 configuraciones posibles** del par `(mtry-min_n)`, para decidir cual es el par de hiperparámetros más óptimo (en total, 6300 árboles). Aquí en iris tampoco podemos elegir mucho ya que solo tenemos 3 variables así que podremos construir árboles solo con 1-2-3 variables. El criterio de división será Gini. ```r # Random forest con tune rf_iris <- rand_forest(mode = "classification", mtry = tune("n_pred"), min_n = tune("min_n"), trees = 100) %>% set_engine("ranger", num.threads = 7) ``` --- # .orange[RANDOM FOREST] Definimos el grid y el flujo ```r # Grid grid_rf <- expand_grid("n_pred" = c(1, 2, 3), "min_n" = c(1, 2, 5, 7, 10, 20, 30)) # Flujo de trabajo iris_rf_wflow <- workflow() %>% add_recipe(iris_rec) %>% add_model(rf_iris) ``` --- # .orange[RANDOM FOREST] ```r # Ajuste con tune paralelizado clusters <- detectCores() - 1 make_cluster <- makeCluster(clusters) registerDoParallel(make_cluster) clusterExport(make_cluster, "outlier_detection") metricas <- metric_set(accuracy, sensitivity, specificity, roc_auc) rf_tune_par <- iris_rf_wflow %>% tune_grid(resamples = iris_cv_folds, grid = grid_rf, metrics = metricas, control = control_grid(verbose = TRUE, allow_par = TRUE, pkgs = c("outliers"), save_pred = TRUE)) # finalizamos clusters (por si acaso) stopCluster(make_cluster) registerDoSEQ() ``` --- # .orange[RANDOM FOREST] Tras ello podemos hacer la misma idea de seleccionar el mejor, para luego palicarlo a test. **Prueba dicha estrategia en hoteles donde tenemos bastantes más variables** ```r rf_tune_par %>% collect_metrics() ``` ``` > # A tibble: 84 × 8 > n_pred min_n .metric .estimator mean n std_err .config > <dbl> <dbl> <chr> <chr> <dbl> <int> <dbl> <fct> > 1 1 1 accuracy multiclass 0.925 32 0.00702 Preprocessor1_Model01 > 2 1 1 roc_auc hand_till 0.982 32 0.00265 Preprocessor1_Model01 > 3 1 1 sensitivity macro 0.925 32 0.00702 Preprocessor1_Model01 > 4 1 1 specificity macro 0.962 32 0.00351 Preprocessor1_Model01 > 5 1 2 accuracy multiclass 0.929 32 0.00698 Preprocessor1_Model02 > 6 1 2 roc_auc hand_till 0.983 32 0.00280 Preprocessor1_Model02 > 7 1 2 sensitivity macro 0.929 32 0.00698 Preprocessor1_Model02 > 8 1 2 specificity macro 0.965 32 0.00349 Preprocessor1_Model02 > 9 1 5 accuracy multiclass 0.928 32 0.00671 Preprocessor1_Model03 > 10 1 5 roc_auc hand_till 0.982 32 0.00298 Preprocessor1_Model03 > # … with 74 more rows > # ℹ Use `print(n = ...)` to see more rows ``` ```r rf_tune_par %>% select_best("roc_auc") ``` ``` > # A tibble: 1 × 3 > n_pred min_n .config > <dbl> <dbl> <fct> > 1 2 20 Preprocessor1_Model13 ``` --- class: inverse center middle name: clase-11 # CLASE 11: análisis de regresión multivariante ### [Intro teórica: univariante](#intro-teoria-reg-uni) ### [Regresión con starwars](#primera-reg-starwars) ### [¿Qué es realmente la bondad de ajuste?](#bondad-ajuste) ### [Regresión en gapminder](#reg-gapminder) ### [Regresión multivariante](#reg-multi) --- name: intro-teoria-reg-uni # .orange[REGRESIÓN] .green[UNIVARIANTE] Empecemos por el más sencillo: ¿cómo se formula un modelo de **.bg-purple_light[reg. univariante]**? * **.bg-purple_light[Modelo teórico]**: dadas dos variables aleatorias `\((X, Y)\)`, asumimos que la relación entre ellas se pueda modelar mediante un modelo lineal (una recta) `$$Y = f(X) + \epsilon = \left(\beta_0 + \beta_1X \right) +\epsilon, \quad f:~\mathbb{R} \to \mathbb{R}$$` -- * **.bg-purple_light[Error]**: `\(\epsilon\)` es una variable aleatoria de **.bg-purple_light[media cero]** y varianza finita (en caso de que nuestra hipótesis teórica sea cierta) que busca **.bg-purple_light[capturar el comportamiento estocástico (ruido)]**. -- * **.bg-purple_light[Objetivo]**: predecir la **.bg-purple_light[variable objetivo]** (en este caso `\(Y\)` será una **.bg-orange[variable cuantitativa continua]**), modelando la parte determinística del modelo `$$\hat{y}_i = \hat{\beta}_0 + \hat{\beta}_1 x_i \text{ (ajuste)}, \quad \epsilon_i = y_i - \hat{y}_i \text{ (errores)}$$` `$$\hat{\beta}_1 = \frac{s_{xy}}{s_{x}^2}, \quad \hat{\beta}_0 = \overline{y} - \hat{\beta}_1 \overline{x} \quad \text{ (coef. estimados)}$$` --- # .orange[REGRESIÓN] .green[UNIVARIANTE] Tanto árboles como knn tiene una **.bg-purple_light[ventaja principal]**: no necesitan hipótesis en los datos. **.bg-purple_light[¿Para qué vamos a necesitar hipótesis?]** Al fin y al cabo, ya hemos obtenido dos estimadores de la probabilidad de pertenencia a una clase. Las **.bg-purple_light[hipótesis probabilísticas]** en el modelo lineal son necesarias para -- a) Poder **.bg-purple_light[cuantificar de forma rigurosa la incertidumbre]** y variablidad de los estimadores. b) Con los datos muestrales de los que disponemos, poder **.bg-purple_light[inferir conclusiones poblacionales]** c) Tener una **.bg-purple_light[expresión explícita del estimador]** --- # .orange[HIPÓTESIS] reg. univariante * **.bg-purple_light[Linealidad]**: se asume que la variable objetivo y la predictora cumplen (en media) que `$${\rm E} [Y | X = x] = \beta_0 + \beta_1 x$$` -- * **.bg-purple_light[Homocedasticidad de los residuos]** los residuos tendrán media cero pero además se pide que `\({\rm Var} [\epsilon | X = x ] = \sigma_{\epsilon}^2\)`, siendo `\(\sigma^2 < \infty\)` una constante (es decir, los residuos visualizados deberán caer en una banda horizontal constante). -- * **.bg-purple_light[Normalidad de los residuos]**: los residuos cumplirán además que `\(\epsilon \sim \mathcal{N} \left(0, \sigma_{\epsilon}^2 \right)\)`. -- * **.bg-purple_light[Residuos incorrelados]**: para cualquier i,j, tendremos que `\({\rm E} [ \epsilon_i \epsilon_j ] = 0\)` -- Todas ellas se resumen en la siguiente `$$(Y|X = x) \sim \mathcal{N} (\beta_0 + \beta_1x, \sigma_{\epsilon}^2)$$` --- # .orange[REGRESIÓN] .green[UNIVARIANTE] El **.bg-purple_light[proceso de una regresión univariante]** la podemos definir en 5 etapas: 1. **.bg-purple_light[Preprocesamiento]** (fases 1-2-3 SEMMA si fuese necesario) -- 2. **.bg-purple_light[Ajuste y estimación]** de los coeficientes (fase 4 SEMMA). **.bg-purple_light[Interpretación]** de los coeficientes. ¿Podemos prescindir de `\((\beta_0, \beta_1)\)`? -- 3. **.bg-purple_light[Diagnosis]**: en este caso debemos **.bg-purple_light[verificar las hipótesis]** parámetricas planteadas asumidas como ciertas. -- 4. **.bg-purple_light[Evaluación]**: análisis de la varianza y bondad de ajuste (fase 5 SEMMA) -- 5. **.bg-purple_light[Predicción]**: al ser una variable **.bg-purple_light[objetivo continua]**, la métrica ya no se basará en una tasa de bien clasificados sino en la **.bg-purple_light[media de los errores al cuadrado]** (llamada varianza residual o error cuadrático medio ECM) --- # .orange[REGRESIÓN]: .green[PREPROCESAMIENTO] En el caso de la regresión univariante, el preprocesamiento será mínimo: * **.bg-purple_light[Variable objetivo]**: la variable `\(Y\)` siempre debe ser numérica continua. * **.bg-purple_light[Variables predictoras]**: la variable `\(X\)` (en este caso una al ser univariante) también debe ser numérica continua. En el caso de que tengamos **.bg-purple_light[varias candidatas]** elegiremos aquella variable con una **.bg-purple_light[mayor correlación lineal]** (mayor % de varianza explicada si ajustásemos una recta) * **.bg-purple_light[Ausentes y outliers]**: una regresión no admite ausentes y es **.bg-purple_light[muy sensible a valores atípicos]**. * **.bg-purple_light[Linealidad]**: a veces necesitaremos aplicar alguna transformación a los datos (logaritmo, exponencial, raíz cuadrada, etc) para **.bg-purple_light[linealizarlos]**. --- name: primera-reg-starwars # .orange[REGRESIÓN]: .green[PREPROCESAMIENTO] Vamos a ejemplificar el proceso con **.bg-purple_light[dos datasets sencillos]** que ya conocemos: `starwars` y `gapminder`. La idea es la siguiente: * **.bg-purple_light[Predecir la estatura]** (`height`) en función del peso (`mass`). * Tomando solo los datos de 1997, **.bg-purple_light[predecir la esperanza de vida]** (`lifeExp`) en función alguna de las variables de `gapminder` Empecemos por `starwars` ```r starwars ``` ``` > # A tibble: 87 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Luke Skywa… 172 77 blond fair blue 19 male mascu… Tatooi… > 2 C-3PO 167 75 <NA> gold yellow 112 none mascu… Tatooi… > 3 R2-D2 96 32 <NA> white,… red 33 none mascu… Naboo > 4 Darth Vader 202 136 none white yellow 41.9 male mascu… Tatooi… > 5 Leia Organa 150 49 brown light brown 19 fema… femin… Aldera… > 6 Owen Lars 178 120 brown,… light blue 52 male mascu… Tatooi… > 7 Beru White… 165 75 brown light blue 47 fema… femin… Tatooi… > 8 R5-D4 97 32 <NA> white,… red NA none mascu… Tatooi… > 9 Biggs Dark… 183 84 black light brown 24 male mascu… Tatooi… > 10 Obi-Wan Ke… 182 77 auburn… fair blue-g… 57 male mascu… Stewjon > # … with 77 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # .orange[REGRESIÓN]: .green[PREPROCESAMIENTO] Empecemos por `starwars` * **.bg-purple_light[Variable objetivo]**: `height` ya es numérica continua. -- * **.bg-purple_light[Predictora]**: en este caso solo tenemos una (`mass`) y es numérica. -- * **.bg-purple_light[Ausentes y outliers]**: una regresión no admite ausentes y es **.bg-purple_light[muy sensible a atípicos]**. En el caso de `{starwars}` sí tenemos ausentes así que podremos probar dos caminos: eliminarlos o imputar la media. Pero antes vamos a decidir que hacemos con los outliers. ```r # Comprobamos ausentes starwars %>% filter(if_any(c(mass, height), is.na)) ``` ``` > # A tibble: 28 × 14 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Wilhuff Ta… 180 NA auburn… fair blue 64 male mascu… Eriadu > 2 Mon Mothma 150 NA auburn fair blue 48 fema… femin… Chandr… > 3 Arvel Cryn… NA NA brown fair brown NA male mascu… <NA> > 4 Finis Valo… 170 NA blond fair blue 91 male mascu… Corusc… > 5 Rugor Nass 206 NA none green orange NA male mascu… Naboo > 6 Ric Olié 183 NA brown fair blue NA <NA> <NA> Naboo > 7 Watto 137 NA black blue, … yellow NA male mascu… Toydar… > 8 Quarsh Pan… 183 NA black dark brown 62 <NA> <NA> Naboo > 9 Shmi Skywa… 163 NA black fair brown 72 fema… femin… Tatooi… > 10 Bib Fortuna 180 NA none pale pink NA male mascu… Ryloth > # … with 18 more rows, 4 more variables: species <chr>, films <list>, > # vehicles <list>, starships <list>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable names ``` --- # .orange[REGRESIÓN]: .green[DATAVIZ] .pull-left[ A la vista del gráfico, es obvio que tenemos al menos un dato atípico (un peso desproporcionado). ```r library(ggthemes) library(scales) ggplot(starwars, aes(x = mass, y = height)) + geom_point(aes(color = sex), size = 3) + scale_color_colorblind() + scale_x_continuous( labels = label_number(suffix = " kg")) + scale_y_continuous( labels = label_number(suffix = " cm")) + theme_minimal() + labs(x = "Peso", y = "Altura", color = "sexo", title = "Regresión altura vs estatura") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-974-1.png" width="90%" /> ] --- # .orange[REGRESIÓN]: .green[DATAVIZ] .pull-left[ Podemos incluso añadir una hipótetica recta de regresión con `geom_smooth()` ```r ggplot(starwars, aes(x = mass, y = height)) + geom_point(aes(color = sex), size = 3) + geom_smooth(method = "lm", se = FALSE) + scale_color_colorblind() + scale_x_continuous( labels = label_number(suffix = " kg")) + scale_y_continuous( labels = label_number(suffix = " cm")) + theme_minimal() + labs(x = "Peso", y = "Altura", color = "sexo", title = "Regresión altura vs estatura") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-976-1.png" width="90%" /> ] --- # .orange[REGRESIÓN]: .green[DATAVIZ] .pull-left[ También podemos visualizar la distribución de una variable continua con un **.bg-purple_light[histograma]** o su límite continuo (**.bg-purple_light[función de densidad]**) ```r ggplot(starwars, aes(x = height)) + geom_histogram(bins = 15, fill = "#D86456", alpha = 0.75) + scale_x_continuous( labels = label_number(suffix = " cm")) + theme_minimal() + labs(x = "Altura", y = "Frecuencia", title = "Distribución de la altura") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-978-1.png" width="90%" /> ] --- # .orange[REGRESIÓN]: .green[DATAVIZ] .pull-left[ También podemos visualizar la distribución de una variable continua con un **.bg-purple_light[histograma]** o su límite continuo (**.bg-purple_light[función de densidad]**) ```r ggplot(starwars, aes(x = mass)) + geom_histogram(bins = 25, fill = "#4F8ADA", alpha = 0.75) + scale_x_continuous( labels = label_number(suffix = " kg")) + theme_minimal() + labs(x = "Peso", y = "Frecuencia", title = "Distribución del peso") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-980-1.png" width="90%" /> ] --- # .orange[REGRESIÓN]: .green[DATAVIZ] .pull-left[ También podemos visualizar la distribución de una variable continua con un **.bg-purple_light[histograma]** o su límite continuo (**.bg-purple_light[función de densidad]**) ```r ggplot(starwars, aes(x = height)) + geom_density(fill = "#D86456", color = "#D86456", alpha = 0.5) + scale_x_continuous(labels = label_number(suffix = " cm")) + theme_minimal() + labs(x = "Altura", y = "Frecuencia", title = "Distribución de la altura") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-982-1.png" width="90%" /> ] --- # .orange[REGRESIÓN]: .green[DATAVIZ] .pull-left[ También podemos visualizar la distribución de una variable continua con un **.bg-purple_light[histograma]** o su límite continuo (**.bg-purple_light[función de densidad]**) ```r ggplot(starwars, aes(x = mass)) + geom_density(fill = "#4F8ADA", color = "#4F8ADA", alpha = 0.5) + scale_x_continuous(labels = label_number(suffix = " kg")) + theme_minimal() + labs(x = "Peso", y = "Frecuencia", title = "Distribución del peso") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-984-1.png" width="90%" /> ] --- # .orange[REGRESIÓN]: .green[OUTLIERS] Hemos visto que claramente **.bg-purple_light[hay al menos un atípico en la predictora]**, pero vamos a comprobarlo numéricamente. ```r library(outliers) starwars_outliers <- starwars %>% drop_na(mass) %>% mutate(outlier_mass = abs(scores(mass, type = "z")) > 3) starwars_outliers %>% filter(outlier_mass) ``` ``` > # A tibble: 1 × 15 > name height mass hair_…¹ skin_…² eye_c…³ birth…⁴ sex gender homew…⁵ > <chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> > 1 Jabba Desil… 175 1358 <NA> green-… orange 600 herm… mascu… Nal Hu… > # … with 5 more variables: species <chr>, films <list>, vehicles <list>, > # starships <list>, outlier_mass <lgl>, and abbreviated variable names > # ¹hair_color, ²skin_color, ³eye_color, ⁴birth_year, ⁵homeworld > # ℹ Use `colnames()` to see all variable names ``` Efectivamente **.bg-purple_light[tenemos un personaje que está muy alejado de la media]**. Vamos a ver que sucede cuando lo quitamos. --- # .orange[REGRESIÓN]: .green[OUTLIERS] .pull-left[ Tras quitar ese valor atípico mejora la fortaleza de la relación lineal ```r starwars_sin_outliers <- starwars_outliers %>% filter(!outlier_mass) ggplot(starwars_sin_outliers, aes(x = mass, y = height)) + geom_point(aes(color = sex), size = 3) + geom_smooth(method = "lm", se = FALSE) + scale_color_colorblind() + scale_x_continuous( labels = label_number(suffix = " kg")) + scale_y_continuous( labels = label_number(suffix = " cm")) + theme_minimal() + labs(x = "Peso", y = "Altura", color = "sexo", title = "Regresión altura vs estatura") ``` ] .pull-left[ <img src="index_files/figure-html/unnamed-chunk-987-1.png" width="90%" /> ] --- # .orange[REGRESIÓN]: .green[DATAVIZ] .pull-left[ ¿Cómo queda la distribución de la predictora tras eliminar outliers? ¿Es simétrica? ```r ggplot(starwars_sin_outliers, aes(x = mass)) + geom_density(fill = "#D86456", color = "#D86456", alpha = 0.5) + scale_x_continuous(labels = label_number(suffix = " kg")) + theme_minimal() + labs(x = "Peso", y = "Frecuencia", title = "Distribución del peso") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-989-1.png" width="90%" /> ] --- # .orange[REGRESIÓN]: .green[PREPROCESAMIENTO] Lo que haremos por tanto será: * **.bg-purple_light[Eliminar registros con ausente en la objetivo]** (fuera de receta) ```r starwars_sin_na <- starwars %>% drop_na(height) ``` * **.bg-purple_light[Eliminar el único valor atípico]** detectado en la predictora (dentro de receta) * **.bg-purple_light[Eliminar ausentes]** (dentro de receta) En este caso no generamos validación ya que tenemos muy pocos datos ```r # Partición split_starwars <- initial_split(starwars_sin_na, prop = 0.8) train_starwars <- training(split_starwars) test_starwars <- testing(split_starwars) ``` --- # .orange[REGRESIÓN]: .green[RECETA] ```r rec_reg_starwars <- # Fórmula y datos recipe(data = train_starwars, height ~ mass) %>% step_filter(!is.na(mass)) %>% step_mutate(outlier_mass = abs(scores(mass, type = "z")) > 3) %>% step_filter(!outlier_mass) %>% step_rm(outlier_mass) rec_reg_starwars ``` ``` > Recipe > > Inputs: > > role #variables > outcome 1 > predictor 1 > > Operations: > > Row filtering using !is.na(mass) > Variable mutation for abs(scores(mass, type = "z")) > 3 > Row filtering using !outlier_mass > Variables removed outlier_mass ``` --- # .orange[REGRESIÓN]: .green[MODELO] El modelo será definido con `linear_reg()` ```r # modelo lineal reg_lineal <- linear_reg() %>% set_mode("regression") %>% set_engine("lm") ``` Con el modelo y la receta construimos el flujo ```r reg_wflow_starwars <- workflow() %>% add_model(reg_lineal) %>% add_recipe(rec_reg_starwars) reg_wflow_starwars ``` ``` > ══ Workflow ════════════════════════════════════════════════════════════════════ > Preprocessor: Recipe > Model: linear_reg() > > ── Preprocessor ──────────────────────────────────────────────────────────────── > 4 Recipe Steps > > • step_filter() > • step_mutate() > • step_filter() > • step_rm() > > ── Model ─────────────────────────────────────────────────────────────────────── > Linear Regression Model Specification (regression) > > Computational engine: lm ``` --- # .orange[REGRESIÓN]: .green[AJUSTE] ```r reg_fit_starwars <- reg_wflow_starwars %>% fit(data = train_starwars) reg_fit_starwars ``` ``` > ══ Workflow [trained] ══════════════════════════════════════════════════════════ > Preprocessor: Recipe > Model: linear_reg() > > ── Preprocessor ──────────────────────────────────────────────────────────────── > 4 Recipe Steps > > • step_filter() > • step_mutate() > • step_filter() > • step_rm() > > ── Model ─────────────────────────────────────────────────────────────────────── > > Call: > stats::lm(formula = ..y ~ ., data = data) > > Coefficients: > (Intercept) mass > 99.4053 0.9896 ``` --- # .orange[REGRESIÓN]: .green[AJUSTE] Con `tidy()` podemos ver un **.bg-purple_light[resumen del ajuste]** ```r tidy(reg_fit_starwars) ``` ``` > # A tibble: 2 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) 99.4 9.85 10.1 5.05e-13 > 2 mass 0.990 0.126 7.87 6.26e-10 ``` * **.bg-purple_light[Coeficientes]**: aquellos que minimizan la Sum of Squared Residuals o SSR (método de mínimos cuadrados) `$$\left(\hat{\beta}_0, \hat{\beta}_1 \right) = \arg \min_{\boldsymbol{\beta} \in \mathbb{R}^2} \sum_{i=1}^{n} \hat{\epsilon}_{i}^2 = \arg \min_{\boldsymbol{\beta} \in \mathbb{R}^2} \sum_{i=1}^{n} \left[y_i - \left(\beta_0 + \beta_1x_i \right) \right]^2$$` --- # .orange[REGRESIÓN]: .green[AJUSTE] Con `tidy()` podemos ver un **.bg-purple_light[resumen del ajuste]** ```r tidy(reg_fit_starwars) ``` ``` > # A tibble: 2 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) 99.4 9.85 10.1 5.05e-13 > 2 mass 0.990 0.126 7.87 6.26e-10 ``` * **.bg-purple_light[Interpretación]**: - La predicción del modelo cuando `mass = 0` es de 99.405 cm - Por cada kg de más, la estatura sube 0.99 cm --- # .orange[REGRESIÓN]: .green[AJUSTE] ```r tidy(reg_fit_starwars) ``` ``` > # A tibble: 2 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) 99.4 9.85 10.1 5.05e-13 > 2 mass 0.990 0.126 7.87 6.26e-10 ``` * `std.error`: nos proporciona la **.bg-purple_light[varianza de la estimación de cada estimador]**, que en el caso univariante es calcula como `$$SE\left( \hat{\beta}_0 \right)^2 = \frac{\sigma_{\epsilon}^{2}}{n} \left[ 1+ \frac{\overline{x}^2}{s_{x}^2} \right], \quad SE\left( \hat{\beta}_1 \right)^2 = \frac{\sigma_{\epsilon}^{2}}{n s_{x}^{2}}$$` En la fórmula anterior, `\(\sigma_{\epsilon}^{2}\)` es la **.bg-purple_light[varianza residual]** real, la varianza de los errores, una cantidad desconocida y cuyo **.bg-purple_light[estimador insesgado]** es `\(\left(\sum_{i=1}^{n} \hat{\epsilon}_{i}^2 \right)/(n-p-1)\)`, donde `\(p\)` es el número de variables predictoras (en este caso `\(p=1\)`), dando lugar a `\(\hat{SE}\left( \hat{\beta}_0 \right)\)` y `\(\hat{SE}\left( \hat{\beta}_0 \right)\)`. **.bg-green_light[IMPORTANTE]**: dados dos modelos similares, optaremos por aquel con menor varianza. --- # .orange[REGRESIÓN]: .green[AJUSTE] ```r tidy(reg_fit_starwars) ``` ``` > # A tibble: 2 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) 99.4 9.85 10.1 5.05e-13 > 2 mass 0.990 0.126 7.87 6.26e-10 ``` Debido a las hipótesis impuestas, tenemos resultados teóricos como el siguiente: `$$\frac{\hat{\beta}_j - \beta_j}{SE \left(\hat{\beta}_j \right)} \sim \mathcal{N}(0,1), \quad \frac{\hat{\beta}_j - \beta_j}{\hat{SE} \left(\hat{\beta}_j \right)} \sim t_{n-p-1}$$` El **.bg-purple_light[t-estadístico]** es lo que tenemos guardado en `statistics`, siendo `p.value` el resultado del contraste: `$$\mathcal{H}_0:~\beta_j = 0, \quad \mathcal{H}_1:~\beta_j \neq 0$$` En este caso ambos son significativamente distintos de cero (al 95% de confianza). --- # .orange[REGRESIÓN]: .green[AJUSTE] Dicho contraste nos permitirá **.bg-purple_light[calibrar la importancia del efecto (lineal) de cada uno de los parámetros]**: si obtenemos p-valores muy elevados, no habría evidencias suficientes en la muestra para rechazar la hipótesis nula, lo que nos podría indicar que quizás dicho parámetro no tiene un efecto estadísticamente significativo en la estimación. Amén de la estimación puntual realizada podemos obtener los **.bg-purple_light[intervalos de confianza]** ```r # Al 95% confint(reg_fit_starwars %>% extract_fit_engine()) ``` ``` > 2.5 % 97.5 % > (Intercept) 79.5524261 119.258097 > mass 0.7361184 1.243125 ``` ```r # Al 90% confint(reg_fit_starwars%>% extract_fit_engine(), level = 0.90) ``` ``` > 5 % 95 % > (Intercept) 82.8537750 115.956748 > mass 0.7782737 1.200969 ``` --- # .orange[REGRESIÓN]: .green[AJUSTE] ```r # Al 95% confint(reg_fit_starwars %>% extract_fit_engine()) ``` ``` > 2.5 % 97.5 % > (Intercept) 79.5524261 119.258097 > mass 0.7361184 1.243125 ``` Un aspecto importante al usar intervalos de confianzas es que el intervalo de confianza (IC) con nivel de confianza `\(1 - \alpha\)` (habitualmente 95%) **.bg-red_light[no nos habla de la probabilidad de que el parámetro esté dentro de ESE intervalo]**. En un enfoque frecuentista, el parámetro a estimar estará o no dentro del intervalo, pero es incorrecto hablar de una probabilidad de pertenencia al mismo. Ese nivel de confianza no nos habla tanto de la probabilidad del parámetro sino del **.bg-purple_light[método con el que se ha construido el intervalo]**: de una colección de muestras extraídas de la población (de forma aleatoria), en aproximadamente 95 de cada 100 de ellas, el intervalo construido habrá conseguido incluir dentro al parámetro. Son los intervalos los que se mueven «aleatoriamente» (aleatoriedad determinada por la muestra obtenida) alrededor del parámetro (cuyo valor es desconocido pero FIJO), no al revés. --- # .orange[REGRESIÓN]: .green[DIAGNOSIS] En este caso no va a ser posible realizarla ya que tenemos muy poca muestra, pero luego veremos cómo **.bg-purple_light[comprobar que las hipótesis son ciertas]**. De ello se ocupará (como se muestra debajo) el paquete `{performance}` ```r library(performance) check_model(reg_fit_starwars %>% extract_fit_engine()) ``` --- # .orange[REGRESIÓN]: .green[EVALUACIÓN] Esta fase es la que haríamos en validación. Con `glance()` obtenemos el resumen de la evaluación del modelo ```r glance(reg_fit_starwars) ``` ``` > # A tibble: 1 × 12 > r.squared adj.r.squa…¹ sigma stati…² p.value df logLik AIC BIC devia…³ > <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> > 1 0.585 0.575 23.3 61.9 6.26e-10 1 -209. 424. 430. 23874. > # … with 2 more variables: df.residual <int>, nobs <int>, and abbreviated > # variable names ¹adj.r.squared, ²statistic, ³deviance > # ℹ Use `colnames()` to see all variable names ``` * **.bg-purple_light[Bondad de ajuste]**: también conocida como `\(R^2\)`, guardado en `r.squared`, será el **.bg-purple_light[ratio de información explicada]** (siempre entre 0 y 1) por el modelo. En el caso de modelos lineales en parámetros, podemos realizar lo que se conoce como **.bg-purple_light[ANOVA]** (análisis de la varianza) `$$SST \text{ (info total)} = SSE \text{ (info explicada)} + SSR \text{ (info no explicada)}$$` --- # .orange[REGRESIÓN]: .green[EVALUACIÓN] `$$SST \text{ (info total)} = SSE \text{ (info explicada)} + SSR \text{ (info no explicada)}$$` Traducido a varianza (con `\(s_{\hat{\epsilon}}^2\)` la estimación de la varianza residual) `\(s_{y}^2 = s_{\hat{y}}^2 + s_{\hat{\epsilon}}^2\)` Así la bondad de ajuste es `\(R^2 = \frac{SSE}{SST} = 1 - \frac{SSR}{SST} = 1 - \frac{s_{\hat{\epsilon}}^2}{s_{y}^2}\)`. En el caso particular de la reg. lineal univariante, `\(R^2 = \rho_{x,y}^2\)` (correlación al cuadrado) -- * **.bg-purple_light[Bondad de ajuste penalizada]**: guardado en `adj.r.squared`, dicha bondad de ajuste **.bg-purple_light[penaliza el uso de predictoras]** para prevenir el sobreajuste `$$R_{adj}^{2} = 1 - \frac{n-1}{n-p-1}\frac{SSR}{SST}$$` Si dos modelos nos proporcionan el mismo `\(R^2\)`, `\(R_{adj}^2\)` disminuirá por cada variable de más que usemos (para conseguir lo mismo). De hecho puede ser negativo --- # .orange[REGRESIÓN]: .green[PREDICCIÓN] Por último podemos predecir y evaluar en test como hacíamos en modelos anteriores ```r # Predecimos en tst fit_starwars <- reg_wflow_starwars %>% last_fit(split = split_starwars) # Evaluamos en test fit_starwars %>% collect_metrics() ``` ``` > # A tibble: 2 × 4 > .metric .estimator .estimate .config > <chr> <chr> <dbl> <fct> > 1 rmse standard 24.3 Preprocessor1_Model1 > 2 rsq standard 0.562 Preprocessor1_Model1 ``` ```r # Errores en test pred_test <- fit_starwars %>% collect_predictions() %>% mutate(error = height - .pred) ``` --- # .orange[REGRESIÓN]: .green[DATAVIZ] .pull-left[ Si pintamos los valores reales frente a las predicciones, si el modelo fuese fiable (que por el bajo tamaño muestral y el bajo `\(R^2\)` ya podíamos intuir que no), deberían estar cerca de la diagonal. ```r # Gráficos en test ggplot(data = pred_test, mapping = aes(x = .pred, y = height)) + geom_point(color = "#006EA1", alpha = 0.6, size = 4) + # Diagonal geom_abline(intercept = 0, slope = 1, color = "orange", size = 1.2) + theme_minimal() + labs(title = "Resultados regresión lineal univariante", subtitle = "Valores deberían estar cercanos a la diagonal", caption = "Autor: Javier Álvarez Liébana | Datos: starwars", x = "Predicciones", y = "Valores reales") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1006-1.png" width="90%" /> ] ] --- name: bondad-ajuste # Paréntesis: .orange[BONDAD DE AJUSTE] Hemos comentado que la bondad de ajuste nos proporciona un ratio de la información explicada, de forma que la **.bg-purple_light[interpretación más habitual]** es que si está cercano a 0 es malo, y si está cercano a 1 es bueno. De hecho habitual se «desprecian» regresiones con `\(R^2 = 0.5\)` (por ejemplo) Veamos un ejemplo de lo que realmente significa el `\(R^2\)` y por qué **.bg-purple_light[no siempre una baja bondad de ajuste]** tiene que implicar un **.bg-purple_light[mal modelo]** Con tamaño muestral `\(n = 3000\)`, vamos a simular los datos según el modelo `\(Y = 4 - 0.4X + \epsilon\)`, donde `\(\epsilon \sim \mathcal{N}(0,\sigma_{\epsilon})\)` --- # Paréntesis: .orange[BONDAD DE AJUSTE] Para ello vamos a generar una función que depende de `\(\sigma_{\epsilon}\)` ```r n <- 3000 # predictora fija x <- rnorm(n, mean = 0, sd = 1) # Función para generar el modelo regresion_sigma <- function(sigma, n, x) { epsilon <- rnorm(n, mean = 0, sd = sigma) y <- 4 - 0.4*x + epsilon return(y) } ``` Tras ello podemos aplicar la función a un vector de sigmas (y que nos devuelva una tabla) ```r sigmas <- seq(0.001, 2, l = 20) y <- sigmas %>% map_dfc(regresion_sigma, n, x) %>% tibble() ``` --- # Paréntesis: .orange[BONDAD DE AJUSTE] Convertimos dicha salida a tidy para juntarlo con la X (la repetimos 20 veces porque X no cambia) ```r datos <- tibble("x" = rep(x, each = 20), "y" = y %>% pivot_longer(cols = everything(), names_to = NULL, values_to = "y") %>% pull(y), "sigma" = rep(round(sigmas, 5), n)) datos ``` ``` > # A tibble: 60,000 × 3 > x y sigma > <dbl> <dbl> <dbl> > 1 -0.0170 4.01 0.001 > 2 -0.0170 4.03 0.106 > 3 -0.0170 3.96 0.211 > 4 -0.0170 3.62 0.317 > 5 -0.0170 3.93 0.422 > 6 -0.0170 3.85 0.527 > 7 -0.0170 3.19 0.632 > 8 -0.0170 4.83 0.737 > 9 -0.0170 4.50 0.843 > 10 -0.0170 4.67 0.948 > # … with 59,990 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # Paréntesis: .orange[BONDAD DE AJUSTE] .pull-left[ Dichos datos podemos visualizarlos junto con el ajuste. **.bg-purple_light[¿Por qué la recta es igual para todos?]** ```r ggplot(datos, aes(x = x, y = y)) + geom_point(size = 0.5, alpha = 0.5) + geom_smooth(method = lm, se = FALSE, size = 0.5) + facet_wrap(~sigma) + theme_minimal() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1011-1.png" width="90%" /> ] --- # Paréntesis: .orange[BONDAD DE AJUSTE] .pull-left[ Dado que las diferencias entre datos no se deben a la parte determinística (lo que busca modelizar el ajuste) sino a la parte estocástica (con un rudio de mayor o menor varianza), el modelo ajustado es exactamente el mismo pero el `\(R^2\)` empeora según aumenta el ruido. **.bg-purple_light[¿La separación de los datos respecto a la recta se debe a un peor modelo?]** La bondad de ajuste no solo va a depender de lo bueno o malo que sea nuestro modelo sino del **.bg-purple_light[error irreductible]**, de la cantidad de ruido presente en los datos, por lo que deberemos combinarlo con una visualización o análisis de los residuos estimados. ```r reg_fit_starwars$fit$fit$fit$residuals ``` ``` > 1 2 3 4 5 6 > 0.4665340 35.1136645 -26.9901207 14.1655570 1.4769125 -40.7550773 > 7 8 9 10 11 12 > -34.0731488 21.0617719 -6.6268726 14.9780113 2.5288051 27.4250199 > 13 14 15 16 17 18 > 10.4976696 6.2063386 -2.5853586 14.4250199 1.4250199 43.4457770 > 19 20 21 22 23 24 > -3.6268726 5.4665340 -50.2288266 -31.1976910 17.1136645 -0.5853586 > 25 26 27 28 29 30 > 22.1863141 0.3627488 -1.5438445 -3.6061156 -21.2324890 -35.0731488 > 31 32 33 34 35 36 > 10.4146414 24.1655570 5.5184266 2.1032859 17.7571325 31.0929074 > 37 38 39 40 41 42 > 9.4250199 5.4665340 -0.7306578 -6.6995222 -31.9937832 -3.5749801 > 43 44 45 46 > -40.1598394 -49.9382281 42.5080481 4.4250199 ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1013-1.png" width="90%" /> ] --- # Paréntesis: .orange[BONDAD DE AJUSTE] .pull-left[ De hecho si calculamos el `\(R^2\)` de cada modelo vemos que, aunque la parte determinística subyacente es la misma (es decir, el ajuste debe ser el mismo, como así es), el `\(R^2\)` decrece. ```r bondad_ajuste <- datos %>% group_by(sigma) %>% summarise(R2 = summary(lm(y ~ x))$r.squared) ggplot(bondad_ajuste, aes(x = sigma, y = R2)) + geom_line(size = 2.5) + theme_minimal() + labs(x = "Sigma (desv. típica del ruido)", y = "Bondad de ajuste") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1015-1.png" width="90%" /> ] --- name: reg-gapminder # .orange[REGRESIÓN]: .green[PREPROCESAMIENTO] En el caso de `gapminder`. * **.bg-purple_light[Variable objetivo]**: `lifeExp` es numérica continua. * **.bg-purple_light[Predictora]**: tenemos varias para elegir como predictora. ¿Cuál elegimos? ```r gapminder %>% select(where(is.numeric)) %>% cor() ``` ``` > year lifeExp pop gdpPercap > year 1.00000000 0.43561122 0.08230808 0.22731807 > lifeExp 0.43561122 1.00000000 0.06495537 0.58370622 > pop 0.08230808 0.06495537 1.00000000 -0.02559958 > gdpPercap 0.22731807 0.58370622 -0.02559958 1.00000000 ``` --- # .orange[REGRESIÓN]: .green[PREPROCESAMIENTO] .pull-left[ ```r library(corrplot) gapminder %>% select(where(is.numeric)) %>% cor() %>% corrplot() ``` La mejor predictora a priori será `gdpPercap` ya que es la que tiene una correlación más elevada (en valor absoluto). Recuerda que en una **.bg-purple_light[reg. lineal univariante la bondad de ajuste es igual a la correlación al cuadrado]** ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1018-1.png" width="90%" /> ] --- # .orange[REGRESIÓN]: .green[PREPROCESAMIENTO] * **.bg-purple_light[Ausentes y outliers]**: una regresión no admite ausentes y es **.bg-purple_light[muy sensible a valores atípicos]**. En el caso de `{gapminder}` no tenemos ausentes ```r gapminder %>% filter(if_any(everything(), is.na)) ``` ``` > # A tibble: 0 × 6 > # … with 6 variables: country <fct>, continent <fct>, year <int>, > # lifeExp <dbl>, pop <int>, gdpPercap <dbl> > # ℹ Use `colnames()` to see all variable names ``` --- # .orange[REGRESIÓN]: .green[OUTLIERS] .pull-left[ En el caso de gapminder no se aprecia a priori ningún atípico pero si se observa que la relación no es lineal sino logarítmica ```r ggplot(gapminder, aes(x = gdpPercap, y = lifeExp)) + geom_point(aes(color = continent), size = 2.5) + geom_smooth(method = "lm", se = FALSE) + scale_color_colorblind() + scale_x_continuous( labels = label_dollar(accuracy = 1)) + scale_y_continuous( labels = label_number(suffix = " años")) + theme_minimal() + labs(x = "Renta per cápita", y = "Esperanza de vida", title = "Regresión esperanza de vida vs renta", color = "Continente") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1021-1.png" width="90%" /> ] --- # .orange[REGRESIÓN]: .green[DATAVIZ] .pull-left[ Con `scale_x_log10()` vamos a realizar el gráfico pero tomando escala logarítmica ```r ggplot(gapminder_1997, aes(x = gdpPercap, y = lifeExp)) + geom_point(aes(color = continent), size = 2.5) + geom_smooth(method = "lm", se = FALSE) + scale_color_colorblind() + scale_x_log10() + scale_y_continuous( labels = label_number(suffix = " años")) + theme_minimal() + labs(x = "Renta per cápita", y = "Esperanza de vida", title = "Regresión esperanza de vida vs renta", color = "Continente") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1023-1.png" width="100%" /> ] --- # .orange[REGRESIÓN]: .green[TRANSFORMAR] Por lo visto en los gráficos, vamos a tener que transformar nuestra variable X tomando logaritmos. Vamos a **.bg-purple_light[aplicar dicha transformación]** para poder analizar la distribución de los datos y detección de outliers, aunque luego la incluiremos dentro de la receta (ya que no queremos perder los datos originales y es una transformación concreta para un modelo - lineal - concreto). ```r gapminder_log <- gapminder %>% mutate(gdpPercap = log(gdpPercap)) gapminder_log %>% select(where(is.numeric)) %>% cor() ``` ``` > year lifeExp pop gdpPercap > year 1.00000000 0.43561122 0.08230808 0.23332777 > lifeExp 0.43561122 1.00000000 0.06495537 0.80761788 > pop 0.08230808 0.06495537 1.00000000 -0.05504261 > gdpPercap 0.23332777 0.80761788 -0.05504261 1.00000000 ``` Fíjate la **.bg-purple_light[subida de la correlación]** entre predictora y objetivo. --- # .orange[REGRESIÓN]: .green[DATAVIZ] .pull-left[ Fíjate que en renta per cápita no se aprecian datos atípicos pero si en la esperanza de vida (en África) ```r ggplot(gapminder_1997, aes(x = gdpPercap, y = lifeExp)) + geom_point(aes(color = continent), size = 2.5) + geom_smooth(method = "lm", se = FALSE) + scale_color_colorblind() + scale_x_log10() + scale_y_continuous(labels = label_number(suffix = " años")) + theme_minimal() + labs(x = "Renta per cápita", y = "Esperanza de vida", title = "Regresión esperanza de vida vs renta", color = "Continente") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1026-1.png" width="90%" /> ] --- # .orange[REGRESIÓN]: .green[DATAVIZ] .pull-left[ Es más o menos simétrica pero con una pecularidad: parece que tiene una distribución bimodal. ```r ggplot(gapminder_log, aes(x = gdpPercap)) + geom_density(fill = "#5263CF", color = "#5263CF", alpha = 0.6) + theme_minimal() + labs(x = "Renta per cápita", y = "Frecuencia") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1028-1.png" width="90%" /> ] --- # .orange[REGRESIÓN]: .green[OUTLIERS] Vamos a detectar si tenemos o no outliers (en la predictora) de manera numérica ```r gapminder_log %>% mutate(outliers = abs(scores(gdpPercap, type = "z")) > 2) %>% filter(outliers) ``` ``` > # A tibble: 13 × 7 > country continent year lifeExp pop gdpPercap outliers > <fct> <fct> <int> <dbl> <int> <dbl> <lgl> > 1 Congo, Dem. Rep. Africa 2002 45.0 55379852 5.49 TRUE > 2 Congo, Dem. Rep. Africa 2007 46.5 64606759 5.63 TRUE > 3 Kuwait Asia 1952 55.6 160000 11.6 TRUE > 4 Kuwait Asia 1957 58.0 212846 11.6 TRUE > 5 Kuwait Asia 1962 60.5 358266 11.5 TRUE > 6 Kuwait Asia 1967 64.6 575003 11.3 TRUE > 7 Kuwait Asia 1972 67.7 841934 11.6 TRUE > 8 Kuwait Asia 1977 69.3 1140357 11.0 TRUE > 9 Kuwait Asia 2007 77.6 2505559 10.8 TRUE > 10 Norway Europe 2002 79.0 4535591 10.7 TRUE > 11 Norway Europe 2007 80.2 4627926 10.8 TRUE > 12 Singapore Asia 2007 80.0 4553009 10.8 TRUE > 13 United States Americas 2007 78.2 301139947 10.7 TRUE ``` La mayoría son los registros de Kuwait así que vamos a decidir eliminarlos todos los registros de dicho país. ```r gapminder_log <- gapminder_log %>% filter(country != "Kuwait") ``` --- # .orange[REGRESIÓN]: .green[RECETA] Así la receta queda de la siguiente manera (63%-27%-10%) ```r # Partición split_gapminder <- initial_split(gapminder, prop = 0.9) train_gapminder <- training(split_gapminder) test_gapminder <- testing(split_gapminder) # Validación validation_gapminder <- validation_split(train_gapminder, prop = 0.7) # Receta rec_reg_gapminder <- # Fórmula y datos recipe(data = train_gapminder %>% filter(country != "Kuwait"), lifeExp ~ gdpPercap) %>% step_log(gdpPercap, base = 10) %>% # los demás imputamos por la media step_mutate(gdpPercap = ifelse(abs(scores(gdpPercap, type = "z")) > 2, NA, gdpPercap)) %>% step_impute_mean(gdpPercap) rec_reg_gapminder ``` ``` > Recipe > > Inputs: > > role #variables > outcome 1 > predictor 1 > > Operations: > > Log transformation on gdpPercap > Variable mutation for ifelse(abs(scores(gdpPercap, type = "z")) ... > Mean imputation for gdpPercap ``` --- # .orange[REGRESIÓN]: .green[AJUSTE] Fíjate que el modelo es el mismo, así que no hace falta redefinirlo ```r reg_wflow_gapminder <- workflow() %>% add_model(reg_lineal) %>% add_recipe(rec_reg_gapminder) reg_wflow_gapminder ``` ``` > ══ Workflow ════════════════════════════════════════════════════════════════════ > Preprocessor: Recipe > Model: linear_reg() > > ── Preprocessor ──────────────────────────────────────────────────────────────── > 3 Recipe Steps > > • step_log() > • step_mutate() > • step_impute_mean() > > ── Model ─────────────────────────────────────────────────────────────────────── > Linear Regression Model Specification (regression) > > Computational engine: lm ``` --- # .orange[REGRESIÓN]: .green[AJUSTE] Tras definir el flujo entrenamos y validamos igual que en modelos anteriores (aquí no tenemos parámetros a optimizar, así que no tenemos `tune_grid()`) ```r reg_fit_gapminder <- reg_wflow_gapminder %>% fit_resamples(resamples = validation_gapminder) ``` En el caso de la regresión, `collect_metrics()` nos devuelve dos métricas: el error cuadrático medio o rmse (la raíz cuadrada de la media de los residuales al cuadrado, también conocida como la raíz de la varianza residual) y rsq (la bondad de ajuste que hemos llamado `\(R^2\)` anteriormente) ```r reg_fit_gapminder %>% collect_metrics() ``` ``` > # A tibble: 2 × 6 > .metric .estimator mean n std_err .config > <chr> <chr> <dbl> <int> <dbl> <fct> > 1 rmse standard 7.34 1 NA Preprocessor1_Model1 > 2 rsq standard 0.672 1 NA Preprocessor1_Model1 ``` --- # .orange[REGRESIÓN]: .green[AJUSTE] Dado que en una regresión no hay parámetros a elegir, **.bg-purple_light[la validación no nos sirve de mucho ya que no hay nada que decidir]**: la expresión de un ajuste de regresión es explícita. Así que vamos a ajustar con `fit()` a todo el train. ```r reg_fit_gapminder <- reg_wflow_gapminder %>% fit(train_gapminder) tidy(reg_fit_gapminder) ``` ``` > # A tibble: 2 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) -11.3 1.33 -8.49 4.82e-17 > 2 gdpPercap 20.0 0.371 53.9 0 ``` * La predicción de la esperanza de vida es -10.927 si el **.bg-purple_light[LOGARITMO de la renta]** per cápita (ojo que nuestra X la hemos transformado) es nula, es decir, si la renta per cápita es de 1$ * Por cada unidad que se **.bg-purple_light[incrementa el logaritmo de la renta per cápita]** sube 19.937 años la esperanza de vida. Es decir, si la renta per cápita se **.bg-purple_light[multiplica por 10]** (es decir su logaritmo aumenta una unidad), la renta aumenta 19.937 años. --- # .orange[REGRESIÓN]: .green[DIAGNOSIS] .pull-left[ Veamos en detalle en que consiste la fase de diagnosis haciendo uso de la función anteriormente mencionada del paquete `{performance}` ```r library(performance) check_model(reg_fit_gapminder %>% extract_fit_engine()) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1037-1.png" width="95%" /> ] --- # .orange[REGRESIÓN]: .green[DIAGNOSIS] .pull-left[ 1. **.bg-purple_light[Linealidad]**: el gráfico titulado `linearity` es un diagrama de dispersión de predicciones (eje X) vs residuos (eje Y). Bajo hipótesis de linealidad, lo esperable es que no exista tendencia significativa ✅ **.bg-green_light[Linealidad superada]** ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1038-1.png" width="95%" /> ] --- # .orange[REGRESIÓN]: .green[DIAGNOSIS] Además de visualizar podemos comprobarlo analíticamente con un **.bg-purple_light[ANOVA de los predictores vs los residuos]** ```r ajuste <- reg_fit_gapminder %>% extract_fit_engine() lm(ajuste$residuals ~ ajuste$fitted.values) %>% anova() ``` ``` > Analysis of Variance Table > > Response: ajuste$residuals > Df Sum Sq Mean Sq F value Pr(>F) > ajuste$fitted.values 1 0 0.000 0 1 > Residuals 1531 89291 58.322 ``` El ANOVA está constrastando el modelo `\(\hat{\epsilon} = \beta_0 + \beta_1 \hat{y}\)` tal que la **.bg-purple_light[hipótesis nula]** será `\(\mathcal{H}_0:~\beta_1 = 0\)`. Si el p-valor `Pr(>F)` de la prueba F realizada es muy pequeño, deberíamos rechazar la hipótesis nula. En este caso no lo es, por lo que no parece existir tendencia lineal entre residuos y predictores --- # .orange[REGRESIÓN]: .green[DIAGNOSIS] ¿Y si tuviésen una **.bg-purple_light[relación cuadrática]**? Con `I()` le indicamos que la fórmula debe ser interpretado en sentido aritmético) ```r lm(ajuste$residuals ~ I(ajuste$fitted.values^2) + ajuste$fitted.values) %>% anova() ``` ``` > Analysis of Variance Table > > Response: ajuste$residuals > Df Sum Sq Mean Sq F value Pr(>F) > I(ajuste$fitted.values^2) 1 1 0.715 0.0123 0.9118 > ajuste$fitted.values 1 96 95.687 1.6414 0.2003 > Residuals 1530 89195 58.297 ``` El ANOVA está constrastando el modelo `\(\hat{\epsilon} = \beta_0 + \beta_1 \hat{y} + \beta_2 \hat{y}^2\)` tal que la **.bg-purple_light[hipótesis nula]** será `\(\mathcal{H}_0:~\beta_1 = \beta_2 = 0\)`. Si el p-valor `Pr(>F)` de la prueba F realizada es muy pequeño, deberíamos rechazar la hipótesis nula. En este caso no lo es, por lo que no parece existir tampoco tendencia cuadrática entre residuos y predictores --- # .orange[REGRESIÓN]: .green[DIAGNOSIS] .pull-left[ 2. **.bg-purple_light[Homocedasticidad]** (varianza finita y constante de los residuos): el gráfico titulado `homogeneity of variance` nos contrasta la raíz cuadrada del valor absoluto de los residuos estandarizados frente a las predicctiones (se conoce como gráfico de escala-localización). Deberíamos obtener un gráfico cuya recta de regresión saliese casi plana en torno al 1 ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1041-1.png" width="95%" /> ] --- # .orange[REGRESIÓN]: .green[DIAGNOSIS] Además de visualizarlo podemos comprobarlo analíticamente realizando un test de heterocedasticidad con la función `check_heteroscedasticity()` del paquete `{performance}` ```r check_heteroscedasticity(ajuste) ``` ``` > Warning: Heteroscedasticity (non-constant error variance) detected (p < .001). ``` **.bg-red_light[Homecedasticidad de los residuos no superada]**: deberíamos probar a transformar la predictora (lo típico es tomar raíz cuadrada o logaritmo para variables no negativos, o transformaciones de Yeo-Johnson si toma valores negativos) o probar algún otro modelo, aunque es la hipótesis más "complicada" de cumplir (y casi nunca se suele cumplir al 100%). --- # .orange[REGRESIÓN]: .green[DIAGNOSIS] .pull-left[ Lo importante es que la recta de regresión al dibujar los residuos no se aprecia una banda cuya anchura se modifique, más o menos constante ```r ggplot( tibble("obs" = 1:length(ajuste$residuals), "res" = ajuste$residuals), aes(x = obs, y = res)) + geom_point() + geom_smooth(method = "lm", se = FALSE) + theme_minimal() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1044-1.png" width="100%" /> ] --- # .orange[REGRESIÓN]: .green[DIAGNOSIS] .pull-left[ 3. **.bg-purple_light[Normalidad de los residuos]**: el gráfico titulado `normality of residuals` nos visualiza un gráfico QQ-plot, mostrando los percentiles teóricos de una normal (la línea diagonal) frente a los percentiles empíricos de nuestros residuos. Bajo normalidad, los puntos deberían estar en torno a la diagonal (suele ser habitual que se alejen los extremos) La función de densidad teórico vs empírica se muestra en la segunda gráfica `normality of residuals` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1045-1.png" width="95%" /> ] --- # .orange[REGRESIÓN]: .green[DIAGNOSIS] Además de visualmente podemos comporbarlo analíticamente con contrates de normalidad, usando `ols_test_normality()` del paquete `{olsrr}` ```r library(olsrr) ols_test_normality(ajuste$residuals) ``` ``` > ----------------------------------------------- > Test Statistic pvalue > ----------------------------------------------- > Shapiro-Wilk 0.9781 0.0000 > Kolmogorov-Smirnov 0.0781 0.0000 > Cramer-von Mises 111.868 0.0000 > Anderson-Darling 10.8189 0.0000 > ----------------------------------------------- ``` **.bg-red_light[No supera el test de normalidad de residuos]**: una opción muy habitual para que lo cumpla es transformar la objetivo tomando raíz cuadrada, logaritmo o transformaciones Box-Cox para variables positivas, o transformaciones Yeo-Johnson para variables que puedan tomar valores negativos. --- # .orange[REGRESIÓN]: .green[TRANSFORMACIONES] La **.bg-purple_light[transformación de Box-Cox]** se define como `$$Y^{(\lambda)} = \frac{Y^{\lambda} - 1}{\lambda} \text{ si } \lambda\neq0, \quad Y^{(\lambda)} =log(Y) \text{ si } \lambda=0$$` La **.bg-purple_light[transformación de Yeo-Johnson]** se define como `$$Y^{(\lambda)} = \frac{(Y + 1)^{\lambda} - 1}{\lambda} \text{ si } \lambda\neq0,y \geq 0 \quad Y^{(\lambda)} =log(Y+1) \text{ si } \lambda=0,y \geq 0$$` `$$Y^{(\lambda)} = \frac{-(-Y + 1)^{2-\lambda} - 1}{2 - \lambda} \text{ si } \lambda\neq2,y < 0 \quad Y^{(\lambda)} =-log(-Y+1) \text{ si } \lambda=2,y < 0$$` Ambas se puede probar en la receta con `step_YeoJohnson()`, `step_BoxCox()`, o con `step-sqrt()`. Tampoco te vuelvas loco: son hipótesis que se deberían cumplir ASINTÓTICAMENTE (es decir, con muestra grande) --- # .orange[REGRESIÓN]: .green[DIAGNOSIS] **.bg-purple_light[Incorrelación de residuos]**: no nos lo da la función de `check_model()` pero podemos calcularlo fácilmente con `durbinWatsonTest()`, del paquete `{car}`. Lo que hace es comparar los residuos con sus retardos (lageados). ```r library(car) durbinWatsonTest(ajuste) ``` ``` > lag Autocorrelation D-W Statistic p-value > 1 0.00280418 1.994163 0.91 > Alternative hypothesis: rho != 0 ``` No hay evidencia suficiente para rechazar la hipótesis nula: **.bg-green_light[no podemos rechazar que estén incorrelados]** --- # .orange[REGRESIÓN]: .green[DIAGNOSIS] .pull-left[ 5. **.bg-purple_light[valores influyentes (extra)]**: el gráfico titulado `influential observations` nos visualiza el impacto atípico que puedan tener algunas observaciones. Diferencia dos tipos: **.bg-purple_light[outliers]** (valor atípico de la respuesta pudiendo perturbar la varianza residual) y **.bg-purple_light[high-leverage points]** con valor atípico en alguna de las predictoras ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1048-1.png" width="95%" /> ] --- # .orange[REGRESIÓN]: .green[EVALUACIÓN] Con `glance()` obtenemos el resumen de la evaluación del modelo ```r glance(reg_fit_starwars) ``` ``` > # A tibble: 1 × 12 > r.squared adj.r.squa…¹ sigma stati…² p.value df logLik AIC BIC devia…³ > <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> > 1 0.585 0.575 23.3 61.9 6.26e-10 1 -209. 424. 430. 23874. > # … with 2 more variables: df.residual <int>, nobs <int>, and abbreviated > # variable names ¹adj.r.squared, ²statistic, ³deviance > # ℹ Use `colnames()` to see all variable names ``` --- # .orange[REGRESIÓN]: .green[PREDICCIÓN] Por último podemos predecir y evaluar en test como hacíamos en modelos anteriores ```r # Predecimos en tst fit_gapminder <- reg_wflow_gapminder %>% last_fit(split = split_gapminder) # Evaluamos en test fit_gapminder %>% collect_metrics() ``` ``` > # A tibble: 2 × 4 > .metric .estimator .estimate .config > <chr> <chr> <dbl> <fct> > 1 rmse standard 6.81 Preprocessor1_Model1 > 2 rsq standard 0.691 Preprocessor1_Model1 ``` ```r # Errores en test pred_test <- fit_gapminder %>% collect_predictions() %>% mutate(error = lifeExp - .pred) ``` --- # .orange[REGRESIÓN]: .green[DATAVIZ] .pull-left[ Si pintamos los valores reales frente a las predicciones, si el modelo fuese fiable (que por el bajo tamaño muestral y el bajo `\(R^2\)` ya podíamos intuir que no), deberían estar cerca de la diagonal. ```r # Gráficos en test ggplot(data = pred_test, mapping = aes(x = .pred, y = lifeExp)) + geom_point(color = "#006EA1", alpha = 0.6, size = 4) + # Diagonal geom_abline(intercept = 0, slope = 1, color = "orange", size = 1.2) + theme_minimal() + labs(title = "Resultados regresión lineal univariante", subtitle = "Valores deberían estar cercanos a la diagonal", caption = "Autor: Javier Álvarez Liébana | Datos: gapminder", x = "Predicciones", y = "Valores reales") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1052-1.png" width="90%" /> ] --- name: reg-multi # .orange[REGRESIÓN] .green[MULTIVARIANTE] Veamos un ejemplo más complicado, el famoso Boston dataset, que tenemos en el archivo `Boston.xlsx` (necesitamos `read_xlsx()` de la librería `{readxl}`) ```r library(readxl) boston <- read_xlsx(path = "./datos/Boston.xlsx") glimpse(boston) ``` ``` > Rows: 506 > Columns: 14 > $ crim <dbl> 0.00632, 0.02731, 0.02729, 0.03237, 0.06905, 0.02985, 0.08829,… > $ zn <dbl> 18.0, 0.0, 0.0, 0.0, 0.0, 0.0, 12.5, 12.5, 12.5, 12.5, 12.5, 1… > $ indus <dbl> 2.31, 7.07, 7.07, 2.18, 2.18, 2.18, 7.87, 7.87, 7.87, 7.87, 7.… > $ chas <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,… > $ nox <dbl> 0.538, 0.469, 0.469, 0.458, 0.458, 0.458, 0.524, 0.524, 0.524,… > $ rm <dbl> 6.575, 6.421, 7.185, 6.998, 7.147, 6.430, 6.012, 6.172, 5.631,… > $ age <dbl> 65.2, 78.9, 61.1, 45.8, 54.2, 58.7, 66.6, 96.1, 100.0, 85.9, 9… > $ dis <dbl> 4.0900, 4.9671, 4.9671, 6.0622, 6.0622, 6.0622, 5.5605, 5.9505… > $ rad <dbl> 1, 2, 2, 3, 3, 3, 5, 5, 5, 5, 5, 5, 5, 4, 4, 4, 4, 4, 4, 4, 4,… > $ tax <dbl> 296, 242, 242, 222, 222, 222, 311, 311, 311, 311, 311, 311, 31… > $ ptratio <dbl> 15.3, 17.8, 17.8, 18.7, 18.7, 18.7, 15.2, 15.2, 15.2, 15.2, 15… > $ black <dbl> 396.90, 396.90, 392.83, 394.63, 396.90, 394.12, 395.60, 396.90… > $ lstat <dbl> 4.98, 9.14, 4.03, 2.94, 5.33, 5.21, 12.43, 19.15, 29.93, 17.10… > $ medv <dbl> 24.0, 21.6, 34.7, 33.4, 36.2, 28.7, 22.9, 27.1, 16.5, 18.9, 15… ``` --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] El dataset está basado en el **.bg-purple_light[estudio que realizaron Harrison and Rubinfeld]**, en 1978, en el que se pretende determinar la **.bg-purple_light[disposición de los compradores para pagar más por una vivienda]** en un entorno con mayor calidad del aire. El conjunto de datos contiene datos del **.bg-purple_light[área metropolitana de Boston]**, con datos de 560 vecindarios, midiendo 14 variables en cada uno. Las variables están totalmente descritas en <https://www.sciencedirect.com/science/article/abs/pii/0095069678900062?via%3Dihub> --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] * **.bg-purple_light[Variable objetivo]**: la variable `medv` que representa la **.bg-purple_light[mediana del precio inmobiliario]** (en miles de dolares). * **.bg-orange[Variables arquitectónicas]**: variables `rm` (número medio de habitaciones) y `age` (porcentaje de propiedades construidas antes de 1940). * **.bg-orange[Variables de vecindario]**: variables `crim` (tasa de criminalidad), `zn` (% del territorio destinado a áreas residenciales), `indus` (% del territorio destinado al tejido industrial), `chas` (¿hay río limitando la extensión en el territorio?) y `tax` (coste de los servicios públicos) * **.bg-orange[Variables socioeconómicas]**: variables `ptratio` (ratio alumno-profesor), `black` (índice de población negra - sí, es un archivo vergonzoso, pero no viene mal ver los sesgo raciales de muchos de los datos que consumimos - calculada como `\(1000 (B - 0.63)^2\)`, donde `\(B\)` es el % de población negra) y `lstat` (porcentaje de la población con bajos ingresos). * **.bg-orange[Variables de accesibilidad]**: variables `dis` (distancia a oficinas de empleo) y `rad` (categoría indicando la accesibilidad a la red de autopistas, a mayor índice, mayor accesibilidad). * **.bg-orange[Variables de calidad del aire]**: variable `nox` (concentración anual de óxido de nitrógeno). --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] * **.bg-purple_light[Variable objetivo]**: ya es numérica * **.bg-purple_light[Variable predictora]**: son todas numéricas (algunas como `rad` en realidad sería cualitativas, pero ya están expresados en niveles numéricos), pero si queremos hacer un modelo univariante necesitaremos decidir con cuál nos quedamos. Por tanto una de las primeras ideas es **.bg-purple_light[calcular la correlación de las variables]** ```r # Calculamos matriz de correlaciones (cor(Xi, Xj)) redondeando boston %>% cor() ``` ``` > crim zn indus chas nox > crim 1.00000000 -0.20046922 0.40658341 -0.055891582 0.42097171 > zn -0.20046922 1.00000000 -0.53382819 -0.042696719 -0.51660371 > indus 0.40658341 -0.53382819 1.00000000 0.062938027 0.76365145 > chas -0.05589158 -0.04269672 0.06293803 1.000000000 0.09120281 > nox 0.42097171 -0.51660371 0.76365145 0.091202807 1.00000000 > rm -0.21924670 0.31199059 -0.39167585 0.091251225 -0.30218819 > age 0.35273425 -0.56953734 0.64477851 0.086517774 0.73147010 > dis -0.37967009 0.66440822 -0.70802699 -0.099175780 -0.76923011 > rad 0.62550515 -0.31194783 0.59512927 -0.007368241 0.61144056 > tax 0.58276431 -0.31456332 0.72076018 -0.035586518 0.66802320 > ptratio 0.28994558 -0.39167855 0.38324756 -0.121515174 0.18893268 > black -0.38506394 0.17552032 -0.35697654 0.048788485 -0.38005064 > lstat 0.45562148 -0.41299457 0.60379972 -0.053929298 0.59087892 > medv -0.38830461 0.36044534 -0.48372516 0.175260177 -0.42732077 > rm age dis rad tax ptratio > crim -0.21924670 0.35273425 -0.37967009 0.625505145 0.58276431 0.2899456 > zn 0.31199059 -0.56953734 0.66440822 -0.311947826 -0.31456332 -0.3916785 > indus -0.39167585 0.64477851 -0.70802699 0.595129275 0.72076018 0.3832476 > chas 0.09125123 0.08651777 -0.09917578 -0.007368241 -0.03558652 -0.1215152 > nox -0.30218819 0.73147010 -0.76923011 0.611440563 0.66802320 0.1889327 > rm 1.00000000 -0.24026493 0.20524621 -0.209846668 -0.29204783 -0.3555015 > age -0.24026493 1.00000000 -0.74788054 0.456022452 0.50645559 0.2615150 > dis 0.20524621 -0.74788054 1.00000000 -0.494587930 -0.53443158 -0.2324705 > rad -0.20984667 0.45602245 -0.49458793 1.000000000 0.91022819 0.4647412 > tax -0.29204783 0.50645559 -0.53443158 0.910228189 1.00000000 0.4608530 > ptratio -0.35550149 0.26151501 -0.23247054 0.464741179 0.46085304 1.0000000 > black 0.12806864 -0.27353398 0.29151167 -0.444412816 -0.44180801 -0.1773833 > lstat -0.61380827 0.60233853 -0.49699583 0.488676335 0.54399341 0.3740443 > medv 0.69535995 -0.37695457 0.24992873 -0.381626231 -0.46853593 -0.5077867 > black lstat medv > crim -0.38506394 0.4556215 -0.3883046 > zn 0.17552032 -0.4129946 0.3604453 > indus -0.35697654 0.6037997 -0.4837252 > chas 0.04878848 -0.0539293 0.1752602 > nox -0.38005064 0.5908789 -0.4273208 > rm 0.12806864 -0.6138083 0.6953599 > age -0.27353398 0.6023385 -0.3769546 > dis 0.29151167 -0.4969958 0.2499287 > rad -0.44441282 0.4886763 -0.3816262 > tax -0.44180801 0.5439934 -0.4685359 > ptratio -0.17738330 0.3740443 -0.5077867 > black 1.00000000 -0.3660869 0.3334608 > lstat -0.36608690 1.0000000 -0.7376627 > medv 0.33346082 -0.7376627 1.0000000 ``` --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] .pull-left[ ```r boston %>% cor() %>% corrplot.mixed() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1056-1.png" width="95%" /> ] --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] Podemos deducir que si el objetivo es **.bg-purple_light[predecir medv]** mediante una reg. lineal univariante las **.bg-purple_light[variables más determinantes]** (más correladas en valor absoluto) serían * `lstat` (proporción de gente de clase baja) * `rm` (nº medio de habitaciones) -- Dicha relación la podemos medir de una forma más rigurosa realizando un contraste de correlación con `cor.test()` (en ambos casos observamos un p-valor ínfimo --> rechazamos la hipótesis nula de incorrelación) ```r # medv vs lstat cor.test(boston$medv, boston$lstat) ``` ``` > > Pearson's product-moment correlation > > data: boston$medv and boston$lstat > t = -24.528, df = 504, p-value < 2.2e-16 > alternative hypothesis: true correlation is not equal to 0 > 95 percent confidence interval: > -0.7749982 -0.6951959 > sample estimates: > cor > -0.7376627 ``` ```r # medv vs rm cor.test(boston$medv, boston$rm) ``` ``` > > Pearson's product-moment correlation > > data: boston$medv and boston$rm > t = 21.722, df = 504, p-value < 2.2e-16 > alternative hypothesis: true correlation is not equal to 0 > 95 percent confidence interval: > 0.6474346 0.7378075 > sample estimates: > cor > 0.6953599 ``` --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] .pull-left[ ```r boston_tidy <- boston %>% pivot_longer(cols = c("lstat", "rm"), names_to = "var", values_to = "values") ggplot(boston_tidy, aes(x = values, y = medv, color = var)) + geom_point(alpha = 0.7) + geom_smooth(method = "lm", se = FALSE) + theme_minimal() + labs(x = "predictora", y = "objetivo", color = "variable") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1059-1.png" width="90%" /> ] --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] .pull-left[ ```r ggplot(boston_tidy, aes(x = values, fill = var)) + geom_density(alpha = 0.5) + theme_minimal() + labs(x = "predictora", y = "frecuencia", color = "variable") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1061-1.png" width="90%" /> ] --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] Como antes **.bg-purple_light[definimos las particiones]**, con un 80% de test y un 20% de train ```r # Partición split_boston <- initial_split(boston, prop = 0.8) train_boston <- training(split_boston) test_boston <- testing(split_boston) ``` Vamos a hacer **.bg-purple_light[dos modelos de regresión univariantes]** con las dos variables más correladas, las variables `lstat` y `rm`, definidos como * **.bg-purple_light[Modelo 1]**: `\(medv = \beta_0 + \beta_1*lstat + \epsilon\)` * **.bg-purple_light[Modelo 2]**: `\(medv = \beta_0 + \beta_1*rm + \epsilon\)` --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] Haciendo una receta básica (piensa una receta mejor), la diferencia entre ambos será la primera línea ```r rec_boston_1 <- recipe(data = train_boston, medv ~ lstat) %>% step_mutate(across(all_numeric_predictors(), function(x) { ifelse(abs(scores(x, type = "z")) > 2, NA, x) })) %>% step_impute_mean(all_numeric_predictors()) ``` ```r rec_boston_2 <- recipe(data = train_boston, medv ~ rm) %>% step_mutate(across(all_numeric_predictors(), function(x) { ifelse(abs(scores(x, type = "z")) > 2, NA, x) })) %>% step_impute_mean(all_numeric_predictors()) ``` --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] Y generamos los dos flujos (mismo modelo, distinta receta) ```r wflow_boston_1 <- workflow() %>% add_recipe(rec_boston_1) %>% add_model(reg_lineal) mod1 <- wflow_boston_1 %>% fit(data = train_boston) tidy(mod1) ``` ``` > # A tibble: 2 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) 34.4 0.613 56.1 3.78e-192 > 2 lstat -0.933 0.0424 -22.0 4.84e- 71 ``` ```r wflow_boston_2 <- workflow() %>% add_recipe(rec_boston_2) %>% add_model(reg_lineal) mod2 <- wflow_boston_2 %>% fit(data = train_boston) tidy(mod2) ``` ``` > # A tibble: 2 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) -32.6 2.81 -11.6 4.37e-27 > 2 rm 8.81 0.445 19.8 2.50e-61 ``` --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] ```r tidy(mod1) ``` ``` > # A tibble: 2 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) 34.4 0.613 56.1 3.78e-192 > 2 lstat -0.933 0.0424 -22.0 4.84e- 71 ``` Los **.bg-purple_light[modelos ajustados]** son los siguientes: * **.bg-purple_light[Modelo 1]**: `\(\hat{medv} = -34.352856 - 0.933154∗lstat\)` --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] ```r tidy(mod2) ``` ``` > # A tibble: 2 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) -32.6 2.81 -11.6 4.37e-27 > 2 rm 8.81 0.445 19.8 2.50e-61 ``` * **.bg-purple_light[Modelo 2]**: `\(\hat{medv} = -32.633704 + 8.805604∗rm\)` --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] Amén de la estimación puntual realizada podemos obtener los **.bg-purple_light[intervalos de confianza de la estimación]**: ```r # Al 95% confint(mod1 %>% extract_fit_engine()) ``` ``` > 2.5 % 97.5 % > (Intercept) 33.148434 35.5572785 > lstat -1.016487 -0.8498222 ``` ```r confint(mod2 %>% extract_fit_engine()) ``` ``` > 2.5 % 97.5 % > (Intercept) -38.157607 -27.109802 > rm 7.930666 9.680542 ``` --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] .pull-left[ ```r # Diagnosis gráfica check_model(mod1 %>% extract_fit_engine()) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1071-1.png" width="90%" /> ] --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] .pull-left[ ```r # Diagnosis gráfica check_model(mod2 %>% extract_fit_engine()) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1073-1.png" width="90%" /> ] --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] Sin entrar en la diagnosis numérica, ya se ve que el **.bg-red_light[modelo de regresión lineal univariante no parece la mejor alternativa]**. Podemos hacer la **.bg-purple_light[evaluación de varios modelos]** a la vez con `compare_performance()` ```r # comparativa compare_performance(mod1 %>% extract_fit_engine(), mod2 %>% extract_fit_engine()) ``` ``` > # Comparison of Model Performance Indices > > Name | Model | AIC | AIC_wt | BIC | BIC_wt | R2 | R2 (adj.) | RMSE | Sigma > --------------------------------------------------------------------------------------------- > Model 1 | lm | 2604.415 | 1.000 | 2616.419 | 1.000 | 0.547 | 0.545 | 6.031 | 6.046 > Model 2 | lm | 2649.265 | < 0.001 | 2661.270 | < 0.001 | 0.493 | 0.492 | 6.375 | 6.391 ``` Es ligeramente mejor el modelo 1 con la variable predictora `lstat` pero ambos son bastante mejorables (amén de cumplir ni estar de cerca de cumplir las hipótesis planteadas) --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] Aun así podemos obtener si queremos las **.bg-purple_light[predicciones]** realizando el ajuste en test. ```r # Predecimos en test fit_1 <- wflow_boston_1 %>% last_fit(split = split_boston) fit_2 <- wflow_boston_2 %>% last_fit(split = split_boston) fit_1 %>% collect_metrics() ``` ``` > # A tibble: 2 × 4 > .metric .estimator .estimate .config > <chr> <chr> <dbl> <fct> > 1 rmse standard 6.85 Preprocessor1_Model1 > 2 rsq standard 0.539 Preprocessor1_Model1 ``` ```r fit_2 %>% collect_metrics() ``` ``` > # A tibble: 2 × 4 > .metric .estimator .estimate .config > <chr> <chr> <dbl> <fct> > 1 rmse standard 7.46 Preprocessor1_Model1 > 2 rsq standard 0.470 Preprocessor1_Model1 ``` --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] Con `collect_predictions()` obtenemos las predicciones (podemos juntarlas con `bind_rows()`) ```r # Predicciones + variable de error pred_test1 <- fit_1 %>% collect_predictions() %>% mutate(error = medv - .pred) pred_test2 <- fit_2 %>% collect_predictions() %>% mutate(error = medv - .pred) # las juntamos pred_test <- bind_rows(pred_test1, pred_test2, .id = "var") %>% mutate(var = ifelse(var == "1", "lstat", "rm")) pred_test ``` ``` > # A tibble: 204 × 7 > var id .pred .row medv .config error > <chr> <chr> <dbl> <int> <dbl> <fct> <dbl> > 1 lstat train/test split 25.8 2 21.6 Preprocessor1_Model1 -4.22 > 2 lstat train/test split 30.6 3 34.7 Preprocessor1_Model1 4.11 > 3 lstat train/test split 31.6 4 33.4 Preprocessor1_Model1 1.79 > 4 lstat train/test split 29.4 5 36.2 Preprocessor1_Model1 6.82 > 5 lstat train/test split 18.4 10 18.9 Preprocessor1_Model1 0.504 > 6 lstat train/test split 24.8 15 18.2 Preprocessor1_Model1 -6.58 > 7 lstat train/test split 23.4 19 20.2 Preprocessor1_Model1 -3.24 > 8 lstat train/test split 18.9 26 13.9 Preprocessor1_Model1 -5.05 > 9 lstat train/test split 22.2 32 14.5 Preprocessor1_Model1 -7.68 > 10 lstat train/test split 23.7 37 20 Preprocessor1_Model1 -3.71 > # … with 194 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] .pull-left[ ```r ggplot(pred_test, aes(x = .pred, y = medv, color = var)) + geom_point(size = 2, alpha = 0.6) + geom_abline(intercept = 0, slope = 1, size = 0.9) + theme_minimal() + labs(x = "predictora", y = "objetivo (medv)", color = "variable") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1078-1.png" width="90%" /> ] --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] Por todo lo visto, no parece la mejor idea usar un modelo univariante (recuerda que son los dos mejores modelos univariantes que podíamos haber elegido) **.bg-purple_light[¿Entonces?]** -- Vamos a incluir más predictoras, definiendo un **.bg-purple_light[modelo de reg. multivariante]** * **.bg-purple_light[Modelo teórico]**: dadas una variable objetivo `\(Y\)` y un conjunto `\(p\)` de predictoras `\((X_1, \ldots, X_p)\)`, asumimos que la relación entre ellas se pueda modelar mediante un modelo lineal (una combinación lineal) `$$Y = f(X_1, \ldots, X_p) + \epsilon = \left(\beta_0 + \beta_1X_1 + \beta_pX_p\right) +\epsilon, \quad f:~\mathbb{R}^{p} \to \mathbb{R}$$` `$$\hat{y}_i = \hat{\beta}_0 + \hat{\beta}_1 x_{i, 1} + \ldots + \hat{\beta}_p x_{i, p} \text{ (ajuste)}, \quad \epsilon_i = y_i - \hat{y}_i \text{ (errores)}$$` --- # .orange[REGRESIÓN] .green[MULTIVARIANTE] El objetivo para obtener los **.bg-purple_light[coeficientes]** será el mismo: encontrar aquellos que **.bg-purple_light[minimizan la Sum of Squared Residuals o SSR (método de mínimos cuadrados)]** `$$\hat{\boldsymbol{\beta}} = \arg \min_{\boldsymbol{\beta} \in \mathbb{R}^{p+1}} \sum_{i=1}^{n} \hat{\epsilon}_{i}^2 = \arg \min_{\boldsymbol{\beta} \in \mathbb{R}^{p+1}} \sum_{i=1}^{n} \left[y_i - \left(\beta_0 + \beta_1x_{i,1} + \ldots + \beta_px_{i, p} \right) \right]^2$$` -- La **.bg-purple_light[solución general matricial del método mínimos cuadrados]** se obtiene como sigue: `$$\hat{\boldsymbol{\beta}} = \left(\boldsymbol{X}^{T} \boldsymbol{X} \right)^{-1} \boldsymbol{X}^{T} \boldsymbol{Y}, \quad \boldsymbol{Y} = \left(y_1, \ldots, y_n \right)^{T}, \quad \boldsymbol{X} = \begin{pmatrix} 1 & x_{1,1} & \ldots & x_{1,p} \\ 1 & x_{2,1} & \ldots & x_{2,p} \\ \vdots & \vdots & \ddots & \vdots \\ 1 & x_{n,1} & \ldots & x_{n,p}\end{pmatrix}$$` --- # .orange[HIPÓTESIS] reg. multivariante * **.bg-purple_light[Linealidad]**: se asume que la variable objetivo y las predictoras cumplen (en media) que `$${\rm E} [Y | \left(X_1 = x_1, \ldots, X_p = x_p \right)] = \beta_0 + \beta_1 x_1 + \ldots + \beta_p x_p$$` -- * **.bg-purple_light[Homocedasticidad de los residuos]** los residuos tendrán media cero pero además se pide que `\({\rm Var} [\epsilon | \left(X_1 = x_1, \ldots, X_p = x_p \right) ] = \sigma_{\epsilon}^2\)`, siendo `\(\sigma^2 < \infty\)` una constante (es decir, los residuos visualizados deberán caer en una banda horizontal constante). -- * **.bg-purple_light[Normalidad de los residuos]**: los residuos cumplirán además que `\(\epsilon \sim \mathcal{N} \left(0, \sigma_{\epsilon}^2 \right)\)`. -- * **.bg-purple_light[Residuos incorrelados]**: para cualquier i,j, tendremos que `\({\rm E} [ \epsilon_i \epsilon_j ] = 0\)` -- Todas ellas se resumen en la siguiente `$$(Y | \left(X_1 = x_1, \ldots, X_p = x_p \right)) \sim \mathcal{N} (\beta_0 + \beta_1x_1 + \ldots + \beta_px_p, \sigma_{\epsilon}^2)$$` --- # .orange[INTERPRETACIÓN] reg. multivariante `$$(Y | \left(X_1 = x_1, \ldots, X_p = x_p \right)) \sim \mathcal{N} (\beta_0 + \beta_1x_1 + \ldots + \beta_px_p, \sigma_{\epsilon}^2)$$` * El coeficiente `\(\beta_0\)` representa la ordenada en el origen y sigue siendo el **.bg-purple_light[valor esperado de la respuesta cuando las predictoras son nulas]**, es decir, cuando `\(X_1 = \ldots = X_p = 0\)` * El coeficiente `\(\beta_j\)`, para un `\(j=1,\ldots,p\)`, representa el **.bg-purple_light[incremento medio esperado de la respuesta]** por cada **.bg-purple_light[incremento unitario de la predictora]** `\(X_j\)` asumiendo que el **resto de predictoras** permanecen fijas --- # .orange[INTERPRETACIÓN] reg. multivariante Vamos a hacer la misma receta simple de antes, solo que ahora en la primera línea enfrentamos `medv` a todas las variables ```r rec_boston_multi <- recipe(data = train_boston, medv ~ .) %>% step_mutate(across(all_numeric_predictors(), function(x) { ifelse(abs(scores(x, type = "z")) > 2, NA, x) })) %>% step_impute_mean(all_numeric_predictors()) %>% step_zv(all_predictors()) # filtro cero varianza wflow_multi <- workflow() %>% add_recipe(rec_boston_multi) %>% add_model(reg_lineal) ``` --- # .orange[INTERPRETACIÓN] reg. multivariante ```r mod_multi <- wflow_multi %>% fit(data = train_boston) tidy(mod_multi) ``` ``` > # A tibble: 14 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) 35.9 5.35 6.71 6.75e-11 > 2 crim -0.0990 0.0350 -2.83 4.88e- 3 > 3 zn 0.0441 0.0149 2.97 3.18e- 3 > 4 indus -0.00481 0.0641 -0.0750 9.40e- 1 > 5 chas 1.56 0.899 1.74 8.33e- 2 > 6 nox -16.2 4.03 -4.02 7.03e- 5 > 7 rm 3.73 0.433 8.61 1.85e-16 > 8 age 0.0152 0.0139 1.09 2.76e- 1 > 9 dis -1.43 0.212 -6.76 4.98e-11 > 10 rad 0.287 0.0706 4.07 5.79e- 5 > 11 tax -0.0118 0.00395 -2.99 2.99e- 3 > 12 ptratio -0.971 0.141 -6.87 2.58e-11 > 13 black 0.00902 0.00290 3.11 2.03e- 3 > 14 lstat -0.547 0.0542 -10.1 1.95e-21 ``` El monstruoso modelo queda como $$ medv = 35.9 - 0.099*crim + 0.044*zn - 0.005*indus + 1.561*chas - 16.203*nox + 3.725*rm + 0.0152 * age -1.432 * dis 0.287 * rad - 0.012 * tax - 0.971 * ptratio + 0.009*black - 0.547 * lstat$$ --- # .orange[REG. MULTIVARIANTE] .green[DIAGNOSIS] .pull-left[ Amén de las gráficas ya mencionados, cuando introducimos más variables aparece una nueva gráfica sobre **.bg-purple_light[colinearidad]**, algo que podemos prevenir con `step_corr()` en la receta (ninguna de ellas debe estar en la zona de riesgo marcada en roja). La **.bg-purple_light[multicolinealidad]** puede producir una reducción de la precisión de las estimaciones (incluso invirtiendo el signo de los coeficientes). ```r check_model(mod_multi %>% extract_fit_engine()) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1082-1.png" width="90%" /> ] --- # .orange[REG. MULTIVARIANTE] .green[EVALUACIÓN] Podemos hacer la **.bg-purple_light[evaluación de varios modelos]** a la vez con `compare_performance()` ```r # comparativa compare_performance(mod1 %>% extract_fit_engine(), mod2 %>% extract_fit_engine(), mod_multi %>% extract_fit_engine()) ``` ``` > # Comparison of Model Performance Indices > > Name | Model | AIC | AIC_wt | BIC | BIC_wt | R2 | R2 (adj.) | RMSE | Sigma > --------------------------------------------------------------------------------------------- > Model 1 | lm | 2604.415 | < 0.001 | 2616.419 | < 0.001 | 0.547 | 0.545 | 6.031 | 6.046 > Model 2 | lm | 2649.265 | < 0.001 | 2661.270 | < 0.001 | 0.493 | 0.492 | 6.375 | 6.391 > Model 3 | lm | 2380.547 | 1.00 | 2440.569 | 1.00 | 0.755 | 0.746 | 4.438 | 4.517 ``` Aparentemente, si nos fijamos solo en la bondad de ajuste `\(R^2\)`, parece que hemos mejorado bastante (de explicar el 49-55% de la información a superar el 75%) aunque quizás no lo esperado (¡hemos metido 14 predictoras!). --- # .orange[REG. MULTIVARIANTE] .green[DIAGNOSIS] No solo podemos tener problemas de colinealidad sino **.bg-purple_light[variables que no aporten al modelo]**, variables cuya influencia en la variable objetivo sea no significativo, algo que podemos cotejar en la columna `p.value`: por ejemplo, en `indus` sale un valor de `\(0.94\)`, es decir, que no hay evidencias suficientes para rechazar la hipótesis nula de que `\(\beta_{indus} = 0\)`. Con `\(\alpha = 0.05\)`, también sucede en `chas` y en `age` **.bg-purple_light[¿Cuál quitar y en qué orden?]** ```r tidy(mod_multi) ``` ``` > # A tibble: 14 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) 35.9 5.35 6.71 6.75e-11 > 2 crim -0.0990 0.0350 -2.83 4.88e- 3 > 3 zn 0.0441 0.0149 2.97 3.18e- 3 > 4 indus -0.00481 0.0641 -0.0750 9.40e- 1 > 5 chas 1.56 0.899 1.74 8.33e- 2 > 6 nox -16.2 4.03 -4.02 7.03e- 5 > 7 rm 3.73 0.433 8.61 1.85e-16 > 8 age 0.0152 0.0139 1.09 2.76e- 1 > 9 dis -1.43 0.212 -6.76 4.98e-11 > 10 rad 0.287 0.0706 4.07 5.79e- 5 > 11 tax -0.0118 0.00395 -2.99 2.99e- 3 > 12 ptratio -0.971 0.141 -6.87 2.58e-11 > 13 black 0.00902 0.00290 3.11 2.03e- 3 > 14 lstat -0.547 0.0542 -10.1 1.95e-21 ``` --- # .orange[SELECCIÓN DE MODELOS] Si te has fijado hay unas columnas que no hemos comentado: las que empiezan por **.bg-purple_light[AIC]** y **.bg-purple_light[BIC]** ```r glance(mod_multi) ``` ``` > # A tibble: 1 × 12 > r.squared adj.r.squ…¹ sigma stati…² p.value df logLik AIC BIC devia…³ > <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> > 1 0.755 0.746 4.52 92.2 3.66e-110 13 -1175. 2381. 2441. 7956. > # … with 2 more variables: df.residual <int>, nobs <int>, and abbreviated > # variable names ¹adj.r.squared, ²statistic, ³deviance > # ℹ Use `colnames()` to see all variable names ``` Ambos son dos de los **.bg-purple_light[criterios de información]** más utilizados en la **.bg-purple_light[selección de modelos]**, ya que ambos nos ofrecen una medida que balancea la calidad del modelo frente al número de predictores empleados * **.bg-purple_light[BIC (Bayesian Information Criterion)]**: definido como `\(BIC = -2\mathcal{L}(modelo) + ln(n)*k\)` * **.bg-purple_light[AIC (Akaike Information Criterion)]**: definido como `\(AIC = -2\mathcal{L}(modelo) + 2*k\)` --- # .orange[SELECCIÓN DE MODELOS] * **.bg-purple_light[BIC (Bayesian Information Criterion)]**: definido como `\(BIC = -2\mathcal{L}(modelo) + ln(n)*k\)` * **.bg-purple_light[AIC (Akaike Information Criterion)]**: definido como `\(AIC = -2\mathcal{L}(modelo) + 2*k\)` En ambos, `\(k\)` representa el número de parámetros a estimar (en el caso de la reg. lineal `\(k=p+2\)` ya que debemos estimar `\(p+1\)` y la varianza residual) y `\(\mathcal{L} (modelo)\)` representa la log-verosimilitud del modelo (como de probable es que, si el modelo fuese cierto, hayamos obtenido los resultados que hemos obtenido), definida como `\(ln(P(observado | modelo))\)` --- # .orange[SELECCIÓN DE MODELOS] * **.bg-purple_light[BIC (Bayesian Information Criterion)]**: definido como `\(BIC = -2\mathcal{L}(modelo) + ln(n)*k\)` * **.bg-purple_light[AIC (Akaike Information Criterion)]**: definido como `\(AIC = -2\mathcal{L}(modelo) + 2*k\)` La **.bg-purple_light[principal diferencia]** entre ambos es el **.bg-purple_light[factor de penalización]** (en BIC es `\(ln(n)\)` y en AIC es `\(2\)`), por lo que cuando crece `\(n\)`, **.bg-purple_light[BIC penaliza más el sobreajuste]** (a menor AIC/AIC, mejor). El criterio BIC no solo es recomendable por penalizar más el sobreajuste sino que además es el único de los dos que es consistente (ver Shao, 1993): si el tamaño muestral fuera suficiente grande, el **.bg-purple_light[BIC nos garantiza acabar eligiendo el modelo correcto]**. --- # .orange[SELECCIÓN DE MODELOS] Para ello haremos uso de `stepAIC()` que aún no está disponible en tidymodels (lo estará), así que hornearemos la receta y se la pasaremos manualmente a `lm()` para ejecutar la regresión (a priori contra todas) ```r boston_prep <- bake(rec_boston_multi %>% prep(), new_data = NULL) ajuste_boston_multi <- lm(data = boston_prep, medv ~ .) ``` -- Tras ello haremos uso de la función `stepAIC()` del paquete `{MASS}`, y con el argumento `k = ...` **.bg-purple_light[decidiremos si es BIC o AIC en función de la penalización]** usada. Dados `\(p\)` predictores, `stepAIC()` realiza la búsqueda entre los `\(2^p\)` modelos posibles mediante una **.bg-purple_light[selección stepwise]**: de forma iterativa, irá añadiendo predictoras que nos bajen el AIC/BIC y eliminando aquellas que lo incrementen. --- # .orange[SELECCIÓN DE MODELOS] El **.bg-purple_light[argumento opcional direction]** nos permitirá decidir si queremos que se añaden/eliminen a la vez (`direction = "both"`), se vayan añadiendo desde cero (`direction = "forward"`) o se vayan eliminando desde un modelo saturado (`direction = "backward"`) ```r library(MASS) modAIC <- stepAIC(ajuste_boston_multi, k = 2) modBIC <- stepAIC(ajuste_boston_multi, k = log(nrow(train_boston))) ``` --- # .orange[SELECCIÓN DE MODELOS] En cada paso de la iteración se nos mostrará una lista ordenada de qué variables harían descender más dicho criterio. Tras decidir su siguiente paso, vuelve a mostarnos la información (hasta que llega un punto en el que no hacer nada es la mejor opción, la fila encabezada por `<none>`). ```r library(MASS) modAIC <- stepAIC(ajuste_boston_multi, k = 2) ``` ``` > Start: AIC=1232.05 > medv ~ crim + zn + indus + chas + nox + rm + age + dis + rad + > tax + ptratio + black + lstat > > Df Sum of Sq RSS AIC > - indus 1 0.11 7956.5 1230.0 > - age 1 24.30 7980.6 1231.3 > <none> 7956.3 1232.0 > - chas 1 61.51 8017.9 1233.2 > - crim 1 163.47 8119.8 1238.3 > - zn 1 179.77 8136.1 1239.1 > - tax 1 182.03 8138.4 1239.2 > - black 1 196.96 8153.3 1239.9 > - nox 1 329.47 8285.8 1246.4 > - rad 1 337.29 8293.6 1246.8 > - dis 1 932.91 8889.3 1274.8 > - ptratio 1 962.38 8918.7 1276.2 > - rm 1 1511.81 9468.2 1300.3 > - lstat 1 2078.33 10034.7 1323.8 > > Step: AIC=1230.05 > medv ~ crim + zn + chas + nox + rm + age + dis + rad + tax + > ptratio + black + lstat > > Df Sum of Sq RSS AIC > - age 1 24.27 7980.7 1229.3 > <none> 7956.5 1230.0 > - chas 1 61.66 8018.1 1231.2 > - crim 1 163.37 8119.8 1236.3 > - zn 1 182.41 8138.9 1237.2 > - black 1 197.56 8154.0 1238.0 > - tax 1 227.62 8184.1 1239.5 > - nox 1 353.33 8309.8 1245.6 > - rad 1 364.63 8321.1 1246.2 > - dis 1 966.97 8923.4 1274.4 > - ptratio 1 982.99 8939.4 1275.1 > - rm 1 1542.45 9498.9 1299.6 > - lstat 1 2090.05 10046.5 1322.3 > > Step: AIC=1229.28 > medv ~ crim + zn + chas + nox + rm + dis + rad + tax + ptratio + > black + lstat > > Df Sum of Sq RSS AIC > <none> 7980.7 1229.3 > - chas 1 67.06 8047.8 1230.7 > - crim 1 164.18 8144.9 1235.5 > - zn 1 168.66 8149.4 1235.7 > - black 1 205.04 8185.8 1237.5 > - tax 1 227.55 8208.3 1238.6 > - nox 1 329.09 8309.8 1243.6 > - rad 1 357.51 8338.2 1245.0 > - ptratio 1 967.25 8948.0 1273.5 > - dis 1 1157.65 9138.4 1282.0 > - rm 1 1712.78 9693.5 1305.8 > - lstat 1 2265.53 10246.3 1328.2 ``` --- # .orange[SELECCIÓN DE MODELOS] Con `summary()` nos resume el modelo final elegido, aquel que enfrenta a `medv` con `crim + zn + chas + nox + rm + dis + rad + tax + ptratio + black + lstat` (ha eliminado 2 variables) ```r summary(modAIC) ``` ``` > > Call: > lm(formula = medv ~ crim + zn + chas + nox + rm + dis + rad + > tax + ptratio + black + lstat, data = boston_prep) > > Residuals: > Min 1Q Median 3Q Max > -14.7145 -2.4539 -0.4188 1.6835 26.3129 > > Coefficients: > Estimate Std. Error t value Pr(>|t|) > (Intercept) 35.500282 5.328834 6.662 9.17e-11 *** > crim -0.099167 0.034920 -2.840 0.004749 ** > zn 0.042156 0.014646 2.878 0.004218 ** > chas 1.616645 0.890783 1.815 0.070310 . > nox -15.198552 3.780284 -4.020 6.97e-05 *** > rm 3.833009 0.417895 9.172 < 2e-16 *** > dis -1.495157 0.198279 -7.541 3.28e-13 *** > rad 0.285217 0.068062 4.191 3.44e-05 *** > tax -0.011931 0.003569 -3.343 0.000908 *** > ptratio -0.962214 0.139598 -6.893 2.20e-11 *** > black 0.009190 0.002896 3.174 0.001625 ** > lstat -0.523981 0.049672 -10.549 < 2e-16 *** > --- > Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 > > Residual standard error: 4.512 on 392 degrees of freedom > Multiple R-squared: 0.7538, Adjusted R-squared: 0.7468 > F-statistic: 109.1 on 11 and 392 DF, p-value: < 2.2e-16 ``` --- # .orange[SELECCIÓN DE MODELOS] ```r modBIC <- stepAIC(ajuste_boston_multi, k = log(nrow(train_boston))) ``` ``` > Start: AIC=1288.06 > medv ~ crim + zn + indus + chas + nox + rm + age + dis + rad + > tax + ptratio + black + lstat > > Df Sum of Sq RSS AIC > - indus 1 0.11 7956.5 1282.1 > - age 1 24.30 7980.6 1283.3 > - chas 1 61.51 8017.9 1285.2 > <none> 7956.3 1288.1 > - crim 1 163.47 8119.8 1290.3 > - zn 1 179.77 8136.1 1291.1 > - tax 1 182.03 8138.4 1291.2 > - black 1 196.96 8153.3 1291.9 > - nox 1 329.47 8285.8 1298.5 > - rad 1 337.29 8293.6 1298.8 > - dis 1 932.91 8889.3 1326.9 > - ptratio 1 962.38 8918.7 1328.2 > - rm 1 1511.81 9468.2 1352.3 > - lstat 1 2078.33 10034.7 1375.8 > > Step: AIC=1282.07 > medv ~ crim + zn + chas + nox + rm + age + dis + rad + tax + > ptratio + black + lstat > > Df Sum of Sq RSS AIC > - age 1 24.27 7980.7 1277.3 > - chas 1 61.66 8018.1 1279.2 > <none> 7956.5 1282.1 > - crim 1 163.37 8119.8 1284.3 > - zn 1 182.41 8138.9 1285.2 > - black 1 197.56 8154.0 1286.0 > - tax 1 227.62 8184.1 1287.5 > - nox 1 353.33 8309.8 1293.6 > - rad 1 364.63 8321.1 1294.2 > - dis 1 966.97 8923.4 1322.4 > - ptratio 1 982.99 8939.4 1323.1 > - rm 1 1542.45 9498.9 1347.7 > - lstat 1 2090.05 10046.5 1370.3 > > Step: AIC=1277.3 > medv ~ crim + zn + chas + nox + rm + dis + rad + tax + ptratio + > black + lstat > > Df Sum of Sq RSS AIC > - chas 1 67.06 8047.8 1274.7 > <none> 7980.7 1277.3 > - crim 1 164.18 8144.9 1279.5 > - zn 1 168.66 8149.4 1279.8 > - black 1 205.04 8185.8 1281.5 > - tax 1 227.55 8208.3 1282.7 > - nox 1 329.09 8309.8 1287.6 > - rad 1 357.51 8338.2 1289.0 > - ptratio 1 967.25 8948.0 1317.5 > - dis 1 1157.65 9138.4 1326.0 > - rm 1 1712.78 9693.5 1349.8 > - lstat 1 2265.53 10246.3 1372.2 > > Step: AIC=1274.68 > medv ~ crim + zn + nox + rm + dis + rad + tax + ptratio + black + > lstat > > Df Sum of Sq RSS AIC > <none> 8047.8 1274.7 > - zn 1 168.60 8216.4 1277.0 > - crim 1 175.41 8223.2 1277.4 > - black 1 215.42 8263.2 1279.3 > - tax 1 253.60 8301.4 1281.2 > - nox 1 320.63 8368.4 1284.5 > - rad 1 383.60 8431.4 1287.5 > - ptratio 1 1005.18 9053.0 1316.2 > - dis 1 1214.05 9261.8 1325.4 > - rm 1 1743.44 9791.2 1347.9 > - lstat 1 2265.98 10313.8 1368.9 ``` --- # .orange[SELECCIÓN DE MODELOS] Con `summary()` nos resume el modelo final elegido, aquel que enfrenta a `medv` con `crim + zn + nox + rm + dis + rad + tax + ptratio + black + lstat` (ha eliminado 3 variables) ```r summary(modBIC) ``` ``` > > Call: > lm(formula = medv ~ crim + zn + nox + rm + dis + rad + tax + > ptratio + black + lstat, data = boston_prep) > > Residuals: > Min 1Q Median 3Q Max > -13.3295 -2.5345 -0.4292 1.8436 26.1992 > > Coefficients: > Estimate Std. Error t value Pr(>|t|) > (Intercept) 35.820913 5.341424 6.706 6.97e-11 *** > crim -0.102369 0.034977 -2.927 0.003625 ** > zn 0.042148 0.014689 2.869 0.004335 ** > nox -14.995508 3.789639 -3.957 9.01e-05 *** > rm 3.863939 0.418764 9.227 < 2e-16 *** > dis -1.525640 0.198142 -7.700 1.12e-13 *** > rad 0.294589 0.068064 4.328 1.91e-05 *** > tax -0.012540 0.003563 -3.519 0.000484 *** > ptratio -0.978797 0.139705 -7.006 1.07e-11 *** > black 0.009412 0.002902 3.243 0.001282 ** > lstat -0.524033 0.049816 -10.519 < 2e-16 *** > --- > Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 > > Residual standard error: 4.525 on 393 degrees of freedom > Multiple R-squared: 0.7517, Adjusted R-squared: 0.7454 > F-statistic: 119 on 10 and 393 DF, p-value: < 2.2e-16 ``` --- # .orange[RECETA] Con las variables seleccionadas en cada criterio, "rescribimos" la receta indicándole solo esas variables ```r rec_boston_AIC <- * recipe(data = train_boston, medv ~ crim + zn + chas + nox + rm + dis + rad + tax + ptratio + black + lstat) %>% step_mutate(across(all_numeric_predictors(), function(x) { ifelse(abs(scores(x, type = "z")) > 2, NA, x) })) %>% step_impute_mean(all_numeric_predictors()) %>% step_zv(all_predictors()) rec_boston_BIC <- * recipe(data = train_boston, medv ~ crim + zn + nox + rm + dis + rad + tax + ptratio + black + lstat) %>% step_mutate(across(all_numeric_predictors(), function(x) { ifelse(abs(scores(x, type = "z")) > 2, NA, x) })) %>% step_impute_mean(all_numeric_predictors()) %>% step_zv(all_predictors()) ``` --- # .orange[AJUSTE] Generamos los dos flujos y el ajuste ```r wflow_AIC <- workflow() %>% add_recipe(rec_boston_AIC) %>% add_model(reg_lineal) mod_AIC <- wflow_AIC %>% fit(data = train_boston) wflow_BIC <- workflow() %>% add_recipe(rec_boston_BIC) %>% add_model(reg_lineal) mod_BIC <- wflow_BIC %>% fit(data = train_boston) ``` --- # .orange[AJUSTE] ```r tidy(mod_AIC) ``` ``` > # A tibble: 12 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) 35.5 5.33 6.66 9.17e-11 > 2 crim -0.0992 0.0349 -2.84 4.75e- 3 > 3 zn 0.0422 0.0146 2.88 4.22e- 3 > 4 chas 1.62 0.891 1.81 7.03e- 2 > 5 nox -15.2 3.78 -4.02 6.97e- 5 > 6 rm 3.83 0.418 9.17 2.67e-18 > 7 dis -1.50 0.198 -7.54 3.28e-13 > 8 rad 0.285 0.0681 4.19 3.44e- 5 > 9 tax -0.0119 0.00357 -3.34 9.08e- 4 > 10 ptratio -0.962 0.140 -6.89 2.20e-11 > 11 black 0.00919 0.00290 3.17 1.62e- 3 > 12 lstat -0.524 0.0497 -10.5 4.56e-23 ``` --- # .orange[AJUSTE] ```r tidy(mod_BIC) ``` ``` > # A tibble: 11 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) 35.8 5.34 6.71 6.97e-11 > 2 crim -0.102 0.0350 -2.93 3.62e- 3 > 3 zn 0.0421 0.0147 2.87 4.34e- 3 > 4 nox -15.0 3.79 -3.96 9.01e- 5 > 5 rm 3.86 0.419 9.23 1.74e-18 > 6 dis -1.53 0.198 -7.70 1.12e-13 > 7 rad 0.295 0.0681 4.33 1.91e- 5 > 8 tax -0.0125 0.00356 -3.52 4.84e- 4 > 9 ptratio -0.979 0.140 -7.01 1.07e-11 > 10 black 0.00941 0.00290 3.24 1.28e- 3 > 11 lstat -0.524 0.0498 -10.5 5.74e-23 ``` --- # .orange[DIAGNOSIS] .pull-left[ ```r check_model(mod_AIC %>% extract_fit_engine()) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1097-1.png" width="90%" /> ] --- # .orange[DIAGNOSIS] Con el AIC no se rechaza que exista una tendencia cuadrática entre errores y predicciones (**.bg-purple_light[violando la hipótesis de linealidad]**). ```r ajuste_AIC <- mod_AIC %>% extract_fit_engine() lm(ajuste_AIC$residuals ~ I(ajuste_AIC$fitted.values^2) + ajuste_AIC$fitted.values) %>% anova() ``` ``` > Analysis of Variance Table > > Response: ajuste_AIC$residuals > Df Sum Sq Mean Sq F value Pr(>F) > I(ajuste_AIC$fitted.values^2) 1 84.9 84.90 5.2988 0.02185 * > ajuste_AIC$fitted.values 1 1470.9 1470.93 91.8054 < 2e-16 *** > Residuals 401 6424.9 16.02 > --- > Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ``` Tampoco parece cumplirse la **.bg-purple_light[homocedasticidad]** ```r check_heteroscedasticity(ajuste_AIC) ``` ``` > Warning: Heteroscedasticity (non-constant error variance) detected (p < .001). ``` --- # .orange[DIAGNOSIS] .pull-left[ ```r check_model(mod_BIC %>% extract_fit_engine()) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1101-1.png" width="90%" /> ] --- # .orange[DIAGNOSIS] Con el BIC tampoco se rechaza que exista una tendencia cuadrática entre errores y predicciones (**.bg-purple_light[violando la hipótesis de linealidad]**). ```r ajuste_BIC <- mod_BIC %>% extract_fit_engine() lm(ajuste_BIC$residuals ~ I(ajuste_BIC$fitted.values^2) + ajuste_BIC$fitted.values) %>% anova() ``` ``` > Analysis of Variance Table > > Response: ajuste_BIC$residuals > Df Sum Sq Mean Sq F value Pr(>F) > I(ajuste_BIC$fitted.values^2) 1 85.2 85.16 5.257 0.02238 * > ajuste_BIC$fitted.values 1 1466.7 1466.69 90.540 < 2e-16 *** > Residuals 401 6495.9 16.20 > --- > Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ``` Tampoco parece cumplirse la **.bg-purple_light[homocedasticidad]** ```r check_heteroscedasticity(ajuste_BIC) ``` ``` > Warning: Heteroscedasticity (non-constant error variance) detected (p < .001). ``` --- # .orange[EVALUACIÓN] Vamos a evaluar los 5 modelos que tenemos ```r # comparativa compare_performance(mod1 %>% extract_fit_engine(), mod2 %>% extract_fit_engine(), mod_multi %>% extract_fit_engine(), mod_AIC %>% extract_fit_engine(), mod_BIC %>% extract_fit_engine()) ``` ``` > # Comparison of Model Performance Indices > > Name | Model | AIC | AIC_wt | BIC | BIC_wt | R2 | R2 (adj.) | RMSE | Sigma > --------------------------------------------------------------------------------------------- > Model 1 | lm | 2604.415 | < 0.001 | 2616.419 | < 0.001 | 0.547 | 0.545 | 6.031 | 6.046 > Model 2 | lm | 2649.265 | < 0.001 | 2661.270 | < 0.001 | 0.493 | 0.492 | 6.375 | 6.391 > Model 3 | lm | 2380.547 | 0.143 | 2440.569 | < 0.001 | 0.755 | 0.746 | 4.438 | 4.517 > Model 4 | lm | 2377.784 | 0.571 | 2429.802 | 0.212 | 0.754 | 0.747 | 4.445 | 4.512 > Model 5 | lm | 2379.164 | 0.286 | 2427.181 | 0.787 | 0.752 | 0.745 | 4.463 | 4.525 ``` Observa que **.bg-purple_light[apenas hay diferencia en la bondad de ajuste]** entre el modelo saturado y las 10 predictoras supervivientes tras BIC (o las 11 del AIC). Tenemos un **.bg-purple_light[modelo igual de bueno pero con 2-3 variables menos]** (más interpretable y menos sobreajustado). --- # .orange[BIC MEJORADO] Vamos a **.bg-purple_light[volver a lanzar los AIC y BIC pero con alguna mejora en la receta]**: vamos a tratar `chas` como binaria (porque lo es), `rad` como factor (es cuali), vamos a aplicar YeoJohnson en las predictoras y la raíz cuadrada a la objetivo, y crear dummys para esa cuali creada (otra opción a veces útil: estandarizar predictoras en media y varianza con `step_normalize()`) --- # .orange[RECETA MEJORADA] ```r rec_boston_mejorada <- recipe(data = train_boston, medv ~ .) %>% # Sacamos chas de numeric_predictors update_role(chas, new_role = "binary") %>% step_mutate(rad = as_factor(rad)) %>% update_role(rad, new_role = "cuali") %>% step_mutate(across(all_numeric_predictors(), function(x) { ifelse(abs(scores(x, type = "z")) > 2, NA, x) })) %>% step_impute_mean(all_numeric_predictors()) %>% step_sqrt(medv) %>% step_YeoJohnson(all_numeric_predictors()) %>% # umbral de correlación step_corr(all_numeric_predictors(), threshold = 0.9) %>% step_dummy(all_nominal_predictors()) %>% step_zv(all_predictors()) # Horneado boston_prep_mejorada <- bake(rec_boston_mejorada %>% prep(), new_data = NULL) ajuste_boston_mejorada <- lm(data = boston_prep_mejorada, medv ~ .) ``` --- # .orange[CRITERIO AIC] Ahora AIC nos reduce a 10 variables (antes eran 11) ```r # AIC mod_AIC_mejorada <- stepAIC(ajuste_boston_mejorada, k = 2) ``` ``` > Start: AIC=-689.68 > medv ~ crim + zn + indus + chas + nox + rm + age + dis + rad + > tax + ptratio + black + lstat > > Df Sum of Sq RSS AIC > - rad 8 2.238 68.282 -692.22 > - zn 1 0.025 66.069 -691.53 > - crim 1 0.035 66.079 -691.47 > - indus 1 0.192 66.236 -690.51 > <none> 66.044 -689.68 > - chas 1 0.578 66.622 -688.16 > - nox 1 0.989 67.033 -685.68 > - age 1 1.100 67.144 -685.01 > - black 1 1.541 67.585 -682.37 > - tax 1 1.681 67.725 -681.53 > - dis 1 3.687 69.731 -669.74 > - rm 1 4.025 70.069 -667.78 > - ptratio 1 4.291 70.335 -666.25 > - lstat 1 45.743 111.787 -479.07 > > Step: AIC=-692.22 > medv ~ crim + zn + indus + chas + nox + rm + age + dis + tax + > ptratio + black + lstat > > Df Sum of Sq RSS AIC > - zn 1 0.005 68.287 -694.19 > - indus 1 0.273 68.554 -692.61 > <none> 68.282 -692.22 > - crim 1 0.653 68.934 -690.38 > - chas 1 0.728 69.010 -689.94 > - age 1 1.051 69.333 -688.05 > - nox 1 1.463 69.745 -685.66 > - black 1 1.757 70.038 -683.96 > - tax 1 2.347 70.629 -680.56 > - dis 1 4.001 72.283 -671.22 > - rm 1 4.709 72.990 -667.28 > - ptratio 1 5.416 73.698 -663.38 > - lstat 1 46.753 115.035 -483.50 > > Step: AIC=-694.19 > medv ~ crim + indus + chas + nox + rm + age + dis + tax + ptratio + > black + lstat > > Df Sum of Sq RSS AIC > - indus 1 0.299 68.585 -694.43 > <none> 68.287 -694.19 > - crim 1 0.666 68.953 -692.27 > - chas 1 0.724 69.011 -691.93 > - age 1 1.048 69.334 -690.04 > - nox 1 1.498 69.784 -687.43 > - black 1 1.764 70.051 -685.89 > - tax 1 2.349 70.636 -682.53 > - dis 1 4.069 72.356 -672.81 > - rm 1 4.766 73.053 -668.93 > - ptratio 1 6.165 74.451 -661.27 > - lstat 1 46.772 115.059 -485.41 > > Step: AIC=-694.43 > medv ~ crim + chas + nox + rm + age + dis + tax + ptratio + black + > lstat > > Df Sum of Sq RSS AIC > <none> 68.585 -694.43 > - chas 1 0.607 69.193 -692.87 > - crim 1 0.649 69.234 -692.62 > - age 1 1.095 69.680 -690.03 > - nox 1 1.828 70.413 -685.80 > - black 1 1.833 70.419 -685.77 > - tax 1 2.871 71.456 -679.86 > - dis 1 3.785 72.371 -674.72 > - rm 1 5.411 73.996 -665.75 > - ptratio 1 7.060 75.646 -656.84 > - lstat 1 47.816 116.402 -482.72 ``` --- # .orange[CRITERIO BIC] Ahora BIC nos reduce a 8 variables (antes eran 10) ```r # BIC mod_BIC_mejorada <- stepAIC(ajuste_boston_mejorada, k = log(nrow(train_boston))) ``` ``` > Start: AIC=-605.65 > medv ~ crim + zn + indus + chas + nox + rm + age + dis + rad + > tax + ptratio + black + lstat > > Df Sum of Sq RSS AIC > - rad 8 2.238 68.282 -640.20 > - zn 1 0.025 66.069 -611.50 > - crim 1 0.035 66.079 -611.44 > - indus 1 0.192 66.236 -610.48 > - chas 1 0.578 66.622 -608.13 > <none> 66.044 -605.65 > - nox 1 0.989 67.033 -605.65 > - age 1 1.100 67.144 -604.98 > - black 1 1.541 67.585 -602.34 > - tax 1 1.681 67.725 -601.50 > - dis 1 3.687 69.731 -589.71 > - rm 1 4.025 70.069 -587.75 > - ptratio 1 4.291 70.335 -586.22 > - lstat 1 45.743 111.787 -399.04 > > Step: AIC=-640.2 > medv ~ crim + zn + indus + chas + nox + rm + age + dis + tax + > ptratio + black + lstat > > Df Sum of Sq RSS AIC > - zn 1 0.005 68.287 -646.17 > - indus 1 0.273 68.554 -644.59 > - crim 1 0.653 68.934 -642.36 > - chas 1 0.728 69.010 -641.92 > <none> 68.282 -640.20 > - age 1 1.051 69.333 -640.03 > - nox 1 1.463 69.745 -637.64 > - black 1 1.757 70.038 -635.94 > - tax 1 2.347 70.629 -632.55 > - dis 1 4.001 72.283 -623.20 > - rm 1 4.709 72.990 -619.26 > - ptratio 1 5.416 73.698 -615.37 > - lstat 1 46.753 115.035 -435.48 > > Step: AIC=-646.17 > medv ~ crim + indus + chas + nox + rm + age + dis + tax + ptratio + > black + lstat > > Df Sum of Sq RSS AIC > - indus 1 0.299 68.585 -650.41 > - crim 1 0.666 68.953 -648.25 > - chas 1 0.724 69.011 -647.91 > <none> 68.287 -646.17 > - age 1 1.048 69.334 -646.02 > - nox 1 1.498 69.784 -643.41 > - black 1 1.764 70.051 -641.87 > - tax 1 2.349 70.636 -638.51 > - dis 1 4.069 72.356 -628.79 > - rm 1 4.766 73.053 -624.92 > - ptratio 1 6.165 74.451 -617.26 > - lstat 1 46.772 115.059 -441.40 > > Step: AIC=-650.41 > medv ~ crim + chas + nox + rm + age + dis + tax + ptratio + black + > lstat > > Df Sum of Sq RSS AIC > - chas 1 0.607 69.193 -652.85 > - crim 1 0.649 69.234 -652.61 > <none> 68.585 -650.41 > - age 1 1.095 69.680 -650.02 > - nox 1 1.828 70.413 -645.79 > - black 1 1.833 70.419 -645.76 > - tax 1 2.871 71.456 -639.85 > - dis 1 3.785 72.371 -634.71 > - rm 1 5.411 73.996 -625.74 > - ptratio 1 7.060 75.646 -616.83 > - lstat 1 47.816 116.402 -442.71 > > Step: AIC=-652.85 > medv ~ crim + nox + rm + age + dis + tax + ptratio + black + > lstat > > Df Sum of Sq RSS AIC > - crim 1 0.709 69.902 -654.73 > <none> 69.193 -652.85 > - age 1 1.247 70.439 -651.64 > - nox 1 1.848 71.041 -648.20 > - black 1 1.963 71.156 -647.55 > - tax 1 3.059 72.252 -641.38 > - dis 1 3.888 73.080 -636.77 > - rm 1 5.476 74.669 -628.08 > - ptratio 1 7.629 76.821 -616.60 > - lstat 1 48.463 117.656 -444.38 > > Step: AIC=-654.73 > medv ~ nox + rm + age + dis + tax + ptratio + black + lstat > > Df Sum of Sq RSS AIC > <none> 69.902 -654.73 > - nox 1 1.296 71.198 -653.31 > - age 1 1.318 71.220 -653.19 > - black 1 1.488 71.390 -652.22 > - tax 1 2.385 72.287 -647.18 > - dis 1 4.064 73.966 -637.90 > - rm 1 5.802 75.705 -628.52 > - ptratio 1 7.117 77.019 -621.56 > - lstat 1 48.025 117.928 -449.45 ``` --- # .orange[BIC MEJORADO] Por simplificar, vamos a quedarnos con el BIC de la receta mejorada así que "rescribimos" la receta indicándole solo esas variables ```r rec_boston_BIC_mejorada <- recipe(data = train_boston, medv ~ nox + rm + age + dis + tax + ptratio + black + lstat) %>% step_mutate(across(all_numeric_predictors(), function(x) { ifelse(abs(scores(x, type = "z")) > 2, NA, x) })) %>% step_impute_mean(all_numeric_predictors()) %>% step_sqrt(medv) %>% step_YeoJohnson(all_numeric_predictors()) %>% # umbral de correlación step_corr(all_numeric_predictors(), threshold = 0.9) %>% step_dummy(all_nominal_predictors()) %>% step_zv(all_predictors()) wflow_BIC_mejorada <- workflow() %>% add_recipe(rec_boston_BIC_mejorada) %>% add_model(reg_lineal) mod_BIC_mejorada <- wflow_BIC_mejorada %>% fit(data = train_boston) ``` --- # .orange[AJUSTE] Fíjate que ya ninguna variable es no significativa ```r tidy(mod_BIC_mejorada) ``` ``` > # A tibble: 9 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) 2.34e+ 1 4.11e+ 0 5.69 2.54e- 8 > 2 nox -1.27e+ 1 4.70e+ 0 -2.71 7.10e- 3 > 3 rm 1.01e+ 0 1.76e- 1 5.73 2.04e- 8 > 4 age 1.11e- 3 4.08e- 4 2.73 6.63e- 3 > 5 dis -9.99e- 1 2.08e- 1 -4.79 2.34e- 6 > 6 tax -9.33e+ 0 2.54e+ 0 -3.67 2.75e- 4 > 7 ptratio -3.03e- 6 4.78e- 7 -6.34 6.23e-10 > 8 black 8.70e-11 3.00e-11 2.90 3.94e- 3 > 9 lstat -7.86e- 1 4.77e- 2 -16.5 8.70e-47 ``` --- # .orange[DIAGNOSIS] .pull-left[ Fíjate cómo la mayoría de las hipótesis parecen cumplirse (vamos a comprobarlo ahora numéricamente) ```r check_model(mod_BIC_mejorada %>% extract_fit_engine()) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1111-1.png" width="90%" /> ] --- # .orange[DIAGNOSIS] Hemos conseguido que no exista tendencia (ni lineal ni cuadrática) entre los residuos y las predicciones **.bg-green_light[Linealidad conseguida]** ```r ajuste_BIC_mejorado <- mod_BIC_mejorada %>% extract_fit_engine() lm(ajuste_BIC_mejorado$residuals ~ ajuste_BIC_mejorado$fitted.values) %>% anova() ``` ``` > Analysis of Variance Table > > Response: ajuste_BIC_mejorado$residuals > Df Sum Sq Mean Sq F value Pr(>F) > ajuste_BIC_mejorado$fitted.values 1 0.000 0.00000 0 1 > Residuals 402 69.902 0.17389 ``` ```r lm(ajuste_BIC_mejorado$residuals ~ I(ajuste_BIC_mejorado$fitted.values^2) + ajuste_BIC_mejorado$fitted.values) %>% anova() ``` ``` > Analysis of Variance Table > > Response: ajuste_BIC_mejorado$residuals > Df Sum Sq Mean Sq F value Pr(>F) > I(ajuste_BIC_mejorado$fitted.values^2) 1 0.029 0.02899 0.1731 0.6776 > ajuste_BIC_mejorado$fitted.values 1 2.710 2.70957 16.1775 6.893e-05 *** > Residuals 401 67.164 0.16749 > --- > Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ``` --- # .orange[DIAGNOSIS] Hemos conseguido incluso homocedasticidad en los residuos **.bg-green_light[Homocedasticidad conseguida]** ```r check_heteroscedasticity(ajuste_BIC_mejorado) ``` ``` > OK: Error variance appears to be homoscedastic (p = 0.874). ``` También tenemos **.bg-green_light[residuos incorrelados]** ```r durbinWatsonTest(ajuste_BIC_mejorado) ``` ``` > lag Autocorrelation D-W Statistic p-value > 1 -0.03941677 2.071063 0.452 > Alternative hypothesis: rho != 0 ``` --- # .orange[DIAGNOSIS] Incluso la normalidad en los residuos se cumple en el test de Kolmogorov-Smirnov **.bg-green_light[Normalidad (casi) de los residuos conseguida]** ```r ols_test_normality(ajuste_BIC_mejorado) ``` ``` > ----------------------------------------------- > Test Statistic pvalue > ----------------------------------------------- > Shapiro-Wilk 0.9833 1e-04 > Kolmogorov-Smirnov 0.0673 0.0514 > Cramer-von Mises 61.4612 0.0000 > Anderson-Darling 2.3697 0.0000 > ----------------------------------------------- ``` --- # .orange[EVALUACIÓN] Y encima hemos mejorado la bondad de ajuste respecto al resto de modelos. ```r # comparativa compare_performance(mod1 %>% extract_fit_engine(), mod2 %>% extract_fit_engine(), mod_multi %>% extract_fit_engine(), mod_AIC %>% extract_fit_engine(), mod_BIC %>% extract_fit_engine(), mod_BIC_mejorada %>% extract_fit_engine()) ``` ``` > # Comparison of Model Performance Indices > > Name | Model | AIC | AIC_wt | BIC | BIC_wt | R2 | R2 (adj.) | RMSE | Sigma > --------------------------------------------------------------------------------------------- > Model 1 | lm | 2604.415 | < 0.001 | 2616.419 | < 0.001 | 0.547 | 0.545 | 6.031 | 6.046 > Model 2 | lm | 2649.265 | < 0.001 | 2661.270 | < 0.001 | 0.493 | 0.492 | 6.375 | 6.391 > Model 3 | lm | 2380.547 | < 0.001 | 2440.569 | < 0.001 | 0.755 | 0.746 | 4.438 | 4.517 > Model 4 | lm | 2377.784 | < 0.001 | 2429.802 | < 0.001 | 0.754 | 0.747 | 4.445 | 4.512 > Model 5 | lm | 2379.164 | < 0.001 | 2427.181 | < 0.001 | 0.752 | 0.745 | 4.463 | 4.525 > Model 6 | lm | 457.758 | 1.00 | 497.772 | 1.00 | 0.789 | 0.785 | 0.416 | 0.421 ``` --- # .orange[REGRESIÓN] .green[PENALIZADA] Por último vamos a hablar de lo que se conoce como **.bg-purple_light[regresión penalizada o regularizada]**. Las estrategias de regularización incorporan ya en la función a optimizar una **.bg-purple_light[penalización]** (similar a lo que hacía paso a paso el BIC/AIC, pero "del tirón") con el objetivo de **.bg-purple_light[reducir la varianza]** y evitar el sobreajuste. Las dos principales técnicas se conoce como **.bg-purple_light[regresión LASSO o L1]** y **.bg-purple_light[regresión ridge o L2]** --- # .orange[REGRESIÓN] .green[PENALIZADA] En el caso de la regresión lineal ordinaria que estamos realizando `$$\hat{\boldsymbol{\beta}} = \arg \min_{\boldsymbol{\beta} \in \mathbb{R}^{p+1}} \left\| \boldsymbol{Y} - \boldsymbol{\beta} \boldsymbol{X} \right\|^2 = \arg \min_{\boldsymbol{\beta} \in \mathbb{R}^{p+1}} \left\| \boldsymbol{\epsilon} \right\|^2 =\arg \min_{\boldsymbol{\beta} \in \mathbb{R}^{p+1}} \sum_{i=1}^{n} \epsilon_{i}^{2}$$` * **.bg-purple_light[Regresión ridge (L2)]**: consiste en añadir una penalización (con factor `\(\lambda\)`) en función de la **.bg-purple_light[suma del cuadrado de los coeficientes]**, lo que se conoce como norma L2 `$$\hat{\boldsymbol{\beta}} = \arg \min_{\boldsymbol{\beta} \in \mathbb{R}^{p+1}} \left[ \left\| \boldsymbol{Y} - \boldsymbol{\beta} \boldsymbol{X} \right\|^2 + \lambda \sum_{j=1}^{p} \beta_{j}^{2}\right] = \arg \min_{\boldsymbol{\beta} \in \mathbb{R}^{p+1}} \left[ \left\| \boldsymbol{Y} - \boldsymbol{\beta} \boldsymbol{X} \right\|^2 + \lambda \left\| \boldsymbol{\beta} \right\|_{2}^{2}\right]$$` Dicha técnica de regularización consigue reducir de forma proporcional el valor de todos los coeficientes del modelo. La **.bg-purple_light[agresividad de la penalización]** está controlada por `\(\lambda\)` (solo se anula los coeficientes si `\(\lambda = \infty\)`) --- # .orange[REGRESIÓN] .green[PENALIZADA] En el caso de la regresión lineal ordinaria que estamos realizando `$$\hat{\boldsymbol{\beta}} = \arg \min_{\boldsymbol{\beta} \in \mathbb{R}^{p+1}} \left\| \boldsymbol{Y} - \boldsymbol{\beta} \boldsymbol{X} \right\|^2 = \arg \min_{\boldsymbol{\beta} \in \mathbb{R}^{p+1}} \left\| \boldsymbol{\epsilon} \right\|^2 =\arg \min_{\boldsymbol{\beta} \in \mathbb{R}^{p+1}} \sum_{i=1}^{n} \epsilon_{i}^{2}$$` * **.bg-purple_light[Regresión LASSO (L1)]**: consiste en añadir una penalización (con factor `\(\lambda\)`) en función de la **.bg-purple_light[suma del valor absoluto de los coeficientes]**, lo que se conoce como norma L1 `$$\hat{\boldsymbol{\beta}} = \arg \min_{\boldsymbol{\beta} \in \mathbb{R}^{p+1}} \left[ \left\| \boldsymbol{Y} - \boldsymbol{\beta} \boldsymbol{X} \right\|^2 + \lambda \sum_{j=1}^{p} \left| \beta_{j} \right| \right] = \arg \min_{\boldsymbol{\beta} \in \mathbb{R}^{p+1}} \left[ \left\| \boldsymbol{Y} - \boldsymbol{\beta} \boldsymbol{X} \right\|^2 + \lambda \left\| \boldsymbol{\beta} \right\|_{1}\right]$$` Dicha técnica de regularización es capaz de hacer una **.bg-purple_light[selección de variables predictoras]** ya que fuerza que sean cero. Dado que estos métodos de regularización actúan sobre la magnitud de los coeficientes del modelo, todos deben de estár en la misma escala, así que en estos casos es **.bg-purple_light[necesario estandarizar por media y varianza]** las variables. --- # .orange[REGRESIÓN] .green[PENALIZADA] Ambas penalizaciones pueden ser **.bg-purple_light[combinadas]** haciendo uso de lo que se conoce como **.bg-purple_light[elastic net]** `$$\hat{\boldsymbol{\beta}} = \arg \min_{\boldsymbol{\beta} \in \mathbb{R}^{p+1}} \left[ \left\| \boldsymbol{Y} - \boldsymbol{\beta} \boldsymbol{X} \right\|^2 + \lambda \left(\alpha \sum_{j=1}^{p} \left| \beta_j \right| + \frac{1 - \alpha}{2} \sum_{j=1}^{p} \beta_{j}^2 \right)\right]$$` * **.bg-purple_light[Penalización]**: el parámetro `\(\lambda\)` (a mayor valor, más agresiva será penalizando el sobreajuste) * **.bg-purple_light[Mixtura]**: el parámetro `\(\alpha\)` (siempre entre 0 y 1) --- # .orange[REGRESIÓN] .green[PENALIZADA] Para ello ahora vamos a generar validación cruzada ya que ahora sí que tenemos dos parámetros que optimizar ```r # Partición split_boston <- initial_split(boston, prop = 0.8) train_boston <- training(split_boston) test_boston <- testing(split_boston) ``` ```r # Validación cruzada validation_cv_boston <- vfold_cv(data = train_boston, v = 4, repeats = 10) ``` --- # .orange[REGRESIÓN] .green[PENALIZADA] Vamos a aplicar la receta mejorada usada en el último BIC pero con todas las variables a priori (y normalizando predictoras) ```r rec_boston_elastic <- recipe(data = train_boston, medv ~ .) %>% update_role(chas, new_role = "binary") %>% step_mutate(across(all_numeric_predictors(), function(x) { ifelse(abs(scores(x, type = "z")) > 2, NA, x) })) %>% step_impute_mean(all_numeric_predictors()) %>% step_sqrt(medv) %>% step_YeoJohnson(all_numeric_predictors()) %>% # umbral de correlación step_corr(all_numeric_predictors(), threshold = 0.9) %>% step_dummy(all_nominal_predictors()) %>% step_normalize(all_predictors()) %>% step_zv(all_predictors()) ``` --- # .orange[REGRESIÓN] .green[PENALIZADA] El modelo ahora vendrá definido por el motor `glmnet` donde `mixture` será el parámetro `\(\alpha\)` y `penalty` el parámetro `\(\lambda\)` ```r elastic_net <- linear_reg(mixture = tune("alpha"), penalty = tune("lambda")) %>% set_mode("regression") %>% set_engine("glmnet") ``` Y vamos a generar un grid de parámetros (200 regresiones) usando `penalty()` (fíjate que está en escala logarítmica, es decir, que -2 es una penalización de 0.01 y 2 de 100) ```r grid_elastic_net <- expand_grid("alpha" = seq(0, 1, l = 5), "lambda" = grid_regular(penalty(range = c(-4, 1)), levels = 40) %>% pull(penalty)) wflow_elastic <- workflow() %>% add_recipe(rec_boston_elastic) %>% add_model(elastic_net) ``` --- # .orange[REGRESIÓN] .green[PENALIZADA] ```r mod_elastic <- wflow_elastic %>% tune_grid(resamples = validation_cv_boston, grid = grid_elastic_net, control = control_grid(verbose = TRUE)) ``` Como antes podemos usar `select_best()` y `collect_metrics()` ```r mod_elastic %>% select_best("rsq") ``` ``` > # A tibble: 1 × 3 > lambda alpha .config > <dbl> <dbl> <fct> > 1 0.00191 1 Preprocessor1_Model171 ``` ```r mod_elastic %>% collect_metrics() ``` ``` > # A tibble: 400 × 8 > lambda alpha .metric .estimator mean n std_err .config > <dbl> <dbl> <chr> <chr> <dbl> <int> <dbl> <fct> > 1 0.0001 0 rmse standard 0.435 40 0.00820 Preprocessor1_Model001 > 2 0.0001 0 rsq standard 0.771 40 0.00839 Preprocessor1_Model001 > 3 0.000134 0 rmse standard 0.435 40 0.00820 Preprocessor1_Model002 > 4 0.000134 0 rsq standard 0.771 40 0.00839 Preprocessor1_Model002 > 5 0.000180 0 rmse standard 0.435 40 0.00820 Preprocessor1_Model003 > 6 0.000180 0 rsq standard 0.771 40 0.00839 Preprocessor1_Model003 > 7 0.000242 0 rmse standard 0.435 40 0.00820 Preprocessor1_Model004 > 8 0.000242 0 rsq standard 0.771 40 0.00839 Preprocessor1_Model004 > 9 0.000326 0 rmse standard 0.435 40 0.00820 Preprocessor1_Model005 > 10 0.000326 0 rsq standard 0.771 40 0.00839 Preprocessor1_Model005 > # … with 390 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # .orange[REGRESIÓN] .green[PENALIZADA] .pull-left[ Con `autoplot()` se nos genera una gráfica de las métricas en función de los parámetros (es un ggplot que podemos personalizar a nuestro gusto) ```r mod_elastic %>% autoplot() ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1127-1.png" width="90%" /> ] --- # .orange[REGRESIÓN] .green[PENALIZADA] Para estar en igualdad de condiciones con el resto de modelos que no tenían validación, nos quedamos con los mejores parámetros y lo volvemos a lanzar de forma "simple" solo en train. ```r elastic_net <- linear_reg(mixture = 1, penalty = 0.00257) %>% set_mode("regression") %>% set_engine("glmnet") wflow_elastic <- workflow() %>% add_recipe(rec_boston_elastic) %>% add_model(elastic_net) mod_elastic <- wflow_elastic %>% fit(train_boston) ``` --- # .orange[REGRESIÓN] .green[PENALIZADA] Nos indica que ha eliminado `crim` y `zn` ```r tidy(mod_elastic) ``` ``` > # A tibble: 13 × 3 > term estimate penalty > <chr> <dbl> <dbl> > 1 (Intercept) 4.67 0.00257 > 2 crim 0 0.00257 > 3 zn 0 0.00257 > 4 indus -0.0310 0.00257 > 5 nox -0.129 0.00257 > 6 rm 0.146 0.00257 > 7 age 0.104 0.00257 > 8 dis -0.211 0.00257 > 9 rad 0.114 0.00257 > 10 tax -0.170 0.00257 > 11 ptratio -0.166 0.00257 > 12 black 0.0727 0.00257 > 13 lstat -0.605 0.00257 ``` --- # .orange[REGRESIÓN] .green[PENALIZADA] Fíjate que podemos incluso jugar con la penalización para ver que variables sobreviven, es decir, ver que **.bg-purple_light[variables son más importantes]** para la regresión penalizada. ```r tidy(mod_elastic, penalty = 0.3) ``` ``` > # A tibble: 13 × 3 > term estimate penalty > <chr> <dbl> <dbl> > 1 (Intercept) 4.67 0.3 > 2 crim 0 0.3 > 3 zn 0 0.3 > 4 indus 0 0.3 > 5 nox 0 0.3 > 6 rm 0.0208 0.3 > 7 age 0 0.3 > 8 dis 0 0.3 > 9 rad 0 0.3 > 10 tax 0 0.3 > 11 ptratio 0 0.3 > 12 black 0 0.3 > 13 lstat -0.439 0.3 ``` --- # .orange[PREDICCIÓN] Vamos a **.bg-purple_light[predecir en test]** con los 7 modelos probados ```r # Predecimos test fit_1 <- wflow_boston_1 %>% last_fit(split = split_boston) fit_2 <- wflow_boston_2 %>% last_fit(split = split_boston) fit_multi <- wflow_multi %>% last_fit(split = split_boston) fit_AIC <- wflow_AIC %>% last_fit(split = split_boston) fit_BIC <- wflow_BIC %>% last_fit(split = split_boston) fit_BIC_mejorado <- wflow_BIC_mejorada %>% last_fit(split = split_boston) fit_elastic <- wflow_elastic %>% last_fit(split = split_boston) # Modelos modelos <- list(fit_1, fit_2, fit_multi, fit_BIC, fit_AIC, fit_BIC_mejorado, fit_elastic) ``` --- # .orange[PREDICCIÓN] Haciendo uso de `{purrr}` podemos aplicar acciones a todos los modelos a la vez ```r # Metricas metricas <- imap_dfr(modelos, collect_metrics, .id = "model") %>% mutate(model = case_when(model == "1" ~ "lstat", model == "2" ~ "rm", model == "3" ~ "saturado", model == "4" ~ "AIC", model == "5" ~ "BIC", model == "6" ~ "BIC mejorado", model == "7" ~ "elastic")) metricas ``` ``` > # A tibble: 14 × 5 > model .metric .estimator .estimate .config > <chr> <chr> <chr> <dbl> <fct> > 1 lstat rmse standard 6.85 Preprocessor1_Model1 > 2 lstat rsq standard 0.539 Preprocessor1_Model1 > 3 rm rmse standard 7.46 Preprocessor1_Model1 > 4 rm rsq standard 0.470 Preprocessor1_Model1 > 5 saturado rmse standard 5.62 Preprocessor1_Model1 > 6 saturado rsq standard 0.692 Preprocessor1_Model1 > 7 AIC rmse standard 5.68 Preprocessor1_Model1 > 8 AIC rsq standard 0.685 Preprocessor1_Model1 > 9 BIC rmse standard 5.57 Preprocessor1_Model1 > 10 BIC rsq standard 0.698 Preprocessor1_Model1 > 11 BIC mejorado rmse standard 0.564 Preprocessor1_Model1 > 12 BIC mejorado rsq standard 0.709 Preprocessor1_Model1 > 13 elastic rmse standard 0.560 Preprocessor1_Model1 > 14 elastic rsq standard 0.713 Preprocessor1_Model1 ``` --- # .orange[PREDICCIÓN] Para las predicciones tenemos que acordarnos que en dos de los modelos hemos transformado la objetivo (y por tanto las predicciones) tomando la raíz, que debemos deshacer ```r # Predicciones predicciones <- bind_rows(lapply(modelos, collect_predictions), .id = "model") %>% mutate(model = case_when(model == "1" ~ "lstat", model == "2" ~ "rm", model == "3" ~ "saturado", model == "4" ~ "AIC", model == "5" ~ "BIC", model == "6" ~ "BIC mejorado", model == "7" ~ "elastic")) %>% mutate(medv = ifelse(model %in% c("BIC mejorado", "elastic"), medv^2, medv)) %>% mutate(.pred = ifelse(model %in% c("BIC mejorado", "elastic"), .pred^2, .pred)) predicciones ``` ``` > # A tibble: 714 × 6 > model id .pred .row medv .config > <chr> <chr> <dbl> <int> <dbl> <fct> > 1 lstat train/test split 25.8 2 21.6 Preprocessor1_Model1 > 2 lstat train/test split 30.6 3 34.7 Preprocessor1_Model1 > 3 lstat train/test split 31.6 4 33.4 Preprocessor1_Model1 > 4 lstat train/test split 29.4 5 36.2 Preprocessor1_Model1 > 5 lstat train/test split 18.4 10 18.9 Preprocessor1_Model1 > 6 lstat train/test split 24.8 15 18.2 Preprocessor1_Model1 > 7 lstat train/test split 23.4 19 20.2 Preprocessor1_Model1 > 8 lstat train/test split 18.9 26 13.9 Preprocessor1_Model1 > 9 lstat train/test split 22.2 32 14.5 Preprocessor1_Model1 > 10 lstat train/test split 23.7 37 20 Preprocessor1_Model1 > # … with 704 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # .orange[PREDICCIÓN] .pull-left[ ```r # Gráficos en test ggplot(data = predicciones, aes(x = .pred, y = medv)) + geom_point(aes(color = model), alpha = 0.5, size = 1.5) + scale_color_colorblind() + # Diagonal geom_abline(intercept = 0, slope = 1, color = "black", size = 1) + facet_wrap(~model) + theme_minimal() + labs(title = "Resultados de la regresión lineal univariante", subtitle = "Valores deberían estar cercanos a la diagonal", caption = "Autor: Javier Álvarez Liébana | Datos: Boston dataset", x = "Predicciones", y = "Valores inmobiliarios reales", color = "Modelos") ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1135-1.png" width="90%" /> ] --- class: inverse center middle name: clase-12 # CLASE 12: regresión logística y glm ### [Intro teórica: reg. logística](#intro-teoria-logit) ### [Reg. logística múltiple](#logit-multiple) ### [Modelos lineales generalizados (glm)](#glm) --- name: intro-teoria-logit # .orange[REGRESIÓN] .green[LOGÍSTICA] Vamos a cargar un archivo llamado `manifd.rda` (las extensiones `.rda` y `.RData` son archivos nativos de `R` que se cargan simplemente con `load()`) ```r load("./datos/manif.rda") # convertimos a tibble manif <- as_tibble(manif) glimpse(manif) ``` ``` > Rows: 100 > Columns: 2 > $ man <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,… > $ edad <int> 18, 19, 20, 21, 22, 23, 24, 25, 40, 40, 42, 45, 45, 47, 48, 50, 5… ``` --- # .orange[REGRESIÓN] .green[LOGÍSTICA] Como ves en él solo tenemos **.bg-purple_light[dos variables]**: la edad de la persona y si asistió (`man = 1`) o no (`man = 0`) a una manifestación. Así está repartido ```r manif %>% count(man) ``` ``` > # A tibble: 2 × 2 > man n > <int> <int> > 1 0 76 > 2 1 24 ``` Hasta ahora solo hemos clasificado con árboles y knn. **.bg-purple_light[¿Podríamos usar la regresión lineal de alguna manera?]** --- # .orange[REGRESIÓN] .green[LOGÍSTICA] .pull-left[ ```r # Ploteado ggplot(manif %>% mutate(man = factor(man, labels = c("Sí", "No"))), aes(x = edad, y = man)) + geom_point(aes(color = man), size = 2) + theme_minimal() + labs(x = "Edad (años)", y = "¿Asistió a manifestación?", color = "Asistencia", title = "¿Cómo usar la regresión lineal para CLASIFICAR?", subtitle = "Reminder: la regresión lineal debe cumplir unas hipótesis", caption = paste0("Autor: Javier Álvarez Liébana | ", "Datos: manif.rda")) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1139-1.png" width="90%" /> ] --- # .orange[REGRESIÓN] .green[LOGÍSTICA] Como se observa, los datos tienen tan solo dos variables: * `man` es la variable objetivo y es binaria * `edad` es una cuantitativa continua Recordemos que las **.bg-purple_light[hipótesis de la regresión lineal]** se pueden resumir en `$$Y|(X_1=x_1, \ldots,X_p=x_p) \sim \mathcal{N}(\beta_0 +\beta_1x_1 + \ldots + \beta_p x_p, \sigma_{\epsilon}^{2})$$` -- Sin embargo, en este caso, la variable objetivo `man` tiene la misma distribución que el **.bg-purple_light[lanzamiento de una moneda]**: hay una probabilidad `\(p\)` de asistir (probabilidad de éxito) y de `\(1−p\)` de no asistir (fracaso), lo que se conoce como **.bg-purple_light[distribución Bernoulli]** $$ Y | (X_1=x_1, \ldots, X_p = x_p)\sim Ber(p)$$ --- # .orange[REGRESIÓN] .green[LOGÍSTICA] Hagamos un viaje al pasado...¿cuál era realmente el objetivo de un clasificador? Aunque lo estamos luego traduciendo a 1/0, sí/no, en realidad todos los métodos que hemos visto buscaban lo mismo: imitar al **.bg-purple_light[clasificador Bayesiano]** y **.bg-purple_light[estimar la probabilidad de pertenencia]** a cada uno de los grupos de la variable objetivo. `$$\hat{y_i} = j \quad \text{si} \quad \hat{P}(Y = j | X = \left(x_{1}, \ldots, x_{p} \right) = \max_{g \in G} \hat{P}(Y = g | X = \left(x_{1}, \ldots, x_{p} \right)$$` -- La **.bg-purple_light[probabilidad]** es siempre una función (bajo ciertas condiciones) cuyo resultado es una **.bg-purple_light[variable continua]** (acotada entre [0,1] pero continua). **.bg-purple_light[¿Y si modelizamos como una regresión lineal esa probabilidad p de ser 1 y 1-p de ser 0?]** `$$P(Y = y | X_1=x_1, \ldots, X_p = x_p ) = p^{y} (1-p)^{1-y} = \beta_0 + \beta_1 x_1 + \ldots + \beta_p x_p, \quad y=\left\lbrace 0, 1 \right\rbrace$$` --- # .orange[REGRESIÓN] .green[LOGÍSTICA] Una primera idea podría ser usar la **.bg-purple_light[regresión lineal]** para modelizar esa probabilidad (de ser `\(y\)`, en el caso de un problema binario `\(y\)` podrá ser 1/0). Vamos a realizar un **.bg-purple_light[ajuste lineal y la salida la interpretaremos como la probabilidad]** de ser 1 (de asistir) ```r set.seed(1234567) # Particion manif_split <- initial_split(manif, prop = 0.8, strata = man) train_manif <- training(manif_split) test_manif <- testing(manif_split) # Receta simple manif_rec <- recipe(data = manif, man ~ .) %>% step_impute_mean(all_numeric_predictors()) # Construimos modelo reg. lineal y flujo linear_mod <- linear_reg() %>% set_engine("lm") manif_flow <- workflow() %>% add_model(linear_mod) %>% add_recipe(manif_rec) manif_fit <- manif_flow %>% fit(data = manif) ``` --- # .orange[REGRESIÓN] .green[LOGÍSTICA] ```r # Resumen del modelo tidy(manif_fit) ``` ``` > # A tibble: 2 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) 0.891 0.169 5.26 0.000000852 > 2 edad -0.0147 0.00373 -3.95 0.000145 ``` El ajuste devuelto es `\(\hat{Y} = \hat{P}(Y=1 | X = x) = 0.891 - 0.015 x\)`. Más allá de la bondad de ajuste...¿qué saldría si hacemos **.bg-purple_light[predicción en test]**? --- # .orange[REGRESIÓN] .green[LOGÍSTICA] Vamos a aplicar `last_fit()` para aplicarlo a test y calcular las predicciones con `collect_predictions()`, y ordenamos de menor a mayor. ¡No tiene sentido! **.bg-red_light[¡Obtenemos probabilidades estimadas negativas]** ```r # Predecimos manif_flow %>% last_fit(split = manif_split) %>% collect_predictions() %>% arrange(.pred) ``` ``` > # A tibble: 21 × 5 > id .pred .row man .config > <chr> <dbl> <int> <int> <fct> > 1 train/test split -0.0586 21 1 Preprocessor1_Model1 > 2 train/test split 0.0116 19 1 Preprocessor1_Model1 > 3 train/test split 0.0291 17 1 Preprocessor1_Model1 > 4 train/test split 0.0817 98 0 Preprocessor1_Model1 > 5 train/test split 0.0993 74 0 Preprocessor1_Model1 > 6 train/test split 0.0993 75 0 Preprocessor1_Model1 > 7 train/test split 0.0993 97 0 Preprocessor1_Model1 > 8 train/test split 0.134 33 0 Preprocessor1_Model1 > 9 train/test split 0.134 71 0 Preprocessor1_Model1 > 10 train/test split 0.134 93 0 Preprocessor1_Model1 > # … with 11 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # .orange[REGRESIÓN] .green[LOGÍSTICA] .pull-left[ De hecho la diagnosis es un pequeño desastre ```r check_model(manif_fit %>% extract_fit_engine()) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1145-1.png" width="90%" /> ] --- # .orange[REGRESIÓN] .green[LOGÍSTICA] Tenemos que **.bg-purple_light[garantizar de alguna manera]** que la salida de la regresión lineal acabe **.bg-purple_light[dentro del rango [0,1]]**. -- La solución va a ser **.bg-purple_light[encapsular la salida de la regresión lineal]** `\(\beta_0 + \beta_1 x_1 + \ldots + \beta_p x_p\)` con una función `\(g^{-1}:\mathbb{R} \to [0,1]\)` que tome de entrada un valor continua y lo **.bg-purple_light[comprima]** dentro del rango `\([0,1]\)`. `$$P(Y = 1 | X_1=x_1, \ldots, X_p = x_p ) = p = g^{-1} \left(\beta_0 + \beta_1 x_1 + \ldots + \beta_p x_p\right) := g^{-1} \left(\eta\right)$$` donde llamaremos `\(\eta = \beta_0 + \beta_1 x_1 + \ldots + \beta_p x_p\)` a la salida de la reg. lineal (por abreviar). De la misma manera, si `\(g^{-1} (\eta) = p\)`, entonces `$$g(p) = \eta = \beta_0 + \beta_1 x_1 + \ldots + \beta_p x_p$$` --- # .orange[REGRESIÓN] .green[LOGÍSTICA] `$$P(Y = 1 | X_1=x_1, \ldots, X_p = x_p ) = p = g^{-1} \left(\beta_0 + \beta_1 x_1 + \ldots + \beta_p x_p\right) := g^{-1} \left(\eta\right)$$` donde llamaremos `\(\eta = \beta_0 + \beta_1 x_1 + \ldots + \beta_p x_p\)` a la salida de la reg. lineal (por abreviar). En función de las **.bg-purple_light[distintas funciones de enlace]** obtenemos distintos modelos: * **.bg-purple_light[Enlace uniforme (unit)]**: función `\(g^{−1}(\eta)=\eta I_{0< \eta < 1} + I_{\eta \geq 1}\)` (nos devuelve 0 si `\(\eta \geq 0\)`, `\(\eta\)` si `\(0<\eta<1\)` y 1 si `\(\eta \geq 1\)`. * **.bg-purple_light[Enlace probit]**: función `\(g^{−1}(\eta) = \Phi (\eta)\)` basada en la distribución acumulada de una **.bg-purple_light[normal]** tal que `\(\Phi(x)=\frac{1}{\sqrt{2\pi}} \int_{-\infty}^{x} e^{-\frac{u^2}{2}} du\)`, para todo `\(x \in \mathbb{R}\)`. * **.bg-purple_light[Enlace logit]**: función `\(g^{−1}(\eta) = logistic(\eta):= \frac{e^{\eta}}{1 + e^{\eta}} = \frac{1}{1 + e^{-\eta}}\)` basada en la distribución acumulada de una **.bg-purple_light[distribución logística]**. --- # .orange[REGRESIÓN] .green[LOGÍSTICA] <img src="index_files/figure-html/unnamed-chunk-1146-1.png" width="50%" style="display: block; margin: auto;" /> --- # .orange[REGRESIÓN] .green[LOGÍSTICA] Pero cuidado... **.bg-red_light[no sirve cualquier función]** de enlace: necesitamos unas **.bg-purple_light[mínimas condiciones de regularidad]** -- * **.bg-purple_light[Invertible]**: `\(g:[0,1]\to \mathbb{R}\)` debe ser invertible. -- * **.bg-purple_light[Soporte en [0,1]]**: `\(g()\)` definida para cualquier valor `\(p\)` en `\([0,1]\)`. -- * **.bg-purple_light[Codominio real]**: `\(g^{−1}()\)` definida para cualquier valor `\(\eta\)` en `\(\mathbb{R}\)`. -- * **.bg-purple_light[Monótona creciente]**: dado que `\(\beta_0 + \beta_1x_1 +\ldots + \beta_p x_p\)` cuantifica el **.bg-purple_light[efecto de los predictores en la probabilidad de éxito]** de la variable objetivo, la probabilidad debe aumentar según crezca dicha cantidad, así que `\(g^{−1}()\)` **.bg-purple_light[NUNCA decrece]**. --- # .orange[REGRESIÓN] .green[LOGÍSTICA] .pull-left[ La función de enlace más usada es la **.bg-purple_light[función logit]** `$$g(p) := logit(p) = log \left(\frac{p}{1 - p} \right)$$` `$$g^{-1} (\eta) = \frac{1}{1 + e^{-\eta}}$$` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1147-1.png" width="90%" /> ] --- # .orange[INTERPRETACIÓN] de .green[COEFICIENTES] Tenemos básicamente tres escenarios * Si `\(\hat{\eta} = \hat{\beta}_0 + \hat{\beta}_1x_1 +\ldots + \hat{\beta}_p x_p = 0\)`, entonces `\(\hat{p} = g^{-1}(\eta) = \frac{1}{1 + e^{0}} = 0.5\)` (la probabilidad de éxito es la misma que la de fracaso) * Si `\(\hat{\eta} = \hat{\beta}_0 + \hat{\beta}_1x_1 +\ldots + \hat{\beta}_p x_p < 0\)`, entonces `\(\hat{p} = g^{-1}(\eta) = \frac{1}{1 + e^{-\eta}} < 0.5\)` (la probabilidad de éxito menor que la de fracaso, sería clasificado como 0) * Si `\(\hat{\eta} = \hat{\beta}_0 + \hat{\beta}_1x_1 +\ldots + \hat{\beta}_p x_p > 0\)`, entonces `\(\hat{p} = g^{-1}(\eta) = \frac{1}{1 + e^{-\eta}} > 0.5\)` (la probabilidad de éxito mayor que la de fracaso, sería clasificado como 1) --- # .orange[INTERPRETACIÓN] de .green[COEFICIENTES] En el contexto de la regresión logística, es habitual hablar de **.bg-purple_light[odds o cuotas]**. Imagina que tiramos un dado y llamamos «éxito» (1) a obtener un 1,2,3 o un 4 en la tirada: ¿cómo expresar la probabilidad de éxito? -- La forma más sencilla e inmediata es decir que tenemos una probabilidad `\(p=2/3\)` de obtener éxito. Pero otra opción es **.bg-purple_light[enfrentar la probabilidad de éxito con la de fracaso]**: ¿cuántas veces es más o menos probable el éxito que el fracaso? -- En este caso, `\(\frac{p}{1-p} = \frac{2/3}{1/3}=2\)`: hay el doble de opciones de acertar que de fracasar, así que se dice que el **.bg-purple_light[evento tiene un ratio 2:1]**. A dicho cociente o ratio se le conoce como **.bg-purple_light[odds o cuota]** `$$odds(Y)=\frac{p}{1-p} = \frac{g^{-1}(\eta)}{1 - g^{-1}(\eta)}, \quad p = \frac{odds(Y)}{1 + odds(Y)}$$` --- # .orange[INTERPRETACIÓN] de .green[COEFICIENTES] En el caso particular de usar logit `$$odds(Y)=\frac{p}{1-p} = \frac{g^{-1}(\eta)}{1 - g^{-1}(\eta)} = \frac{1/(1+e^{-\eta})}{1 - 1/(1+e^{-\eta})} = \frac{1}{1+e^{-\eta} - 1} = e^{\eta}$$` Aplicando las propiedades la exponencial `$$odds(Y)=\frac{p}{1-p} = e^{\eta} = e^{\beta_0 + \beta_1 x_1 + \ldots + \beta_p x_p} = e^{\beta_0} e^{\beta_1x_1} \ldots e^{\beta_px_p}$$` -- Si linealizamos tomando **.bg-purple_light[logaritmos]** obtenemos los **.bg-purple_light[log-odds]** `$$log-odds(Y)=log(e^{\eta}) = \eta = \beta_0 + \beta_1 x_1 + \ldots + \beta_p x_p$$` --- # .orange[INTERPRETACIÓN] de .green[COEFICIENTES] `$$log-odds(Y)=log(e^{\eta}) = \eta = \beta_0 + \beta_1 x_1 + \ldots + \beta_p x_p$$` Por tanto la **.bg-purple_light[interpretación de los coeficientes]** es la siguiente: * `\(\beta_0\)`: la **.bg-purple_light[estimación (media) de log-odds]** cuando `\(X_1=\ldots=X_p=0\)`. * `\(\beta_j\)` con `\(j \geq 1\)`: el **.bg-purple_light[incremento aditivo medio de log-odds]** para un **.bg-purple_light[incremento unitario]** de `\(X_j\)`, siempre y cuando el resto permanezcan fijas. --- # .orange[INTERPRETACIÓN] de .green[COEFICIENTES] `$$odds(Y)=\frac{p}{1-p} = e^{\eta} = e^{\beta_0 + \beta_1 x_1 + \ldots + \beta_p x_p} = e^{\beta_0} e^{\beta_1x_1} \ldots e^{\beta_px_p}$$` En el caso de los odds son más interpretables que los anteriores: * `\(e^{\beta_0}\)`: la **.bg-purple_light[estimación (media) de odds]** cuando `\(X_1=\ldots=X_p=0\)`, es decir, el **.bg-purple_light[ratio esperado p:1−p]** (éxito vs fracaso) cuando `\(X_1=\ldots=X_p=0\)` * `\(e^{\beta_j}\)` con `\(j \geq 1\)`: el **.bg-purple_light[incremento multiplicativo medio de odds]** para un **.bg-purple_light[incremento aditivo unitario]** de `\(X_j\)`, siempre y cuando el resto permanezcan fijas. Dicho de otra manera: por cada unidad que se incremente `\(X_j\)` (manteniendo el resto fijas), el **.bg-purple_light[ratio éxito/fracaso se verá multiplicado]** por `\(e^{\beta_j}\)`: si `\(\beta_j > 0\)`, aumentará el ratio por cada unidad incrementada de `\(X_j\)`; si `\(\beta_j < 0\)`, disminuirá. --- # .orange[REGRESIÓN] .green[LOGÍSTICA] Para definir el modelo de reg. logística bastará con definir `logistic_reg() %>% set_engine("glm")` como modelo (glm son las siglas de general linearl models, luego veremos porqué). Como sucedía en árboles y knn, la **.bg-purple_light[objetivo ya no puede ser numérica sino factor]** ```r manif_factor <- manif %>% mutate(man = as_factor(man)) # Receta simple manif_rec <- recipe(data = manif_factor, man ~ .) %>% step_impute_mean(all_numeric_predictors()) # Construimos modelo reg. logística logit_mod <- logistic_reg() %>% set_engine("glm") # Flujo manif_flow <- workflow() %>% add_model(logit_mod) %>% add_recipe(manif_rec) manif_fit <- manif_flow %>% fit(data = manif_factor) ``` --- # .orange[REGRESIÓN] .green[LOGÍSTICA] Vamos a **.bg-purple_light[interpretar los coeficientes]** ```r manif_fit %>% extract_fit_engine() %>% coef() ``` ``` > (Intercept) edad > 2.24287128 -0.08068845 ``` La **.bg-purple_light[probabilidad de asistir]** queda estimada como `$$\hat{\eta} = 2.2429 - 0.0807x, \quad \hat{p} = \hat{P}(Y=1 | X=x) = \frac{1}{1 + e^{-(2.2429 - 0.0807x)}}$$` --- # .orange[REGRESIÓN] .green[LOGÍSTICA] Aplicando la exponencial obtenemos los log-odds ```r manif_fit %>% extract_fit_engine() %>% coef() %>% exp() ``` ``` > (Intercept) edad > 9.420341 0.922481 ``` * Es **.bg-purple_light[9.42 veces más probable]** que una persona de 0 años asista a la manifestación a que no lo haga (interpretación inservible ya que X=0 no está dentro del rango) * Por **.bg-purple_light[cada año que cumpla la persona]**, la probabilidad de asistir frente a no asistir se multiplica por 0.9225, es decir, se **.bg-purple_light[reduce un 7.75%]**. --- # .orange[REGRESIÓN] .green[LOGÍSTICA] Así quedarían las predicciones y se calcularían las cuotas ```r # Predicciones y odds predicciones <- augment(manif_fit, new_data = test_manif) %>% mutate(odds = .pred_1 / .pred_0, log.odds = log(odds)) predicciones ``` ``` > # A tibble: 21 × 7 > man edad .pred_class .pred_0 .pred_1 odds log.odds > <int> <int> <fct> <dbl> <dbl> <dbl> <dbl> > 1 1 19 1 0.330 0.670 2.03 0.710 > 2 1 56 0 0.907 0.0932 0.103 -2.28 > 3 1 57 0 0.913 0.0866 0.0948 -2.36 > 4 1 61 0 0.936 0.0642 0.0686 -2.68 > 5 1 25 1 0.444 0.556 1.25 0.226 > 6 0 38 0 0.695 0.305 0.439 -0.823 > 7 0 50 0 0.857 0.143 0.167 -1.79 > 8 0 48 0 0.836 0.164 0.196 -1.63 > 9 0 49 0 0.847 0.153 0.181 -1.71 > 10 0 41 0 0.744 0.256 0.345 -1.07 > # … with 11 more rows > # ℹ Use `print(n = ...)` to see more rows ``` --- # .orange[REGRESIÓN] .green[LOGÍSTICA] Podemos como en casos anteriores calcular la matriz de confusión ```r # Matriz de confusión predicciones %>% conf_mat(man, .pred_class) ``` ``` > Truth > Prediction 0 1 > 0 16 3 > 1 0 2 ``` ```r # Accuracy predicciones %>% accuracy(truth = as_factor(man), estimate = .pred_class) ``` ``` > # A tibble: 1 × 3 > .metric .estimator .estimate > <chr> <chr> <dbl> > 1 accuracy binary 0.857 ``` --- # .orange[REGRESIÓN] .green[LOGÍSTICA] .pull-left[ ```r # Ploteado ggplot(predicciones, aes(x = edad, y = .pred_1, color = factor(man, labels = c("No", "Sí")), shape = factor(.pred_class, labels = c("No", "Sí")))) + geom_point(size = 3, alpha = 0.5) + theme_minimal() + labs(x = "Edad (años)", y = "Probabilidad de asistir", color = "Realidad", shape = "Predicción", title = "Ajuste de la regresión logística", caption = paste0("Autor: Javier Álvarez Liébana | ", "Datos: manif.rda")) ``` ] .pull-right[ <img src="index_files/figure-html/unnamed-chunk-1154-1.png" width="90%" /> ] --- name: logit-multiple # .orange[LOGÍSTICA] .green[MÚLTIPLE] Vamos a ver un ejemplo más complejo con varias variables: la **.bg-purple_light[regresión logística múltiple]**, y para ello cargaremos **.bg-purple_light[datos de incidencia cardiaca]**. ```r load("./datos/incidencia_cardiaca.rda") cardio <- as_tibble(datos2) glimpse(cardio) ``` ``` > Rows: 200 > Columns: 8 > $ codigo <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,… > $ edad <int> 44, 35, 41, 31, 61, 61, 44, 58, 52, 52, 52, 40, 49, 34, 37… > $ psistolica <int> 124, 110, 114, 100, 190, 130, 130, 110, 120, 120, 130, 120… > $ pdiastolica <int> 80, 70, 80, 80, 110, 88, 94, 74, 80, 80, 80, 90, 75, 80, 7… > $ colesterol <int> 254, 240, 279, 284, 315, 250, 298, 384, 310, 337, 367, 273… > $ altura <int> 70, 73, 68, 68, 68, 70, 68, 67, 66, 67, 69, 68, 66, 74, 65… > $ peso <int> 190, 216, 178, 149, 182, 185, 161, 175, 144, 130, 162, 175… > $ problemas <fct> 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0… ``` El objetivo de nuestra regresión logística será **.bg-purple_light[clasificar si el paciente ha tenido o no problemas cardíacos]** (variable `problemas`) --- # .orange[LOGÍSTICA] .green[MÚLTIPLE] ```r cardio %>% count(problemas) %>% mutate(porc = 100 * n / sum(n)) ``` ``` > # A tibble: 2 × 3 > problemas n porc > <fct> <int> <dbl> > 1 0 174 87 > 2 1 26 13 ``` Tenemos una variable objetivo desbalanceada así que tendremos que incluir **.bg-purple_light[sobremuestreo en la futura receta]** --- # .orange[LOGÍSTICA] .green[MÚLTIPLE] Lo primero es siempre **.bg-purple_light[realizar la partición]**. Como sucedía en la regresión sin penalizar, **.bg-purple_light[no tiene sentido crear validación]** ya que ningún hiperparámetro a afinar. ```r set.seed(12345) # partición 80-20% split_cardio <- initial_split(cardio, prop = 0.8, strata = problemas) cardio_train <- training(split_cardio) cardio_test <- testing(split_cardio) ``` --- # .orange[LOGÍSTICA] .green[MÚLTIPLE] No tenemos ninguna predictora cualitativa salvo la **.bg-purple_light[variable código que en realidad es un ID]** (algo cualitativo, que no debería de entrar en el ajuste, así que la eliminaremos) ```r rec_cardio <- recipe(data = cardio_train, problemas ~ .) %>% # Eliminamos step_rm(codigo) %>% # Outliers step_mutate(across(all_numeric_predictors(), function(x) { ifelse(abs(scores(x)) > 2, NA, x)})) %>% # Imputamos step_impute_mean(all_numeric_predictors()) %>% # umbral de correlación step_corr(all_numeric_predictors(), threshold = 0.9) %>% # filtro cero varianza y oversampling step_zv(all_predictors()) %>% themis::step_upsample(problemas, over_ratio = 0.5) ``` --- # .orange[LOGÍSTICA] .green[MÚLTIPLE] Tras ello definimos modelo y flujo, y realizamos el **.bg-purple_light[ajuste]** ```r # Construimos modelo log_reg <- logistic_reg() %>% set_engine("glm") # Construimos flujo cardio_flow <- workflow() %>% add_model(log_reg) %>% add_recipe(rec_cardio) # Ajuste cardio_fit <- cardio_flow %>% fit(data = cardio_train) ``` --- # .orange[LOGÍSTICA] .green[MÚLTIPLE] Vamos a **.bg-purple_light[interpretar la exponencial de los coeficientes]** para interpretarlo en términos de las cuotas/odds ```r exp(coef(cardio_fit %>% extract_fit_engine())) ``` ``` > (Intercept) edad psistolica pdiastolica colesterol altura > 2.220418e-06 1.060119e+00 9.929319e-01 1.038311e+00 1.006721e+00 1.041851e+00 > peso > 1.014745e+00 ``` * `\(e^{\hat{\beta}_0} = 0.00000222\)`: si todas las predictoras fuesen cero (algo irreal, ya que se salen del rango y no puedes tener edad nula o colesterol nulo), hay un 99.99978% menos de probabilidad de tener problemas cardiacos que de no tenerlos. --- # .orange[LOGÍSTICA] .green[MÚLTIPLE] Vamos a **.bg-purple_light[interpretar la exponencial de los coeficientes]** para interpretarlo en términos de las cuotas/odds ```r exp(coef(cardio_fit %>% extract_fit_engine())) ``` ``` > (Intercept) edad psistolica pdiastolica colesterol altura > 2.220418e-06 1.060119e+00 9.929319e-01 1.038311e+00 1.006721e+00 1.041851e+00 > peso > 1.014745e+00 ``` * **.bg-purple_light[Variables edad, pdiastolica, colesterol, peso, altura]**: al tener `\(\hat{\beta}_j>0\)`, implica que sus **.bg-purple_light[coef. exponenciales son mayores que 1]**, así que por cada **.bg-purple_light[incremento unitario]** de estas variables, se produce un **.bg-purple_light[incremento en la probabilidad de tener un problema cardiaco]** frente a no tenerlo (son los llamados factores de riesgo). * **.bg-purple_light[Variable psistolica]**: al tener `\(\hat{\beta}_j <0\)`, implica que sus coeficientes exponenciales son menores que 1, así que por cada incremento unitario de estas variables, se produce un decrecimiento en la probabilidad de tener un problema cardiaco frente a no tenerlo. --- # .orange[LOGÍSTICA] .green[MÚLTIPLE] ¿Cómo se **.bg-purple_light[evalúa]** una regresión logística (cualquier modelo lineal generalizado)? -- Para ello debemos introducir el **.bg-purple_light[concepto de anomalía o deviance (D)]**: es una una generalización del SSR (suma de residuos al cuadrado) del modelo lineal, definido como la **.bg-purple_light[diferencia entre la log-verosimilitud de mi modelo saturado]** (un modelo sobreajustado, que acertará siempre cada punto) y la **.bg-purple_light[log-verosimilitud de mi ajuste]** `$$D = -2(\mathcal{L}_{\hat{\beta}} - \mathcal{L}_{saturado}) \geq 0$$` donde como antes la log-verosimilitud cuantifica como de probable es que, si el modelo fuese cierto, hayamos obtenido los resultados que hemos obtenido), definida como `\(ln(P(observado | modelo))\)` De forma sencilla, `\(D\)` será lo que le **.bg-purple_light[falta a nuestro modelo para ser «perfecto»]** (en el sentido de saturado/sobreajustado, el modelo más probable dada una muestra). --- # .orange[LOGÍSTICA] .green[MÚLTIPLE] Al igual que en la bondad de ajuste de un modelo lineal se usa como referencia la suma total de los cuadrados (SST), definiendo `\(R^2 = 1 − \frac{SSE}{SST}\)`, aquí llamaremos `\(D_0\)` a la **.bg-purple_light[anomalía nula o null deviance]**: aquella obtenida al comparar el modelo perfecto frente a un **.bg-purple_light[modelo sin parámetros]**, solo con el intercepto. `$$D = -2(\mathcal{L}_{\hat{\beta}_0} - \mathcal{L}_{saturado}) \geq 0$$` Con ambas deviance podemos definir un **.bg-purple_light[pseudo-R2]** conocido como **.bg-purple_light[coeficiente de McFadden]** `$$R^2 = 1 - \frac{D}{D_0}$$` --- # .orange[LOGÍSTICA] .green[MÚLTIPLE] Dichos valores se pueden ver haciendo un `summary()` del ajuste ```r cardio_fit %>% extract_fit_engine() %>% summary() ``` ``` > > Call: > stats::glm(formula = ..y ~ ., family = stats::binomial, data = data) > > Deviance Residuals: > Min 1Q Median 3Q Max > -1.7950 -0.8144 -0.5051 0.9273 2.3077 > > Coefficients: > Estimate Std. Error z value Pr(>|z|) > (Intercept) -13.017815 5.588406 -2.329 0.01984 * > edad 0.058381 0.018417 3.170 0.00152 ** > psistolica -0.007093 0.016577 -0.428 0.66873 > pdiastolica 0.037595 0.032040 1.173 0.24065 > colesterol 0.006699 0.002682 2.498 0.01249 * > altura 0.040999 0.075466 0.543 0.58694 > peso 0.014637 0.008201 1.785 0.07430 . > --- > Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 > > (Dispersion parameter for binomial family taken to be 1) > > Null deviance: 264.33 on 207 degrees of freedom > Residual deviance: 222.08 on 201 degrees of freedom > AIC: 236.08 > > Number of Fisher Scoring iterations: 4 ``` --- # .orange[LOGÍSTICA] .green[MÚLTIPLE] Dichos valores también se pueden ver haciendo un resumen del ajuste con `glance()` (donde `logLik` es justo la log-verosimilitud del modelo) ```r glance(cardio_fit) ``` ``` > # A tibble: 1 × 8 > null.deviance df.null logLik AIC BIC deviance df.residual nobs > <dbl> <int> <dbl> <dbl> <dbl> <dbl> <int> <int> > 1 264. 207 -111. 236. 259. 222. 201 208 ``` Ese «pseudo-R2» que hemos calculado se conoce también como coeficiente de McFadden y podemos extraerlo con la función `pR2()` del paquete `{pscl}`. ```r library(pscl) pR2(cardio_fit %>% extract_fit_engine()) ``` ``` > fitting null model for pseudo-r2 ``` ``` > llh llhNull G2 McFadden r2ML r2CU > -111.0377036 -132.1626951 42.2499828 0.1598408 0.1838237 0.2555266 ``` --- # .orange[LOGÍSTICA] .green[MÚLTIPLE] Si te fijas volvemos a tener en la salida de `tidy()` unos p-valores que nos indican que hay variables que no están siendo significativas (por ejemplo `psistolica` o `altura`), así que deberemos **.bg-purple_light[realizar una selección stepwise de modelos]** como antes ```r tidy(cardio_fit) ``` ``` > # A tibble: 7 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) -13.0 5.59 -2.33 0.0198 > 2 edad 0.0584 0.0184 3.17 0.00152 > 3 psistolica -0.00709 0.0166 -0.428 0.669 > 4 pdiastolica 0.0376 0.0320 1.17 0.241 > 5 colesterol 0.00670 0.00268 2.50 0.0125 > 6 altura 0.0410 0.0755 0.543 0.587 > 7 peso 0.0146 0.00820 1.78 0.0743 ``` --- # .orange[LOGÍSTICA] .green[MÚLTIPLE] Pero dado que para la selección BIC/AIC vamos a tener que "salirnos" del entorno tidymodels y aplicar una función (en concreto `glm()` en lugar del `lm()` de antes), veamos antes que es eso de `glm()` o modelos lineales generalizados. --- name: glm # Modelos .orange[GLM] A lo largo del documento hemos mencionado varias veces a los **.bg-purple_light[modelos lineales generalizados]**. ¿Qué son? -- La idea es aplicar la misma filosofía de la regresión logística: **.bg-purple_light[encapsular una combinación lineal de parámetros]** mediante el uso de una función enlace. Los **.bg-purple_light[modelos lineales generalizados (glm)]** son una generalización de los mismos, de las siguientes maneras * **.bg-purple_light[Cambiar enlace g]**: por ejemplo, el modelo probit mantiene todo igual pero cambia la función que actua sobre `\(\eta\)` * **.bg-purple_light[Cambiar el soporte de Y]**: la variable respuesta `\(Y\)` podría no ser binaria sino tomar varias categorías (**.bg-purple_light[regresión logística multinomial]**) o incluso infinitas discretas (**.bg-purple_light[regresión de Poisson]**). --- # Modelos .orange[GLM] La idea es aplicar la misma filosofía de la regresión logística: **.bg-purple_light[encapsular una combinación lineal de parámetros]** mediante el uso de una función enlace. Los **.bg-purple_light[modelos lineales generalizados (glm)]** son una generalización de los mismos, de las siguientes maneras * **.bg-purple_light[Distribución condicional]**: hasta ahora `\(Y|(X_1=x_1,\ldots, X_p=x_p) \sim Ber(logistic(\eta))\)`, pero la distribución de Bernoulli es un caso particular de la **.bg-purple_light[familia exponencial de distribuciones]**. Decimos que `\(Y|(X_1=x_1,\ldots, X_p=x_p) \sim E(\eta(\beta),\phi,a,b,c)\)` donde `\(E(\eta(\beta),\phi,a,b,c)\)` representa lo que se conoce como familia de distribuciones exponenciales, aquellas cuya función de densidad se puede definirde manera general como `$$f(y;\theta,\phi)= e^{\frac{y\theta − b(\theta)}{a(\phi)} + c(y,\phi)}, \quad Y \sim E(\theta,\phi,a,b,c)$$` Un ejemplo de distribuciones de la familia exponencial son la Normal, exponencial, gamma, chi-cuadrado, Binomial o Poisson. El ejemplo más famoso fuera de la familia exponencial es la t-Student. --- # Modelos .orange[GLM] `$$f(y;\theta,\phi)= e^{\frac{y\theta − b(\theta)}{a(\phi)} + c(y,\phi)}, \quad Y \sim E(\theta,\phi,a,b,c)$$` El parámetro `\(\phi\)` se conoce como **.bg-purple_light[escala]** (si se conoce se dice que es una familia exponencial con parámetro canónico de interés `\(\theta\)`). Lo **.bg-purple_light[interesante de la familia exponencial]** es que se cumple que `$$\mu = E[Y] = b'(\theta), \quad \sigma^2 = Var[Y] = b''(\theta)a(\phi)$$` y además nuestra **.bg-purple_light[función de enlace]** (canónica) se definirá como una función `\(g\)` (cumpliendo las condiciones) tal que `\(\theta = (b')^{−1}(\mu)=g(\mu)\)`. --- # Modelos .orange[GLM] `$$f(y;\theta,\phi)= exp \left\lbrace \frac{y\theta − b(\theta)}{a(\phi)} + c(y,\phi) \right\rbrace, \quad Y \sim E(\theta,\phi,a,b,c)$$` Veamos un ejemplo con la **.bg-purple_light[distribución normal]**: vamos a tomar su función de densidad y vamos a ponerla de tal forma que podamos sustituir valores en la ecuación de arriba `$$\begin{eqnarray} f(y; \theta, \phi ) &=& \frac{1}{\sqrt{2 \pi} \sigma} e^{-\frac{(y - \mu)^2}{2 \sigma^2}} = \frac{1}{\sqrt{2 \pi} \sigma} e^{\frac{-y^2 - \mu^2 + 2y\mu}{2 \sigma^2}} = e^{ln(\frac{1}{\sqrt{2 \pi} \sigma})} e^{\frac{-y^2 - \mu^2 + 2y\mu}{2 \sigma^2}} = e^{ln\left(\left(2 \pi \sigma \right)^{-1/2} \right)} e^{\frac{-y^2 - \mu^2 + 2y\mu}{2 \sigma^2}} \nonumber \\ &=& exp \left\lbrace \frac{-y^2 - \mu^2 + 2y\mu}{2 \sigma^2} - \frac{1}{2} \ln \left(2 \pi \sigma^2 \right) \right\rbrace = exp \left\lbrace \frac{y\mu - \mu^2 / 2}{\sigma^2} + \left[- \frac{1}{2} \ln \left(2 \pi \sigma^2 \right) - \frac{y^2}{2 \sigma^2} \right] \right\rbrace \nonumber \end{eqnarray}$$` * `\(\theta = \mu\)` y `\(b(\theta) = \frac{\theta^2}{2}\)` (se cumple que `\(b'(\theta) = \mu\)`), por lo que `\(g(\mu) = \theta = \mu\)` (es decir, la **.bg-purple_light[función enlace es la identidad]**) * Como `\(b''(\theta) = 1\)` y `\(\sigma^2 = b''(\theta) * a(\phi)\)`, entonces `\(a(\phi) = \phi = \sigma^2\)`. * Por último, `\(c(y, \phi) = - \frac{1}{2} \ln \left(2 \pi \phi \right) - \frac{y^2}{2 \phi}\)` --- # Modelos .orange[GLM] `$$f(y;\theta,\phi)= exp \left\lbrace \frac{y\theta − b(\theta)}{a(\phi)} + c(y,\phi) \right\rbrace, \quad Y \sim E(\theta,\phi,a,b,c)$$` Vamos a repetir la idea con la función de densidad de `\(Y\)` para una **.bg-purple_light[logística]** (que hemos dicho que sigue una Bernoulli, que es un caso particular de binomial con `\(n=1\)`) `$$\begin{eqnarray} f(y; \theta, \phi ) &=& {n \choose y} p^y (1-p)^{n - y} = p^y (1-p)^{1 - y} = exp \left\lbrace ln(p^y) \right\rbrace exp \left\lbrace ln((1-p)^{1 - y}) \right\rbrace \nonumber \\ &=& exp \left\lbrace yln(p) \right\rbrace exp \left\lbrace (1 - y)ln(1-p) \right\rbrace = exp \left\lbrace y \ln \left(\frac{p}{1-p} \right) + \ln \left(1-p\right) + \ln \left(1 \right) \right\rbrace \nonumber \end{eqnarray}$$` * `\(\theta = \ln \left(\frac{p}{1-p} \right)\)` y `\(b(\theta) = \frac{\theta^2}{2}\)` por lo que `\(g(\mu) = \theta = \ln \left(\frac{p}{1-p} \right)\)` (es decir, la función de enlace logit que habíamos visto) * `\(b(\theta) = -ln(1-p)\)`, y si despejamos `\(p\)` de arriba, tenemos que `\(b(\theta) = -ln(1-\frac{\theta}{1+\theta})\)`. * `\(a \left( \phi \right) = 1\)`, `\(\phi = 1\)` y `\(c(y, \phi) = \ln \left(1\right)\)` --- # Modelos .orange[GLM] La potencia de la **.bg-purple_light[teoría de modelos lineales generalizados]** es que una gran variedad de modelos en realidad son casos particulares de un modelo general. <div class="figure" style="text-align: center"> <img src="./img/glm.jpg" alt="Tabla de algunos GLM" width="85%" /> <p class="caption">Tabla de algunos GLM</p> </div> --- # Modelos .orange[GLM] Si volvemos a nuestra regresión logística, teníamos pendiente **.bg-purple_light[preparar receta y ejecutar el ajuste manual]** para luego hacer `stepAIC()` ```r cardio_prep <- bake(rec_cardio %>% prep(), new_data = NULL) ``` Para aplicarlo simplemente debemos usar la familia `glm()` e indicarle que **.bg-purple_light[familia de distribuciones]** (de todas las de la tabla anterior) queremos usar (que caso particular de glm queremos). En el caso de la **.bg-purple_light[logística será la familia binomial]** (si fuese una reg. lineal sería `"gaussian"`). ```r reg_logit_glm <- glm(data = cardio_prep, problemas ~ ., * family = "binomial") ``` --- # Modelos .orange[GLM] Tras ello volvemos como antes a ejecutar `stepAIC()` (voy a lanzar solo el AIC por simplificar) ```r # AIC cardio_fit_AIC <- stepAIC(reg_logit_glm, k = 2) ``` ``` > Start: AIC=236.08 > problemas ~ edad + psistolica + pdiastolica + colesterol + altura + > peso > > Df Deviance AIC > - psistolica 1 222.26 234.26 > - altura 1 222.37 234.37 > - pdiastolica 1 223.47 235.47 > <none> 222.07 236.07 > - peso 1 225.32 237.32 > - colesterol 1 228.59 240.59 > - edad 1 232.78 244.78 > > Step: AIC=234.26 > problemas ~ edad + pdiastolica + colesterol + altura + peso > > Df Deviance AIC > - altura 1 222.50 232.50 > - pdiastolica 1 224.23 234.23 > <none> 222.26 234.26 > - peso 1 225.77 235.77 > - colesterol 1 228.68 238.68 > - edad 1 233.22 243.22 > > Step: AIC=232.5 > problemas ~ edad + pdiastolica + colesterol + peso > > Df Deviance AIC > - pdiastolica 1 224.26 232.26 > <none> 222.50 232.50 > - peso 1 227.96 235.96 > - colesterol 1 228.68 236.68 > - edad 1 233.23 241.23 > > Step: AIC=232.26 > problemas ~ edad + colesterol + peso > > Df Deviance AIC > <none> 224.26 232.26 > - peso 1 232.25 238.25 > - colesterol 1 232.93 238.93 > - edad 1 243.56 249.56 ``` --- # Modelos .orange[GLM] Nos ha acabado dejando como factores de riesgo lo obvio: edad, colesterol y peso. ```r tidy(cardio_fit_AIC) ``` ``` > # A tibble: 4 × 5 > term estimate std.error statistic p.value > <chr> <dbl> <dbl> <dbl> <dbl> > 1 (Intercept) -9.25 1.69 -5.48 0.0000000418 > 2 edad 0.0645 0.0155 4.16 0.0000324 > 3 colesterol 0.00732 0.00253 2.89 0.00383 > 4 peso 0.0194 0.00703 2.76 0.00579 ``` --- # Modelos .orange[GLM] ```r exp(coef(cardio_fit_AIC)) ``` ``` > (Intercept) edad colesterol peso > 9.647417e-05 1.066654e+00 1.007349e+00 1.019590e+00 ``` * Por cada año que cumples, tu probabilidad de problema cardiaco vs no tenerlo se incrementa un 6.665% * Por cada unidad de colesterol que amentas, se incrementa un 0.7349% * Por cada kg de más, aumenta un 1.959% --- # Modelos .orange[GLM] Repetimos la receta quedándonos con la selección de modelos hecha por el AIC ```r set.seed(12345) rec_cardio_AIC <- recipe(data = cardio_train, problemas ~ edad + colesterol + peso) %>% step_mutate(across(all_numeric_predictors(), function(x) { ifelse(abs(scores(x)) > 2, NA, x)})) %>% step_impute_mean(all_numeric_predictors()) %>% step_corr(all_numeric_predictors(), threshold = 0.9) %>% step_zv(all_predictors()) %>% themis::step_upsample(problemas, over_ratio = 0.5) # Construimos flujo cardio_flow_AIC <- workflow() %>% add_model(log_reg) %>% add_recipe(rec_cardio_AIC) # Ajuste cardio_fit_AIC <- cardio_flow_AIC %>% fit(data = cardio_train) ``` --- # Modelos .orange[GLM] ```r cardio_fit_AIC %>% extract_fit_engine() %>% summary() ``` ``` > > Call: > stats::glm(formula = ..y ~ ., family = stats::binomial, data = data) > > Deviance Residuals: > Min 1Q Median 3Q Max > -1.9009 -0.8141 -0.5269 0.9679 2.3577 > > Coefficients: > Estimate Std. Error z value Pr(>|z|) > (Intercept) -9.432621 1.607946 -5.866 4.46e-09 *** > edad 0.056323 0.015491 3.636 0.000277 *** > colesterol 0.006433 0.002687 2.394 0.016649 * > peso 0.024645 0.007411 3.326 0.000883 *** > --- > Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 > > (Dispersion parameter for binomial family taken to be 1) > > Null deviance: 264.33 on 207 degrees of freedom > Residual deviance: 218.49 on 204 degrees of freedom > AIC: 226.49 > > Number of Fisher Scoring iterations: 4 ``` --- # Modelos .orange[GLM] El modelo con selección de variables se equivoca incluso menos. ```r compare_performance(cardio_fit %>% extract_fit_engine(), cardio_fit_AIC %>% extract_fit_engine()) ``` ``` > # Comparison of Model Performance Indices > > Name | Model | AIC | AIC_wt | BIC | BIC_wt | Tjur's R2 | RMSE | Sigma | Log_loss | Score_log | Score_spherical | PCP > ----------------------------------------------------------------------------------------------------------------------------------- > Model 1 | glm | 236.075 | 0.008 | 259.438 | < 0.001 | 0.193 | 0.423 | 1.051 | 0.534 | -30.963 | 0.014 | 0.642 > Model 2 | glm | 226.486 | 0.992 | 239.836 | 1.000 | 0.204 | 0.421 | 1.035 | 0.525 | -31.485 | 0.016 | 0.647 ``` --- # Modelos .orange[GLM] Construimos las predicciones y odds como antes ```r # Predicciones y odds predicciones <- augment(cardio_fit_AIC, new_data = cardio_test) %>% mutate(odds = .pred_1 / .pred_0, log.odds = log(odds)) predicciones %>% conf_mat(problemas, .pred_class) ``` ``` > Truth > Prediction 0 1 > 0 29 4 > 1 6 2 ``` ```r predicciones %>% accuracy(truth = problemas, estimate = .pred_class) ``` ``` > # A tibble: 1 × 3 > .metric .estimator .estimate > <chr> <chr> <dbl> > 1 accuracy binary 0.756 ``` --- # .orange[RECURSOS] y .green[BIBLIOGRAFÍA] #### 📚 **.bg-purple_light[Artículos o libros]** científicos que han sido sometidos a revisión por pares. #### 🔗 **.bg-green_light[Recursos online]** recomendados #### 💻 Recursos para la **.bg-orange[programación en R]** --- # Bibliografía general 📚 **«Statistical tests, P values, confidence intervals, and power: a guide to misinterpretations»**. Greenland et al. (2016) <https://github.com/dadosdelaplace/teaching/blob/main/data_mining/biblio/p-value_Greenland_etal_2016.pdf> 💻 **Tidy Data Tutor**: para visualizar la mecánica interna de `{tidyverse}`. <https://tidydatatutor.com/> 🔗 Web con recursos para la **introducción a la estadística y Machine Learning en R** <https://artofstat.com/> 💻 **Manual introductorio de R** (Javier Álvarez Liébana): <https://dadosdelaplace.github.io/courses-intro-R/> --- # Bibliografía general 📚 **«The reproducibility of research and the misinterpretation of p-values»**. Colquhoun (2017) <https://github.com/dadosdelaplace/teaching/blob/main/data_mining/biblio/p-values_Colquhoun_2017.pdf> 📚 **«An Introduction to Multivariate Statistical Analysis»**. Anderson (1958) <https://github.com/dadosdelaplace/teaching/blob/main/data_mining/biblio/introduction_mva_anderson_2003.pdf> 📚 **«A New Measure of Rank Correlation»**. Kendall (1938) <https://github.com/dadosdelaplace/teaching/blob/main/data_mining/biblio/correlation_kendall_1938.pdf> 📚 **«The generalised product moment distribution in samples from a normal multivariate population»**. Wishart (1928) <https://github.com/dadosdelaplace/teaching/blob/main/data_mining/biblio/multivariate_normal_wishart_1928.pdf> 📚 **«On lines and planes of closest fit to systems of points in space»**. Pearson (1901) <https://github.com/dadosdelaplace/teaching/blob/main/data_mining/biblio/fit_pearson_1901.pdf> --- # Recursos dataviz ### Dataviz 📚 **«Gramática de las gráficas: pistas para mejorar las representaciones de datos»**. Sevilla (2005) <http://academica-e.unavarra.es/bitstream/handle/2454/15785/Gram%C3%A1tica.pdf> 📚 **«Quantitative Graphics in Statistics: A Brief History»**. Beniger and Robyn (1978) <https://github.com/dadosdelaplace/teaching/blob/main/bdba-pca-clustering-2022/biblio/graphics_beniger_robin_1978.pdf> 💻 **«Analizando datos, visualizando información, rasando historias»** (curso de dataviz en R). Álvarez-Liébana y Valverde-Castilla (2022) <https://dadosdelaplace.github.io/curso-dataviz-ECI-2022> 📚 **«40 years of boxplots»**. Wickham and Stryjewski (2011) <https://github.com/dadosdelaplace/teaching/blob/main/bdba-pca-clustering-2022/biblio/boxplot_Wickham_Stryjewski_2011.pdf> --- # Bibliografía componentes principales 💻 **Componentes principales** en `{tidymodels}`. <https://www.tmwr.org/dimensionality.html#beans> 📚 **«Principal Component Analysis»**. Jolliffe (2002) <https://github.com/dadosdelaplace/teaching/blob/main/bdba-pca-clustering-2022/biblio/pca_jolliffe_2002.pdf> 📚 **«Principal Component Analysis»**. Hervé and Lynne (2010) <http://staff.ustc.edu.cn/~zwp/teach/MVA/abdi-awPCA2010.pdf> 📚 **«Principal Component Analysis: a review and recent developments»**. Jolliffe and Cadima (2016) <https://royalsocietypublishing.org/doi/10.1098/rsta.2015.0202> 🔗 **«The Mathematics Behind Principal Component Analysis»**. Dubey (2018). <https://towardsdatascience.com/the-mathematics-behind-principal-component-analysis-fff2d7f4b643> 🔗 **«A One-Stop Shop for Principal Component Analysis»**. Brems (2017). <https://towardsdatascience.com/a-one-stop-shop-for-principal-component-analysis-5582fb7e0a9c> 📚 **«On the number of principal components: a test of dimensionality based on measurements of similarity between matrices»**. Dray (2008) <https://github.com/dadosdelaplace/teaching/blob/main/bdba-pca-clustering-2022/biblio/numer_pca_dray_2008.pdf> ---