LAB2
Ignacio Titos
INSTALACIONES PREVIAS
install.packages("tidyverse", dependencies = TRUE)## Installing package into '/home/ignacio/R/x86_64-pc-linux-gnu-library/4.5'
## (as 'lib' is unspecified)install.packages('ragg')## Installing package into '/home/ignacio/R/x86_64-pc-linux-gnu-library/4.5'
## (as 'lib' is unspecified)install.packages("summarytools")## Installing package into '/home/ignacio/R/x86_64-pc-linux-gnu-library/4.5'
## (as 'lib' is unspecified)library(knitr)EJERCICIO 1
#data(esoph)
data(iris)
data(Orange)
head(iris)## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 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.0 3.6 1.4 0.2 setosa
## 6 5.4 3.9 1.7 0.4 setosahead(Orange)## Tree age circumference
## 1 1 118 30
## 2 1 484 58
## 3 1 664 87
## 4 1 1004 115
## 5 1 1231 120
## 6 1 1372 142summary(iris)## Sepal.Length Sepal.Width Petal.Length Petal.Width
## Min. :4.300 Min. :2.000 Min. :1.000 Min. :0.100
## 1st Qu.:5.100 1st Qu.:2.800 1st Qu.:1.600 1st Qu.:0.300
## Median :5.800 Median :3.000 Median :4.350 Median :1.300
## Mean :5.843 Mean :3.057 Mean :3.758 Mean :1.199
## 3rd Qu.:6.400 3rd Qu.:3.300 3rd Qu.:5.100 3rd Qu.:1.800
## Max. :7.900 Max. :4.400 Max. :6.900 Max. :2.500
## Species
## setosa :50
## versicolor:50
## virginica :50
##
##
## summary(Orange)## Tree age circumference
## 3:7 Min. : 118.0 Min. : 30.0
## 1:7 1st Qu.: 484.0 1st Qu.: 65.5
## 5:7 Median :1004.0 Median :115.0
## 2:7 Mean : 922.1 Mean :115.9
## 4:7 3rd Qu.:1372.0 3rd Qu.:161.5
## Max. :1582.0 Max. :214.0###################
cat("Sepal.Lenght ABS:")## Sepal.Lenght ABS:table(iris$Sepal.Length)##
## 4.3 4.4 4.5 4.6 4.7 4.8 4.9 5 5.1 5.2 5.3 5.4 5.5 5.6 5.7 5.8 5.9 6 6.1 6.2
## 1 3 1 4 2 5 6 10 9 4 1 6 7 6 8 7 3 6 6 4
## 6.3 6.4 6.5 6.6 6.7 6.8 6.9 7 7.1 7.2 7.3 7.4 7.6 7.7 7.9
## 9 7 5 2 8 3 4 1 1 3 1 1 1 4 1cat("\nSepal Width REL:")##
## Sepal Width REL:prop.table(table(iris$Petal.Width))##
## 0.1 0.2 0.3 0.4 0.5 0.6
## 0.033333333 0.193333333 0.046666667 0.046666667 0.006666667 0.006666667
## 1 1.1 1.2 1.3 1.4 1.5
## 0.046666667 0.020000000 0.033333333 0.086666667 0.053333333 0.080000000
## 1.6 1.7 1.8 1.9 2 2.1
## 0.026666667 0.013333333 0.080000000 0.033333333 0.040000000 0.040000000
## 2.2 2.3 2.4 2.5
## 0.020000000 0.053333333 0.020000000 0.020000000# https://rpubs.com/dsulmont/660289
# Otra forma de obtener las frecuencias
library(summarytools)
t <- freq(iris$Species)
t## Frequencies
## iris$Species
## Type: Factor
##
## Freq % Valid % Valid Cum. % Total % Total Cum.
## ---------------- ------ --------- -------------- --------- --------------
## setosa 50 33.33 33.33 33.33 33.33
## versicolor 50 33.33 66.67 33.33 66.67
## virginica 50 33.33 100.00 33.33 100.00
## <NA> 0 0.00 100.00
## Total 150 100.00 100.00 100.00 100.00###################
kable(table(Orange$Tree))| Var1 | Freq |
|---|---|
| 3 | 7 |
| 1 | 7 |
| 5 | 7 |
| 2 | 7 |
| 4 | 7 |
kable(table(Orange$age))| Var1 | Freq |
|---|---|
| 118 | 5 |
| 484 | 5 |
| 664 | 5 |
| 1004 | 5 |
| 1231 | 5 |
| 1372 | 5 |
| 1582 | 5 |
kable(table(Orange$circumference))| Var1 | Freq |
|---|---|
| 30 | 3 |
| 32 | 1 |
| 33 | 1 |
| 49 | 1 |
| 51 | 1 |
| 58 | 1 |
| 62 | 1 |
| 69 | 1 |
| 75 | 1 |
| 81 | 1 |
| 87 | 1 |
| 108 | 1 |
| 111 | 1 |
| 112 | 1 |
| 115 | 2 |
| 120 | 1 |
| 125 | 1 |
| 139 | 1 |
| 140 | 1 |
| 142 | 2 |
| 145 | 1 |
| 156 | 1 |
| 167 | 1 |
| 172 | 1 |
| 174 | 1 |
| 177 | 1 |
| 179 | 1 |
| 203 | 2 |
| 209 | 1 |
| 214 | 1 |
Los datos de frecuencias son homogeneos incluso cuando son datos muy diversos.
Para el último apartado
table(Orange$Tree, Orange$age)##
## 118 484 664 1004 1231 1372 1582
## 3 1 1 1 1 1 1 1
## 1 1 1 1 1 1 1 1
## 5 1 1 1 1 1 1 1
## 2 1 1 1 1 1 1 1
## 4 1 1 1 1 1 1 1EJERCICIO 2
vect1 <- c(1,2,1,2,1,2,1,2,1,2,1,1,1,1,2,2,1,1,2,1)
vect2 <- c(1,1,2,2,2,1,2,1,1,2,1,2,1,1,1,2,1,1,1,1)a)
Bajo_peso <- factor(vect1, levels=c(1, 2), labels=c("Bajo peso", "Peso normal"))
Bajo_peso## [1] Bajo peso Peso normal Bajo peso Peso normal Bajo peso Peso normal
## [7] Bajo peso Peso normal Bajo peso Peso normal Bajo peso Bajo peso
## [13] Bajo peso Bajo peso Peso normal Peso normal Bajo peso Bajo peso
## [19] Peso normal Bajo peso
## Levels: Bajo peso Peso normalb)
Fumador <- factor(vect2, levels=c(1,2), labels=c("Fuma", "No fuma"))
Fumador## [1] Fuma Fuma No fuma No fuma No fuma Fuma No fuma Fuma Fuma
## [10] No fuma Fuma No fuma Fuma Fuma Fuma No fuma Fuma Fuma
## [19] Fuma Fuma
## Levels: Fuma No fumac)
contig <- table(Bajo_peso, Fumador)
contig## Fumador
## Bajo_peso Fuma No fuma
## Bajo peso 8 4
## Peso normal 5 3d)
chisq.test(contig)## Warning in chisq.test(contig): Chi-squared approximation may be incorrect##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: contig
## X-squared = 0, df = 1, p-value = 1fisher.test(contig)##
## Fisher's Exact Test for Count Data
##
## data: contig
## p-value = 1
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
## 0.1200513 10.9278345
## sample estimates:
## odds ratio
## 1.189031EJERCICIO 3
a)
data("airquality")
par(mfrow=c(1,2))
plot(airquality$Ozone, col='blue', pch="#")
boxplot(airquality$Temp, col="red", main="Temperatura (en grados Farenheit)")
b)
data("airmiles")
par(mfrow=c(1,2))
plot(airmiles,
col="cadetblue2",
main="Datos de pasajeros en vuelos comerciales (en miles)",
xlab="Miles de pasajeros")
hist(airmiles, col="chocolate2")
c)
par(mfrow=c(2,2))
plot(airquality$Ozone, col='blue', pch="#")
boxplot(airquality$Temp, col="red", main="Temperatura (en grados Farenheit)")
plot(airmiles,
col="cadetblue2",
main="Datos de pasajeros en vuelos comerciales (en miles)",
xlab="Miles de pasajeros")
hist(airmiles, col="chocolate2")
EJERCICIO 4
set.seed(999)
x1 <- rnorm(100)
y1 <- (x1*rnorm(100)) + rnorm(100)
plot(x1, y1, main="Gráfico de dispersión")
abline(lm(y1~x1), col="cadetblue3")
plot(density(x1), main="Densidad de x1", col="aquamarine")
lines(density(y1), col="darkred") 
EJERCICIO 5
a)
library(ggplot2)
data("airquality")
ggplot(data=airquality, aes(x=Wind, y=Ozone)) +
geom_point() +
geom_smooth(method = "lm", color = "darkred")## `geom_smooth()` using formula = 'y ~ x'## Warning: Removed 37 rows containing non-finite outside the scale range
## (`stat_smooth()`).## Warning: Removed 37 rows containing missing values or values outside the scale range
## (`geom_point()`).
b)
ggplot (data=airquality, aes(x=Solar.R, y=Temp, col=factor(Month),
shape=factor(Month))) +
geom_point() ## Warning: Removed 7 rows containing missing values or values outside the scale range
## (`geom_point()`).
c)
library(MASS)
data("birthwt")
ggplot(data=birthwt, aes(age))+
geom_histogram(fill="blue", col="black")## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.
d)
ggplot(data=birthwt, aes(age)) +
geom_boxplot(fill="cadetblue4") +
facet_wrap(~ factor(smoke, labels = c("No Fumadora", "Fumadora")))
EJERCICIO 6
data("esoph")
summary(esoph)## agegp alcgp tobgp ncases ncontrols
## 25-34:15 0-39g/day:23 0-9g/day:24 Min. : 0.000 Min. : 0.000
## 35-44:15 40-79 :23 10-19 :24 1st Qu.: 0.000 1st Qu.: 1.000
## 45-54:16 80-119 :21 20-29 :20 Median : 1.000 Median : 4.000
## 55-64:16 120+ :21 30+ :20 Mean : 2.273 Mean : 8.807
## 65-74:15 3rd Qu.: 4.000 3rd Qu.:10.000
## 75+ :11 Max. :17.000 Max. :60.000jpeg("grafico_size_alc.jpg")
ggplot(data = esoph, aes(x = alcgp, y = tobgp)) +
geom_point(aes(size = ncases))
dev.off## function (which = dev.cur())
## {
## if (which == 1)
## stop("cannot shut down device 1 (the null device)")
## .External(C_devoff, as.integer(which))
## dev.cur()
## }
## <bytecode: 0x6295a02c7cc0>
## <environment: namespace:grDevices>pdf("grafico_size_alc.pdf")
ggplot(data = esoph, aes(x = alcgp, y = tobgp)) +
geom_point(aes(size = ncases))
dev.off## function (which = dev.cur())
## {
## if (which == 1)
## stop("cannot shut down device 1 (the null device)")
## .External(C_devoff, as.integer(which))
## dev.cur()
## }
## <bytecode: 0x6295a02c7cc0>
## <environment: namespace:grDevices>EJERCICIO 7
# Paso 1
data(Orange)
# Paso 2
summary(Orange)## Tree age circumference
## 3:7 Min. : 118.0 Min. : 30.0
## 1:7 1st Qu.: 484.0 1st Qu.: 65.5
## 5:7 Median :1004.0 Median :115.0
## 2:7 Mean : 922.1 Mean :115.9
## 4:7 3rd Qu.:1372.0 3rd Qu.:161.5
## Max. :1582.0 Max. :214.0# Paso 3
pairs(Orange)
# Paso 4
kable(cor(Orange$age, Orange$circumference))| x |
|---|
| 0.9135189 |
# Paso 5
modelreg <- lm(circumference ~ age, data = Orange)
summary(modelreg)##
## Call:
## lm(formula = circumference ~ age, data = Orange)
##
## Residuals:
## Min 1Q Median 3Q Max
## -46.310 -14.946 -0.076 19.697 45.111
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 17.399650 8.622660 2.018 0.0518 .
## age 0.106770 0.008277 12.900 1.93e-14 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 23.74 on 33 degrees of freedom
## Multiple R-squared: 0.8345, Adjusted R-squared: 0.8295
## F-statistic: 166.4 on 1 and 33 DF, p-value: 1.931e-14#Paso 6
plot(Orange$age, Orange$circumference, xlab="Edad", ylab="Circunferencia")
abline(modelreg)
# Paso 7
residuos <- rstandard(modelreg)
valores.ajustados <- fitted(modelreg)
plot(valores.ajustados, residuos)
# Paso 8
qqnorm(residuos)
qqline(residuos)
# Paso 9
predict(modelreg, data.frame(age = 600))## 1
## 81.46185EJERCICIO 8
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.0 ✔ readr 2.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ lubridate 1.9.5 ✔ tibble 3.3.1
## ✔ purrr 1.2.1 ✔ tidyr 1.3.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::select() masks MASS::select()
## ✖ tibble::view() masks summarytools::view()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsOrange %>%
ggplot(aes(x = age,
y = circumference)) +
geom_point()
###
Orange %>%
ggplot(aes(x = age,
y = circumference)) +
geom_point()+
geom_abline(intercept=17.399650,
slope=0.106770,
col="blue")
EJERCICIO 9
data("PlantGrowth")
head(PlantGrowth)## weight group
## 1 4.17 ctrl
## 2 5.58 ctrl
## 3 5.18 ctrl
## 4 6.11 ctrl
## 5 4.50 ctrl
## 6 4.61 ctrlsummary(PlantGrowth)## weight group
## Min. :3.590 ctrl:10
## 1st Qu.:4.550 trt1:10
## Median :5.155 trt2:10
## Mean :5.073
## 3rd Qu.:5.530
## Max. :6.310ggplot(PlantGrowth, aes(x = group, y = weight, fill = group)) +
geom_boxplot()
# SÍ hay diferencias entre ambos.
# Las pruebas planteadas son para comprobar la normalidad con el test de shapiro
# y para testear la homocedasticidad con el test de bartlett
# TEST DE SHAPIRO
by(PlantGrowth$weight, PlantGrowth$group, shapiro.test)## PlantGrowth$group: ctrl
##
## Shapiro-Wilk normality test
##
## data: dd[x, ]
## W = 0.95668, p-value = 0.7475
##
## ------------------------------------------------------------
## PlantGrowth$group: trt1
##
## Shapiro-Wilk normality test
##
## data: dd[x, ]
## W = 0.93041, p-value = 0.4519
##
## ------------------------------------------------------------
## PlantGrowth$group: trt2
##
## Shapiro-Wilk normality test
##
## data: dd[x, ]
## W = 0.94101, p-value = 0.5643# TEST DE BARTLETT
bartlett.test(PlantGrowth$weight, PlantGrowth$group)##
## Bartlett test of homogeneity of variances
##
## data: PlantGrowth$weight and PlantGrowth$group
## Bartlett's K-squared = 2.8786, df = 2, p-value = 0.2371# en todos obtuvimos p_value > 0.05, por lo que no hay problemas de heterocedasticidad ni de normalidad.
# vamos a ver si existen diferencias entre grupos con el test de anova.
model_anov <- aov(weight ~ group, data = PlantGrowth)
summary(model_anov)## Df Sum Sq Mean Sq F value Pr(>F)
## group 2 3.766 1.8832 4.846 0.0159 *
## Residuals 27 10.492 0.3886
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Sí que existen diferencias entre grupos ya que Pr(>F) = 0.0159,
# osea, p_value < 0.05EJERCICIO 10
install.packages("plotly")## Installing package into '/home/ignacio/R/x86_64-pc-linux-gnu-library/4.5'
## (as 'lib' is unspecified)library(plotly)##
## Adjuntando el paquete: 'plotly'## The following object is masked from 'package:MASS':
##
## select## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutfig <- plot_ly(PlantGrowth, x = ~group, y = ~weight, color = ~group, type = 'box')
figCASO PRÁCTICO
# datos provenientes de mexico (http://datos.gob.mx/dataset/defunciones_relacionadas_consumo_sustancias_psicoactivas/resource/eccbf297-3354-4a8d-b558-2c21333cd6ce)
defunc <- read.csv(file="data-2026-03-15.csv", sep=",")
head(defunc)## anio_defuncion entidad_defuncion edad_quinquenal sexo F10 F11 F12
## 1 2011 AGUASCALIENTES 25 a 29 años Femenino 0 0 0
## 2 2011 AGUASCALIENTES 25 a 29 años Masculino 2 0 0
## 3 2011 AGUASCALIENTES 25 a 29 años No Especificado 0 NA NA
## 4 2011 AGUASCALIENTES 30 a 34 años Femenino 0 0 0
## 5 2011 AGUASCALIENTES 30 a 34 años Masculino 2 0 1
## 6 2011 AGUASCALIENTES 30 a 34 años No Especificado 0 NA NA
## F14 F15 F17 F18 F19 F13 F16 cve_entidad fecha entidad_defuncion_etq
## 1 0 0 0 0 0 NA NA 1 2011-12-31 Aguascalientes
## 2 0 0 0 0 0 NA NA 1 2011-12-31 Aguascalientes
## 3 NA NA NA NA NA NA NA 1 2011-12-31 Aguascalientes
## 4 0 0 0 0 0 NA NA 1 2011-12-31 Aguascalientes
## 5 0 0 0 0 0 NA NA 1 2011-12-31 Aguascalientes
## 6 NA NA NA NA NA NA NA 1 2011-12-31 Aguascalientes
## temporal_fecha ..anio_fecha
## 1 2011-12 2011
## 2 2011-12 2011
## 3 2011-12 2011
## 4 2011-12 2011
## 5 2011-12 2011
## 6 2011-12 2011summary(defunc)## anio_defuncion entidad_defuncion edad_quinquenal sexo
## Min. :2011 Length:12473 Length:12473 Length:12473
## 1st Qu.:2014 Class :character Class :character Class :character
## Median :2017 Mode :character Mode :character Mode :character
## Mean :2017
## 3rd Qu.:2020
## Max. :2023
##
## F10 F11 F12 F14
## Min. : 0.000 Min. :0.00000 Min. :0.0000 Min. :0.0000
## 1st Qu.: 0.000 1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.:0.0000
## Median : 0.000 Median :0.00000 Median :0.0000 Median :0.0000
## Mean : 2.763 Mean :0.01332 Mean :0.0027 Mean :0.0076
## 3rd Qu.: 2.000 3rd Qu.:0.00000 3rd Qu.:0.0000 3rd Qu.:0.0000
## Max. :63.000 Max. :6.00000 Max. :1.0000 Max. :2.0000
## NA's :391 NA's :2339 NA's :4671 NA's :2339
## F15 F17 F18 F19
## Min. :0.0000 Min. :0.00000 Min. :0.00000 Min. : 0.0000
## 1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.: 0.0000
## Median :0.0000 Median :0.00000 Median :0.00000 Median : 0.0000
## Mean :0.0146 Mean :0.03306 Mean :0.02102 Mean : 0.1931
## 3rd Qu.:0.0000 3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.: 0.0000
## Max. :4.0000 Max. :2.00000 Max. :4.00000 Max. :30.0000
## NA's :2339 NA's :2339 NA's :2339 NA's :1540
## F13 F16 cve_entidad fecha
## Min. :0.0000 Min. :0.0000 Min. : 1.00 Length:12473
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.: 9.00 Class :character
## Median :0.0000 Median :0.0000 Median :16.00 Mode :character
## Mean :0.0036 Mean :0.0023 Mean :17.72
## 3rd Qu.:0.0000 3rd Qu.:0.0000 3rd Qu.:25.00
## Max. :1.0000 Max. :1.0000 Max. :99.00
## NA's :8565 NA's :7727
## entidad_defuncion_etq temporal_fecha ..anio_fecha
## Length:12473 Length:12473 Min. :2011
## Class :character Class :character 1st Qu.:2014
## Mode :character Mode :character Median :2017
## Mean :2017
## 3rd Qu.:2020
## Max. :2023
## defunc <- defunc %>%
rename(
Alcohol = F10,
Opioides = F11,
Cannabinoides = F12,
Sedantes = F13,
Cocaina = F14,
Estimulantes = F15,
Alucinogenos = F16,
Tabaco = F17,
Inhalables = F18,
Multidrogas = F19
)
summary(defunc)## anio_defuncion entidad_defuncion edad_quinquenal sexo
## Min. :2011 Length:12473 Length:12473 Length:12473
## 1st Qu.:2014 Class :character Class :character Class :character
## Median :2017 Mode :character Mode :character Mode :character
## Mean :2017
## 3rd Qu.:2020
## Max. :2023
##
## Alcohol Opioides Cannabinoides Cocaina
## Min. : 0.000 Min. :0.00000 Min. :0.0000 Min. :0.0000
## 1st Qu.: 0.000 1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.:0.0000
## Median : 0.000 Median :0.00000 Median :0.0000 Median :0.0000
## Mean : 2.763 Mean :0.01332 Mean :0.0027 Mean :0.0076
## 3rd Qu.: 2.000 3rd Qu.:0.00000 3rd Qu.:0.0000 3rd Qu.:0.0000
## Max. :63.000 Max. :6.00000 Max. :1.0000 Max. :2.0000
## NA's :391 NA's :2339 NA's :4671 NA's :2339
## Estimulantes Tabaco Inhalables Multidrogas
## Min. :0.0000 Min. :0.00000 Min. :0.00000 Min. : 0.0000
## 1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.: 0.0000
## Median :0.0000 Median :0.00000 Median :0.00000 Median : 0.0000
## Mean :0.0146 Mean :0.03306 Mean :0.02102 Mean : 0.1931
## 3rd Qu.:0.0000 3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.: 0.0000
## Max. :4.0000 Max. :2.00000 Max. :4.00000 Max. :30.0000
## NA's :2339 NA's :2339 NA's :2339 NA's :1540
## Sedantes Alucinogenos cve_entidad fecha
## Min. :0.0000 Min. :0.0000 Min. : 1.00 Length:12473
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.: 9.00 Class :character
## Median :0.0000 Median :0.0000 Median :16.00 Mode :character
## Mean :0.0036 Mean :0.0023 Mean :17.72
## 3rd Qu.:0.0000 3rd Qu.:0.0000 3rd Qu.:25.00
## Max. :1.0000 Max. :1.0000 Max. :99.00
## NA's :8565 NA's :7727
## entidad_defuncion_etq temporal_fecha ..anio_fecha
## Length:12473 Length:12473 Min. :2011
## Class :character Class :character 1st Qu.:2014
## Mode :character Mode :character Median :2017
## Mean :2017
## 3rd Qu.:2020
## Max. :2023
## ## GRÁFICOS
totales <- c(
Alcohol = sum(defunc$Alcohol, na.rm = TRUE),
Opioides = sum(defunc$Opioides, na.rm = TRUE),
Cannabinoides = sum(defunc$Cannabinoides, na.rm = TRUE),
Sedantes = sum(defunc$Sedantes, na.rm = TRUE),
Cocaina = sum(defunc$Cocaina, na.rm = TRUE),
Estimulantes = sum(defunc$Estimulantes, na.rm = TRUE),
Alucinogenos = sum(defunc$Alucinogenos, na.rm = TRUE),
Tabaco = sum(defunc$Tabaco, na.rm = TRUE),
Inhalables = sum(defunc$Inhalables, na.rm = TRUE),
Multidrogas = sum(defunc$Multidrogas, na.rm = TRUE)
)
totales["Alcohol"]## Alcohol
## 33383totales["Multidrogas"]## Multidrogas
## 2111barplot(totales, main = "Total de Defunciones por Sustancia Psicoactiva",
col = "skyblue", las = 2, cex.names = 0.8)
Aquí vemos las defunciones totales por cada sustancia psicoactiva. Observamos como el alcohol es las más letal de todas.
## veamos un grafico mas descriptivo excluyendo el alcohol
drogas_sin_alcohol <- c("Opioides", "Cannabinoides", "Sedantes", "Cocaina",
"Estimulantes", "Alucinogenos", "Tabaco",
"Inhalables", "Multidrogas")
totales_sin_alcohol <- colSums(defunc[, drogas_sin_alcohol], na.rm = TRUE)
barplot(totales_sin_alcohol, main = "Defunciones por Sustancia (Excluyendo Alcohol)",
col = "mediumpurple",
las = 2,
cex.names = 0.9)
En este gráfico para ser más descriptivo, vemos mejor las defunciones asociadas a cada droga, siendo de mayor mortalidad cuando la muerte ha sido causada por múltiples drogas en el organismo, en las que en la mayoría seguramente, estará el alcohol de por medio.
edad_alcohol <- aggregate(Alcohol ~ edad_quinquenal, data = defunc, sum)
barplot(edad_alcohol$Alcohol, names.arg = edad_alcohol$edad_quinquenal,
main = "Distribución de Defunciones por Alcohol y Edad",
col = "coral", las = 2, cex.names = 0.8)
edad_multidrogas <- aggregate(Multidrogas ~ edad_quinquenal, data = defunc, sum)
barplot(edad_multidrogas$Multidrogas, names.arg = edad_multidrogas$edad_quinquenal,
main = "Distribución de Defunciones por Multidrogas y Edad",
col = "brown4", las = 2, cex.names = 0.8)
edad_cannabis <- aggregate(Cannabinoides ~ edad_quinquenal, data = defunc, sum)
barplot(edad_cannabis$Cannabinoides, names.arg = edad_cannabis$edad_quinquenal,
main = "Distribución de Defunciones por Cannabis y Edad",
col = "green4", las = 2, cex.names = 0.8)
Estos gráficos son bastantes interesantes ya que muestran el rango de edad de las muertes ocasionadas por distintos tipos de droga. Como última muestra he querido representar los cannabinoides por pura curiosidad de a que franja de edad causa mayores defunciones.
defunc_evolucion <- defunc %>%
group_by(anio_defuncion) %>%
summarise(Total_Alcohol = sum(Alcohol, na.rm = TRUE))
graf <- ggplot(defunc_evolucion, aes(x = anio_defuncion, y = Total_Alcohol)) +
geom_line(color = "red", size = 1.5) +
geom_point(color = "darkred", size = 3) +
scale_x_continuous(breaks = 2011:2023) +
labs(
title = "Evolución de Defunciones por Alcohol (2011-2023)",
subtitle = "Tendencia nacional (Código CIE-10: F10)",
x = "Año",
y = "Total de Defunciones"
)## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.print(graf)
Este gráfico muestra la evolución de defunciones por año relacionadas con el alcohol.
defunc_alcohol_sexo <- defunc %>%
filter(sexo %in% c("Femenino", "Masculino")) %>%
group_by(sexo) %>%
summarise(Total_Alcohol = sum(Alcohol, na.rm = TRUE))
grafico_alcohol_sexo <- ggplot(defunc_alcohol_sexo, aes(x = sexo, y = Total_Alcohol, fill = sexo)) +
geom_bar(stat = "identity", color = "black", width = 0.7) +
scale_fill_manual(values = c("pink", "lightblue")) +
labs(
title = "Total de Defunciones por Alcohol según Sexo (2011-2023)",
subtitle = "Brecha de género en la mortalidad (Código CIE-10: Alcohol)",
x = "Sexo",
y = "Total de Defunciones"
)
print(grafico_alcohol_sexo)
Muertes por alcohol según el sexo. La cantidad de hombres frente a mujeres que mueren por esta droga es abrumante.
Vamos a hacer ahora una regresión lineal paso a paso.
# Paso 2
summary(defunc)## anio_defuncion entidad_defuncion edad_quinquenal sexo
## Min. :2011 Length:12473 Length:12473 Length:12473
## 1st Qu.:2014 Class :character Class :character Class :character
## Median :2017 Mode :character Mode :character Mode :character
## Mean :2017
## 3rd Qu.:2020
## Max. :2023
##
## Alcohol Opioides Cannabinoides Cocaina
## Min. : 0.000 Min. :0.00000 Min. :0.0000 Min. :0.0000
## 1st Qu.: 0.000 1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.:0.0000
## Median : 0.000 Median :0.00000 Median :0.0000 Median :0.0000
## Mean : 2.763 Mean :0.01332 Mean :0.0027 Mean :0.0076
## 3rd Qu.: 2.000 3rd Qu.:0.00000 3rd Qu.:0.0000 3rd Qu.:0.0000
## Max. :63.000 Max. :6.00000 Max. :1.0000 Max. :2.0000
## NA's :391 NA's :2339 NA's :4671 NA's :2339
## Estimulantes Tabaco Inhalables Multidrogas
## Min. :0.0000 Min. :0.00000 Min. :0.00000 Min. : 0.0000
## 1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.: 0.0000
## Median :0.0000 Median :0.00000 Median :0.00000 Median : 0.0000
## Mean :0.0146 Mean :0.03306 Mean :0.02102 Mean : 0.1931
## 3rd Qu.:0.0000 3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.: 0.0000
## Max. :4.0000 Max. :2.00000 Max. :4.00000 Max. :30.0000
## NA's :2339 NA's :2339 NA's :2339 NA's :1540
## Sedantes Alucinogenos cve_entidad fecha
## Min. :0.0000 Min. :0.0000 Min. : 1.00 Length:12473
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.: 9.00 Class :character
## Median :0.0000 Median :0.0000 Median :16.00 Mode :character
## Mean :0.0036 Mean :0.0023 Mean :17.72
## 3rd Qu.:0.0000 3rd Qu.:0.0000 3rd Qu.:25.00
## Max. :1.0000 Max. :1.0000 Max. :99.00
## NA's :8565 NA's :7727
## entidad_defuncion_etq temporal_fecha ..anio_fecha
## Length:12473 Length:12473 Min. :2011
## Class :character Class :character 1st Qu.:2014
## Mode :character Mode :character Median :2017
## Mean :2017
## 3rd Qu.:2020
## Max. :2023
## # Paso 3
defunc_numericas <- defunc %>%
mutate(
sexo_num = case_when(
sexo == "Masculino" ~ 1,
sexo == "Femenino" ~ 0,
TRUE ~ NA_real_
),
edad_num = as.numeric(str_extract(edad_quinquenal, "^[0-9]+"))
)
defunc_numericas <- defunc_numericas[, sapply(defunc_numericas, is.numeric)]
pairs(defunc_numericas)
defunc_cols <- c("Alcohol", "Multidrogas", "Cannabinoides",
"sexo_num", "edad_num", "anio_defuncion", "cve_entidad")
defunc_nuevo <- defunc_numericas[,defunc_cols]
pairs(defunc_nuevo)
# Vamos a ver la correlacion entre distintas variables
defunc_sin_na <- drop_na(defunc_nuevo)
kable(cor(defunc_sin_na$Multidrogas, defunc_sin_na$anio_defuncion))| x |
|---|
| 0.116079 |
kable(cor(defunc_sin_na$Alcohol, defunc_sin_na$anio_defuncion))| x |
|---|
| -0.0466177 |
kable(cor(defunc_sin_na$Alcohol, defunc_sin_na$edad_num))| x |
|---|
| 0.0130711 |
kable(cor(defunc_sin_na$Multidrogas, defunc_sin_na$edad_num))| x |
|---|
| -0.1186173 |
kable(cor(defunc_sin_na$Alcohol, defunc_sin_na$Multidrogas))| x |
|---|
| 0.0620934 |
Vemos que la que más relación tiene, siendo muy poca aun así, es la de Multidrogas con año de defunción, ya que en la correlación con pairs vemos como va creciendo cada año.
modelreg <- lm(Multidrogas ~ anio_defuncion, data = defunc_nuevo)
summary(modelreg)##
## Call:
## lm(formula = Multidrogas ~ anio_defuncion, data = defunc_nuevo)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.4061 -0.2968 -0.1874 -0.0417 29.5939
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -73.311742 5.854098 -12.52 <2e-16 ***
## anio_defuncion 0.036440 0.002902 12.56 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.099 on 10931 degrees of freedom
## (1540 observations deleted due to missingness)
## Multiple R-squared: 0.01422, Adjusted R-squared: 0.01413
## F-statistic: 157.7 on 1 and 10931 DF, p-value: < 2.2e-16Aquí podemos observar que el p_value es extremadamente bajo, casi 0, lo que hace que sea estadísticamente significativo, y como era de esperar por el gráfico de correlación de arriba, con una linealidad al alza cada año por muertes por policonsumo. También se observa que el R-Squared es extremadamente bajo, lo que explica que no únicamente el policonsumo es la causa de muerte, sino que intervienen más factores, lo cual tiene sentido.
plot(defunc_nuevo$anio_defuncion, defunc_nuevo$Multidrogas, xlab = "año de defunción", ylab = "Multidrogas")
abline(modelreg)
Aunque la gran dispersión de los datos explica la R-Squared tan baja, la tendencia de los últimos años a la alza por muertes de policonsumo es innegable y alarmante. Representa una crisis de salud pública en crecimiento.