LAB2

Ejercicio 1

• Buscar un resumen estadístico de las variables del dataset Iris y Orange.

library(knitr)
library("datasets")
data(iris)
summary(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  
##                 
##                 
## 

data(Orange)
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

• Generar una tabla de frecuencias absolutas y una tabla de frecuencias relativas con el dataset Iris. ¿Todas las tablas generadas tienen sentido para vosotros?

• Frecuencias absolutas y relativas de Sepal.Length

kable(data.frame(
  Sepal.Length = as.numeric(names(table(iris$Sepal.Length))),
  Absolute.Frequency = as.vector(table(iris$Sepal.Length)),
  Relative.Frequency = as.vector(prop.table(table(iris$Sepal.Length)))
))

Sepal.Length	Absolute.Frequency	Relative.Frequency
4.3	1	0.0066667
4.4	3	0.0200000
4.5	1	0.0066667
4.6	4	0.0266667
4.7	2	0.0133333
4.8	5	0.0333333
4.9	6	0.0400000
5.0	10	0.0666667
5.1	9	0.0600000
5.2	4	0.0266667
5.3	1	0.0066667
5.4	6	0.0400000
5.5	7	0.0466667
5.6	6	0.0400000
5.7	8	0.0533333
5.8	7	0.0466667
5.9	3	0.0200000
6.0	6	0.0400000
6.1	6	0.0400000
6.2	4	0.0266667
6.3	9	0.0600000
6.4	7	0.0466667
6.5	5	0.0333333
6.6	2	0.0133333
6.7	8	0.0533333
6.8	3	0.0200000
6.9	4	0.0266667
7.0	1	0.0066667
7.1	1	0.0066667
7.2	3	0.0200000
7.3	1	0.0066667
7.4	1	0.0066667
7.6	1	0.0066667
7.7	4	0.0266667
7.9	1	0.0066667

• Frecuencias absolutas y relativas de Sepal.Width

kable(data.frame(
  Sepal.Width = as.numeric(names(table(iris$Sepal.Width))),
  Absolute.Frequency = as.vector(table(iris$Sepal.Width)),
  Relative.Frequency = as.vector(prop.table(table(iris$Sepal.Width)))
))

Sepal.Width	Absolute.Frequency	Relative.Frequency
2.0	1	0.0066667
2.2	3	0.0200000
2.3	4	0.0266667
2.4	3	0.0200000
2.5	8	0.0533333
2.6	5	0.0333333
2.7	9	0.0600000
2.8	14	0.0933333
2.9	10	0.0666667
3.0	26	0.1733333
3.1	11	0.0733333
3.2	13	0.0866667
3.3	6	0.0400000
3.4	12	0.0800000
3.5	6	0.0400000
3.6	4	0.0266667
3.7	3	0.0200000
3.8	6	0.0400000
3.9	2	0.0133333
4.0	1	0.0066667
4.1	1	0.0066667
4.2	1	0.0066667
4.4	1	0.0066667

• Frecuencias absolutas y relativas de Petal.Length

kable(data.frame(
  Petal.Length = as.numeric(names(table(iris$Petal.Length))),
  Absolute.Frequency = as.vector(table(iris$Petal.Length)),
  Relative.Frequency = as.vector(prop.table(table(iris$Petal.Length)))
))

Petal.Length	Absolute.Frequency	Relative.Frequency
1.0	1	0.0066667
1.1	1	0.0066667
1.2	2	0.0133333
1.3	7	0.0466667
1.4	13	0.0866667
1.5	13	0.0866667
1.6	7	0.0466667
1.7	4	0.0266667
1.9	2	0.0133333
3.0	1	0.0066667
3.3	2	0.0133333
3.5	2	0.0133333
3.6	1	0.0066667
3.7	1	0.0066667
3.8	1	0.0066667
3.9	3	0.0200000
4.0	5	0.0333333
4.1	3	0.0200000
4.2	4	0.0266667
4.3	2	0.0133333
4.4	4	0.0266667
4.5	8	0.0533333
4.6	3	0.0200000
4.7	5	0.0333333
4.8	4	0.0266667
4.9	5	0.0333333
5.0	4	0.0266667
5.1	8	0.0533333
5.2	2	0.0133333
5.3	2	0.0133333
5.4	2	0.0133333
5.5	3	0.0200000
5.6	6	0.0400000
5.7	3	0.0200000
5.8	3	0.0200000
5.9	2	0.0133333
6.0	2	0.0133333
6.1	3	0.0200000
6.3	1	0.0066667
6.4	1	0.0066667
6.6	1	0.0066667
6.7	2	0.0133333
6.9	1	0.0066667

• Frecuencias absolutas y relativas de Petal.Width

kable(data.frame(
  Petal.Width = as.numeric(names(table(iris$Petal.Width))),
  Absolute.Frequency = as.vector(table(iris$Petal.Width)),
  Relative.Frequency = as.vector(prop.table(table(iris$Petal.Width)))
))

Petal.Width	Absolute.Frequency	Relative.Frequency
0.1	5	0.0333333
0.2	29	0.1933333
0.3	7	0.0466667
0.4	7	0.0466667
0.5	1	0.0066667
0.6	1	0.0066667
1.0	7	0.0466667
1.1	3	0.0200000
1.2	5	0.0333333
1.3	13	0.0866667
1.4	8	0.0533333
1.5	12	0.0800000
1.6	4	0.0266667
1.7	2	0.0133333
1.8	12	0.0800000
1.9	5	0.0333333
2.0	6	0.0400000
2.1	6	0.0400000
2.2	3	0.0200000
2.3	8	0.0533333
2.4	3	0.0200000
2.5	3	0.0200000

• Frecuencias absolutas y relativas de Species

kable(data.frame(
  Species = names(table(iris$Species)),
  Absolute.Frequency = as.vector(table(iris$Species)),
  Relative.Frequency = as.vector(prop.table(table(iris$Species)))
))

Species	Absolute.Frequency	Relative.Frequency
setosa	50	0.3333333
versicolor	50	0.3333333
virginica	50	0.3333333

• Las tablas y sus resultados son coherentes

• Generar una tabla de frecuencias absolutas con cada una de las variables del conjunto de datos Orange. ¿Todas las tablas generadas tienen sentido para vosotros?

• Frecuencias absolutas y relativas de Tree

kable(data.frame(
  Tree = as.numeric(names(table(Orange$Tree))),
  Absolute.Frequency = as.vector(table(Orange$Tree)),
  Relative.Frequency = as.vector(prop.table(table(Orange$Tree)))
))

Tree	Absolute.Frequency	Relative.Frequency
3	7	0.2
1	7	0.2
5	7	0.2
2	7	0.2
4	7	0.2

• Frecuencias absolutas y relativas de age

kable(data.frame(
  age = as.numeric(names(table(Orange$age))),
  Absolute.Frequency = as.vector(table(Orange$age)),
  Relative.Frequency = as.vector(prop.table(table(Orange$age)))
))

age	Absolute.Frequency	Relative.Frequency
118	5	0.1428571
484	5	0.1428571
664	5	0.1428571
1004	5	0.1428571
1231	5	0.1428571
1372	5	0.1428571
1582	5	0.1428571

• Frecuencias absolutas y relativas de circumference

kable(data.frame(
  circumference = as.numeric(names(table(Orange$circumference))),
  Absolute.Frequency = as.vector(table(Orange$circumference)),
  Relative.Frequency = as.vector(prop.table(table(Orange$circumference)))
))

circumference	Absolute.Frequency	Relative.Frequency
30	3	0.0857143
32	1	0.0285714
33	1	0.0285714
49	1	0.0285714
51	1	0.0285714
58	1	0.0285714
62	1	0.0285714
69	1	0.0285714
75	1	0.0285714
81	1	0.0285714
87	1	0.0285714
108	1	0.0285714
111	1	0.0285714
112	1	0.0285714
115	2	0.0571429
120	1	0.0285714
125	1	0.0285714
139	1	0.0285714
140	1	0.0285714
142	2	0.0571429
145	1	0.0285714
156	1	0.0285714
167	1	0.0285714
172	1	0.0285714
174	1	0.0285714
177	1	0.0285714
179	1	0.0285714
203	2	0.0571429
209	1	0.0285714
214	1	0.0285714

• Las tablas y sus resultados son coherentes

• Generar una tabla de doble entrada entre las variables Tree y Age de Orange.

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    1

Ejercicio 2

• Copiad y ejecutad el código siguiente de los dos vectores (se consutla este codigo en soluciones porque no s encuentra en el enunciado).

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)

