R_PDH EXERCICE N°19

Importez les trois feuilles du classeur dept.xlsx (à télécharger ici) et les combiner en un seul data.frame à 3 colonnes : REG, DEPT et LIB.

Sur les données MCO 2024 de BRetagne, comptez les séjours (hors GHM commençant par 28 ou 90) par département et CMD. Présentez le résultat comme dans le tableau ci-dessous (à part la mise en forme). cmd 22 – Côtes d'Armor 29 – Finistère 35 – Ille et Villaine 56 – Morbihan 01 9231 20512 24664 17492 02 10154 21583 23509 19699 03 4552 12856 17031 9233 04 6989 18906 17785 11913 05 14112 28819 36302 22839 06 21684 41903 42630 […]

Calculez le nombre d’établissements par champ en 2024 par département en Bretagne, d’après la table NOMGEN.FINESS. Pour rappel les départements bretons sont le 22, le 29, le 35 et le 56.

Calculez le nombre d’établissements par champ en 2024 d’après la table NOMGEN.FINESS.

Comptez par diagnostic principal (colonne DP) les séjours MCO correspondant à des infarctus. On cherchera ce terme dans NOMPMSI.ALL_CIM10 pour avoir les codes DP correspondant aux infarctus.

Comptez le nombre de séjours MCO (hors GHM commençant par 28 ou 90) par secteur de l’établissement. Cette information est dans la table NOMGEN.FINESS ; attention, cette table empile plusieurs années.

Calculez le nombre de séjours MCO (hors GHM commençant par 28 ou 90) par jour de sortie dans la semaine avec les noms des jours en clair (de lundi à dimanche). Aidez-vous de la fonction Teradata td_day_of_week qui renvoie un numéro de 1 à 7, où 1 est le dimanche, 2 le lundi, etc.

Comptez par mois le nombre de séjours MCO passant par un lit dédié aux soins palliatifs (LIT_PALLIATIF vaut « 0 » ou « 1 ») sans utiliser la fonction filter. On ne cherchera pas à éliminer les GHM commençant par 28 ou 90.

Comptez le nombre de séjours MCO (hors GHM commençant par 28 ou 90) par durée de séjour, en faisant 4 tranches : 0 jour, 1 jour, 2 à 7 jours, 8 jours et plus.

Listez les GHM et CMD correspondant à des césariennes (la colonne LIB contient le mot « césar ») qui sont encore valables aujourd’hui (la colonne DATE_FIN a une valeur dans le futur), à partir des données NOMPMSI.ALL_CLASSIF_PMSI.

Affichez le top 10 des départements ayant le plus d’établissements relevant du champ psy en 2024, à partir de la table NOMGEN.FINESS. Pensez à filter sur l’année et à utiliser la colonne PSY=1.

Affichez le top 10 des établissements par nombre de séances (uniquement les GHM en 28xxxx) en prenant bien en compte la colonne nbseance.

Affichez le top 10 des établissements du département 92 selon le nombre d’accouchements par césarienne (GHM 14c06, 14c07 et 14c08).

Comptez les séjours de la table MCO24.FIXE par établissement, hors GHM commençant par 28 ou 90.

Affichez le top 10 des établissements avec le plus grand nombre de lignes dans PSY24.FIXE.

Compter les lignes de la table PSY24.FIXE par établissement (FINESS).

Exécutez sur Teradata la requête suivante : SELECT SUBSTR(sej.ghm2,1,2) AS cmd, nom.lib AS cmd_lib, COUNT(DISTINCT sej.anonyme) AS nb_patients FROM prd_vue_mco_2024.fixe AS sej LEFT JOIN prd_vue_nompmsi.all_classif_pmsi AS nom ON SUBSTR(sej.ghm2,1,2) = nom.code WHERE sej.ano_retour = « 000000000 » AND SUBSTR(sej.ghm2,1,2) NOT IN (« 28″, »90 ») AND nom.champ = « mco »‘ AND nom.type_code = « cmd » AND YEAR(date_fin) > 2025 GROUP BY cmd, cmd_lib ORDER BY nb_patients DESC

Compter les colonnes de la table PSY24.FIXE.

Donner un nom de colonnes entre guillemets dans mutate ou summarise est inhabituel mais permet de déroger aux contraintes de nommage de colonnes de R. On obtient alors de beaux en-têtes de colonnes dans Excel. Mieux vaut cependant faire cette opération comme un renommage de dernière minute si on doit faire des opérations sur la colonne, ce qui n’est pas le cas ici (on se contente de tricher avec everything() pour ne pas la citer nommément). library(pRatihque) # connexion Teradata […]

Deux appels à la fonction union_all sont nécessaires puisqu’on n’y empile que 2 tables à fois. library(readxl) # import Excel library(dplyr) # requêtes reg1 <- read_excel(« exercices/dept.xlsx », sheet= »Ile de France ») %>% mutate(reg = « Ile de France ») reg2 <- read_excel(« exercices/dept.xlsx », sheet= »Bretagne ») %>% mutate(reg = « Bretagne ») reg3 <- read_excel(« exercices/dept.xlsx », sheet= »Nouvelle Aquitaine ») %>% mutate(reg = « Nouvelle Aquitaine ») regions <- union_all(reg1, reg2) %>% union_all(reg3) %>% mutate(dept = as.character(dept)) # bind_rows peut empiler plus de 2 tables mais dbplyr ne saurait pas le traduire en SQL […]

