true 
knitr::opts_chunk$set(echo = TRUE)

0. Set up y carga de datos

library(tidyverse)
## ── Attaching packages ───────────────────────────────────────────────── tidyverse 1.3.0 ──
## ✓ ggplot2 3.3.0     ✓ purrr   0.3.4
## ✓ tibble  2.1.3     ✓ dplyr   0.8.5
## ✓ tidyr   1.0.2     ✓ stringr 1.4.0
## ✓ readr   1.3.1     ✓ forcats 0.5.0
## Warning: package 'purrr' was built under R version 3.6.2
## ── Conflicts ──────────────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(readxl)
library(lubridate)
## Warning: package 'lubridate' was built under R version 3.6.2
## 
## Attaching package: 'lubridate'
## The following objects are masked from 'package:dplyr':
## 
##     intersect, setdiff, union
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union
library(ggpubr)
## Loading required package: magrittr
## 
## Attaching package: 'magrittr'
## The following object is masked from 'package:purrr':
## 
##     set_names
## The following object is masked from 'package:tidyr':
## 
##     extract
library(ggdark)
library(knitr)

1. Carga de datos

fuente de los datos: https://data.europa.eu/euodp/en/data/dataset/covid-19-coronavirus-data/resource/55e8f966-d5c8-438e-85bc-c7a5a26f4863

2. Preparación de los datos

• Transformamos tipos y nombres de variables • Seleccionamos solo China, Italia y España • Calculamos el acumulado de infectados

3. Exploración Inicial. Situación General.

Vamos a analizar como está la situación por Pais

Pais Infectados
China 81238
Italy 35713
Iran 17361
Spain 13716
United_States_of_America 9415
France 9134
South_Korea 8565
Germany 8198
Switzerland 3010
United_Kingdom 2630

Claramente China e Italia son los mas afectados

España segun este dataset se sitúa 6 en el mundo por detras de Francia

4. Que podemos aprender de China?

El modelo epidemiológio predice que el número de infectados crecerá de forma exponencial hasta llegar al pico.

En ese momento el ritmo de crecimiento comenzará a decaer y el acumulado de infectados pasará de una forma exponencial a una sigmoidal.

Dado que China se considera el primer país que ha pasado el virus, vamos a estudiar su modelo en primer lugar.

Comenzamos por explorar gráficamente su ciclo en cuánto a nuevos infectados por dia:

data %>%
  filter(Pais == 'China', Fecha > '2020-01-23') %>%
  ggplot(aes(x=factor(Fecha), y = Infec_New)) +
  geom_col(fill = 'orange', color= 'red') +
  scale_y_continuous(limits = c(0,4100)) +
  dark_theme_minimal() +
  theme(axis.text.x = element_text(angle = 90,
                                   size = 8))
## Inverted geom defaults of fill and color/colour.
## To change them back, use invert_geom_defaults().
## Warning: Removed 2 rows containing missing values (position_stack).

En el gráfico vemos el número de infectados en cada uno de los días, la curva empezó a crecer a partir del 24 de enero

Conclusiones:

• Con las medidas tomadas por China la fase de crecimiento exponencial duró menos de 2 semanas • Tras ellas se cumplen las predicciones de la desaceleración en cuanto a nuevos casos de infectados. • Tras alcanzar el pico y el cambio de tendencia en el factor de crecimiento, China tardó aprox un mes en decir que “ha superado la crisis”

Vamos a ver la forma del acumulado de casos.

data %>%
  filter(Pais == 'China', Fecha > '2020-01-23') %>%
  ggplot(aes(x=factor(Fecha), y = Infec_acu)) +
  geom_point(color ='orange') +
  dark_theme_minimal() +
  theme(axis.text.x = element_text(angle = 90,
                                   size = 8))

De nuevo las predicciones se cumplen del modelo epidemiológico.

Queríamos buscar esa forma de “S” donde la curva se aplana.Los puntos en blanco es posible que no haya datos porque se cambiaria el sistema de conteo o algo parecido.

• Por lo que hemos podido comprobar la clave es conseguir que el factor de crecimiento comienze a bajar de 1 para que se produzca el cambio de tendencia • En ese momento todavía debemos esperar 4-5 semanas para tener la situación bajo control.

5. Que podemos aprender de Italia?