• Usando el vect1 creamos un nuevo vector llamado Bajo_peso que sea un factor con dos niveles. Las etiquetas corresponden a 1 = Bajo peso y 2 = Peso normal

Bajo_peso <- factor(vect1, levels = c(1, 2), labels = c("Bajo peso", "Peso normal"))

• Usando el vect2 creamos un nuevo vector llamado Fumador que sea un factor con dos niveles. Las etiquetas corresponden a 1 = Fuma y 2 = No fuma.

Fumador <- factor(vect2, levels = c(1, 2), labels = c("Fuma", "No fuma"))

• Creamos una tabla de contingencia con las dos variables anteriores con el nombre Tabla.

Tabla <- table(Bajo_peso, Fumador)
kable(Tabla)

	Fuma	No fuma
Bajo peso	8	4
Peso normal	5	3

• Miramos la relación de las variables anteriores con la prueba del ji cuadrado

chisq.test(Tabla)

## Warning in chisq.test(Tabla): Chi-squared approximation may be incorrect

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  Tabla
## X-squared = 0, df = 1, p-value = 1

• Obtenemos warning debido a que algunos valores son menores que 5

• Miramos también cómo resulta el test de Fisher

fisher.test(Tabla)

## 
##  Fisher's Exact Test for Count Data
## 
## data:  Tabla
## 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.189031