library(pRatihque) # connexion Teradata library(dplyr) # requêtes library(dbplyr) # traduction dplyr -> SQL library(stringr) # travailler sur des textes library(tidyr) # pivots pmsi % mutate(cmd = str_sub(ghm2, 1, 2), dept = case_when( str_sub(finess,1,2) == « 22 » ~ « 22 – Côtes d’Armor », str_sub(finess,1,2) == « 29 » ~ « 29 – Finistère », str_sub(finess,1,2) == « 35 » ~ « 35 – Ille et Villaine », str_sub(finess,1,2) == « 56 » ~ « 56 – Morbihan », TRUE ~ NA )) %>% filter( ! is.na(dept) ) %>% count(cmd, dept) %>% pivot_wider(id_cols = cmd, names_from […]

library(pRatihque) # connexion Teradata library(dplyr) # requêtes library(dbplyr) # traduction dplyr -> SQL atihble(pmsi, « nomgen.finess ») %>% mutate(dept = str_sub(finess,1,2)) %>% filter(annee == 2024 & dept %in% c(« 22″, »29″, »35″, »56 »)) %>% group_by(dept) %>% summarise(nb_mco = sum(as.integer(mco), na.rm=TRUE), nb_smr = sum(as.integer(ssr), na.rm=TRUE), nb_psy = sum(as.integer(psy), na.rm=TRUE), nb_had = sum(as.integer(had), na.rm=TRUE)) %>% ungroup() %>% arrange(dept)

Astuce déjà vue dans un exercice précédent, sommer des 0 et des 1 permet de compter le nombre d’occurences de la valeur 1. library(pRatihque) # connexion Teradata library(dplyr) # requêtes library(dbplyr) # traduction dplyr -> SQL atihble(pmsi, « nomgen.finess ») %>% filter(annee == 2024) %>% summarise(nb_mco = sum(as.integer(mco), na.rm=TRUE), nb_smr = sum(as.integer(ssr), na.rm=TRUE), nb_psy = sum(as.integer(psy), na.rm=TRUE), nb_had = sum(as.integer(had), na.rm=TRUE))

library(pRatihque) # connexion Teradata library(dplyr) # requêtes library(dbplyr) # traduction dplyr -> SQL pmsi <- connection_database() infarctus <- atihble(pmsi, « nompmsi.all_cim10 ») %>% filter(between(2024, annee_deb, annee_fin) & nchar(code) == 4 & toupper(lib) %LIKE% « %INFARCTUS% ») %>% select(code, lib, liblong) inner_join( atihble(pmsi, « mco24.fixe »), infarctus, by = join_by(dp == code)) %>% count(dp, lib, liblong) %>% arrange(desc(n))

library(pRatihque) # connexion Teradata library(dplyr) # requêtes library(dbplyr) # traduction dplyr -> SQL # en plusieurs étapes dont une agrégation de mco24.fixe à l’établissement etab24 <- atihble(pmsi, « nomgen.finess ») %>% filter(annee == 2024) %>% select(finess, secteur) activite24 <- atihble(pmsi, « mco24.fixe ») %>% filter( ! str_sub(ghm2, 1, 2) %in% c(« 28″, »90 ») ) %>% count(finess) inner_join(activite24, etab24, by = join_by(finess == finess)) %>% count(secteur, wt=n) # ou en joignant les tables brutes inner_join(atihble(pmsi, « mco24.fixe ») %>% select(finess, annee, ghm2), atihble(pmsi, « nomgen.finess ») %>% select(finess, annee, secteur), by […]

library(pRatihque) # connexion Teradata library(dplyr) # requêtes library(dbplyr) # traduction dplyr -> SQL atihble(pmsi, « mco24.fixe ») %>% filter( ! str_sub(ghm2, 1, 2) %in% c(« 28″, »90 ») ) %>% mutate(jour = sql(« td_day_of_week(date_sortie) »), jour = case_when( jour == 2 ~ « lundi », jour == 3 ~ « mardi », jour == 4 ~ « mercredi », jour == 5 ~ « jeudi », jour == 6 ~ « vendredi », jour == 7 ~ « samedi », jour == 1 ~ « dimanche » )) %>% count(jour) %>% arrange(desc(n))

library(pRatihque) # connexion Teradata library(dplyr) # requêtes library(dbplyr) # traduction dplyr -> SQL library(stringr) # gestion des données texte atihble(pmsi, « mco24.fixe ») %>% filter( ! str_sub(ghm2, 1, 2) %in% c(« 28″, »90 ») ) %>% mutate(duree_tranches = cut(duree, breaks=c(-Inf,0,1,7,Inf), labels=c(« 0 jour », »1 jour », « 2-7 jours », « 8 jours et + »))) %>% count(duree_tranches) %>% arrange(duree_tranches)

Avec l’option de pondération on utilise la colonne LIT_PALLIATIF transformée en numérique (ou en entier) pour en obtenir la somme, c’est à dire le nombre de valeurs 1. library(pRatihque) # connexion Teradata library(dplyr) # requêtes library(dbplyr) # traduction dplyr -> SQL atihble(pmsi, « mco24.fixe ») %>% mutate(pal = as.integer(lit_palliatif)) %>% # pour pouvoir l’utiliser comme poids count(mois, wt=pal) %>% arrange(mois)

Pensez bien à activer le package {lubridate} pour accéder à la fonction today ! library(pRatihque) # connexion Teradata library(dplyr) # requêtes library(dbplyr) # traduction dplyr -> SQL library(lubridate) # manipulation de dates atihble(pmsi, « nompmsi.all_classif_pmsi ») %>% filter(champ == « mco ») %>% filter(date_fin > today()) %>% filter(tolower(lib) %LIKE% « %césar% » )

library(pRatihque) # connexion Teradata library(dplyr) # requêtes library(dbplyr) # traduction dplyr -> SQL library(stringr) # manipulation de textes atihble(pmsi, « nomgen.finess ») %>% mutate(dept = str_sub(finess,1,2)) %>% filter(annee == 2024 & psy == 1) %>% count(dept) %>% arrange(desc(n))

