codes/2_admin_njours.R

In INESSSQC/INESSS: Useful functions

setwd("V:/GI-Data/_MedPersAg/HISTORIQUE_ADMISS_CODE_R/Construction Admin")
library(data.table)
dt <- fread("V:/GI-Data/_MedPersAg/HISTORIQUE_ADMISS_CODE_R/HISTORQUE_ADMISS_INADMISS.txt")
setnames(dt, c("ID", "DATE_NAISSANCE","DATE_DECES", "DATE_DEBU", "DATE_FIN", "SITU"),
         c("id", "nais", "mort", "debut", "fin", "situ"))

#### Arrangement ####

# convertir en date
dt[, `:=` (nais = as.Date(nais),
           mort = as.Date(mort),
           debut = as.Date(debut),
           fin = as.Date(fin))]

# debut & fin = NA => debut = "1973-01-01", fin = "2018-12-31, situ = 1
dt[
  is.na(debut) & is.na(fin),
  `:=` (situ = 1L,  # personne admissible
        debut = as.Date("1973-01-01"),  # date debut analyse
        fin = as.Date("2018-12-31"))  # date fin analyse
]
# debut ne peut être avant la naissance, fin ne peut être après mort.
dt[debut < nais, debut := nais]
dt[fin > mort, fin := mort]
# debut ne peut être avant debut analyse = 1973-01-01
dt[debut < as.Date("1973-01-01"), debut := as.Date("1973-01-01")]
# fin ne peut être après fin analyse = 2018-12-31
dt[fin > as.Date("2018-12-31"), fin := as.Date("2018-12-31")]
# supprimer les incohérence = debut > fin
dt <- dt[!debut > fin]



#### Jours par année ####
# Indiquer l'intervale d'année à créer
dt[, d := as.numeric(substr(debut, 1, 4))]  # debut intervale
dt[, f := as.numeric(substr(fin, 1, 4))]  # fin intervale
# Ajouter une colonne par année et ajouter le nombre de jours
for(i in seq(1, nrow(dt))){  # chaque ligne
  for(j in seq(dt[[i, "d"]], dt[[i, "f"]])){  # colonnes = [d, f]
    if(j == dt[[i, "d"]]){  # si j = d => 12-31 - debut = nbr de jours
      set(dt, i, paste(j), as.Date(paste0(j,"-12-31")) - dt[[i, "debut"]] + 1L)
    } else if(j == dt[[i, "f"]]){  # si j = f => fin - 01-01 = nbr de jours
      set(dt, i, paste(j), dt[[i, "fin"]] - as.Date(paste0(j, "-01-01")) + 1L)
    } else {  # sinon => 12-31 - 01-01 = 365/366
      set(dt, i, paste(j), as.Date(paste0(j, "-12-31")) - as.Date(paste0(j, "-01-01")) + 1L)
    }
  }
}

# melt des données
cols <- c(1, 6, 9:ncol(dt))  # colonnes à sélectionner
dt <- dt[, ..cols]  # sélection des colonnes
dt <- melt(dt, id.vars = c("id", "situ"),
           variable.name = "an", value.name = "njours",
           na.rm = TRUE)
setorder(dt, id, an)

dt[, id := as.character(id)]  # id en CHR plus facile à chercher dans R (filter)
dt[, an := as.integer(as.character(an))]
dt[, njours := as.integer(njours)]


#### SAVE ####
saveRDS(dt, "admin_njours.rds")