• No hay suficientes pruebas para demostrar la relación

Ejercicio 3

• a) Activad el paquete de datos airquality del paquete datasets y generad los siguientes gráficos:

data(airquality)

• Un gráfico de dispersión de la variable Ozone de color azul y con almohadillas (#) en vez de puntos.

plot(airquality$Ozone, col = "blue",pch="#")

• Un gráfico de caja de color rojo con la variable Temp con el título Temperatura (en grados Farenheit).

boxplot(airquality$Temp, col = "red", main = "Temperatura (en grados Farenheit)")

• b) Activad el paquete de datos airmiles del paquete datasets y generad los siguientes gráficos:

data(airmiles)

• Un gráfico de líneas de la serie de datos airmiles con el título Datos de pasajeros en vuelos comerciales (en miles) y de color azul (cadetblue2) y la etiqueta del eje x con Miles de pasajeros.

plot(airmiles, main = "Datos de pasajeros en vuelos comerciales (en miles)", col = "cadetblue2", xlab = "Miles de pasajeros")

• Un histograma de la serie de datos airmiles de color marrón (chocolate2).

hist(airmiles, col = "chocolate2", main = "Histograma de Datos de Pasajeros en Vuelos Comerciales")

• c) Representad los cuatro gráficos en una única imagen donde los veamos juntos.

par(mfrow = c(2, 2))
plot(airquality$Ozone, col = "blue",pch="#")
boxplot(airquality$Temp, col = "red", main = "Temperatura (en grados Farenheit)")
plot(airmiles, main = "Datos de pasajeros en vuelos comerciales (en miles)", col = "cadetblue2", xlab = "Miles de pasajeros")
hist(airmiles, col = "chocolate2", main = "Histograma de Datos de Pasajeros en Vuelos Comerciales")

par(mfrow=c(2,2))

Ejercicio 4

set.seed(123)
x1 <- rnorm(1000) #simulamos una variable x1
y1 <- x1 + rnorm(1000) #simulamos una variable y1
plot(x1, y1, main="Gráfico de dispersión") #creamos el gráfico de dispersión de las variables
abline(lm(y1~x1), col="cadetblue3") #creamos la recta de regresión de color verde

plot(density(x1), main="Densidad de x1", col="aquamarine") #generamos el gráfico de densidad para ver cómo es la distribución
lines(density(y1), col="darkred") #generamos un gráfico con las densidades de las dos variables.

Ejercicio 5

• a) Con los datos airquality del paquete datasets crear un gráfico de dispersión simple, pero con la recta de regresión ajustada en color rojo (darkred).

library(ggplot2)
summary(airquality)