On pondère le comptage par la colonne NBSEANCE pour obtenir une somme plutôt qu’un simple comptage de lignes. library(pRatihque) # connexion Teradata library(dplyr) # requêtes library(dbplyr) # traduction dplyr -> SQL pmsi <- connection_database() atihble(pmsi, « mco24.fixe ») %>% filter( ghm2 %LIKE% « 28% » ) %>% count(finess, wt=nbseance) %>% arrange(desc(n))

Au choix on utilisera l’opérateur %LIKE% ou la fonction str_sub pour filtrer les débuts de chaînes. La solution illustre l’une et l’autre. library(pRatihque) # connexion Teradata library(dplyr) # requêtes library(dbplyr) # traduction dplyr -> SQL library(stringr) # manipulation de textes pmsi <- connection_database() atihble(pmsi, « mco24.fixe ») %>% filter( str_sub(ghm2,1,5) %in% c(« 14C06″, »14C07″, »14C08 ») & finess %LIKE% « 92% » ) %>% count(finess) %>% arrange(desc(n))

Les séjours sont, comme d’habitude, hors CMD 28 et 90. L’aspect « top 10 » est directement fourni par l’affichage de la lazy query dans la Console, où on ne voit que les 10 premières lignes. Il suffit donc de trier par ordre décroissant. library(pRatihque) # connexion Teradata library(dplyr) # requêtes library(dbplyr) # traduction dplyr -> SQL library(stringr) # manipulation de textes pmsi <- connection_database() atihble(pmsi, « mco24.fixe ») %>% filter( ! str_sub(ghm2,1,2) %in% c(« 28″, »90 »)) %>% count(finess) %>% arrange(desc(n))

library(pRatihque) # connexion Teradata library(dplyr) # requêtes library(dbplyr) # traduction dplyr -> SQL pmsi <- connection_database() atihble(pmsi, « psy24.fixe ») %>% count(finess) %>% arrange(desc(n))

library(pRatihque) # connexion Teradata library(dplyr) # requêtes library(dbplyr) # traduction dplyr -> SQL pmsi <- connection_database() atihble(pmsi, « psy24.fixe ») %>% count(finess) Exemple de résultat (l’ordre des lignes peut être différent chez chacun).

La seule difficulté dans l’incorporation de ce code tient aux guillemets présents dans le SQL. Teradata attend des apostrophes autour des chaînes de caractères, il faut donc mettre le code SQL entre guillemets doubles et transformer les guillemets du WHERE en apostrophes. library(pRatihque) # connexion Teradata library(DBI) # dialogue avec une base de données pmsi <- connection_database() dbGetQuery(pmsi, « SELECT SUBSTR(sej.ghm2,1,2) AS cmd, nom.lib AS cmd_lib, COUNT(DISTINCT sej.anonyme) AS nb_patients FROM prd_vue_mco_2024.fixe AS sej LEFT JOIN prd_vue_nompmsi.all_classif_pmsi AS nom ON SUBSTR(sej.ghm2,1,2) […]

