Reporte Covid 19

Leemos la data

 [1] "FLAG_MUERTE_COVID"                   
 [2] "DEPARTAMENTO_NOTIFICACION_NOMBRE"    
 [3] "MUNICIPIO_NOTIFICACION_NOMBRE"       
 [4] "TIPO_SEGURIDAD_SOCIAL"               
 [5] "CODIGO_ASEGURADORA"                  
 [6] "DIRECCION_RESIDENCIA"                
 [7] "LOCALIDAD_RESIDENCIA"                
 [8] "GRUPOS_EDAD_QUINQUENIOS"             
 [9] "OCUPACION"                           
[10] "PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD"
[11] "ESTRATO_SOCIOECONOMICO"              
[12] "CONDICION_GESTANTE"                  
[13] "HABITANTE_DE_CALLE"                  
[14] "ETNIA"                               
[15] "localidad_residencia_saludata"       
[16] "fuente_saludata"                     
[17] "ORIGEN"                              
[18] "AÑO"

 [1] 19 - Ciudad Bolívar        09 - Fontibón             
 [3] 10 - Engativá              11 - Suba                 
 [5] 13 - Teusaquillo           02 - Chapinero            
 [7] 01 - Usaquén               22 - En Rev_Loc           
 [9] 12 - Barrios Unidos        99 - Localidad Desconocida
[11] 18 - Rafael Uribe Uribe    06 - Tunjuelito           
[13] 08 - Kennedy               07 - Bosa                 
[15] 16 - Puente Aranda         14 - Los Mártires         
[17] 15 - Antonio Nariño        05 - Usme                 
[19] 04 - San Cristóbal         03 - Santa Fe             
[21] 17 - La Candelaria         20 - Sumapaz              
[23] NEIVA                     
23 Levels: 01 - Usaquén 02 - Chapinero 03 - Santa Fe ... NEIVA

                Nacionalidad Frecuencia
1                   COLOMBIA      92694
2                  VENEZUELA       2534
3  ESTADOS UNIDOS DE AMERICA         45
4                      CHINA         22
5                  ARGENTINA         21
6                       PERU         20
7                    ECUADOR         18
8                     ESPANA         17
9                     BRASIL         16
10                    ITALIA         13

Warning in instance$preRenderHook(instance): It seems your data is too big for
client-side DataTables. You may consider server-side processing:
https://rstudio.github.io/DT/server.html

Descriptivos Basicos

         NACIONALIDAD_AGRUPADA
1                     COLOMBIA
21                   VENEZUELA
148  ESTADOS UNIDOS DE AMERICA
347       Otras nacionalidades
381                     ITALIA
842                  ARGENTINA
2215                    BRASIL
3803                     CHINA
6297                   ECUADOR
6747                      PERU
9814                    ESPANA