##      Ozone           Solar.R           Wind             Temp      
##  Min.   :  1.00   Min.   :  7.0   Min.   : 1.700   Min.   :56.00  
##  1st Qu.: 18.00   1st Qu.:115.8   1st Qu.: 7.400   1st Qu.:72.00  
##  Median : 31.50   Median :205.0   Median : 9.700   Median :79.00  
##  Mean   : 42.13   Mean   :185.9   Mean   : 9.958   Mean   :77.88  
##  3rd Qu.: 63.25   3rd Qu.:258.8   3rd Qu.:11.500   3rd Qu.:85.00  
##  Max.   :168.00   Max.   :334.0   Max.   :20.700   Max.   :97.00  
##  NA's   :37       NA's   :7                                       
##      Month            Day      
##  Min.   :5.000   Min.   : 1.0  
##  1st Qu.:6.000   1st Qu.: 8.0  
##  Median :7.000   Median :16.0  
##  Mean   :6.993   Mean   :15.8  
##  3rd Qu.:8.000   3rd Qu.:23.0  
##  Max.   :9.000   Max.   :31.0  
## 

ggplot(airquality,aes(x = Ozone, y = Solar.R)) +geom_point(size=3) +  geom_smooth(method="lm", col="darkred")

## `geom_smooth()` using formula = 'y ~ x'

## Warning: Removed 42 rows containing non-finite outside the scale range
## (`stat_smooth()`).

## Warning: Removed 42 rows containing missing values or values outside the scale range
## (`geom_point()`).

• b) Con los datos airquality del paquete datasets cread un gráfico de dispersión con las variables Solar.R y Temp con sus respectivas etiquetas de eje. Los colores y la forma de los puntos deben ser en función de la variable Month convertida a factor.

ggplot (data=airquality, aes(x=Solar.R, y=Temp, col=factor(Month), shape=factor(Month))) + geom_point(size=3) + labs(x = "Solar.R", y = "Temp")

## Warning: Removed 7 rows containing missing values or values outside the scale range
## (`geom_point()`).

• c) Con los datos de Birthwt del paquete MASS mostrad la distribución de la variable age que tenga el borde de color negro y azul en el interior de las barras

library(MASS)
data(birthwt)
ggplot(birthwt, aes(x = age)) + geom_histogram(binwidth = 1, fill = "blue", color = "black") + labs(x = "Age")

• d) Con los datos de Birthwt del paquete MASS mostrad la distribución de la variable age, pero separada en dos gráficos (fumador/no fumador) por la variable smoke.

ggplot(birthwt, aes(x = age)) + geom_histogram(fill = "blue", color = "black")+facet_wrap(~ smoke) + labs(x = "Age")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Ejercicio 6

jpeg("C:/Users/mario/Desktop/UOC/Software para el análisis de datos/RStudio/Lab2/migrafic1.jpg")
data(iris)
plot(iris$Petal.Length, col = "blue",pch="#")
dev.off()

## png 
##   2

pdf("C:/Users/mario/Desktop/UOC/Software para el análisis de datos/RStudio/Lab2/migrafic2.pdf")
data(iris)
plot(iris$Petal.Length, col = "blue",pch="#")
dev.off()

## png 
##   2

Ejercicio 7

• Queremos saber qué valor de circunferencia tendrá un árbol seiscientos días después de plantarlo. Cread para ello un modelo lineal y practicad la regresión lineal paso a paso con los pasos que habéis visto en este laboratorio

str(Orange)

## Classes 'nfnGroupedData', 'nfGroupedData', 'groupedData' and 'data.frame':   35 obs. of  3 variables:
##  $ Tree         : Ord.factor w/ 5 levels "3"<"1"<"5"<"2"<..: 2 2 2 2 2 2 2 4 4 4 ...
##  $ age          : num  118 484 664 1004 1231 ...
##  $ circumference: num  30 58 87 115 120 142 145 33 69 111 ...
##  - attr(*, "formula")=Class 'formula'  language circumference ~ age | Tree
##   .. ..- attr(*, ".Environment")=<environment: R_EmptyEnv> 
##  - attr(*, "labels")=List of 2
##   ..$ x: chr "Time since December 31, 1968"
##   ..$ y: chr "Trunk circumference"
##  - attr(*, "units")=List of 2
##   ..$ x: chr "(days)"
##   ..$ y: chr "(mm)"

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

