-
Notifications
You must be signed in to change notification settings - Fork 0
/
Creando curvas epidemiologicas e informes con R
204 lines (159 loc) · 10 KB
/
Creando curvas epidemiologicas e informes con R
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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
#importando/descargando librerías a utilizar
#install.packages("pacman") #una vez instalada esta librería se puede eliminar la línea de comando
#importando e instalando las librarías a utilizas con la librería "pacman"
pacman::p_load(
RColorBrewer, # paleta de colores para R de colorbrewer2.org
dplyr, # Manejo de datos
ggplot2 #construcción gráficos
)
#generando un set de datos ficticio
p1 = data.frame(Den = rep("D1", 200),
fecha = seq(as.Date("2022-01-01"), as.Date("2022-05-25"), length = 100)) #Tabla con pocos casos D1 de marzo a mayo
p2 = data.frame(Den = rep(c("D2", "D3"), 300),
fecha = seq(as.Date("2022-05-26"), as.Date("2022-06-26"), length = 600)) #Tabla con muchos casos D2 y D3 de mayo a junio
p3 = data.frame(Den = rep(c("D2", "D3"), 500),
fecha = seq(as.Date("2022-06-27"), as.Date("2022-07-27"), length = 1000)) #Tabla con muchisimos casos D2 y D3 de junio a julio
p4 = data.frame(Den = rep(c("D2", "D3"), 250),
fecha = seq(as.Date("2022-07-28"), as.Date("2022-08-30"), length = 500)) #Tabla con menos casos D2 y D3 de julio a agosto
p5 = data.frame(Den = rep("D3", 200),
fecha = seq(as.Date("2022-08-30"), as.Date("2022-12-25"), length = 100)) #Tabla con pocos casos D3 de Agosto a Diciembre
data = rbind(p1,p2,p3,p4, p5) # uniendo todas las tablas para crear un solo set de datos
remove(p1, p2, p3, p4, p5) #eliminar las tablas creadas para construir la dataframe y que ya no servirán
#creando un histograma para dar una revisión general del rango de los datos
ggplot(data = data)+
geom_histogram(aes(x = fecha))
#Creando un informe Agrupando los sertipos y fechas y contando los casos por fechas
conteo_de_datos <- data %>%
group_by(Den, fecha = as.character(fecha)) %>%
summarise(n_cases = dplyr::n()) %>% ungroup()
conteo_de_datos$fecha = as.Date( conteo_de_datos$fecha) #convirtiendo a tipo fecha la columna fecha
conteo_de_datos
#Creando un informe Agrupando los serOtipos y fechas y contando los casos por semana
conteo_de_datos_semanal <- data
conteo_de_datos_semanal$semana <- format(data$fecha, "%V")
conteo_de_datos_semanal %>%
group_by(Den, fecha = as.character(semana)) %>%
summarise(n_cases = dplyr::n()) %>% ungroup()
#Creando un informe Agrupando los serOtipos y fechas y contando los casos por mes
conteo_de_datos_mensual <- data
conteo_de_datos_mensual$mes <- format(data$fecha, "%m")
conteo_de_datos_mensual %>%
group_by(Den, fecha = as.character(mes)) %>%
summarise(n_cases = dplyr::n()) %>% ungroup()
#Creando una curva epidemiológica con ggplot
ggplot(data = data) + # set de datos
geom_histogram( # tipo histograma
mapping = aes(x = fecha), # fecha al eje x
binwidth = 1)+ # casos por día
labs(title = "Casos diarios DENGUE") # título
# semanal
ggplot(data = data) + # configuramos el set de datos
geom_histogram( # tipo histograma
mapping = aes(x = fecha), # fecha al eje x
binwidth = 7)+ # casos por cada 7 días
labs(title = "Casos semanales DENGUE") # título
# monthly
ggplot(data = data) + # configuramos el set de datos
geom_histogram( # tipo histograma
mapping = aes(x = fecha), # fecha al eje x
binwidth = 30.41)+ # casos cada 30.41 día (mensual)
labs(title = "Casos Mensuales DENGUE") # Título
#### DETERMINAR EL PRIMER CASO
format(min(data$fecha, na.rm=T), "%A %d %b, %Y")
#### DETERMINAR EL ÚLTIMO CASO
format(max(data$fecha, na.rm=T), "%A %d %b, %Y")
# TOTALIZAR DATOS DE MANERA SEMANAL (INICIANDO LUNES) Y CREANDO CURVA EPIDEMIOLÓGICA
#############################
# Definir una secuencia semanal (7 días)
secuencia_semanal <- seq.Date(
from = floor_date(min(data$fecha, na.rm=T), "week", week_start = 1), # Lunes antes del primer caso
to = ceiling_date(max(data$fecha, na.rm=T), "week", week_start = 1), # Lunes después del primer caso
by = "week") # los bloques son de 7 días
ggplot(data = data) + #llamamos a la función ggplot y especificamos la tabla a utilizar
# hacer un histograma: especificar los puntos de ruptura: comienza el lunes anterior al primer caso, finaliza el lunes posterior al último caso
geom_histogram(
# mapping aesthetics
mapping = aes(x = fecha), # fecha al eje X
# especificar los puntos de quiebre semanal, definido previamente
breaks = secuencia_semanal,
closed = "left", # contar casos desde el inicio del punto de interrupción
# bars
color = "darkblue", # color de la linea que bordea las barras
fill = "lightblue" # color de las barras
)+
# x-axis labels
scale_x_date(
expand = c(0,0), # elimine el espacio en el eje x antes y después de las barras
date_breaks = "4 weeks", # las etiquetas de fecha y las principales líneas de cuadrícula verticales aparecen cada 3 lunes de semana
date_minor_breaks = "week", # líneas verticales menores aparecen todos los lunes de la semana
date_labels = "%a\n%d %b\n%Y")+ # formato de las etiquetas de fecha
# y-axis
scale_y_continuous(
expand = c(0,0))+ # eliminar el exceso de espacio en el eje y por debajo de 0 (alinee el histograma con el eje x)
# aesthetic themes
theme_minimal()+ # aplicar un tema que simplifique el fondo
theme(
plot.caption = element_text(hjust = 0, # ubicar titulos a la izquierda
face = "italic"), # Titulos en letra itálica
axis.title = element_text(face = "bold"))+ # Títulos en los ejes en Negrita
# etiquetas que incluyen subtítulos
labs(
title = "Incidencia semanal de casos (semana iniciando lunes)",
subtitle = "Tenga en cuenta la alineación de las barras, las líneas de cuadrícula verticales y las etiquetas de los ejes los lunes de la semana",
x = "Semana de inicio de síntomas",
y = "Incidencia de casos reportados por semana",
caption = stringr::str_glue("n = {nrow(data)} de la tabla data; Los inicios de los casos van desde {format(min(data$fecha, na.rm=T), format = '%a %d %b %Y')} to {format(max(data$fecha, na.rm=T), format = '%a %d %b %Y')}\n{nrow(data %>% filter(is.na(fecha)))} casos a los que les falta la fecha de inicio y no se muestran"))
######Si se desea que la Semana inicie en domingo reemplazar el apartado "scale_x_date" en el código anterior por el siguiente
scale_x_date(
expand = c(0,0),
# especificar el intervalo de las etiquetas de fecha y las principales líneas de cuadrícula verticales
breaks = seq.Date(
from = floor_date(min(data$fecha, na.rm=T), "week", week_start = 7), # Domingo ántes del primer caso
to = ceiling_date(max(data$fecha, na.rm=T), "week", week_start = 7), # Domingo después del último caso
by = "4 weeks"),
# especificar el intervalo de la línea de cuadrícula vertical menor
minor_breaks = seq.Date(
from = floor_date(min(data$fecha, na.rm=T), "week", week_start = 7), # Domingo ántes del primer caso
to = ceiling_date(max(data$fecha, na.rm=T), "week", week_start = 7), # Domingo después del último caso
by = "week"),
# date label format
date_labels = "%a\n%d %b\n%Y") # día, encima de la abreviatura del mes, encima del año de 2 dígitos
###########################
#Agrupar/colorear por valor o categría
#En la sección "mapping aesthetics", el código se debe adecuar de la siguiente manera: "aes(x = data, group = Den, fill = Den)"
#A continuación el código completo con la curva agrupada
ggplot(data = data) + #llamamos a la función ggplot y especificamos la tabla a utilizar
# hacer un histograma: especificar los puntos de ruptura: comienza el lunes anterior al primer caso, finaliza el lunes posterior al último caso
geom_histogram(
# mapping aesthetics
mapping = aes(x = fecha, group = Den, fill = Den),
# especificar los puntos de quiebre semanal, definido previamente
breaks = secuencia_semanal,
closed = "left",
alpha=0.7 #Configura la transparencia de las barras 0 es sin color, 1 es full color
)+
scale_fill_manual(values=c("#a0e77d", "#82b6d9", "#ef8677")) + #configuramos los colores de cada barra
# x-axis labels
scale_x_date(
expand = c(0,0), # elimine el espacio en el eje x antes y después de las barras
date_breaks = "4 weeks", # las etiquetas de fecha y las principales líneas de cuadrícula verticales aparecen cada 3 lunes de semana
date_minor_breaks = "week", # líneas verticales menores aparecen todos los lunes de la semana
date_labels = "%a\n%d %b\n%Y")+ # formato de las etiquetas de fecha
# y-axis
scale_y_continuous(
expand = c(0,0))+ # eliminar el exceso de espacio en el eje y por debajo de 0 (alinee el histograma con el eje x)
# aesthetic themes
theme_minimal()+ # aplicar un tema que simplifique el fondo
theme(
plot.caption = element_text(hjust = 0, # ubicar titulos a la izquierda
face = "italic"), # Titulos en letra itálica
axis.title = element_text(face = "bold"),
legend.position = "top")+ # Títulos en los ejes en Negrita
# etiquetas que incluyen subtítulos
labs(
title = "Incidencia semanal de casos (semana iniciando lunes)",
subtitle = "Tenga en cuenta la alineación de las barras, las líneas de cuadrícula verticales y las etiquetas de los ejes los lunes de la semana",
x = "Semana de inicio de síntomas",
y = "Incidencia de casos reportados por semana",
fill = " ", #Que la leyenda no tenga títulos
caption = stringr::str_glue("n = {nrow(data)} de la tabla data; Los inicios de los casos van desde {format(min(data$fecha, na.rm=T), format = '%a %d %b %Y')} to {format(max(data$fecha, na.rm=T), format = '%a %d %b %Y')}\n{nrow(data %>% filter(is.na(fecha)))} casos a los que les falta la fecha de inicio y no se muestran"))