Curvas epidemicas

Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` instead.

TableGrob (2 x 1) "arrange": 2 grobs
  z     cells    name           grob
1 1 (1-1,1-1) arrange gtable[layout]
2 2 (2-2,1-1) arrange gtable[layout]

TableGrob (2 x 1) "arrange": 2 grobs
  z     cells    name           grob
1 1 (1-1,1-1) arrange gtable[layout]
2 2 (2-2,1-1) arrange gtable[layout]

TableGrob (2 x 1) "arrange": 2 grobs
  z     cells    name           grob
1 1 (1-1,1-1) arrange gtable[layout]
2 2 (2-2,1-1) arrange gtable[layout]

TableGrob (2 x 1) "arrange": 2 grobs
  z     cells    name           grob
1 1 (1-1,1-1) arrange gtable[layout]
2 2 (2-2,1-1) arrange gtable[layout]

Anaisis en personal de salud

TableGrob (2 x 1) "arrange": 2 grobs
  z     cells    name           grob
1 1 (1-1,1-1) arrange gtable[layout]
2 2 (2-2,1-1) arrange gtable[layout]

TableGrob (2 x 1) "arrange": 2 grobs
  z     cells    name           grob
1 1 (1-1,1-1) arrange gtable[layout]
2 2 (2-2,1-1) arrange gtable[layout]

TableGrob (2 x 1) "arrange": 2 grobs
  z     cells    name           grob
1 1 (1-1,1-1) arrange gtable[layout]
2 2 (2-2,1-1) arrange gtable[layout]

TableGrob (2 x 1) "arrange": 2 grobs
  z     cells    name           grob
1 1 (1-1,1-1) arrange gtable[layout]
2 2 (2-2,1-1) arrange gtable[layout]

##Inicio Modelo

[1] "SEXO"                                
[2] "TIPO_SEGURIDAD_SOCIAL"               
[3] "GRUPOS_EDAD_QUINQUENIOS"             
[4] "PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD"
[5] "ESTRATO_SOCIOECONOMICO"              
[6] "CONDICION_GESTANTE"                  
[7] "ETNIA"                               
[8] "localidad_residencia_saludata"


Call:
glm(formula = PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD ~ SEXO + GRUPOS_EDAD_QUINQUENIOS + 
    ESTRATO_SOCIOECONOMICO + ETNIA + localidad_residencia_saludata, 
    family = binomial, data = Class_gestante_bal_over)

Coefficients:
                                                     Estimate Std. Error
(Intercept)                                          -1.59439    0.38568
SEXOM                                                -0.83994    0.02504
GRUPOS_EDAD_QUINQUENIOS06. 20 a 24 años               2.29761    0.11456
GRUPOS_EDAD_QUINQUENIOS07. 25 a 29 años               2.60090    0.11318
GRUPOS_EDAD_QUINQUENIOS08. 30 a 34 años               2.53158    0.11315
GRUPOS_EDAD_QUINQUENIOS09. 35 a 39 años               2.47570    0.11370
GRUPOS_EDAD_QUINQUENIOS10. 40 a 44 años               2.21619    0.11451
GRUPOS_EDAD_QUINQUENIOS11. 45 A 49 años               2.04894    0.11647
GRUPOS_EDAD_QUINQUENIOS12. 50 a 54 años               1.96410    0.11694
GRUPOS_EDAD_QUINQUENIOS13. 55 a 59 años               1.61596    0.11982
GRUPOS_EDAD_QUINQUENIOS14. 60 a 64 años               0.85808    0.13188
GRUPOS_EDAD_QUINQUENIOS15. 65 a 69 años               0.53617    0.14848
GRUPOS_EDAD_QUINQUENIOS16. 70 a 74 años              -0.32243    0.19067
GRUPOS_EDAD_QUINQUENIOS17. 75 a 79 años              -0.25667    0.22863
GRUPOS_EDAD_QUINQUENIOS18. 80 a 84 años              -1.17045    0.36462
ESTRATO_SOCIOECONOMICO2                               0.22173    0.04926
ESTRATO_SOCIOECONOMICO3                               0.20665    0.05063
ESTRATO_SOCIOECONOMICO4                               0.42776    0.06184
ESTRATO_SOCIOECONOMICO5                               0.40294    0.08585
ESTRATO_SOCIOECONOMICO6                              -0.34369    0.09056
ESTRATO_SOCIOECONOMICOSD                             -0.56485    0.06149
ETNIA2. Rom Gitano                                    0.04054    0.40080
ETNIA3. Raizal                                       -0.60460    0.47308
ETNIA5. Negro mulato afro colombiano                  1.21562    0.41733
ETNIA6. Otro                                         -0.21552    0.36440
ETNIASin Dato                                         1.49217    0.39571
localidad_residencia_saludata02 - Chapinero           0.02998    0.07418
localidad_residencia_saludata03 - Santa Fe           -0.89423    0.11336
localidad_residencia_saludata04 - San Cristóbal       0.16412    0.07330
localidad_residencia_saludata05 - Usme               -0.28726    0.08072
localidad_residencia_saludata06 - Tunjuelito         -0.21778    0.09147
localidad_residencia_saludata07 - Bosa               -0.24967    0.06376
localidad_residencia_saludata08 - Kennedy            -0.20080    0.05522
localidad_residencia_saludata09 - Fontibón           -0.11038    0.06565
localidad_residencia_saludata10 - Engativá           -0.41988    0.05731
localidad_residencia_saludata11 - Suba               -0.19114    0.05050
localidad_residencia_saludata12 - Barrios Unidos     -0.42561    0.09101
localidad_residencia_saludata13 - Teusaquillo         0.04613    0.07750
localidad_residencia_saludata14 - Los Mártires        0.10467    0.11330
localidad_residencia_saludata15 - Antonio Nariño     -0.02917    0.10596
localidad_residencia_saludata16 - Puente Aranda      -0.57239    0.08053
localidad_residencia_saludata17 - La Candelaria      -0.74536    0.17825
localidad_residencia_saludata18 - Rafael Uribe Uribe  0.03448    0.07112
localidad_residencia_saludata19 - Ciudad Bolívar     -0.16058    0.06808
localidad_residencia_saludataFuera de Bogotá         -0.83622    0.08277
                                                     z value Pr(>|z|)    
(Intercept)                                           -4.134 3.56e-05 ***
SEXOM                                                -33.539  < 2e-16 ***
GRUPOS_EDAD_QUINQUENIOS06. 20 a 24 años               20.055  < 2e-16 ***
GRUPOS_EDAD_QUINQUENIOS07. 25 a 29 años               22.981  < 2e-16 ***
GRUPOS_EDAD_QUINQUENIOS08. 30 a 34 años               22.373  < 2e-16 ***
GRUPOS_EDAD_QUINQUENIOS09. 35 a 39 años               21.774  < 2e-16 ***
GRUPOS_EDAD_QUINQUENIOS10. 40 a 44 años               19.355  < 2e-16 ***
GRUPOS_EDAD_QUINQUENIOS11. 45 A 49 años               17.592  < 2e-16 ***
GRUPOS_EDAD_QUINQUENIOS12. 50 a 54 años               16.796  < 2e-16 ***
GRUPOS_EDAD_QUINQUENIOS13. 55 a 59 años               13.486  < 2e-16 ***
GRUPOS_EDAD_QUINQUENIOS14. 60 a 64 años                6.506 7.69e-11 ***
GRUPOS_EDAD_QUINQUENIOS15. 65 a 69 años                3.611 0.000305 ***
GRUPOS_EDAD_QUINQUENIOS16. 70 a 74 años               -1.691 0.090837 .  
GRUPOS_EDAD_QUINQUENIOS17. 75 a 79 años               -1.123 0.261588    
GRUPOS_EDAD_QUINQUENIOS18. 80 a 84 años               -3.210 0.001327 ** 
ESTRATO_SOCIOECONOMICO2                                4.501 6.75e-06 ***
ESTRATO_SOCIOECONOMICO3                                4.082 4.47e-05 ***
ESTRATO_SOCIOECONOMICO4                                6.917 4.60e-12 ***
ESTRATO_SOCIOECONOMICO5                                4.694 2.68e-06 ***
ESTRATO_SOCIOECONOMICO6                               -3.795 0.000147 ***
ESTRATO_SOCIOECONOMICOSD                              -9.186  < 2e-16 ***
ETNIA2. Rom Gitano                                     0.101 0.919426    
ETNIA3. Raizal                                        -1.278 0.201250    
ETNIA5. Negro mulato afro colombiano                   2.913 0.003581 ** 
ETNIA6. Otro                                          -0.591 0.554235    
ETNIASin Dato                                          3.771 0.000163 ***
localidad_residencia_saludata02 - Chapinero            0.404 0.686147    
localidad_residencia_saludata03 - Santa Fe            -7.889 3.06e-15 ***
localidad_residencia_saludata04 - San Cristóbal        2.239 0.025147 *  
localidad_residencia_saludata05 - Usme                -3.559 0.000373 ***
localidad_residencia_saludata06 - Tunjuelito          -2.381 0.017266 *  
localidad_residencia_saludata07 - Bosa                -3.916 9.01e-05 ***
localidad_residencia_saludata08 - Kennedy             -3.636 0.000277 ***
localidad_residencia_saludata09 - Fontibón            -1.681 0.092699 .  
localidad_residencia_saludata10 - Engativá            -7.327 2.36e-13 ***
localidad_residencia_saludata11 - Suba                -3.785 0.000154 ***
localidad_residencia_saludata12 - Barrios Unidos      -4.677 2.91e-06 ***
localidad_residencia_saludata13 - Teusaquillo          0.595 0.551730    
localidad_residencia_saludata14 - Los Mártires         0.924 0.355579    
localidad_residencia_saludata15 - Antonio Nariño      -0.275 0.783084    
localidad_residencia_saludata16 - Puente Aranda       -7.108 1.18e-12 ***
localidad_residencia_saludata17 - La Candelaria       -4.182 2.90e-05 ***
localidad_residencia_saludata18 - Rafael Uribe Uribe   0.485 0.627784    
localidad_residencia_saludata19 - Ciudad Bolívar      -2.359 0.018344 *  
localidad_residencia_saludataFuera de Bogotá         -10.103  < 2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 46354  on 33441  degrees of freedom
Residual deviance: 40945  on 33397  degrees of freedom
AIC: 41035

Number of Fisher Scoring iterations: 5

Confusion Matrix and Statistics

          Reference
Prediction    No    Si
        No 10384  4919
        Si  6575 11564
                                          
               Accuracy : 0.6563          
                 95% CI : (0.6512, 0.6614)
    No Information Rate : 0.5071          
    P-Value [Acc > NIR] : < 2.2e-16       
                                          
                  Kappa : 0.3134          
                                          
 Mcnemar's Test P-Value : < 2.2e-16       
                                          
            Sensitivity : 0.6123          
            Specificity : 0.7016          
         Pos Pred Value : 0.6786          
         Neg Pred Value : 0.6375          
             Prevalence : 0.5071          
         Detection Rate : 0.3105          
   Detection Prevalence : 0.4576          
      Balanced Accuracy : 0.6569          
                                          
       'Positive' Class : No


    Hosmer and Lemeshow goodness of fit (GOF) test

data:  modelo_bal_over$y, fitted(modelo_bal_over)
X-squared = 97.8, df = 8, p-value < 2.2e-16

--- title: "Reporte Covid 19" format: html: self-contained: true code-tools: true --- ```{r setup, message=FALSE, include=FALSE,warning=FALSE} # Cargar las librerías necesarias #library('brglm2') library(detectseparation) library(readxl) library(lubridate) # Para trabajar con fechas library(dplyr) library(zoo) library(gridExtra) library(ggplot2) # Cargar librerías necesarias (si no están instaladas, se instalan automáticamente) if (!require("dplyr")) install.packages("dplyr") if (!require("stringr")) install.packages("stringr") if (!require("stringi")) install.packages("stringi") library(dplyr) library(stringr) library(stringi) # =============================== # CONFIGURACIÓN INICIAL Y CARGA DE PAQUETES # =============================== # Configurar entorno virtual de Python para reticulate Sys.setenv(RETICULATE_PYTHON = "C:/Users/Windows 11/Documents/.virtualenvs/env_covid/Scripts/python.exe") library(reticulate) use_virtualenv("env_covid", required = TRUE) # Gestor de paquetes if (!require("pacman")) install.packages("pacman") # Lista completa de paquetes necesarios (sin duplicados) paquetes <- c( # Análisis y manipulación de datos "reticulate","tidyverse", "dplyr", "tidyr", "stringr", "lubridate", "forcats", "haven", "readr", "readxl", "writexl", "rio", "janitor", "cleaner", "naniar", "skimr", "bench", # Visualización "ggplot2", "ggthemes", "ggridges", "ggforce", "GGally", "gridExtra", "gplots", "corrplot", "RColorBrewer", "pheatmap", "plotly", "leaflet", "leaflet.extras", "esquisse", "DT", "kableExtra", "flextable", "scales", # Estadística y modelado "caret", "pROC", "ROSE", "rcompanion", "psych", "PerformanceAnalytics", "effsize", "effectsize", "car", "DescTools", "binom", "qgraph", "FactoMineR", "factoextra", "FactoClass", "Rcpp", # Series temporales y epidemiología "tseries", "forecast", "tsibble", "incidence", "epicontacts", "distcrete", "epitrix", "EpiEstim", "projections", "outbreaker2", # Otros "shiny", "pander", "broom", "knitr", "magrittr", "ape", "detectseparation", "easypackages" # aunque easypackages no es necesario si ya usas pacman, lo dejo por si acaso ) # Instalar y cargar todos los paquetes pacman::p_load(char = paquetes) # =============================== # FUNCIONES PERSONALIZADAS # =============================== # Función para calcular intervalos de confianza para proporciones calc_ci <- function(count, total, conf.level = 0.95) { prop <- count / total z <- qnorm(1 - (1 - conf.level) / 2) se <- sqrt(prop * (1 - prop) / total) lower <- max(0, prop - z * se) # Asegura que no haya valores negativos upper <- min(1, prop + z * se) # Opcional: garantiza que no supere 100% return(sprintf("%.1f-%.1f", lower * 100, upper * 100)) # Devuelve porcentaje } calcular_ic <- function(x) { n <- sum(!is.na(x)) error_est <- sd(x, na.rm = TRUE) / sqrt(n) media <- mean(x, na.rm = TRUE) margen_error <- qnorm(0.975) * error_est media <- round(media, 2) margen_error <- round(margen_error, 2) return(paste(media, "±", margen_error)) } ``` ## Leemos la data ```{python echo=FALSE, message=FALSE, warning=FALSE} # Importamos pandas #import pandas as pd #import warnings #warnings.filterwarnings('ignore') # Leemos el archivo CSV (ajusta el nombre si es diferente) #Pacientes_covid_p = pd.read_csv("D:/nocturno/temporales/elena amatista/2026/02-febrero/OSB_EnfTransm_COVID_code.csv" ,sep=';') # Función para unificar las categorías #def unificar_profesional(valor): # if pd.isna(valor): # return "Sin Ocupacion en Sivigila" # v = str(valor).strip() # if v.upper() in ["NO", "NO "] or v == "No": # return "No" #elif v.upper() in ["SI", "SI "] or v == "Si": # return "Si" #else: # return "Sin Ocupacion en Sivigila" # Aplicar la transformación #Pacientes_covid_p["PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD"] = Pacientes_covid_p["PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD"].apply(unificar_profesional) # Mostramos información básica #print("Dimensiones:", Pacientes_covid_p.shape) #print("\nPrimeras 5 filas:") #print(Pacientes_covid_p.head()) # Si quieres ver los nombres de las columnas #print("\nColumnas:", Pacientes_covid_p.columns.tolist()) ``` ```{r, echo=FALSE, message=FALSE, warning=FALSE} Pacientes_covid_r <- read_csv("D:/nocturno/temporales/elena amatista/2026/02-febrero/muestra_mas.csv") Pacientes_covid_r<-Pacientes_covid_r%>%filter(DEPARTAMENTO_NOTIFICACION=="BOGOTA") Pacientes_covid_r <- Pacientes_covid_r %>% mutate(EDAD_SIMPLE_CALCULADORA = case_when( UNI_MED == 1 ~ EDAD, # años UNI_MED == 2 ~ round(EDAD / 12,3), # meses a años UNI_MED == 3 ~ round(EDAD / 365.25,3), # días a años (con bisiestos) TRUE ~ NA_real_ # cualquier otro valor )) colnames(Pacientes_covid_r)[25:42] Pacientes_covid_r <- Pacientes_covid_r %>% mutate( # Conversión de tipos de datos FECHA_NOTIFICACION = as.Date(FECHA_NOTIFICACION, format = "%d/%m/%Y"), across(2:4, as.factor),across(5, as.numeric),across(6, as.factor),across(7, as.numeric),across(8:16, as.factor), FECHA_INICIO_SINTOMAS = as.Date(FECHA_INICIO_SINTOMAS, format = "%d/%m/%Y"),FECHA_NOTIFICACION = as.Date(FECHA_NOTIFICACION, format = "%d/%m/%Y"),FECHA_INICIO_SINTOMAS_O_CONSULTA_SALUDATA = as.Date(FECHA_INICIO_SINTOMAS_O_CONSULTA_SALUDATA, format = "%d/%m/%Y"),FECHA_DE_HOSPITALIZACION = as.Date(FECHA_DE_HOSPITALIZACION, format = "%d/%m/%Y"), across(21:23, as.factor),FECHA_DE_MUERTE = as.Date(FECHA_DE_MUERTE, format = "%d/%m/%Y"), across(25:42, as.factor)) #ordenamos de mas antiguo a mas reciente Pacientes_covid_r <- Pacientes_covid_r %>% arrange(across(2)) colnames(Pacientes_covid_r)[5]<-c("EDAD_SIMPLE") colnames(Pacientes_covid_r)[7]<-c("EDAD") Pacientes_covid_r <- Pacientes_covid_r %>% mutate(across(where(is.factor), ~ fct_explicit_na(.x, na_level = "Sin Dato"))) Pacientes_covid_r$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD<-factor(Pacientes_covid_r$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD, levels=levels(Pacientes_covid_r$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD), labels=c("No","No","Si","Si","Sin Ocupacion en Sivigila")) # 1. Asegurarnos de que la columna existe y es factor if (!"NOMBRE_NACIONALIDAD" %in% names(Pacientes_covid_r)) { stop("La variable 'NOMBRE_NACIONALIDAD' no se encuentra en el data frame.") } # 2. Crear un dataframe de trabajo con la columna original y una versión estandarizada df_work <- Pacientes_covid_r %>% mutate( original = as.character(NOMBRE_NACIONALIDAD), # Estandarización: mayúsculas, sin acentos, sin espacios dobles, sin puntuación estandar = original %>% toupper() %>% stri_trans_general("Latin-ASCII") %>% str_replace_all("[[:punct:]]", "") %>% # elimina signos de puntuación str_squish() # recorta espacios múltiples ) # 3. Identificar todos los valores estandarizados únicos y sus originales correspondientes grupos <- df_work %>% group_by(estandar) %>% summarise( originales = list(unique(original)), n = n(), .groups = "drop" ) %>% arrange(estandar) # 4. Seleccionar el nombre canónico para cada grupo estandarizado. # Para elegir un representante legible, usamos el valor original más frecuente. # En caso de empate, se toma el primero alfabéticamente. representante <- df_work %>% count(estandar, original) %>% group_by(estandar) %>% slice_max(order_by = n, n = 1, with_ties = FALSE) %>% ungroup() %>% select(estandar, canonico = original) # 5. Unir la tabla de representantes y asignar el nombre canónico a cada fila df_work <- df_work %>% left_join(representante, by = "estandar") %>% mutate(canonico = ifelse(is.na(canonico), original, canonico)) # 6. Verificar que no hay valores perdidos en canonico (no debería haber) if (any(is.na(df_work$canonico))) { warning("Algunos valores no tienen un canónico asignado. Revisa los datos.") } Pacientes_covid_r[9]<-df_work[44] # ==================== 1. DEFINIR LOCALIDADES OFICIALES DE BOGOTÁ ==================== # Lista completa (número y nombre con tilde correcta) localidades_oficiales <- data.frame( numero = 1:20, nombre_oficial = c("Usaquén", "Chapinero", "Santa Fe", "San Cristóbal", "Usme", "Tunjuelito", "Bosa", "Kennedy", "Fontibón", "Engativá", "Suba", "Barrios Unidos", "Teusaquillo", "Los Mártires", "Antonio Nariño", "Puente Aranda", "La Candelaria", "Rafael Uribe Uribe", "Ciudad Bolívar", "Sumapaz"), stringsAsFactors = FALSE ) # Crear el formato estándar "Número - Nombre" localidades_oficiales$formato_estandar <- sprintf("%02d - %s", localidades_oficiales$numero, localidades_oficiales$nombre_oficial) # Versión normalizada (sin acentos, mayúsculas, sin números, sin espacios, sin guiones) # para comparar sin importar el formato original localidades_oficiales$normalizado <- localidades_oficiales$nombre_oficial %>% toupper() %>% stri_trans_general("Latin-ASCII") %>% str_replace_all("[^A-Z0-9]", "") # elimina todo excepto letras y números # ==================== 2. FUNCIÓN PARA NORMALIZAR CUALQUIER TEXTO ==================== normalizar <- function(texto) { texto %>% toupper() %>% stri_trans_general("Latin-ASCII") %>% str_replace_all("^[0-9]+\\s*-\\s*", "") %>% # quita número inicial "01 - " str_replace_all("[^A-Z0-9]", "") %>% # elimina todo excepto letras/números str_squish() } # ==================== 3. PROCESAR LA COLUMNA DE LOCALIDAD ==================== # Identificar la columna (asumo columna 10; cámbiala si es otra) col_localidad <- Pacientes_covid_r[[39]] unique(col_localidad) if (!is.factor(col_localidad)) { col_localidad <- as.factor(col_localidad) } # Crear dataframe con valores originales df_loc <- data.frame( original = as.character(col_localidad), stringsAsFactors = FALSE ) # Normalizar cada valor original df_loc$norm <- normalizar(df_loc$original) # ==================== 4. ASIGNAR CATEGORÍA FINAL ==================== # Inicialmente todo será "Fuera de Bogotá" df_loc$final <- "Fuera de Bogotá" # Recorrer cada localidad oficial y asignar el formato estándar cuando corresponda for (i in 1:nrow(localidades_oficiales)) { # Coincidencia exacta entre el normalizado del original y el normalizado oficial coinciden <- which(df_loc$norm == localidades_oficiales$normalizado[i]) if (length(coinciden) > 0) { df_loc$final[coinciden] <- localidades_oficiales$formato_estandar[i] } } # Caso especial: "Sumapaz" no tiene número? Sí, 20. Todo correcto. # ==================== 5. REEMPLAZAR LA COLUMNA ORIGINAL ==================== Pacientes_covid_r[[39]] <- factor(df_loc$final) Pacientes_covid_r[[31]] <- factor(df_loc$final) # ============================================================================= # Generar top 10 frecuencias de NOMBRE_NACIONALIDAD y agrupar el resto # ============================================================================= # Asegurar que la variable NOMBRE_NACIONALIDAD ya está unificada (paso previo) # Si no está unificada, aplica primero el script de normalización de nacionalidades. # 1. Calcular frecuencias y obtener las 10 nacionalidades más comunes frecuencias <- sort(table(Pacientes_covid_r$NOMBRE_NACIONALIDAD), decreasing = TRUE) top10_nombres <- names(frecuencias)[1:10] # 2. Crear el data frame ORDEN con las frecuencias de esas 10 ORDEN <- data.frame( Nacionalidad = top10_nombres, Frecuencia = as.integer(frecuencias[1:10]), stringsAsFactors = FALSE ) # Mostrar ORDEN print(ORDEN) # 3. Crear nueva variable en Pacientes_covid_r que agrupe "Otras nacionalidades" Pacientes_covid_r$NACIONALIDAD_AGRUPADA <- ifelse( Pacientes_covid_r$NOMBRE_NACIONALIDAD %in% top10_nombres, as.character(Pacientes_covid_r$NOMBRE_NACIONALIDAD), "Otras nacionalidades" ) # Convertir a factor (opcional, pero recomendable) Pacientes_covid_r$NACIONALIDAD_AGRUPADA <- factor(Pacientes_covid_r$NACIONALIDAD_AGRUPADA) ``` ```{r,echo=FALSE} datatable( Pacientes_covid_r, rownames = FALSE, extensions = c("Buttons", "Scroller"), options = list( scrollX = TRUE, scrollY = "500px", scroller = TRUE, dom = "Bfrtip", buttons = c("copy", "csv", "excel") ) ) ``` ## Descriptivos Basicos ```{r, echo=FALSE, warning=FALSE, message=FALSE} edades_caja<-ggplot(data = Pacientes_covid_r, aes(x= EDAD,y =SEXO)) + geom_boxplot(fill = "#69b3a2", color = "#2d5c5a", width = 0.6) + labs(title = "Distribución de Edades", y = "Sexo", x = "Edad") + theme_minimal() + theme(plot.title = element_text(hjust = 0.5, face = "bold"), panel.grid.major.x = element_blank(), panel.grid.minor = element_blank(), axis.text = element_text(size = 10), axis.title = element_text(size = 12)) + coord_flip() # Opcional para orientación horizontal #colnames(MME_2024_desc) edades_caja # Calcular estadísticas y datos faltantes sin_dato <- sum(is.na(Pacientes_covid_r$EDAD)) datos_limpios <- Pacientes_covid_r %>% filter(!is.na(EDAD)) cuartiles <- quantile(datos_limpios$EDAD, probs = c(0.25, 0.5, 0.75)) N <- nrow(datos_limpios) # Total de observaciones válidas # Gráfico con eje Y en números absolutos grafico1 <- ggplot(datos_limpios, aes(x = EDAD )) + geom_density( aes(y = after_stat(density * N)), # Escalar densidad a conteos fill = "steelblue", alpha = 0.3, color = NA ) + geom_line( aes(y = after_stat(density * N)), # Línea escalada stat = "density", color = "steelblue", linewidth = 0.8 ) + geom_vline( xintercept = cuartiles, color = "red", linetype = "dashed" ) + annotate( "text", x = cuartiles, y = 0, label = c("", "Med", ""), vjust = 1.5, color = "red" ) + labs( title = "Distribución de edades", x = "Edad", y = "N" ) + scale_x_continuous(breaks = seq(0, 60, 10)) + scale_y_continuous(labels = comma) + # Formato con comas theme_minimal() grafico1 ##inicio tablas descriptivas #colnames(Pacientes_covid_r[8:10]) Pacientes_covid_r_desc<-cbind.data.frame(Pacientes_covid_r[8],Pacientes_covid_r[43],Pacientes_covid_r[3:4],Pacientes_covid_r[21:23],Pacientes_covid_r[26],Pacientes_covid_r[28],Pacientes_covid_r[31:42]) ##inicio tablas descriptivas #colnames(Pacientes_covid_r[8:10]) #Pacientes_covid_r_desc<-cbind.data.frame(Pacientes_covid_r[8:9],Pacientes_covid_r[3:4],Pacientes_covid_r[21:23],Pacientes_covid_r[26],Pacientes_covid_r[28],Pacientes_covid_r[31:39],Pacientes_covid_r[41:42]) unique(Pacientes_covid_r_desc[2]) # Crear una lista para almacenar las tablas de resultados results_list <- list() #colnames(Pacientes_covid_r_desc)<-c("sexo","Año","Localidad","Edad por quinquenios","Migrante","Personal de salud") col_name_temp <- colnames(Pacientes_covid_r_desc) # Renombrar columnas #colnames(resultados_finales)[3:(ncol(resultados_finales)-4)] <- colnames(tabla) #k <- 4 filtrada <- Pacientes_covid_r_desc #i<-1 # Inicio del ciclo for for (i in 2:length(colnames(filtrada))) { # Obtener el nombre de la columna basada en el índice col_name <- col_name_temp[i] col_name tabla <- table(filtrada[[i]], filtrada[[1]]) tabla # 2. Calcular porcentajes porcentajes <- prop.table(tabla, margin = 1) * 100 # 3. Formatear tabla combinando counts y porcentajes tabla_con_porcentajes <- matrix( paste0(tabla, " (", round(porcentajes, 2), "%)"), nrow = nrow(tabla), dimnames = dimnames(tabla) ) ###################################### # Suponiendo que 'tabla' es la matriz de frecuencias absolutas con años en filas y géneros en columnas # Ejemplo: tabla <- table(filtrada[[i]], filtrada[[1]]) donde i es la columna de género (F/M) # Convertir a data frame para trabajar tabla_df <- as.data.frame.matrix(tabla) tabla_df$Categorias <- rownames(tabla_df) tabla_df$variable <- rep(col_name_temp[i],length(rownames(tabla_df))) rownames(tabla_df) <- NULL # Verificar que los nombres de columna sean "F" y "M" (ajustar si es necesario) if (!all(c("F", "M") %in% colnames(tabla_df))) { stop("Las columnas de género deben llamarse 'F' y 'M'") } # Función para calcular IC de proporción (usando la función calc_ci del usuario) calc_ci <- function(count, total, conf.level = 0.95) { prop <- count / total z <- qnorm(1 - (1 - conf.level) / 2) se <- sqrt(prop * (1 - prop) / total) lower <- max(0, prop - z * se) upper <- min(1, prop + z * se) return(sprintf("%.1f-%.1f", lower * 100, upper * 100)) } # Función para prueba de dos proporciones (F vs M) prueba_proporciones <- function(f_F, f_M) { total <- f_F + f_M # Prueba de proporciones: prop.test con dos muestras test <- prop.test(x = c(f_F, f_M), n = c(total, total), correct = FALSE) p_valor <- test$p.value # Formatear p-valor (redondear a 4 decimales o usar notación científica si es muy pequeño) if (p_valor < 0.0001) { return("<0.0001") } else { return(sprintf("%.4f", p_valor)) } } # Calcular para cada año resultados <- tabla_df %>% mutate( Total = F + M, # Para F Frec_F = F, Porc_F = sprintf("%.2f%%", 100 * F / Total), IC_F = calc_ci(F, Total), # Para M Frec_M = M, Porc_M = sprintf("%.2f%%", 100 * M / Total), IC_M = calc_ci(M, Total), # Prueba de hipótesis p_valor = mapply(prueba_proporciones, F, M) ) %>% select(variable,Categorias, Frec_F, Porc_F, IC_F, Frec_M, Porc_M, IC_M, p_valor) # Mostrar la tabla con kableExtra (opcional) results_list[[col_name]] <- resultados } # Unir todas las tablas en una sola combined_table <- do.call(rbind, results_list) # Procesar la tabla combinada para eliminar duplicados en las columnas de interpretación y p combined_table_processed <- combined_table # Ajustar nombres de columnas colnames(combined_table_processed) <- c("Variable","Categoria", "Frecuencia fem", "Porcentaje fem","IC_ fem", "Frecuencia masc", "Porcentaje masc","IC_ masc", "p") datatable( combined_table_processed, rownames = FALSE, extensions = c("Buttons", "Scroller"), options = list( scrollX = TRUE, scrollY = "500px", scroller = TRUE, dom = "Bfrtip", buttons = c("copy", "csv", "excel") ) ) ``` ## Curvas epidemicas ```{r, echo=FALSE, message=FALSE, message=FALSE} calcular_periodo_epi <- function(fecha) { # Obtener el número de la semana del año semana <- as.numeric(format(fecha, "%U")) + 1 # Calcular el periodo epidemiológico (7 periodos por año) periodo <- ceiling(semana / (52/7)) # Convertir a números romanos periodo_romano <- as.character(as.roman(periodo)) return(periodo_romano) } # Agregar la columna del periodo epidemiológico Pacientes_covid_r$Periodo_Epidemiologico <- sapply(Pacientes_covid_r$FECHA_NOTIFICACION, calcular_periodo_epi) # Definir las fechas de inicio de la semana 1 para cada año (modifica según sea necesario) fechas_inicio_epi <- data.frame( ano = 2020:2026, inicio_semana_1 = as.Date(c( "2019-12-29", "2021-01-03", "2022-01-02", "2023-01-01", "2023-12-31", "2024-12-29", "2026-01-04")) # Fechas personalizadas ) # Función para calcular la semana epidemiológica calcular_semana_epi <- function(fecha, fechas_inicio_epi) { # Extraer el año de la fecha ano <- year(fecha) # Obtener la fecha de inicio de la semana 1 para ese año inicio_semana_1 <- fechas_inicio_epi$inicio_semana_1[fechas_inicio_epi$ano == ano] # Calcular la diferencia en días entre la fecha y el inicio de la semana 1 dias_diferencia <- as.numeric(difftime(fecha, inicio_semana_1, units = "days")) # Calcular la semana epidemiológica (cada semana tiene 7 días) semana_epi <- floor(dias_diferencia / 7) + 1 return(semana_epi) } Pacientes_covid_r_f<-Pacientes_covid_r #%>%filter(AÑO==2020|AÑO==2021|AÑO==2022) inc.week.gender <- incidence(Pacientes_covid_r_f$FECHA_NOTIFICACION, interval = "1 epiweeks: sunday", groups = Pacientes_covid_r_f$AÑO)#FIS ES LA VARIABLE A ESTUDIAR # --- 1. Extraer fechas y datos del objeto incidence --- fechas <- inc.week.gender$dates n <- length(fechas) # Crear data frame auxiliar con fecha, año y semana epidemiológica (ISO) df_fechas <- data.frame( fecha = fechas, año = format(fechas, "%Y"), semana = lubridate::epiweek(fechas) # semana epidemiológica (domingo a sábado) ) # --- 2. Definir periodo epidemiológico (ejemplo: cada 4 semanas) --- # Ajusta según la definición de tu país (Colombia: 13 periodos de 4 semanas) df_fechas <- df_fechas %>% mutate( periodo = ceiling(semana / 4), # periodo 1 a 13 periodo_romano = as.character(as.roman(periodo)) ) # --- 3. Crear etiquetas para los periodos (solo en la primera semana de cada periodo) --- df_fechas <- df_fechas %>% group_by(año, periodo) %>% mutate(etiqueta_periodo = if_else(row_number() == 1, periodo_romano, "")) %>% ungroup() # --- 4. Crear etiquetas para los años (solo en la primera semana de cada año) --- df_fechas <- df_fechas %>% group_by(año) %>% mutate(etiqueta_año = if_else(row_number() == 1, año, "")) %>% ungroup() # 2. Crear columna de trimestre y año df_casos <- Pacientes_covid_r %>% mutate( año = year(FECHA_NOTIFICACION), trimestre = quarter(FECHA_NOTIFICACION, with_year = FALSE), # 1,2,3,4 trimestre_label = paste0(año, "-Q", trimestre) # Ej: "2020-Q1" ) # 3. Contar casos por trimestre casos_trimestre <- df_casos %>% group_by(año, trimestre, trimestre_label) %>% summarise(casos = n(), .groups = "drop") %>% arrange(año, trimestre) # 4. Opcional: completar trimestres sin datos (para que el gráfico muestre huecos) # Generar todos los trimestres desde el mínimo hasta el máximo min_fecha <- min(Pacientes_covid_r$FECHA_NOTIFICACION) max_fecha <- max(Pacientes_covid_r$FECHA_NOTIFICACION) trimestres_completos <- tibble( fecha_inicio = seq(floor_date(min_fecha, "quarter"), floor_date(max_fecha, "quarter"), by = "quarter") ) %>% mutate( año = year(fecha_inicio), trimestre = quarter(fecha_inicio), trimestre_label = paste0(año, "-Q", trimestre) ) # Unir con los datos reales, reemplazando NA con 0 casos_trimestre_completo <- trimestres_completos %>% left_join(casos_trimestre, by = c("año", "trimestre", "trimestre_label")) %>% mutate(casos = ifelse(is.na(casos), 0, casos)) %>% arrange(fecha_inicio) # --- 5. Vectores finales para usar en scale_x_continuous --- vector_final <- df_fechas$etiqueta_periodo year_labels <- df_fechas$etiqueta_año # --- 6. Gráfico de la curva epidémica (barras + media móvil) --- colores <- c("2020" = "#96bef0","2021" = "#96bef0","2022" = "#96bef0","2023" = "#96bef0","2024" = "#96bef0","2025" = "#96bef0","2026" = "#96bef0") vector_final<-rep("",length(df_fechas$etiqueta_periodo)) FISCURVEEPI0 <- plot(inc.week.gender) + theme(axis.title = element_text(size = 10), axis.text = element_text(size = 4), axis.ticks.x = element_blank(), axis.ticks.length = unit(0, "cm"), legend.title = element_text(size = 10), legend.position = "none",panel.background = element_rect(fill = "white")) + scale_x_continuous( breaks = as.numeric(fechas), labels = vector_final, expand = c(0, 0) ) + ylab("Casos") + labs(title = "Curva Epidemiológica COVID19 General") + scale_fill_manual(values = colores)+ geom_vline(xintercept = as.numeric(as.Date(paste0(2020:2026, "-01-01"))), linetype = "dashed", color = "gray") #FISCURVEEPI0 # Media móvil (ventana de 3 semanas) inc_week_df <- data.frame( dates = fechas, counts = rowSums(inc.week.gender$counts) ) inc_week_df$moving_avg <- rollmean(inc_week_df$counts, k = 3, fill = NA, align = "right") FISCURVEEPI1 <- FISCURVEEPI0 + geom_line(data = inc_week_df, aes(x = dates, y = moving_avg), inherit.aes = FALSE, color = "#068FAB", size = 0.5) #FISCURVEEPI1 # --- 7. Gráfico inferior con los años --- plot_years <- ggplot(df_fechas, aes(x = as.numeric(fecha), y = 0,size = 2.5)) + geom_blank() + theme_classic() + scale_x_continuous( breaks = as.numeric(fechas), labels = year_labels, expand = expansion(mult = c(0.05, 0.01)) ) + theme( axis.title.x = element_blank(), axis.text.x = element_text(size = 4, vjust = 56), axis.line.y = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank(), axis.line.x = element_blank(), axis.ticks.x = element_blank() ) + xlab("Periodo Epidemiológico") + theme(panel.background = element_rect(fill = "white")) #plot_years # --- 8. Combinar ambos gráficos --- grafica_final <- grid.arrange(FISCURVEEPI0, plot_years, ncol = 1, heights = c(0.9, 0.1)) grafica_final # me genera la grafica que le estoy anexando, pero lo que deseo es que los años esten mas apegados al eje x, obviamente, correspondiendo a donde pertenece su temporalidad ############################################ #########################################genero # ---------------------------------------------------------------------- # Curva epidémica por género (automática, con periodos y años) # ---------------------------------------------------------------------- library(incidence) library(dplyr) library(zoo) library(ggplot2) library(gridExtra) # Crear objeto incidence agrupado por género (ajusta el nombre de la columna) inc.week.gender <- incidence(Pacientes_covid_r_f$FECHA_NOTIFICACION, interval = "1 epiweeks: sunday", groups = Pacientes_covid_r_f$SEXO) # <--- cambiar según tu variable # Extraer fechas fechas <- inc.week.gender$dates n <- length(fechas) # Data frame auxiliar con fecha, año y semana epidemiológica df_fechas <- data.frame( fecha = fechas, año = format(fechas, "%Y"), semana = lubridate::epiweek(fechas) ) # Periodo epidemiológico (cada 4 semanas) df_fechas <- df_fechas %>% mutate( periodo = ceiling(semana / 4), periodo_romano = as.character(as.roman(periodo)) ) # Etiquetas de periodo (solo primera semana de cada periodo) df_fechas <- df_fechas %>% group_by(año, periodo) %>% mutate(etiqueta_periodo = if_else(row_number() == 1, periodo_romano, "")) %>% ungroup() # Etiquetas de año (solo primera semana de cada año) df_fechas <- df_fechas %>% group_by(año) %>% mutate(etiqueta_año = if_else(row_number() == 1, año, "")) %>% ungroup() vector_final <- df_fechas$etiqueta_periodo year_labels <- df_fechas$etiqueta_año # Colores para los géneros (automático según niveles) generos <- levels(inc.week.gender$groups) colores_genero <- setNames(c("#F2AEB4", "#1E90FF"), generos) # rosa y azul vector_final<-rep("",length(df_fechas$etiqueta_periodo)) # Gráfico de barras apiladas por género FISCURVEEPI01 <- plot(inc.week.gender) + theme(axis.title = element_text(size = 10), axis.text = element_text(size = 4), axis.ticks.x = element_blank(), axis.ticks.length = unit(0, "cm"), legend.title = element_text(size = 10), legend.position = "right",panel.background = element_rect(fill = "white"))+ # muestra la leyenda para identificar géneros scale_x_continuous( breaks = as.numeric(fechas), labels = vector_final, expand = c(0, 0) ) + ylab("Casos") + labs(title = "Curva Epidemiológica por Género") + scale_fill_manual(values = colores_genero, name = "Género")+ geom_vline(xintercept = as.numeric(as.Date(paste0(2020:2026, "-01-01"))), linetype = "dashed", color = "gray") # Media móvil total (ventana de 3 semanas) inc_week_df <- data.frame( dates = fechas, counts_total = rowSums(inc.week.gender$counts) ) inc_week_df$moving_avg <- zoo::rollmean(inc_week_df$counts_total, k = 3, fill = NA, align = "right") FISCURVEEPI11 <- FISCURVEEPI01 + geom_line(data = inc_week_df, aes(x = dates, y = moving_avg), inherit.aes = FALSE, color = "#068FAB", size = 0.5) # Gráfico inferior con los años plot_years1 <- ggplot(df_fechas, aes(x = as.numeric(fecha), y = 0)) + geom_blank() + theme_classic() + scale_x_continuous( breaks = as.numeric(fechas), labels = year_labels, expand = expansion(mult = c(0.05, 0.14))) + theme( axis.title.x = element_blank(), axis.text.x = element_text(size = 4, vjust = 56), axis.line.y = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank(), axis.line.x = element_blank(), axis.ticks.x = element_blank() ) + xlab("Periodo Epidemiológico") + theme(panel.background = element_rect(fill = "white")) # Combinar ambos gráficos grafica_final1 <- grid.arrange(FISCURVEEPI01, plot_years1, ncol = 1, heights = c(0.9, 0.1)) grafica_final1 ###################################################### Pacientes_covid_r_f<-Pacientes_covid_r%>%filter(AÑO==2023|AÑO==2024|AÑO==2025|AÑO==2026) inc.week.gender <- incidence(Pacientes_covid_r_f$FECHA_NOTIFICACION, interval = "1 epiweeks: sunday", groups = Pacientes_covid_r_f$AÑO)#FIS ES LA VARIABLE A ESTUDIAR # --- 1. Extraer fechas y datos del objeto incidence --- fechas <- inc.week.gender$dates n <- length(fechas) # Crear data frame auxiliar con fecha, año y semana epidemiológica (ISO) df_fechas <- data.frame( fecha = fechas, año = format(fechas, "%Y"), semana = lubridate::epiweek(fechas) # semana epidemiológica (domingo a sábado) ) # --- 2. Definir periodo epidemiológico (ejemplo: cada 4 semanas) --- # Ajusta según la definición de tu país (Colombia: 13 periodos de 4 semanas) df_fechas <- df_fechas %>% mutate( periodo = ceiling(semana / 4), # periodo 1 a 13 periodo_romano = as.character(as.roman(periodo)) ) # --- 3. Crear etiquetas para los periodos (solo en la primera semana de cada periodo) --- df_fechas <- df_fechas %>% group_by(año, periodo) %>% mutate(etiqueta_periodo = if_else(row_number() == 1, periodo_romano, "")) %>% ungroup() # --- 4. Crear etiquetas para los años (solo en la primera semana de cada año) --- df_fechas <- df_fechas %>% group_by(año) %>% mutate(etiqueta_año = if_else(row_number() == 1, año, "")) %>% ungroup() # --- 5. Vectores finales para usar en scale_x_continuous --- vector_final <- df_fechas$etiqueta_periodo year_labels <- df_fechas$etiqueta_año # --- 6. Gráfico de la curva epidémica (barras + media móvil) --- FISCURVEEPI01 <- plot(inc.week.gender) + theme(axis.title = element_text(size = 10), axis.text = element_text(size = 4), axis.ticks.x = element_blank(), axis.ticks.length = unit(0, "cm"), legend.title = element_text(size = 10), legend.position = "none") + scale_x_continuous( breaks = as.numeric(fechas), labels = vector_final, expand = c(0, 0) ) + ylab("Casos") + labs(title = "Curva Epidemiológica COVID19 General 23-26") + scale_fill_manual(values = colores) #FISCURVEEPI0 # Media móvil (ventana de 3 semanas) inc_week_df <- data.frame( dates = fechas, counts = rowSums(inc.week.gender$counts) ) inc_week_df$moving_avg <- rollmean(inc_week_df$counts, k = 3, fill = NA, align = "right") FISCURVEEPI1 <- FISCURVEEPI0 + geom_line(data = inc_week_df, aes(x = dates, y = moving_avg), inherit.aes = FALSE, color = "#068FAB", size = 0.5) # --- 7. Gráfico inferior con los años --- plot_years1 <- ggplot(df_fechas, aes(x = as.numeric(fecha), y = 0)) + geom_blank() + theme_classic() + scale_x_continuous( breaks = as.numeric(fechas), labels = year_labels, expand = expansion(mult = c(0.05, 0.01)) ) + theme( axis.title.x = element_blank(), axis.text.x = element_text(size = 4, vjust = 56), axis.line.y = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank(), axis.line.x = element_blank(), axis.ticks.x = element_blank() ) + xlab("Periodo Epidemiológico") + theme(panel.background = element_rect(fill = "white")) # --- 8. Combinar ambos gráficos --- grafica_final1 <- grid.arrange(FISCURVEEPI01, plot_years1, ncol = 1, heights = c(0.9, 0.1)) grafica_final1 ############################################ #########################################genero # ---------------------------------------------------------------------- # Curva epidémica por género (automática, con periodos y años) # ---------------------------------------------------------------------- library(incidence) library(dplyr) library(zoo) library(ggplot2) library(gridExtra) # Crear objeto incidence agrupado por género (ajusta el nombre de la columna) inc.week.gender <- incidence(Pacientes_covid_r_f$FECHA_NOTIFICACION, interval = "1 epiweeks: sunday", groups = Pacientes_covid_r_f$SEXO) # <--- cambiar según tu variable # Extraer fechas fechas <- inc.week.gender$dates n <- length(fechas) # Data frame auxiliar con fecha, año y semana epidemiológica df_fechas <- data.frame( fecha = fechas, año = format(fechas, "%Y"), semana = lubridate::epiweek(fechas) ) # Periodo epidemiológico (cada 4 semanas) df_fechas <- df_fechas %>% mutate( periodo = ceiling(semana / 4), periodo_romano = as.character(as.roman(periodo)) ) # Etiquetas de periodo (solo primera semana de cada periodo) df_fechas <- df_fechas %>% group_by(año, periodo) %>% mutate(etiqueta_periodo = if_else(row_number() == 1, periodo_romano, "")) %>% ungroup() # Etiquetas de año (solo primera semana de cada año) df_fechas <- df_fechas %>% group_by(año) %>% mutate(etiqueta_año = if_else(row_number() == 1, año, "")) %>% ungroup() vector_final <- df_fechas$etiqueta_periodo year_labels <- df_fechas$etiqueta_año # Colores para los géneros (automático según niveles) generos <- levels(inc.week.gender$groups) colores_genero <- setNames(c("#F2AEB4", "#1E90FF"), generos) # rosa y azul # Gráfico de barras apiladas por género FISCURVEEPI02 <- plot(inc.week.gender) + theme(axis.title = element_text(size = 10), axis.text = element_text(size = 4), axis.ticks.x = element_blank(), axis.ticks.length = unit(0, "cm"), legend.title = element_text(size = 10), legend.position = "right") + # muestra la leyenda para identificar géneros scale_x_continuous( breaks = as.numeric(fechas), labels = vector_final, expand = c(0, 0) ) + ylab("Casos") + labs(title = "Curva Epidemiológica por Género 23-26") + scale_fill_manual(values = colores_genero, name = "Género") # Media móvil total (ventana de 3 semanas) inc_week_df <- data.frame( dates = fechas, counts_total = rowSums(inc.week.gender$counts) ) inc_week_df$moving_avg <- zoo::rollmean(inc_week_df$counts_total, k = 3, fill = NA, align = "right") FISCURVEEPI12 <- FISCURVEEPI01 + geom_line(data = inc_week_df, aes(x = dates, y = moving_avg), inherit.aes = FALSE, color = "#068FAB", size = 0.5) # Gráfico inferior con los años plot_years2 <- ggplot(df_fechas, aes(x = as.numeric(fecha), y = 0)) + geom_blank() + theme_classic() + scale_x_continuous( breaks = as.numeric(fechas), labels = year_labels, expand = expansion(mult = c(0.05, 1.3)) ) + theme( axis.title.x = element_blank(), axis.text.x = element_text(size = 4, vjust = 56), axis.line.y = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank(), axis.line.x = element_blank(), axis.ticks.x = element_blank() ) + xlab("Periodo Epidemiológico") + theme(panel.background = element_rect(fill = "white")) # Combinar ambos gráficos grafica_final2 <- grid.arrange(FISCURVEEPI02, plot_years2, ncol = 1, heights = c(0.9, 0.1)) grafica_final2 ``` ## Anaisis en personal de salud ```{r, echo=FALSE, message=FALSE, message=FALSE} calcular_periodo_epi <- function(fecha) { # Obtener el número de la semana del año semana <- as.numeric(format(fecha, "%U")) + 1 # Calcular el periodo epidemiológico (7 periodos por año) periodo <- ceiling(semana / (52/7)) # Convertir a números romanos periodo_romano <- as.character(as.roman(periodo)) return(periodo_romano) } # Agregar la columna del periodo epidemiológico Pacientes_covid_r$Periodo_Epidemiologico <- sapply(Pacientes_covid_r$FECHA_NOTIFICACION, calcular_periodo_epi) # Definir las fechas de inicio de la semana 1 para cada año (modifica según sea necesario) fechas_inicio_epi <- data.frame( ano = 2020:2026, inicio_semana_1 = as.Date(c( "2019-12-29", "2021-01-03", "2022-01-02", "2023-01-01", "2023-12-31", "2024-12-29", "2026-01-04")) # Fechas personalizadas ) # Función para calcular la semana epidemiológica calcular_semana_epi <- function(fecha, fechas_inicio_epi) { # Extraer el año de la fecha ano <- year(fecha) # Obtener la fecha de inicio de la semana 1 para ese año inicio_semana_1 <- fechas_inicio_epi$inicio_semana_1[fechas_inicio_epi$ano == ano] # Calcular la diferencia en días entre la fecha y el inicio de la semana 1 dias_diferencia <- as.numeric(difftime(fecha, inicio_semana_1, units = "days")) # Calcular la semana epidemiológica (cada semana tiene 7 días) semana_epi <- floor(dias_diferencia / 7) + 1 return(semana_epi) } Pacientes_covid_r_f1<-Pacientes_covid_r%>%filter( PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD=="Si") inc.week.gender <- incidence(Pacientes_covid_r_f1$FECHA_NOTIFICACION, interval = "1 epiweeks: sunday", groups = Pacientes_covid_r_f1$AÑO)#FIS ES LA VARIABLE A ESTUDIAR # --- 1. Extraer fechas y datos del objeto incidence --- fechas <- inc.week.gender$dates n <- length(fechas) # Crear data frame auxiliar con fecha, año y semana epidemiológica (ISO) df_fechas <- data.frame( fecha = fechas, año = format(fechas, "%Y"), semana = lubridate::epiweek(fechas) # semana epidemiológica (domingo a sábado) ) # --- 2. Definir periodo epidemiológico (ejemplo: cada 4 semanas) --- # Ajusta según la definición de tu país (Colombia: 13 periodos de 4 semanas) df_fechas <- df_fechas %>% mutate( periodo = ceiling(semana / 4), # periodo 1 a 13 periodo_romano = as.character(as.roman(periodo)) ) # --- 3. Crear etiquetas para los periodos (solo en la primera semana de cada periodo) --- df_fechas <- df_fechas %>% group_by(año, periodo) %>% mutate(etiqueta_periodo = if_else(row_number() == 1, periodo_romano, "")) %>% ungroup() # --- 4. Crear etiquetas para los años (solo en la primera semana de cada año) --- df_fechas <- df_fechas %>% group_by(año) %>% mutate(etiqueta_año = if_else(row_number() == 1, año, "")) %>% ungroup() # --- 5. Vectores finales para usar en scale_x_continuous --- vector_final <- df_fechas$etiqueta_periodo year_labels <- df_fechas$etiqueta_año # --- 6. Gráfico de la curva epidémica (barras + media móvil) --- vector_final<-rep("",length(df_fechas$etiqueta_periodo)) FISCURVEEPI03 <- plot(inc.week.gender) + theme(axis.title = element_text(size = 10), axis.text = element_text(size = 4), axis.ticks.x = element_blank(), axis.ticks.length = unit(0, "cm"), legend.title = element_text(size = 10), legend.position = "none",panel.background = element_rect(fill = "white")) + scale_x_continuous( breaks = as.numeric(fechas), labels = vector_final, expand = c(0, 0) ) + ylab("Casos") + labs(title = "Curva Epidemiológica COVID19 personal salud") + scale_fill_manual(values = colores)+ geom_vline(xintercept = as.numeric(as.Date(paste0(2020:2026, "-01-01"))), linetype = "dashed", color = "gray") #FISCURVEEPI0 # Media móvil (ventana de 3 semanas) inc_week_df <- data.frame( dates = fechas, counts = rowSums(inc.week.gender$counts) ) inc_week_df$moving_avg <- rollmean(inc_week_df$counts, k = 3, fill = NA, align = "right") FISCURVEEPI3 <- FISCURVEEPI0 + geom_line(data = inc_week_df, aes(x = dates, y = moving_avg), inherit.aes = FALSE, color = "#068FAB", size = 0.5) # --- 7. Gráfico inferior con los años --- plot_years3 <- ggplot(df_fechas, aes(x = as.numeric(fecha), y = 0)) + geom_blank() + theme_classic() + scale_x_continuous( breaks = as.numeric(fechas), labels = year_labels, expand = expansion(mult = c(0.05, 0.001)) ) + theme( axis.title.x = element_blank(), axis.text.x = element_text(size = 4, vjust = 56), axis.line.y = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank(), axis.line.x = element_blank(), axis.ticks.x = element_blank() ) + xlab("Periodo Epidemiológico") + theme(panel.background = element_rect(fill = "white")) # --- 8. Combinar ambos gráficos --- grafica_final3 <- grid.arrange(FISCURVEEPI03, plot_years3, ncol = 1, heights = c(0.9, 0.1)) grafica_final3 ############################################ #########################################genero # ---------------------------------------------------------------------- # Curva epidémica por género (automática, con periodos y años) # ---------------------------------------------------------------------- library(incidence) library(dplyr) library(zoo) library(ggplot2) library(gridExtra) # Crear objeto incidence agrupado por género (ajusta el nombre de la columna) inc.week.gender <- incidence(Pacientes_covid_r_f1$FECHA_NOTIFICACION, interval = "1 epiweeks: sunday", groups = Pacientes_covid_r_f1$SEXO) # <--- cambiar según tu variable # Extraer fechas fechas <- inc.week.gender$dates n <- length(fechas) # Data frame auxiliar con fecha, año y semana epidemiológica df_fechas <- data.frame( fecha = fechas, año = format(fechas, "%Y"), semana = lubridate::epiweek(fechas) ) # Periodo epidemiológico (cada 4 semanas) df_fechas <- df_fechas %>% mutate( periodo = ceiling(semana / 4), periodo_romano = as.character(as.roman(periodo)) ) # Etiquetas de periodo (solo primera semana de cada periodo) df_fechas <- df_fechas %>% group_by(año, periodo) %>% mutate(etiqueta_periodo = if_else(row_number() == 1, periodo_romano, "")) %>% ungroup() # Etiquetas de año (solo primera semana de cada año) df_fechas <- df_fechas %>% group_by(año) %>% mutate(etiqueta_año = if_else(row_number() == 1, año, "")) %>% ungroup() vector_final <- df_fechas$etiqueta_periodo year_labels <- df_fechas$etiqueta_año # Colores para los géneros (automático según niveles) generos <- levels(inc.week.gender$groups) colores_genero <- setNames(c("#F2AEB4", "#1E90FF"), generos) # rosa y azul vector_final<-rep("",length(df_fechas$etiqueta_periodo)) # Gráfico de barras apiladas por género FISCURVEEPI04 <- plot(inc.week.gender) + theme(axis.title = element_text(size = 10), axis.text = element_text(size = 4), axis.ticks.x = element_blank(), axis.ticks.length = unit(0, "cm"), legend.title = element_text(size = 10), legend.position = "right", panel.background = element_rect(fill = "white") ) + # muestra la leyenda para identificar géneros scale_x_continuous( breaks = as.numeric(fechas), labels = vector_final, expand = c(0, 0) ) + ylab("Casos") + labs(title = "Curva Epidemiológica por Género") + scale_fill_manual(values = colores_genero, name = "Género")+ geom_vline(xintercept = as.numeric(as.Date(paste0(2020:2026, "-01-01"))), linetype = "dashed", color = "gray") # Media móvil total (ventana de 3 semanas) inc_week_df <- data.frame( dates = fechas, counts_total = rowSums(inc.week.gender$counts) ) inc_week_df$moving_avg <- zoo::rollmean(inc_week_df$counts_total, k = 3, fill = NA, align = "right") FISCURVEEPI14 <- FISCURVEEPI01 + geom_line(data = inc_week_df, aes(x = dates, y = moving_avg), inherit.aes = FALSE, color = "#068FAB", size = 0.5) # Gráfico inferior con los años plot_years4 <- ggplot(df_fechas, aes(x = as.numeric(fecha), y = 0)) + geom_blank() + theme_classic() + scale_x_continuous( breaks = as.numeric(fechas), labels = year_labels, expand = expansion(mult = c(0.05, -1)) ) + theme( axis.title.x = element_blank(), axis.text.x = element_text(size = 4, vjust = 56), axis.line.y = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank(), axis.line.x = element_blank(), axis.ticks.x = element_blank() ) + xlab("Periodo Epidemiológico") + theme(panel.background = element_rect(fill = "white")) # Combinar ambos gráficos grafica_final4 <- grid.arrange(FISCURVEEPI04, plot_years4, ncol = 1, heights = c(0.9, 0.1)) grafica_final4 ###################################################### Pacientes_covid_r_f1<-Pacientes_covid_r%>%filter(PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD=="Si") inc.week.gender <- incidence(Pacientes_covid_r_f1$FECHA_NOTIFICACION, interval = "1 epiweeks: sunday", groups = Pacientes_covid_r_f1$AÑO)#FIS ES LA VARIABLE A ESTUDIAR # --- 1. Extraer fechas y datos del objeto incidence --- fechas <- inc.week.gender$dates n <- length(fechas) # Crear data frame auxiliar con fecha, año y semana epidemiológica (ISO) df_fechas <- data.frame( fecha = fechas, año = format(fechas, "%Y"), semana = lubridate::epiweek(fechas) # semana epidemiológica (domingo a sábado) ) # --- 2. Definir periodo epidemiológico (ejemplo: cada 4 semanas) --- # Ajusta según la definición de tu país (Colombia: 13 periodos de 4 semanas) df_fechas <- df_fechas %>% mutate( periodo = ceiling(semana / 4), # periodo 1 a 13 periodo_romano = as.character(as.roman(periodo)) ) # --- 3. Crear etiquetas para los periodos (solo en la primera semana de cada periodo) --- df_fechas <- df_fechas %>% group_by(año, periodo) %>% mutate(etiqueta_periodo = if_else(row_number() == 1, periodo_romano, "")) %>% ungroup() # --- 4. Crear etiquetas para los años (solo en la primera semana de cada año) --- df_fechas <- df_fechas %>% group_by(año) %>% mutate(etiqueta_año = if_else(row_number() == 1, año, "")) %>% ungroup() # --- 5. Vectores finales para usar en scale_x_continuous --- vector_final <- df_fechas$etiqueta_periodo year_labels <- df_fechas$etiqueta_año # --- 6. Gráfico de la curva epidémica (barras + media móvil) --- FISCURVEEPI05 <- plot(inc.week.gender) + theme(axis.title = element_text(size = 10), axis.text = element_text(size = 4), axis.ticks.x = element_blank(), axis.ticks.length = unit(0, "cm"), legend.title = element_text(size = 10), legend.position = "none") + scale_x_continuous( breaks = as.numeric(fechas), labels = vector_final, expand = c(0, 0) ) + ylab("Casos") + labs(title = "Curva Epidemiológica COVID19 General 23-26") + scale_fill_manual(values = colores) #FISCURVEEPI0 # Media móvil (ventana de 3 semanas) inc_week_df <- data.frame( dates = fechas, counts = rowSums(inc.week.gender$counts) ) inc_week_df$moving_avg <- rollmean(inc_week_df$counts, k = 3, fill = NA, align = "right") FISCURVEEPI5 <- FISCURVEEPI0 + geom_line(data = inc_week_df, aes(x = dates, y = moving_avg), inherit.aes = FALSE, color = "#068FAB", size = 0.5) # --- 7. Gráfico inferior con los años --- plot_years5 <- ggplot(df_fechas, aes(x = as.numeric(fecha), y = 0)) + geom_blank() + theme_classic() + scale_x_continuous( breaks = as.numeric(fechas), labels = year_labels, expand = expansion(mult = c(0.05, 1.2)) ) + theme( axis.title.x = element_blank(), axis.text.x = element_text(size = 4, vjust = 56), axis.line.y = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank(), axis.line.x = element_blank(), axis.ticks.x = element_blank() ) + xlab("Periodo Epidemiológico") + theme(panel.background = element_rect(fill = "white")) # --- 8. Combinar ambos gráficos --- grafica_final5 <- grid.arrange(FISCURVEEPI05, plot_years5, ncol = 1, heights = c(0.9, 0.1)) grafica_final5 ############################################ #########################################genero # ---------------------------------------------------------------------- # Curva epidémica por género (automática, con periodos y años) # ---------------------------------------------------------------------- library(incidence) library(dplyr) library(zoo) library(ggplot2) library(gridExtra) # Crear objeto incidence agrupado por género (ajusta el nombre de la columna) inc.week.gender <- incidence(Pacientes_covid_r_f1$FECHA_NOTIFICACION, interval = "1 epiweeks: sunday", groups = Pacientes_covid_r_f1$SEXO) # <--- cambiar según tu variable # Extraer fechas fechas <- inc.week.gender$dates n <- length(fechas) # Data frame auxiliar con fecha, año y semana epidemiológica df_fechas <- data.frame( fecha = fechas, año = format(fechas, "%Y"), semana = lubridate::epiweek(fechas) ) # Periodo epidemiológico (cada 4 semanas) df_fechas <- df_fechas %>% mutate( periodo = ceiling(semana / 4), periodo_romano = as.character(as.roman(periodo)) ) # Etiquetas de periodo (solo primera semana de cada periodo) df_fechas <- df_fechas %>% group_by(año, periodo) %>% mutate(etiqueta_periodo = if_else(row_number() == 1, periodo_romano, "")) %>% ungroup() # Etiquetas de año (solo primera semana de cada año) df_fechas <- df_fechas %>% group_by(año) %>% mutate(etiqueta_año = if_else(row_number() == 1, año, "")) %>% ungroup() vector_final <- df_fechas$etiqueta_periodo year_labels <- df_fechas$etiqueta_año # Colores para los géneros (automático según niveles) generos <- levels(inc.week.gender$groups) colores_genero <- setNames(c("#F2AEB4", "#1E90FF"), generos) # rosa y azul # Gráfico de barras apiladas por género FISCURVEEPI06 <- plot(inc.week.gender) + theme(axis.title = element_text(size = 10), axis.text = element_text(size = 4), axis.ticks.x = element_blank(), axis.ticks.length = unit(0, "cm"), legend.title = element_text(size = 10), legend.position = "right") + # muestra la leyenda para identificar géneros scale_x_continuous( breaks = as.numeric(fechas), labels = vector_final, expand = c(0, 0) ) + ylab("Casos") + labs(title = "Curva Epidemiológica por Género 23-26") + scale_fill_manual(values = colores_genero, name = "Género") # Media móvil total (ventana de 3 semanas) inc_week_df <- data.frame( dates = fechas, counts_total = rowSums(inc.week.gender$counts) ) inc_week_df$moving_avg <- zoo::rollmean(inc_week_df$counts_total, k = 3, fill = NA, align = "right") FISCURVEEPI16 <- FISCURVEEPI01 + geom_line(data = inc_week_df, aes(x = dates, y = moving_avg), inherit.aes = FALSE, color = "#068FAB", size = 0.5) # Gráfico inferior con los años plot_years6 <- ggplot(df_fechas, aes(x = as.numeric(fecha), y = 0)) + geom_blank() + theme_classic() + scale_x_continuous( breaks = as.numeric(fechas), labels = year_labels, expand = expansion(mult = c(0.05, 0)) ) + theme( axis.title.x = element_blank(), axis.text.x = element_text(size = 4, vjust = 56), axis.line.y = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank(), axis.line.x = element_blank(), axis.ticks.x = element_blank() ) + xlab("Periodo Epidemiológico") + theme(panel.background = element_rect(fill = "white")) # Combinar ambos gráficos grafica_final6 <- grid.arrange(FISCURVEEPI06, plot_years6, ncol = 1, heights = c(0.9, 0.1)) grafica_final6 ``` ##Inicio Modelo ```{r, include=FALSE} #sexo,tiposeguridad, localidad, #grupos_edad_quinquenios,estrato,gestante,etnia #profesional_trabajador_dela salud, variable dependiente a predecir Pacientes_covid_r<-Pacientes_covid_r%>%filter(PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD=="Si"|PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD=="No") columnas_deseadas<-c("PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD","SEXO","TIPO_SEGURIDAD_SOCIAL","localidad_residencia_saludata","GRUPOS_EDAD_QUINQUENIOS","ESTRATO_SOCIOECONOMICO","CONDICION_GESTANTE","ETNIA") # Obtener los índices de las columnas indices_columnas <- which(colnames(Pacientes_covid_r) %in% columnas_deseadas) # Extraer las columnas usando los índices datareg <- Pacientes_covid_r[, indices_columnas] ###########################################################################333 #filtramos datareg<-datareg %>% mutate(across(where(is.factor), droplevels)) datareg<-datareg%>%filter(PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD!="Sin Ocupacion en Sivigila") table(datareg$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD) # Calcular frecuencias y porcentajes data_summary <- datareg %>% group_by(PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD) %>% summarise(count = n()) %>% mutate(percentage = round((count / sum(count)) * 100, 1)) # Crear gráfico con valores y porcentajes ggplotly(ggplot(data_summary, aes(x = PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD, y = count, fill = PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD)) + geom_bar(stat = "identity")+ geom_text(aes(label = paste0(count, " (", percentage, "%)")), vjust = -0.5, size = 3)+ theme_minimal() + theme( text = element_text(size = 9), axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "rigth" )+ # Tema limpio y estético scale_fill_manual(values = c("#DAAAAD", "#AAFFB5")) + labs( title = "Distr de Clase Gestante", x = "Clase", y = "Frecuencia", fill = " " )) #############Texto########################################################################## #modelo de regresion logistica 1 # Crear una copia de seguridad de datareg datareg_clean <- datareg # Iterar sobre todas las variables predictoras (excepto la variable objetivo) for (var in names(datareg_clean)[names(datareg_clean) != "PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD"]) { # Crear tabla de frecuencia cruzada entre la variable y la variable objetivo tabla <- table(datareg_clean[[var]], datareg_clean$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD) # Identificar niveles con conteo 0 en alguna categoría de la variable objetivo niveles_a_eliminar <- rownames(tabla)[apply(tabla, 1, function(x) any(x == 0))] # Si hay niveles problemáticos, eliminarlos if (length(niveles_a_eliminar) > 0) { cat("\nEliminando niveles en:", var, "->", niveles_a_eliminar, "\n") # Convertir la variable a factor y eliminar los niveles problemáticos datareg_clean[[var]] <- factor(datareg_clean[[var]]) datareg_clean[[var]] <- droplevels(datareg_clean[[var]], exclude = niveles_a_eliminar) } } for (var in names(datareg_clean)[names(datareg_clean) != "PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD"]) { tabla <- table(datareg_clean[[var]], datareg_clean$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD) # Mostrar solo tablas con posibles problemas if (any(tabla == 0)) { cat("\nVariable:", var, "\n") print(tabla) cat("----------------------\n") } } #table(datareg_clean$CLASIFICACION_SISBEN) ##################################### #overcodigoviejo # 1. Generación de datos simulados set.seed(123) # Crear el dataset ############################################### datos <-datareg_clean library(stringi) # Añade esto al inicio library(tidyverse) # O cualquier otro paquete que necesites # Reemplazar espacios por "_", quitar comas y eliminar tildes en nombres de columnas colnames(datos) <- datos %>% colnames() %>% stri_trans_general("Latin-ASCII") %>% # Elimina tildes gsub(" ", "_", .) %>% # Reemplaza espacios por "_" gsub(",", "", .) # Elimina comas #<- data.frame(Ganador, Genero, Equipo, Nivel_Experiencia) #este va resumen<-skimr::skim(datos) resumen #resumen #table(datos$Class_gestante_unida) #prop.table(table(datos$Class_gestante_unida)) # 2. Ajuste del modelo de regresión logística #table(is.na(datos[15])) # Estratificar solo por Class_gestante (evitar combinaciones raras) train_index <- createDataPartition( datos$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD, # Variable objetivo única p = 0.7, list = FALSE ) train <- datos[train_index, ] test <- datos[-train_index, ] train <- train %>% mutate(across(where(is.numeric), ~ scale(.x) %>% as.numeric)) # balancear los datos mediante la técnica de oversampling. prop.table(table(train$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD)) table(train$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD)[2] table(train$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD)[1] colnames(train) set.seed(123) # Para reproducibilidad # Obtener el tamaño de cada clase tabla_clases <- table(train$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD) tabla_clases clase_minoritaria <-min(tabla_clases) clase_mayoritaria <- max(tabla_clases) # Definir un N intermedio entre ambas clases N_intermedio <- round((clase_minoritaria + clase_mayoritaria) / 2) # Renombrar columnas problemáticas automáticamente colnames(train) <- make.names(colnames(train)) # Verificar nombres después del cambio # Verificar nombres después del cambio #colnames(train) Class_gestante_bal_over <- ovun.sample( PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD~ ., data = train,method = "both", N =N_intermedio, seed = 123,p = 0.5)$data #table(Class_gestante_bal_over$Class_gestante_unida) modelo_bal_over <-step(glm(PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD ~., data = Class_gestante_bal_over, family = binomial), direction = "backward") library(logistf) library(MASS) summary(modelo_bal_over) x_test <- model.matrix(modelo_bal_over) y_test <-Class_gestante_bal_over$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD check_separation<- detect_separation(x = x_test, y = y_test, family = binomial()) # Buscar coeficientes extremos (>10 o < -10) summary_model <- summary(modelo_bal_over) library(knitr) library(kableExtra) # Captura el resumen como texto resumen_texto <- capture.output(summary_model) # Ajustar el modelo (asegúrate de que modelo_bal_over es tu modelo logístico) # Si no está definido, aquí un ejemplo genérico: # modelo_bal_over <- glm(respuesta ~ predictor1 + predictor2, data = datos, family = binomial) #inicio or validos # 1. Instalar paquetes necesarios (si no están instalados) if (!require("pacman")) install.packages("pacman") pacman::p_load(broom, logistf, marginaleffects, dplyr, flextable) # 2. Función segura para extraer coeficientes safe_tidy <- function(model) { # Intentar con método Wald primero try_wald <- tryCatch({ broom::tidy(model, conf.int = TRUE, conf.method = "wald", exponentiate = TRUE) }, error = function(e) NULL) # Si Wald falla, usar perfil de verosimilitud if (is.null(try_wald)) { coefs <- coef(model) ses <- sqrt(diag(vcov(model))) data.frame( term = names(coefs), estimate = exp(coefs), conf.low = exp(coefs - 1.96 * ses), conf.high = exp(coefs + 1.96 * ses), stringsAsFactors = FALSE ) } else { try_wald } } # 3. Aplicar al modelo resultados <- safe_tidy(modelo_bal_over) resultados # 4. Identificar predictores problemáticos predictores_problematicos <- resultados %>% filter(!is.finite(estimate) | !is.finite(conf.low) | !is.finite(conf.high)) %>% pull(term) predictores_problematicos # 5. Filtrar resultados válidos resultados_validos <- resultados %>% filter( is.finite(estimate), is.finite(conf.low), is.finite(conf.high) ) #fin or validos # Ejemplo para glm/lm coef_df <- as.data.frame(summary(modelo_bal_over)$coefficients) otros_stats <- data.frame( AIC = AIC(modelo_bal_over), Devianza = deviance(modelo_bal_over) ) # Unir en una lista para exportar lista_export <- list( Coeficientes = coef_df, Estadísticos = otros_stats ) # Guarda en PDF #pdf("D:/nocturno/temporales/elena amatista/2025/02-febreo/gestantes depurado/resumen_modelo.pdf", width = 8, height = 11) # Tamaño carta #max(abs(summary_model$coefficients[, "Estimate"])) coef_extremos <- which(abs(summary_model$coefficients[, "Estimate"]) > 5) #coef_extremos #print(summary_model$coefficients[coef_extremos, ]) # Extraer las etiquetas de las variables problemáticas categorias_extremas <- rownames(summary_model$coefficients)[coef_extremos] coeficientes_todos<-coef(modelo_bal_over) #modelo_bal_over$coefficients coeficientes_filtrados <- coeficientes_todos[!names(coeficientes_todos) %in% categorias_extremas] coeficientes_filtrados #?tidy #resultados <- tidy(modelo_bal_over, confint.glht = TRUE, exponentiate = TRUE ) #tidy(modelo_bal_over, conf.int = TRUE, exponentiate = TRUE , test=c("EDAD_C", "Riesgo_6_alt_nutricional")) categorias_extremas #Class_gestante_bal_over$Riesgo_6_alt_nutricional resultados bal_over_pred <- predict(modelo_bal_over, newdata = Class_gestante_bal_over, type = "response") head(bal_over_pred) bal_over_pred_clase <- factor(ifelse(bal_over_pred > 0.5, 1, 0)) #programamos para eliminar categorias extremas modelo_bal_over_pred <- predict(modelo_bal_over, newdata = Class_gestante_bal_over, type = "response") head(modelo_bal_over_pred) modelo_bal_over_pred_clase <- factor(ifelse(modelo_bal_over_pred > 0.5, 1, 0)) levels(modelo_bal_over_pred_clase) <- c("Adecuado","Riesgo") modelo_bal_over_pred_clase table(Predicho = modelo_bal_over_pred_clase, Real =Class_gestante_bal_over$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD) #colnames(train)<- colnames(modelo_bal_over$data) #length(modelo_bal_over1$data)==length(test) roc_test <- roc(Class_gestante_bal_over$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD, modelo_bal_over_pred) # Opción 3: Eliminar variables problemáticas (si se identificaron) # modelo_log0 <- glm(`Gan-Per` ~ . - Variable_Problema, data = train, family = binomial) # --- Evaluación --- # Resumen del modelo print(summary(modelo_bal_over)) modelo_bal_over print(summary(modelo_bal_over)) resumen<-summary(modelo_bal_over) # Convertir el summary en un DataFrame resumen_df <- as.data.frame(summary(modelo_bal_over)$coefficients) colnames(resumen_df) # Agregar nombres de columnas más descriptivos colnames(resumen_df) <- c("Estimado", "Error estándar", "Z-valor", "P-valor") resumen_df$Variable <- rownames(resumen_df) #rownames(resumen_df) <- NULL # Crear una columna indicando la relevancia de cada variable resumen_df$Significancia <- case_when( resumen_df$`P-valor` < 0.01 ~ "Muy significativa", resumen_df$`P-valor` < 0.05 ~ "Significativa", resumen_df$`P-valor` < 0.1 ~ "Marginalmente significativa", TRUE ~ "No significativa" ) # Extraer coeficientes y calcular Odds Ratios (OR) con intervalos de confianza #resultado <- tidy(modelo_bal_over, conf.int = TRUE, exponentiate = TRUE) table(Class_gestante_bal_over$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD, modelo_bal_over_pred > 0.5) #glm(Class_gestante_unida ~.-1, data = train, family = binomial) #summary(glm(Class_gestante_unida ~., data = train, family = binomial)) # Primero asegurémonos de que ambas tablas tengan una columna común para unir colnames(resumen_df)<-c(colnames(resumen_df[1:4]),"term",colnames(resumen_df[5])) tabla_combinada <- resultados_validos %>% # Unir con resumen_df (ajusta 'by' según tu columna común) left_join(resumen_df, by = "term") tabla_combinada summary(modelo_bal_over) # Extraer el resumen del modelo summ <- summary(modelo_bal_over) # Convertir la tabla de coeficientes en un dataframe coef_df <- as.data.frame(summ$coefficients) # Filtrar por p-valor < 0.05 (ajusta el umbral según necesites) coef_significativos <- coef_df[coef_df$`Pr(>|z|)` < 0.05, ] # Para modelos logísticos # coef_significativos <- coef_df[coef_df$`Pr(>|t|)` < 0.05, ] # Para modelos lineales # Mostrar solo los significativos pred_class <- factor(ifelse(bal_over_pred > 0.5, "Si" ,"No"), levels = levels(Class_gestante_bal_over$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD)) # Matriz de confusión conf_matrix <- confusionMatrix(pred_class, Class_gestante_bal_over$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD) # Obtener la primera categoría de cada variable categórica lista_primeras_categorias <- lapply(datareg, function(x) { if (is.factor(x)) { levels(x)[1] # Primera categoría si es factor } else if (is.character(x)) { unique(x)[1] # Primera categoría si es carácter } else { NA # Si no es categórica, devuelve NA } }) # Convertir la lista en un dataframe para mejor visualización df_primeras_categorias <- data.frame( Variable = names(lista_primeras_categorias), Primera_Categoria = unlist(lista_primeras_categorias) ) # Mostrar el resultado #print(df_primeras_categorias) #install.packages("stargazer") library(stargazer) library(ggplot2) library( ResourceSelection) library(caret) resultado_filtrado <- tabla_combinada[abs(tabla_combinada$`P-valor`) < 0.5, ] resultado_filtrado$term<-factor(resultado_filtrado$term) #levels(resultado_filtrado$term)[4] resultado_filtrado<-resultado_filtrado%>%filter(term!="(Intercept)"&term!="CLASIFICACION_SISBENSin clasificacion SISBEN") #grafica de odds bal_over # Primero asegurémonos que los nombres coincidan exactamente resultado_filtrado <- resultado_filtrado %>% rename( OddsRatio = estimate, IC_inferior = conf.low, IC_superior = conf.high ) resultado_filtrado <- resultado_filtrado %>% mutate( IC_inferior_log = Estimado - 1.96 * `Error estándar`, IC_superior_log = Estimado + 1.96 * `Error estándar` ) #transformador1<-c(rep(1,12),-1,rep(1,20),-1,1,-1) #resultado_filtrado$Estimado * transformador1 #resultado_filtrado$Estimado <- resultado_filtrado$Estimado * transformador1 #resultado_filtrado$IC_inferior_log <- resultado_filtrado$IC_inferior_log * transformador1 #resultado_filtrado$IC_superior_log <- resultado_filtrado$IC_superior_log * transformador1 #resultado_filtrado$term #resultado_filtrado$term1<-nombres_corregidos #write_xlsx(resultado_filtrado,"D:/nocturno/temporales/elena amatista/2025/02-febreo/gestantes depurado/odds.xlsx") #resultado_filtrado_<-resultado_filtrado%>%filter(term1=="País de Nacimiento Venezuela" | term1 =="Régimen Seguridad No asegurado" | term1 =="Régimen Seguridad No asegurado" | term1=="Núm. Gestaciones 7-9"|term1=="Cat Edad 40-44 años"|term1=="Clasif SISBEN Vulnerable"|term1=="Clasif SISBEN Pobreza Extrema"|term1=="Riesgo Preeclampsia"|term1=="Nivel Educativo Media Técnica"|term1=="Nivel Educativo Postgrado"|term1=="Núm. Controles Prenatales 7-9"|term1=="Estrato 5"|term1=="Multiplicidad de Embarazo Multiple"|term1=="Multiplicidad de Embarazo Simple") oddscorregidos<-ggplot(resultado_filtrado, aes(x = reorder(term, Estimado+1), y = Estimado+1)) + geom_point(size = 3, shape = 18, color = "#2c3e50") + geom_errorbar( aes(ymin = IC_inferior_log+1, ymax = IC_superior_log+1), width = 0.2, color = "#e74c3c", linewidth = 1 ) + geom_hline(yintercept = 1, linetype = "dashed", color = "gray50") + # Línea de referencia en 0 coord_flip() + labs( title = "Coeficientes Logísticos (Log-Odds) con Intervalos de Confianza 95%", x = "Variables Predictoras", y = "Coeficiente (escala logarítmica)", caption = "Línea punteada indica referencia (Coeficiente = 0)" ) + theme_minimal() roc_curve <- roc( response = Class_gestante_bal_over$PROFESIONAL_O_TRABAJADOR_DE_LA_SALUD, predictor = modelo_bal_over_pred ) ``` ```{r, echo=FALSE} colnames(datareg) summary(modelo_bal_over) datatable( tabla_combinada, rownames = FALSE, extensions = c("Buttons", "Scroller"), options = list( scrollX = TRUE, scrollY = "500px", scroller = TRUE, dom = "Bfrtip", buttons = c("copy", "csv", "excel") ) ) print(conf_matrix) fourfoldplot(conf_matrix$table, color = c("#ca0020", "#0571b0"), main = "Matriz de Confusión") print(hoslem.test(modelo_bal_over$y, fitted(modelo_bal_over), g = 10)) oddscorregidos ggroc(roc_curve, color = "red", size = 1) + geom_abline(linetype = "dashed") + labs( title = "Curva ROC Riesgo personal salud", x = "Tasa de Falsos Positivos (1 - Especificidad)", y = "Tasa de Verdaderos Positivos (Sensibilidad)" ) + theme_minimal() ```