pairs(Orange)

kable(cor(Orange$age, Orange$circumference))

x
0.9135189

• Observamos que el coeficiente es elevado y se acerca a 1. Parece que que hay relación entre age y circumference.

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

• Ecuación de mínimos cuadrados: y=17.3997+0.1068x

plot(Orange$age, Orange$circumference, xlab='age', ylab='circumference')
abline(modelreg)

• Medida para 600 dias:

0.1068 * 600 + 17.3997

## [1] 81.4797

Ejercicio 8

ggplot(data=Orange, aes(x = age,y = circumference)) +geom_point() + geom_abline(intercept = 17.3997, slope = 0.1068, col = 'blue')

Ejercicio 9

data(PlantGrowth)
summary(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.310

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  ctrl

• ¿Creéis que hay diferencias entre tratamientos?

library(psych)

## 
## Adjuntando el paquete: 'psych'

## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha

describeBy(PlantGrowth$weight, PlantGrowth$group)

## 
##  Descriptive statistics by group 
## group: ctrl
##    vars  n mean   sd median trimmed  mad  min  max range skew kurtosis   se
## X1    1 10 5.03 0.58   5.15       5 0.72 4.17 6.11  1.94 0.23    -1.12 0.18
## ------------------------------------------------------------ 
## group: trt1
##    vars  n mean   sd median trimmed  mad  min  max range skew kurtosis   se
## X1    1 10 4.66 0.79   4.55    4.62 0.53 3.59 6.03  2.44 0.47     -1.1 0.25
## ------------------------------------------------------------ 
## group: trt2
##    vars  n mean   sd median trimmed  mad  min  max range skew kurtosis   se
## X1    1 10 5.53 0.44   5.44     5.5 0.36 4.92 6.31  1.39 0.48    -1.16 0.14

boxplot(PlantGrowth$weight ~ PlantGrowth$group, col=palette.colors())

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

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

• Se puede comprobar que con el tratamiento 1 los pesos disminuyen y con el tratamiento 2 aumentan

•Se cumplen las condiciones para poder aplicar una ANOVA. ¿Qué pruebas os planteáis?

anova_result <- aov(weight ~ group, data= PlantGrowth)
summary (anova_result)

##             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

• El valor p del analisis ANOVA es 0.0159, es decir, menos que 0,05, por lo que podemos afirmar que hay diferencias significativas entre los grupos. Aplicaremos la prueba de comparaciones múltiples post hoc de Tukey para evaluar entre qué grupos encontramos las diferencias.

TukeyHSD(anova_result)

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = weight ~ group, data = PlantGrowth)
## 
## $group
##             diff        lwr       upr     p adj
## trt1-ctrl -0.371 -1.0622161 0.3202161 0.3908711
## trt2-ctrl  0.494 -0.1972161 1.1852161 0.1979960
## trt2-trt1  0.865  0.1737839 1.5562161 0.0120064

• Podemos concluir que existen la principal diferencia se encuentra en la comparación entre el tratamiento 1 y 2 ya que el p valor es 0.012

Ejercicio 10

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':
## 
##     layout

fig = plot_ly(data=birthwt, x = ~age, y = ~smoke, type = 'bar')
fig

• Con este tipo de gráfico es posible aplicar zoom y desplazarse por el gráfico ademas de visualizar información de los datos de la gráfica.

Caso práctico

• Se obtienen datos de https://datos.gob.es/en/catalogo/e05070101-evolucion-de-enfermedad-por-el-coronavirus-covid-19

Este conjunto de datos ofrece datos sobre el brote de la enfermedad por un nuevo tipo de virus de la familia Coronaviridae, denominado como SARS-CoV-2. La enfermedad causada por este nuevo virus se ha denominado por consenso internacional COVID-19.

Los datos aquí recogidos provienen de los reportados por los servicios de salud de las Comunidades Autónomas.

datos_con_na <- read.csv("C:/Users/mario/Desktop/UOC/Software para el análisis de datos/RStudio/Lab2/casos_diagnostico_provincia.csv")
kable(head(datos_con_na))

