Agregar tarea 1

tareas/tarea-01.qmd

@@ -0,0 +1,198 @@
+---
+title: "Tarea 1"
+format: html
+editor: visual
+---
+
+En esta tarea veremos 
+
+- Un ejemplo más de cómo los diagramas causales pueden
+guiarnos hacia el análisis correcto, y entender por qué pueden aparacer correlaciones
+no causales. 
+- Un ejercicio para repasar la motivación a estadística bayesiana que
+vimos en clase.
+
+
+```{r}
+library(tidyverse)
+library(DiagrammeR)
+```
+
+
+# Pensamiento causal: Paradoja de Berkson
+
+Supongamos que en una universidad los alumnos pueden ser aceptados
+por habilidad atlética y habilidad académica. Cuando un analista de
+datos examina los datos, encuentra que hay una **correlación negativa**
+entre habilidad atlética y académica.
+
+Veremos cómo puede suceder esto sin que en realidad exista una relación
+negativa de estas dos habilidades en la población. Para este
+ejercicio supondremos que
+
+- Para que alguien sea aceptado, tiene su score deportivo debe ser mayor
+a 120 y/o su score académico debe ser mayor a 120.
+- No existe relación causal entre los dos tipos de aptitud (podemos también modificar este supuestos más adelante)
+
+El diagrama que ilustra esto es el siguiente.
+
+```{r}
+grViz("
+digraph {
+  graph [ranksep = 0.2]
+  node [shape=plaintext]
+    Academica
+    Deportes
+    Aceptacion
+  edge [minlen = 3]
+Academica -> Aceptacion
+Deportes -> Aceptacion
+}
+")
+```
+
+Adicionalmente, sabemos que los scores de los que aplican están estandarizados,
+y tienen distribución aproximadamente normal con media 100 y desviación
+estándar 10. Podemos construir entonces un modelo generativo como sigue:
+
+```{r}
+simular_alumnos <- function(n = 10){
+  academico <- rnorm(n, 100, 10)
+  deportes <- rnorm(n, 100, 10)
+  aceptacion <- ifelse(academico > 125 | deportes > 125, 1, 0)
+  tibble(academico, deportes, aceptacion)
+}
+```
+
+
+Confirma los resultados que obtuvo el analista anterior: hay una correlación
+negativa entre habilidades para los estudiantes aceptados: 
+
+```{r}
+alumnos_sim_tbl <- simular_alumnos(5000)
+aceptados_tbl <- alumnos_sim_tbl |> 
+  filter(aceptacion == 1)
+aceptados_tbl |> ggplot(aes(academico, deportes)) +
+  geom_point() +
+  geom_smooth(method = "lm", formula = y ~ x)
+```
+
+
+**Pregunta 1**: Según nuestros supuestos, discute
+por qué una explicación de esta correlación como "cuando alguien es bueno para
+los deportes le dedica más tiempo a deportes y descuida aspectos académicos,
+y viceversa" no necesariamente es válida. ¿El problema es estádistico (muestra chica) o conceptual?
+
+
+**Pregunta 2**: Verifica que en la población general (tanto alumnos rechazados como aceptados) no existe tal correlación (según nuestros supuestos). Utiliza los mismos datos simulados 
+de arriba. 
+
+**Pregunta 3**: para entender cómo se relaciona habilidad académica y
+en deportes en las personas, ¿cuáles datos son más adecuados?
+
+- Necesitamos ver los datos de aceptados y no aceptados.
+- Podemos ver los datos de aceptados solamente.
+
+Este tipo de correlaciones distorsionadas al hacer análisis por subgrupos
+en un diagrama como el de arriba se llama también **sesgo de selección**.
+
+
+# Modelación y pruebas a priori
+
+Considera el ejemplo en clase de seropositividad que vimos en clase.
+Según nuestro diagrama, propusimos una función de simulación como la
+que sigue:
+
+```{r}
+sim_pos_neg <- function(N = 20, sens = 1, esp = 1) {
+  # supuesto a priori acerca de la prevalencia
+  theta <- runif(1, 0, 1)
+  # verdaderos positivos que capturamos en la muestra
+  Pos_verdadero <- rbinom(N, 1, theta)
+  Neg_verdadero <- 1 - Pos_verdadero
+  # positivos observados en la muestra
+  Pos <- Pos_verdadero
+  Neg <- 1 - Pos
+  # Observaciones, también regresamos la theta real
+  # que se usó para simular:
+  tibble(Pos = Pos, Neg = Neg, theta = theta)
+}
+```
+
+
+Y propusimos un proceso de estimación (ver notas) como sigue (donde utilizaremos
+una rejilla más fina):
+
+```{r}
+calcular_posterior <- function(muestra){
+  theta <- seq(0, 1, length.out = 51)
+  # distribución inicial o a prior
+  priori <- tibble(theta = theta, prob_priori = (1 - theta) * (1 - theta)) |> 
+    mutate(prob_priori = prob_priori / sum(prob_priori))
+  # calcular la probabilidad posterior
+  N <- length(muestra)
+  Npos <- sum(muestra)
+  prob_post <- tibble(theta = theta) |> 
+      left_join(priori, by = "theta") |> 
+      mutate(prob_posterior = theta ^ Npos * (1 - theta)^(N - Npos) * prob_priori) |> 
+    mutate(prob_posterior = prob_posterior / sum(prob_posterior)) 
+  prob_post |> select(theta, prob_posterior)
+}
+```
+
+La pregunta que queremos contestar es la siguiente: bajo nuestros
+supuestos del modelo generativo, nuestro proceso de estimación 
+es adecuado? Para esto es necesario hacer pruebas.
+
+Considera entonces una simulación de datos y la posterior obtenida:
+
+```{r}
+set.seed(1134)
+una_muestra <- sim_pos_neg(N = 100)
+theta_real <- una_muestra$theta[1]
+posterior <- calcular_posterior(una_muestra$Pos)
+ggplot(posterior, aes(x = theta, y = prob_posterior)) +
+  geom_col() +
+  geom_vline(xintercept = theta_real, col = "red")
+```
+
+**Pregunta 4**: Nota que la distribución posterior (probabilidad de
+cada conjetura de theta dada la muestra) no está concentrada en 
+verdadero valor de theta. ¿Esto indica un problema necesariamente?
+¿Qué dirías acerca de nuestro método de estimación dada esta gráfica?
+
+
+En realidad, es importante ver qué sucede con distintos valores del
+parámetro a estimar y distintas muestras posibles.
+
+
+Corre este código al menos unas 20 veces y checa el resultado:
+
+```{r}
+una_muestra <- sim_pos_neg(N = 100)
+theta_real <- una_muestra$theta[1]
+posterior <- calcular_posterior(una_muestra$Pos)
+ggplot(posterior, aes(x = theta, y = prob_posterior)) +
+  geom_col() +
+  geom_vline(xintercept = theta_real, col = "red")
+```
+
+**Pregunta 5**: De acuerdo a este ejercicio de simulación bajo nuestros supuestos,
+¿qué dirías acerca de nuestro proceso de estimación? ¿Nos informa correctamente
+acerca del valor de theta?
+
+**Pregunta 6**: Repite los dos ejercicios anteriores con una muestra mucho más
+chica, como N=3 por ejemplo. ¿Qué dirías de nuestras estimaciones en este caso?
+
+**Pregunta 7** (opcional, más dificíl) Si quisiéramos usar una muestra mucho
+más grande que N=100, ¿qué problemas encuentras? ¿qué defecto numérico tiene nuestro
+proceso de estimación?
+
+
+
+
+
+
+
+
+