Analizamos su gráfico de nuevos casos por día:

Está todavía claramente en la fase de crecimiento. (Ignoramos de momento el dato del día 15 porque parece muy raro)

Vamos a ver su gráfico de acumulados para poder mejor la tendencia de su curva.

Se confirma de nuevo la forma exponencial y la forma de crecimiento.

Por ahora no podemos aprender nada de Italia, lleva 15 dias de crecimiento continuo y sigue el modelo previsto.

6. Analisis de España

6.1 Creamos un subconjunto de Datos solo para España

6.2 Hacemos el gráfico de nuevos infectados por día

Claramente estamos en fase de crecimiento y solo podemos esperar que siga subiendo.

6.3 Hacemos el gráfico de acumulados infectados

Si los datos se ajustan bien al modelo, podemos crear el modelo y si lo podemos crear podemos extrapolarlo y podemos saber si las medidas son necesarias o no.

Viendo y sabiendo que vamos a seguir empeorando, la pregunta es:

6.4 ¿Cuántos infectados podríamos esperar en los siguientes días si no se hubiera tomado ninguna medida?

Vamos a intentar ajustar un modelo para predecirlo.

La estrategia de modelización va a ser linealizar los datos mediante una escala logarítmica, para después aplicar un algoritmo lineal.

Transformando el acumulado de infectados a escala logarítmica de base 10.

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

Lo que hago con el log10 es linealizarme los datos.

Al superponer una recta de regresión sobre esta escala vemos que se ajusta bastante bien y que el R2 es del 99%

Vamos a crear el modelo para conocer el factor de crecimiento.

Primero creamos una variable que sea el acumulado de infectados pero en escala de logaritmos base 10. (esto quiere decir que cada vez que esta escala aumente en 1, como vemos en el gráfico, quiere decir que se multiplica por 10)

Fecha Infec_New Infec_acu Log_Infec_acu
2020-02-26 4 7 0.845098
2020-02-27 5 12 1.079181
2020-02-28 13 25 1.397940
2020-02-29 9 34 1.531479
2020-03-01 32 66 1.819544
2020-03-02 17 83 1.919078
2020-03-03 31 114 2.056905
2020-03-04 37 151 2.178977
2020-03-05 49 200 2.301030
2020-03-06 61 261 2.416641
2020-03-07 113 374 2.572872
2020-03-08 56 430 2.633469
2020-03-09 159 589 2.770115
2020-03-10 615 1204 3.080627
2020-03-11 435 1639 3.214579
2020-03-12 501 2140 3.330414
2020-03-13 864 3004 3.477700
2020-03-14 1227 4231 3.626443
2020-03-15 1522 5753 3.759894
2020-03-16 2000 7753 3.889470
2020-03-17 1438 9191 3.963363
2020-03-18 1987 11178 4.048364
2020-03-19 2538 13716 4.137227

De esta manera estamos ajustando un modelo lineal y también para:

Esto ya nos permite algunos análisis interesantes. Ya que si miramos esta escala sube de entero nos dice el número de días necesario para que el número de infectados se multiplique por 10.

Por ejemplo, el valor 1 está aprox en el día 2020-02-27, mientras que el valor 2 está en el 2020-03-03.

Es decir, el número de Infectados se ha multiplicado por 10 en aprox 1 semana.

El valor 3 se alcanza el 2020-03-10, de nuevo 1 semana después.

Es decir, si no hacemos nada podemos esperar que el número de infectados se multiplique por 10 con cada semana que pase.

Por ello el 17 de marzo, estaríamos esperando 12.000 infectados y de no hacer nada podríamos acabar dos semanas después con 1.200.000 infectados.

6.5 Vamos a hacer las estimaciones más finas con un modelo.

Entrenamos una regresión lineal sobre los datos transformados

## 
## Call:
## lm(formula = Log_Infec_acu ~ Fecha, data = spain)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.24774 -0.05602  0.02435  0.05896  0.14306 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -2.672e+03  5.716e+01  -46.74   <2e-16 ***
## Fecha        1.459e-01  3.118e-03   46.79   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.09921 on 21 degrees of freedom
## Multiple R-squared:  0.9905, Adjusted R-squared:   0.99 
## F-statistic:  2189 on 1 and 21 DF,  p-value: < 2.2e-16