provincia_iso	fecha	num_casos	num_casos_prueba_pcr	num_casos_prueba_test_ac	num_casos_prueba_ag	num_casos_prueba_elisa	num_casos_prueba_desconocida
A	2020-01-01	1	1	0	0	0	0
AB	2020-01-01	0	0	0	0	0	0
AL	2020-01-01	0	0	0	0	0	0
AV	2020-01-01	0	0	0	0	0	0
B	2020-01-01	2	2	0	0	0	0
BA	2020-01-01	0	0	0	0	0	0

ccaa_iso Código ISO de la CCAA de residencia

fecha Desde el inicio de la pandemia hasta el 10 de mayo, la fecha de inicio de síntomas o, en su defecto, la fecha de diagnóstico menos 6 días. A partir del 11 de mayo, la fecha de inicio de síntomas, o en su defecto, la fecha de diagnóstico menos 3 días, o la fecha de diagnóstico para los casos asintomáticos

num_casos Número de casos por técnica diagnóstica y CCAA de residencia

num_casos_prueba_pcr Número de casos con prueba de laboratorio PCR o técnicas moleculares

num_casos_prueba_test_ac Número de casos con prueba de laboratorio de test rápido de anticuerpos

num_casos_prueba_ag Número de casos con prueba de laboratorio de test de detección de antígeno

num_casos_prueba_elisa Número de casos con prueba de laboratorio de serología de alta resolución (ELISA/ECLIA/CLIA)

num_casos_prueba_desconocida Número de casos sin información sobre la prueba de laboratorio

• Realizad un resumen estadístico completo del dataset y explicad los resultados.

summary(datos_con_na)

##  provincia_iso         fecha             num_casos      num_casos_prueba_pcr
##  Length:20723       Length:20723       Min.   :   0.0   Min.   :   0.0      
##  Class :character   Class :character   1st Qu.:   2.0   1st Qu.:   1.0      
##  Mode  :character   Mode  :character   Median :  26.0   Median :  22.0      
##                                        Mean   : 125.5   Mean   : 103.7      
##                                        3rd Qu.: 112.0   3rd Qu.:  95.0      
##                                        Max.   :6743.0   Max.   :6726.0      
##  num_casos_prueba_test_ac num_casos_prueba_ag num_casos_prueba_elisa
##  Min.   : 0.0000          Min.   :   0.00     Min.   : 0.0000       
##  1st Qu.: 0.0000          1st Qu.:   0.00     1st Qu.: 0.0000       
##  Median : 0.0000          Median :   0.00     Median : 0.0000       
##  Mean   : 0.2299          Mean   :  21.24     Mean   : 0.1782       
##  3rd Qu.: 0.0000          3rd Qu.:   4.00     3rd Qu.: 0.0000       
##  Max.   :32.0000          Max.   :3411.00     Max.   :86.0000       
##  num_casos_prueba_desconocida
##  Min.   : 0.0000             
##  1st Qu.: 0.0000             
##  Median : 0.0000             
##  Mean   : 0.1097             
##  3rd Qu.: 0.0000             
##  Max.   :65.0000

datos <- na.omit(datos_con_na)
summary(datos)

##  provincia_iso         fecha             num_casos      num_casos_prueba_pcr
##  Length:20332       Length:20332       Min.   :   0.0   Min.   :   0.0      
##  Class :character   Class :character   1st Qu.:   2.0   1st Qu.:   1.0      
##  Mode  :character   Mode  :character   Median :  25.0   Median :  21.0      
##                                        Mean   : 125.6   Mean   : 103.7      
##                                        3rd Qu.: 110.0   3rd Qu.:  94.0      
##                                        Max.   :6743.0   Max.   :6726.0      
##  num_casos_prueba_test_ac num_casos_prueba_ag num_casos_prueba_elisa
##  Min.   : 0.0000          Min.   :   0.00     Min.   : 0.0000       
##  1st Qu.: 0.0000          1st Qu.:   0.00     1st Qu.: 0.0000       
##  Median : 0.0000          Median :   0.00     Median : 0.0000       
##  Mean   : 0.2312          Mean   :  21.38     Mean   : 0.1816       
##  3rd Qu.: 0.0000          3rd Qu.:   4.00     3rd Qu.: 0.0000       
##  Max.   :32.0000          Max.   :3411.00     Max.   :86.0000       
##  num_casos_prueba_desconocida
##  Min.   : 0.0000             
##  1st Qu.: 0.0000             
##  Median : 0.0000             
##  Mean   : 0.1118             
##  3rd Qu.: 0.0000             
##  Max.   :65.0000