On a vu que la fonction ncol comptait les colonnes. En revanche, ici, nrow n’aurait pas fonctionné. library(pRatihque) # connexion Teradata pmsi <- connection_database() ncol(atihble(pmsi, « psy24.fixe »)) Réponse attendue : 45

 Le classeur Excel utilisé pour les exemples est à télécharger ici. library(readxl) library(tidyverse) library(janitor) library(stringr) etab <- read_excel(« liste_finess.xlsx ») etab etab <- read_excel(« liste_finess.xlsx », col_types = c(« Numéro d’établissement »= »text », « Nom »= »text »)) etab etab <- read_excel(« liste_finess.xlsx ») %>% clean_names() etab etab <- read_excel(« liste_finess.xlsx ») %>% clean_names() %>% mutate(num_etab = str_pad(numero_detablissement, pad= »0″, side= »left », width=9)) %>% select(-numero_detablissement) etab right_join(mco24 %>% count(finess), etab, by = join_by(finess == num_etab), copy = TRUE) # lister les feuilles d’un classeur excel_sheets(« liste_finess.xlsx ») # options pour cibler l’import / sauter des lignes vides / […]

        library(tidyr) library(stringr) library(janitor) # pivot_longer mco24 %>% filter( ! str_sub(ghm2, 1, 2) %in% c(« 28″, »90 »)) %>% group_by(mois) %>% summarise(nb_sejours = sum(1), dont_urgences = sum(if_else(is.na(passage_urg), 0, 1, 1))) %>% ungroup() %>% pivot_longer(cols = c(dont_urgences, nb_sejours)) %>% arrange(mois) mco24 %>% filter( ! str_sub(ghm2, 1, 2) %in% c(« 28″, »90 »)) %>% group_by(mois) %>% summarise(nb_sejours = sum(1), dont_urgences = sum(if_else(is.na(passage_urg), 0, 1, 1))) %>% ungroup() %>% pivot_longer(cols = – mois) %>% # les anciens noms sont tronqués par Teradata ! arrange(mois) mco24 %>% […]

        mco24 %>% summarise(age_moyen = mean(age)) mco24 %>% summarise(age_moyen = mean(age, na.rm=TRUE)) mco24 %>% summarize(age_moyen = mean(age, na.rm=TRUE)) mco24 %>% count() mco24 %>% summarise(n = n()) mco24 %>% summarise(n = sum(1)) mco24 %>% summarise(nb_urg = sum(if_else( ! is.na(passage_urg), 1, 0, 0))) mco24 %>% filter( ! is.na(passage_urg) ) %>% count() mco24 %>% summarise(duree_max = max(duree , na.rm=TRUE), entree_plus_ancienne = min(date_entree, na.rm=TRUE), age_moyen = mean(age , na.rm=TRUE), nb_sejours = n(), nb_patients = n_distinct(anonyme), nb_pass_urg = sum(if_else( is.na(passage_urg), 0, 1), […]

        mco24 %>% select(anonyme, finess) %>% count() mco24 %>% select(anonyme, finess) %>% distinct() %>% count() mco24 %>% select(anonyme, finess) %>% distinct() %>% count(finess) %>% arrange(desc(n)) mco24 %>% distinct(anonyme, finess) mco24 %>% distinct(anonyme, finess) %>% count() mco24 %>% distinct(anonyme, finess, .keep_all=TRUE)

        mco_fixe24 % count(finess) full_join(activite23, activite24, by = join_by(finess == finess)) full_join(activite23, activite24, by = join_by(finess == finess), suffix = c(« _2023 », « _2024 »)) # données « locales » (pourrait être le résultat d’un import Excel) library(janitor) library(stringr) etab % mutate(numero_finess = str_pad(numero_finess, width=9, pad= »0″, side= »left »)) # la table « locale » est en 2e position + option COPY=TRUE right_join(mco_fixe %>% count(finess), etab, by = join_by(finess == numero_finess), copy = TRUE) # empilement union_all(atihble(pmsi, « mco_2024.fixe ») %>% count(annee, mois), atihble(pmsi, « mco_2023.fixe ») %>% count(annee, mois)) […]

        # formules conditionnelles mco24 %>% mutate(chirurgie = if_else(str_sub(ghm2,3,3)== »C », « OUI », « NON »)) %>% count(chirurgie) mco24 %>% mutate(prov_smr = if_else(provenance == « 2 », « OUI », « NON »)) %>% count(prov_smr) mco24 %>% mutate(prov_smr = if_else(provenance == « 2 », « OUI », # cas vrai « NON », # cas faux « NON » # cas provenance NA )) %>% count(prov_smr) mco24 %>% mutate(dept = ifelse(finess %LIKE% « 97% », paste(« 97″, str_sub(finess,4,4), sep= » »), str_sub(finess,1,2))) %>% count(dept) %>% arrange(desc(dept)) mco24 %>% mutate(dept = str_sub(finess, 1, 2)) %>% filter(dept %in% c(« 44″, »49″, »53″, »72″, »85 »)) %>% mutate(lib_dept = case_when( […]

        mco24 %>% count(finess) %>% mutate(n = as.numeric(n), pct = n / sum(n) * 100) %>% arrange(desc(n)) mco24 %>% count(finess) %>% mutate(n = as.numeric(n), pct = n / sum(n) * 100) %>% arrange(desc(n)) %>% mutate(cum_pct = cumsum(pct)) # le tri n’est plus pris en compte mco24 %>% count(finess) %>% mutate(n = as.numeric(n), pct = n / sum(n) * 100) %>% window_order(desc(n)) %>% mutate(cum_pct = cumsum(pct)) %>% arrange(desc(n)) # il y a un warning mais il n’est pas […]

Le support est le même qu’à la leçon 14.   # calculs sur les datetimes : en SQL direct atihble(pmsi, « rpu_2024.passage ») %>% filter(date_entree == date_sortie) %>% filter(substr(finess,1,2) == « 17 ») %>% mutate(duree = sql(« heure_sortie – heure_entree MINUTE(4) »)) %>% mutate(duree = as.numeric(duree)) %>% select(starts_with(« heure »), duree) # conversions mco24 %>% count(sexe) %>% collect() mco24 %>% count(sexe) %>% mutate(n = as.numeric(n)) %>% collect() mco24 %>% count(sexe) %>% mutate(n = as.integer(n)) %>% # risque de valeurs > limite (± 2E9) collect() mco24 %>% filter( as.numeric(ano_retour) […]

Le support est le même qu’à la leçon 14.   # mise en tranches mco24 %>% mutate(tranche_age = cut(age, breaks = c(0, 18, 65))) %>% count(tranche_age) mco24 %>% mutate(tranche_age = cut(age, breaks = c(-Inf, 0, 18, 65, Inf))) %>% count(tranche_age) mco24 %>% mutate(tranche_age = cut(age, breaks = c(-Inf, 0, 18, 65, Inf), labels = c(« Moins d’un an », « 1-18 ans », « 19-65 ans », « Plus de 65 ans »))) %>% count(tranche_age) mco24 %>% mutate( tranches_age = cut(age, breaks = c(-Inf, 0, local(seq(4,89, by=5)), Inf)) […]

Le support est le même qu’à la leçon 14.   # dates mco24 %>% mutate(mois_entree = month(date_entree), annee_entree = year (date_entree)) %>% count(annee_entree) mco24 %>% mutate(duree2 = date_sortie – date_entree, ecart_duree = abs(duree2 – duree)) %>% filter(ecart_duree > 0) %>% select(finess, ghm2, contains(« duree »)) %>% arrange(desc(ecart_duree)) mco24 %>% mutate(duree2 = date_sortie – date_entree, ecart_duree = abs(duree2 – duree)) %>% filter(ecart_duree > 0 & str_sub(ghm2, 1, 2) != « 90 ») %>% select(finess, ghm2, contains(« duree »)) %>% arrange(desc(ecart_duree)) mco24 %>% mutate(ds_mois = floor(months_between(date_sortie, date_entree))) %>% […]

        library(stringr) # manipuler des textes library(lubridate) # manipuler des dates # textes mco24 %>% mutate(dept = str_sub(finess, 1, 2)) %>% relocate(dept, .after=finess) fixe % mutate(dept = str_sub(finess, 1, 2)) fixe %>% filter(dept %in% c(« 2A », »2B »)) %>% count(dept) mco24 %>% mutate(dept = str_sub(finess, 1, 2)) %>% filter(dept %in% c(« 2A », »2B »)) %>% count(dept) mco24 %>% mutate(dept = str_sub(finess, 1, 2), cmd = str_sub(ghm2 , 1, 2)) %>% filter( dept %in% c(« 67″, »68 ») & ! cmd %in% c(« 28″, »90 »)) %>% count(dept) mco24 %>% […]

        mco24 %>% select(ident, finess, ghm2, age, sexe, duree, dp) %>% arrange(desc(duree)) mco24 %>% select(ident, finess, ghm2, age, sexe, duree, starts_with(« date »)) %>% arrange(desc(duree)) mco24 %>% select(ends_with(« entree »)) mco24 %>% select(contains(« mo ») ) %>% select(- ends_with(« hemo ») ) # pour éliminer des variables, on ajoute des – devant leurs noms mco24 %>% select( – dr, – seqmco, – ghs) # déplacement de colonnes mco24 %>% select(duree, finess, age, sexe, everything()) mco24 %>% relocate(duree, finess, age, sexe, .before = everything()) mco24 %>% […]

        mco24 %>% filter( age > 90 ) %>% count() mco24 %>% filter( modeentree == « 8 ») %>% count() mco24 %>% count(sexe) mco24 %>% filter( sexe != « X » ) %>% count() library(stringr) mco24 %>% filter( str_to_lower(sexe) != « x » ) %>% count() mco24 %>% filter( str_to_upper(sexe) != « X » ) %>% count() mco24 %>% filter(sexe %in% c(« 1″, »2 ») ) %>% count() # /!\ la valeur NA se teste de manière très spécifique mco24 %>% filter( is.na(provenance) ) %>% count() # combien […]

        mco24 %>% count(provenance) %>% arrange(provenance) mco24 %>% count(provenance) %>% arrange(n) mco24 %>% count(provenance) %>% arrange(desc(n)) mco24 %>% count(mois, finess) %>% arrange(mois, desc(n))

        # packages utiles —- library(dplyr) library(dbplyr) library(DBI) library(pRatihque) # mise en place de la connexion Teradata —- pmsi % count(sexe) mco24 %>% count(provenance) mco24 %>% count(sexe, provenance) mco24 %>% count(provenance, sexe) mco24 %>% count(name= »nb_sejours ») mco24 %>% count(wt=duree) mco24 %>% count(sexe, wt=duree, name= »total_duree_sejours »)

        finess17 % filter(annee == 2024) finess16 % filter(finess %LIKE% « 16% ») %>% filter(annee == 2024) %>% collect() # sauvegarde pérenne saveRDS(finess16, « demo/finess_16_2024.rds ») saveRDS(finess17, « demo/finess_17_2024.rds ») # suppression de l’objet rm(finess16, finess17) gc() # restauration etab_2024_dept_17

        library(dplyr) # requêtes… library(dbplyr) # … traduites en SQL count(etablissements) count(etablissements, t2a) filter(etablissements, mco == 1) count( filter(etablissements, mco == 1), t2a) etablissements %>% count() etablissements %>% count(t2a) etablissements %>% filter(mco == 1) %>% count(t2a) mco24 %>% filter(substr(finess,1,2) == « 17 ») %>% count() %>% arrange(desc(n)) mco24 %>% filter(substr(finess,1,2) == « 17 ») %>% count() %>% arrange(desc(n)) %>% show_query() mco24 %>% filter(sexe not in (‘1′,’2’)) %>% show_query() mco24 %>% filter(sql(« sexe not in (‘1′,’2’) »)) %>% show_query() mco24 %>% filter(sexe %not in% […]

        library(DBI) library(glue) # alternative à base::paste dbGetQuery(pmsi, « SELECT modesortie, COUNT(*) AS nb FROM prd_vue_mco_2024.fixe WHERE substr(ghm2,1,2) NOT IN (’28’,’90’) GROUP BY modesortie ORDER BY nb DESC ») finess17

        library(pRatihque) library(dplyr) pmsi

    # packages utiles —- library(DBI) # package « classique » library(pRatihque) # package pour se connecter à Teradata # connexion —- pmsi

    # données exemple —- mtcars # dans le package {dplyr} library(dplyr) starwars ncol(mtcars) ncol(starwars) nrow(mtcars) nrow(starwars) str(mtcars) str(starwars) voitures

library(openxlsx) library(janitor) evolution <- full_join(mco_fixe24 %>% count(finess), mco_fixe23 %>% count(finess), by = join_by(finess == finess), suffix = c(« _2024″, »_2023″)) %>% collect() write.xlsx(evolution, file= »evol_2023_2024.xlsx ») # attention aux int64 générés par count (ou n, ou n_distinct) evolution <- full_join(mco_fixe24 %>% count(finess), mco_fixe23 %>% count(finess), by = join_by(finess == finess), suffix = c(« _2024″, »_2023″)) %>% mutate(n_2023 = as.numeric(n_2023), n_2024 = as.numeric(n_2024)) %>% collect() write.xlsx(evolution, file= »evol_2023_2024.xlsx ») # options de write.xlsx write.xlsx(evolution, file= »evol_2023_2024.xlsx », asTable = TRUE) write.xlsx(evolution, file= »evol_2023_2024.xlsx », sheetName = « Par établissement », asTable = TRUE, withFilter = […]

        # packages utiles —- library(pRatihque) # connexion Teradata ATIH library(dplyr) # manipulation de données # état des lieux —- sessionInfo()

Pour cette première leçon, uniquement une vidéo pour vérifier ensemble que vous arrivez à vous connecter à la PDH et à ouvrir RStudio.

Ceci est une page de test. Ci-dessous on doit normalement voir un Powerpoint :    Et là une vidéo (sans rapport avec le Powerpoint) :  

# packages utiles —- library(tidyverse) # gestion des données library(openxlsx) # export dans un classeur Excel # fonction de l’exercice 13 : crosstab —- crosstab <- function(df, rows, cols){ library(tidyverse) res <- df %>% group_by({{rows}},{{cols}}) %>% # modification pour compter les établissements summarise(n=n_distinct(FI)) %>% ungroup() %>% pivot_wider(id_cols = {{rows}}, names_from = {{cols}}, values_from = n) return(res) } # préparation du contenu —- tab <- capa %>% crosstab(rows=REG, cols=AN) # mise à jour du modèle Excel —- xl <- loadWorkbook(« c:/olivier/sae/sae_modele.xlsx ») # […]

Mettre à jour le classeur Excel disponible ici avec le nombre d’établissements par région et par année. Modifiez la fonction crosstab de l’exercice 13 pour bien compter une seule fois les établissements. Attention, dans le classeur Excel toutes les années ne sont pas visibles (des colonnes sont masquées) : on a bien toutes les années de 2000 à 2019. Les régions sont affichées dans le tableau dans le même ordre que les valeurs de la variable REG dans les données […]

# packages utiles —- library(tidyverse) # gestion des données library(lubridate) # gestion des dates library(flextable) # mise en forme des tableaux library(officer) # export dans un doc Word set_flextable_defaults(big.mark =  » « ) # fonction de l’exercice 13 : crosstab —- crosstab % summarise(n=n()) %>% ungroup() %>% pivot_wider(id_cols = {{rows}}, names_from = {{cols}}, values_from = n) return(res) } # fonction crosstab avec mise en forme —- tableau % add_header(« DISCIPLINE »= »DISCIPLINE », « 2010 »= »ANNEE », « 2019 »= »ANNEE ») %>% merge_v(part= »header ») %>% merge_h(part= »header ») %>% theme_box() %>% bg(part= »header », bg=gray(0.8)) %>% […]

Mettre à jour le document Word disponible ici avec trois tableaux dérivés de ceux de l’exercice 13 (comparant le nombre d’établissement par discipline en 2010 et 2019), le nombre total d’établissements en 2019 (attention à ne pas compter deux fois le même numéro FINESS) et la date de production de la note. Pour rappel, REG de 1 à 6 = DOM, de 11 à 94 = France métropolitaine.

library(flextable) set_flextable_defaults(big.mark =  » « ) crosstab <- function(df, rows, cols){ library(tidyverse) res <- df %>% group_by({{rows}},{{cols}}) %>% summarise(n=n()) %>% ungroup() %>% pivot_wider(id_cols = {{rows}}, names_from = {{cols}}, values_from = n) return(res) } capa %>% filter(AN %in% c(2010,2019)) %>% crosstab(rows = DISCIPLINE, cols = AN) %>% flextable() %>% add_header(« DISCIPLINE »= »DISCIPLINE », « 2010 »= »ANNEE », « 2019 »= »ANNEE ») %>% merge_v(part= »header ») %>% merge_h(part= »header ») %>% theme_box() %>% bg(part= »header », bg=gray(0.8)) %>% bg(j=1, bg=gray(0.8)) %>% bold(j=1)

Voici la fonction crosstab. crosstab <- function(df, rows, cols){   library(tidyverse)   res <- df %>%            group_by({{rows}},{{cols}}) %>%            summarise(n=n()) %>%            ungroup() %>%            pivot_wider(id_cols = {{rows}},                        names_from = {{cols}},                        values_from = n)   return(res) } A partir du résultat de capa %>% filter(AN %in% c(2010,2019)) %>% crosstab(rows = DISCIPLINE, cols = AN) produire le flextable ci-dessous.  

nmiss

Les descriptifs des fichiers sont ici. Créer une fonction nmiss ayant deux arguments, une table et un nom de variable (entre guillemets). Elle compte le nombre de valeurs manquantes dans cette colonne. Tests : nmiss(capa, « IVG ») # doit répondre 123951

nmiss

Les descriptifs des fichiers sont ici. Créer une fonction nmiss ayant un vecteur pour argument, qui compte les valeurs manquantes dans le vecteur. Tests : nmiss(capa$IVG) # doit répondre 123951

# syntaxe across avec ellipse : l’option est indiquée après la fonction capa %>% group_by(AN) %>% summarise(across(c(LIT, SEJHC, JOU, PLA, IVG), sum, na.rm=TRUE)) %>% ungroup() # syntaxe across sans ellipse, avec une fonction anonyme capa %>% group_by(AN) %>% summarise(across(c(LIT, SEJHC, JOU, PLA, IVG), ~ sum(.x, na.rm=TRUE))) %>% ungroup() # bonus : si on veut plusieurs statistiques en un seul across capa %>% group_by(AN) %>% summarise(across(c(LIT, SEJHC, JOU, PLA, IVG), list(tot = ~ sum(.x, na.rm=TRUE), max = ~ max(.x, na.rm=TRUE)), .names= »{.col}_{.fn} »)) […]

Les descriptifs des fichiers sont ici. A partir des données capa calculez le total des variables LIT, SEJHC, JOU, PLA et IVG par année. Bonus : calculez dans la même requête le maximum de ces mêmes variables, toujours par année.

for (an in unique(capa$AN)){ capa %>% filter(AN == {{an}}) %>% write.table(file=paste0(« c:/temp/SAE_ », an, « .csv »)) }

Exporter dans autant de fichiers CSV à séparateur point-virgule (avec la fonction write.table) les capacités des établissements (données capa) selon l’année. Chaque fichier portera le nom de l’année, par exemple SAE_2010.CSV.

min = {{min}} & LIT % distinct(DEP, FI, RS)

dept <- « 09 » annee <- 2010 capa %>% filter(DEP == {{dept}} & AN == {{annee}}) %>% group_by(DEP, AN, DISCIPLINE) %>% summarise(nb_etab = n_distinct(FI), nb_lits = sum(LIT, na.rm=TRUE)) %>% ungroup()

annees <- 2015:2019 capa %>% filter(AN %in% {{annees}}) %>% group_by(AN) %>% summarise(capacite = sum(LIT, na.rm=TRUE), journees = sum(JOU, na.rm=TRUE)) %>% ungroup()

annee <- 2016 capa %>% filter(AN == {{annee}}) %>% summarise(capacite = sum(LIT, na.rm=TRUE), journees = sum(JOU, na.rm=TRUE))

Les descriptifs des fichiers sont ici. En commençant le code par min <- 500 max <- 800 lister les établissements (département, numéro Finess et raison sociale) présents au moins une fois dans les données capa, ayant un nombre de lits entre ces deux bornes, en psychiatrie. Pour les valeurs ci-dessous il doit y en avoir 38 (mais seulement 22 établissements réellement distincts, l’écart étant dû à des raisons sociales légèrement différentes d’une année sur l’autre).

Les descriptifs des fichiers sont ici. Paramétrer le département en texte (« 06 », « 17 », « 9A », etc.) et l’année sur 4 chiffres. Calculer pour ce département et pour cette année le nombre d’établissements et le nombre de lits par discipline. # exemple de résultat (Département = Ariège 09, année = 2010) # A tibble: 6 × 5 # DEP AN DISCIPLINE nb_etab nb_lits # # 1 09 2010 Chirurgie 3 108 # 2 09 2010 Gynéco-Obstétrique 3 35 # 3 09 2010 […]

Les descriptifs des fichiers sont ici. En commençant le code par annees <- 2015:2019 compter à partir de capa le nombre total de lits (somme de LIT) et de séjours (somme de JOU) pour chaque année demandée. Faire varier les années demandées (avec des syntaxes alternatives comme c, seq, …) pour vérifier que le code est compatible avec toutes. # exemple de résultat # A tibble: 5 × 3 # AN capacite journees # # 1 2015 423309 126779053 # […]

Les descriptifs des fichiers sont ici. En commençant le code par annee <- 2010 compter à partir de capa le nombre total de lits (somme de LIT) et de séjours (somme de JOU) pour cette année. Faire varier l’année (2016, 2019, …). # exemple de résultat pour 2010 # capacite journees # 1 430162 127437247

Les données utilisées ici sont fictives. Les caractéristiques des agents ont été modifiées. Seules les caractéristiques des établissements sont authentiques, même si elles datent un peu…   Le fichier AGENTS.CSV est un descriptif d’agents du Ministère de l’Education Nationale (âge, sexe, ancienneté, …) identifiés par la colonne Clef. Le fichier est à séparateur point-virgule. Il compte 361231 lignes et 7 colonnes. Ces agents exercent dans un établissement dont le numéro identifiant est dans la colonne etab et dont le type […]

  Le modèle de classeur Excel utilisé dans le code est ici. library(openxlsx) # export Excel library(dplyr) # requêtes # classeur créé de zéro —- classeur <- createWorkbook() colnames(tableau) <- c(« Quartier », »Logement entier », « Chambre privatisée », »Chambre partagée ») for (type_loc in colnames(tableau[,-1])){ addWorksheet(classeur, sheet = type_loc) writeDataTable(classeur, type_loc, tableau[,c(« Quartier », type_loc)]) setColWidths(classeur, type_loc, cols=1:2, widths = « auto ») } saveWorkbook(classeur, file= »c:/temp/maisons.xlsx », overwrite = TRUE) openXL(« c:/temp/maisons.xlsx ») # classeur existant modifié —- classeur <- loadWorkbook(« c:/temp/modele_par_quartier.xlsx ») tableau <- tableau %>% mutate(nb_maisons = `Logement entier`+`Chambre privatisée`+`Chambre partagée`) %>% arrange(desc(nb_maisons)) […]

  Le modèle de document Word utilisé dans le code est ici. # packages —- library(officer) # création de doc Word ou PowerPoint library(tidyr) # pivots library(ggplot2) # graphiques # lecture du modèle word <- read_docx(« c:/olivier/airbnb/airbnb.docx ») # sauvegarde du graphique comme image ggsave(« c:/temp/airbnb_graphique1.emf », plot=graphique, width=4, height=4.5) # insertion du nombre d’appartements word %>% body_replace_img_at_bkm(« graphique1 », external_img(« c:/temp/airbnb_graphique1.emf », width=4, height=4.5)) %>% body_replace_flextable_at_bkm(« tableau1″, tableau_fxt) %>% print(target= »c:/temp/airbnb_complete.docx »)

    # packages —- library(officer) # création de doc Word ou PowerPoint library(tidyr) # pivots library(ggplot2) # graphiques # création du document Word vierge word % body_add_par(« Logements Airbnb sur Paris », style= »heading 1″) %>% body_add_par( » « ) %>% body_add_fpar(fpar(« Le tableau ci-dessous résume le nombre de maisons « , « louées par Airbnb à la date du 03/07/2016. »)) %>% body_add_par( » « ) %>% body_add_par( » « ) %>% body_add_par(« Tableau 1 – Capacité d’accueil des maisons selon le quartier et le type de location ») %>% body_add_par( » « ) %>% […]

    library(dplyr) library(ggplot2) prix_aout % filter(substr(date,6,7) == « 08 ») %>% inner_join(flats, by=c(« listing_id »= »id »)) %>% group_by(neighbourhood_cleansed, date) %>% summarise(prix_moyen = mean(price_x, na.rm=TRUE)) %>% ungroup() %>% collect() %>% mutate(date = as.Date(date)) # un graphique obscur… ggplot(prix_aout) + aes(x=date, y=prix_moyen, colour=neighbourhood_cleansed) + geom_line() # en version plus claire ! ggplot(prix_aout) + aes(x=date, y=prix_moyen) + geom_line() + facet_wrap(~neighbourhood_cleansed) # comparer les ordres de grandeur ou les variations ? ggplot(prix_aout) + aes(x=date, y=prix_moyen) + geom_line() + facet_wrap(~neighbourhood_cleansed, scales= »free_y ») # éclater selon 2 variables ggplot(houses) + aes(y=cancellation_policy) […]

    # boxplots de base library(dplyr) library(ggplot2) ggplot(houses) + aes(x=room_type, y=accommodates) + geom_boxplot() # ajout des moyennes ggplot(houses) + aes(x=room_type, y=accommodates) + geom_boxplot() + geom_point(stat= »summary », fun= »mean », color= »red », size=5, shape=24) # ajout des « sérifs » en fin de moustaches ggplot(houses) + aes(x=room_type, y=accommodates) + geom_errorbar(stat= »boxplot », width=0.2) + geom_boxplot() # ajout des données brutes en transparence ggplot(houses) + aes(x=room_type, y=accommodates) + geom_boxplot() + geom_jitter(alpha=0.2)

    # courbe simple library(dplyr) library(ggplot2) prix_aout % filter(room_type == « Entire home/apt » & accommodates == 4) %>% inner_join(calendar %>% filter(substr(date,6,7) == « 08 »), by=c(« id »= »listing_id »)) %>% group_by(date) %>% summarise(prix = mean(price_y, na.rm=TRUE)) %>% ungroup() ggplot(prix_aout) + aes(x=date, y=prix) + geom_line() # comme date est une variable de type texte, les points ne sont pas connectés ggplot(prix_aout) + aes(x=as.Date(date), y=prix) + geom_line() # variante en escalier ggplot(prix_aout) + aes(x=as.Date(date), y=prix) + geom_step() # une ligne de référence ggplot(prix_aout) + aes(x=as.Date(date), y=prix) + […]

    # packages utiles —- library(dplyr) # requêtes sparklyr library(ggplot2) # graphiques library(ggrepel) # complément à {ggplot2} library(ggforce) # complément à {ggplot2} # nuage de points simple houses %>% filter(room_type== »Entire home/apt ») %>% ggplot() + aes(x=accommodates, y=price) + geom_point() # avec une perturbation aléatoire houses %>% filter(room_type== »Entire home/apt ») %>% ggplot() + aes(x=accommodates, y=price) + geom_jitter() # et un lissage houses %>% filter(room_type== »Entire home/apt ») %>% ggplot() + aes(x=accommodates, y=price) + geom_jitter(alpha=0.3) + geom_smooth(method= »lm », se=FALSE) + geom_smooth(method= »loess », se=FALSE, color= »red ») # gradient de […]

    # packages utiles —- library(dplyr) # requêtes sparklyr library(ggplot2) # graphiques library(forcats) # gestion des facteurs # diagrammes en bâtons sur données agrégées —- ## agrégation des données —- agregat1 % group_by(room_type) %>% summarise(nb_logements = n(), prix_moyen = mean(price,na.rm=TRUE), capacite = sum(accommodates,na.rm=TRUE), note_moyenne = mean(review_scores_rating, na.rm=TRUE)) %>% ungroup() agregat2 % group_by(cancellation_policy) %>% summarise(nb_logements = n()) %>% ungroup() agregat3 % group_by(room_type, neighbourhood_cleansed) %>% summarise(nb_logements = n(), prix_moyen = mean(price,na.rm=TRUE), capacite = sum(accommodates,na.rm=TRUE), note_moyenne = mean(review_scores_rating, na.rm=TRUE)) %>% ungroup() ## […]

    # repris du dput (cf. leçon n°10) tableau % library(flextable) library(magrittr) # réglages par défaut pour tous les tableaux set_flextable_defaults(big.mark =  » « , decimal.mark = « , ») # construction du flextable tableau_fxt % add_header_row(top=FALSE, c(« Quartier », rep(« Type de location »,3))) %>% add_header_lines(« Maisons en location sur Paris via Airbnb ») # affichage (fenêtre Viewer) tableau_fxt # fusion des cellules de l’en-tête tableau_fxt % merge_h(part= »header ») %>% merge_v(part= »header ») # affichage (fenêtre Viewer) tableau_fxt # mise en forme tableau_fxt % theme_box() %>% # toutes bordures visibles […]

    # une fonction simple : si c’est pour un calcul ça doit se faire dans R n_unique % summarise(nb_quartiers = n_unique(neighbourhood_cleansed)) # ne fonctionne pas # on ajoute un collect pour revenir dans R (attention aux volumes !) houses %>% collect() %>% summarise(nb_quartiers = n_unique(neighbourhood_cleansed)) # mise en commun d’opérations à réaliser sur plusieurs tables preparation % select(id, neighbourhood_cleansed, price, accommodates, room_type) return(result) } # applications preparation(houses) preparation(flats) # + insérer le nom de la table source dans […]

    # réaliser la même opération sur plusieurs tables for (table in c(« houses », »other », »flats »)){ tmp % filter( ! is.na(price) ) %>% select(id, neighbourhood_cleansed, price, accommodates, room_type) assign(paste(table, »_2″,sep= » »), tmp) } ls() # les objets sont-ils bien créés ? # on peut en regarder un houses_2 # créer une série de colonnes houses2

    # paramètre sur une valeur limite % filter(price < {{limite}}) %>% select(id, price, accommodates) # paramètre sur le nom d’une colonne variable 150) %>% filter(.data[[{{variable}}]] == {{valeur}}) %>% select(id, price, accommodates, {{variable}}) # paramètre sur le nom d’une colonne créée library(dplyr) variable % sdf_nrow() # paramétrage sur le nom de la table source table % filter(price > 100) %>% sdf_nrow() # on relance ensuite en ne changeant que la valeur du paramètre table % filter(price > 100) %>% […]