Lo que obtenemos básicamente es que la variable FECHA es muy significativa (***) y que el R2 también ajusta muy bien (99%)

Ahora vamos a utilizar el coeficiente para estimar el factor de crecimiento

## El factor de crecimiento en España es de: 1.399295 Es decir, cada dia se detecta un 39.92951 % más de casos que el día anterior

Tenemos que el factor de crecimiento es 1.40, lo que quiere decir que cada dia se detectan un 40% de casos más que el dia anterior. Mientras este número sea mayor que 1, el crecimiento será exponencial. Cuando se aproxime a 1 querrá decir que estaremos en una fase contención.

Vamos a contrastar las predicciones del modelo con los datos reales (deberíamos comparar la predicción con otros datos reales que no haya visto el modelo, pero en este caso con los pocos datos que disponemos solo podemos hacerlo así)

Podemos decir que ajusta bastante bien, aunque a la cola sobreestima bastante. Vamos a predecir que pasaría dentro de 15 días si no se tomaran medidas

Fecha Infec_acu Pred
2020-02-26 7 12.38345
2020-02-27 12 17.32810
2020-02-28 25 24.24712
2020-02-29 34 33.92887
2020-03-01 66 47.47651
2020-03-02 83 66.43364
2020-03-03 114 92.96026
2020-03-04 151 130.07884
2020-03-05 200 182.01868
2020-03-06 261 254.69783
2020-03-07 374 356.39742
2020-03-08 430 498.70515
2020-03-09 589 697.83565
2020-03-10 1204 976.47797
2020-03-11 1639 1366.38080
2020-03-12 2140 1911.96991
2020-03-13 3004 2675.41004
2020-03-14 4231 3743.68805
2020-03-15 5753 5238.52419
2020-03-16 7753 7330.24101
2020-03-17 9191 10257.17003
2020-03-18 11178 14352.80733
2020-03-19 13716 20083.81237
2020-03-15 NA 5238.52419
2020-03-16 NA 7330.24101
2020-03-17 NA 10257.17003
2020-03-18 NA 14352.80733
2020-03-19 NA 20083.81237
2020-03-20 NA 28103.17940
2020-03-21 NA 39324.64006
2020-03-22 NA 55026.77451
2020-03-23 NA 76998.69366
2020-03-24 NA 107743.89153
2020-03-25 NA 150765.49499

Vamos a verlo gráficamente

spain_pred %>%
  ggplot(aes(x= Fecha)) + 
  geom_line(aes(y= Pred), color = 'red') + 
  geom_line(aes(y= Infec_acu), color = 'blue', size= 2) +
  geom_vline(xintercept = as_date('2020-03-15')) +
  dark_theme_minimal() +
  scale_x_date(breaks = spain_pred$Fecha) +
  theme(axis.text.x = element_text(angle = 90,
                                   size= 6))
## Warning: Removed 7 row(s) containing missing values (geom_path).

Parece que tenemos un “margen” hasta el 22 o 23 de marzo para que las medidas tengan efecto, la línea azul es el día que estamos hoy.

Si las medidas tomadasa no hacen efecto en este tiempo entraríamos en una fase peligrosa y los infectados se dispararían.

7. Conclusiones y respuestas a las principales preguntas

** Las medidas han sido proporcionadas o se ha exagerado? **

** Que medidas?**

Analíticamente hay que controlar dos factores:

Por tanto, todas las medidas que influyan en estos dos factores serán positivas para el objetivo de tener la tasa de crecimiento por debajo de 1.

** En cuanto tiempo se puede detener la expansión? **

** Estamos a tiempo? **

Segun el modelo, el tema se descontrolaría sobre el 22 o 23 de marzo. Según los expertos, el decalaje entre que se toman medidas y se ve su efecto es de 10-15 días.

Así que vamos justos.

** Cuándo podemos empezar a ve run cambio en la curva? **

Teniendo en cuenta todo lo anterior es posible que los próximos días todavía veamos el crecimiento predicho por el modelo y a finales de esta semana comencemos a notar una reducción paulatina en el factor de crecimiento.

** Cuando vamos a recuperar la normalidad? **

Viendo que en China tardaron un mes tras el pico en tener el control, yo diría que podríamos recuperar la normalidad entre el 6 y 8 semanas desde el 16 de marzo.