nrow(datos)

## [1] 20332

sapply(datos, mean)

## Warning in mean.default(X[[i]], ...): argument is not numeric or logical:
## returning NA
## Warning in mean.default(X[[i]], ...): argument is not numeric or logical:
## returning NA

##                provincia_iso                        fecha 
##                           NA                           NA 
##                    num_casos         num_casos_prueba_pcr 
##                  125.5780051                  103.6701751 
##     num_casos_prueba_test_ac          num_casos_prueba_ag 
##                    0.2312119                   21.3832874 
##       num_casos_prueba_elisa num_casos_prueba_desconocida 
##                    0.1815857                    0.1117450

sd(datos$num_casos)

## [1] 354.4712

min(datos$fecha)

## [1] "2020-01-01"

max(datos$fecha)

## [1] "2021-01-25"

A simple vista parece que el mayor porcentaje de los casos detectados ha sido mediante prueba cpr y que la media y la desviación típica son bastantes distintas durante un año

• Realizad cinco gráficos básicos con las variables, explicad su significado y guardadlos como imágenes (jpeg o bmp).

datos$num_casos <- as.numeric(datos$num_casos)
casos_por_provincia <- aggregate(num_casos ~ provincia_iso, data = datos, sum)
jpeg("C:/Users/mario/Desktop/UOC/Software para el análisis de datos/RStudio/Lab2/caso_practico_1.jpg")
pie(casos_por_provincia$num_casos,labels = casos_por_provincia$provincia_iso,main = "Casos Totales por Provincia")
dev.off()

## png 
##   2

pie(casos_por_provincia$num_casos,labels = casos_por_provincia$provincia_iso,main = "Casos Totales por Provincia")

Concentración de casos por comunidad durante todo el periodo. Se puede comprobar que salvo las comunidades Madrid, Barcelona y Valencia, el resto se distribuye bastante uniformemente.

datos$fecha <- as.Date(datos$fecha)
casos_tiempo <- aggregate(num_casos ~ fecha, data = datos, sum)
jpeg("C:/Users/mario/Desktop/UOC/Software para el análisis de datos/RStudio/Lab2/caso_practico_2.jpg")
plot(casos_tiempo$fecha,casos_tiempo$num_casos,type = "l",xlab = "Fecha",ylab = "Número de Casos",main = "Número Total de Casos a lo Largo del Tiempo")
dev.off()

## png 
##   2

plot(casos_tiempo$fecha,casos_tiempo$num_casos,type = "l",xlab = "Fecha",ylab = "Número de Casos",main = "Número Total de Casos a lo Largo del Tiempo")

Se puede comprobar que después de los picos de Marzo/Abril y Octubre/Noviembre hubo un periodo de estabilización de casos

top_3_comunidades <- subset(datos, provincia_iso %in% c("M", "B", "V"))
jpeg("C:/Users/mario/Desktop/UOC/Software para el análisis de datos/RStudio/Lab2/caso_practico_3.jpg")
boxplot(num_casos ~ provincia_iso,data = top_3_comunidades,main = "Diagrama de Caja del Número Total de Casos por Provincia (M, B, V)",xlab = "Provincia",ylab = "Número de Casos")
dev.off()

## png 
##   2

boxplot(num_casos ~ provincia_iso,data = top_3_comunidades,main = "Diagrama de Caja del Número Total de Casos por Provincia (M, B, V)",xlab = "Provincia",ylab = "Número de Casos")

Se puede comprobar la gran diferencia entre las 3 comunidades con mas casos.

casos_por_test <- c(PCR = sum(datos$num_casos_prueba_pcr),Test_ac = sum(datos$num_casos_prueba_test_ac),Antigen = sum(datos$num_casos_prueba_ag),Elisa = sum(datos$num_casos_prueba_elisa),otros = sum(datos$num_casos_prueba_desconocida))
jpeg("C:/Users/mario/Desktop/UOC/Software para el análisis de datos/RStudio/Lab2/caso_practico_4.jpg")           
pie(casos_por_test,labels = names(casos_por_test), main = "Casos Totales por Tipo de Prueba")
dev.off()           

## png 
##   2

pie(casos_por_test,labels = names(casos_por_test), main = "Casos Totales por Tipo de Prueba")

Se comprueba como el tipo de prueba PCR es el más utlizado

jpeg("C:/Users/mario/Desktop/UOC/Software para el análisis de datos/RStudio/Lab2/caso_practico_5.jpg") 
barplot(casos_por_provincia$num_casos,names.arg = casos_por_provincia$provincia_iso,main = "Total de Casos por Provincia",xlab = "Provincia",ylab = "Número de Casos")
dev.off() 

## png 
##   2

barplot(casos_por_provincia$num_casos,names.arg = casos_por_provincia$provincia_iso,main = "Total de Casos por Provincia",xlab = "Provincia",ylab = "Número de Casos")

Se comprueba lo visto anteriormente, que 3 comunidades descatan entre las demás. Se puede afirmar que la gráfica seleccionada no es la más indicada puesto que no se puede identificar las comunidades.

• Realizad dos gráficos con el comando ggplot(), explicad su significado y guardadlos como imágenes (jpeg o bmp).

jpeg("C:/Users/mario/Desktop/UOC/Software para el análisis de datos/RStudio/Lab2/caso_practico_6.jpg") 
total_cases_by_province <- datos %>%group_by(provincia_iso) %>% summarise(total_casos = sum(num_casos))
ggplot(total_cases_by_province, aes(x = provincia_iso, y = total_casos)) +geom_bar(stat = "identity", fill = "skyblue") + labs(title = "Total de Casos por Provincia", x = "Provincia", y = "Número de Casos")
dev.off() 

## png 
##   2

ggplot(total_cases_by_province, aes(x = provincia_iso, y = total_casos)) +geom_bar(stat = "identity", fill = "skyblue") + labs(title = "Total de Casos por Provincia", x = "Provincia", y = "Número de Casos")

jpeg("C:/Users/mario/Desktop/UOC/Software para el análisis de datos/RStudio/Lab2/caso_practico_7.jpg") 
casor_top_3_tiempo <- top_3_comunidades %>% group_by(fecha, provincia_iso) %>% summarise(total_casos = sum(num_casos))

## `summarise()` has grouped output by 'fecha'. You can override using the
## `.groups` argument.

ggplot(casor_top_3_tiempo, aes(x = as.Date(fecha), y = total_casos, color = provincia_iso)) + geom_line(size = 1) + labs(title = "Evolución de los Casos para M, B y V Durante el Tiempo", x = "Fecha", y = "Número de Casos", color = "Provincia")

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

dev.off()

## png 
##   2

ggplot(casor_top_3_tiempo, aes(x = as.Date(fecha), y = total_casos, color = provincia_iso)) + geom_line(size = 1) + labs(title = "Evolución de los Casos para M, B y V Durante el Tiempo", x = "Fecha", y = "Número de Casos", color = "Provincia")

• Generad una regresión lineal entre dos de sus variables paso a paso y comentad los resultados obtenidos.

datos_numericos <- datos[sapply(datos, is.numeric)]
pairs(datos_numericos)

Intentamos generar una regresión lineal entre numero de casos y numero de casos diagnosticados con PCR

kable(cor(datos$num_casos, datos$num_casos_prueba_pcr))

x
0.957864

Al obtener un valor cercano a uno generamos un modelo cuya variable dependiente sea los casos diagnosticados total y la variable casos diagnosticados con pcr

modelreg <- lm(num_casos ~ num_casos_prueba_pcr, data = datos)
summary(modelreg) 

## 
## Call:
## lm(formula = num_casos ~ num_casos_prueba_pcr, data = datos)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -919.5  -12.6   -7.9   -7.6 3213.1 
## 
## Coefficients:
##                      Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          7.589842   0.755921   10.04   <2e-16 ***
## num_casos_prueba_pcr 1.138111   0.002393  475.50   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 101.8 on 20330 degrees of freedom
## Multiple R-squared:  0.9175, Adjusted R-squared:  0.9175 
## F-statistic: 2.261e+05 on 1 and 20330 DF,  p-value: < 2.2e-16