5 exploiter le endpoint range pour obtenir facilement les codes et libellés (#6)

*  ajout des fonctions get_range et get_range_geo (travaux Christophe)
* fix version de R à cause du pipe

Author: cbobinec

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: melodi
 Title: Retrieve Data from the Insee Melodi APIs
-Version: 0.2.0
+Version: 0.3.0
 Authors@R: c(
     person("Cédric", "Bobinec", email = "cedric.bobinec@insee.fr", role = c("aut", "cre")),
     person(family = "Institut national de la statistique et des études économiques", role = "cph")
@@ -9,14 +9,16 @@ Description: A wrapper for the Insee Melodi APIs that returns data frames and me
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3
 Language: fr
 Suggests: 
     knitr,
     rmarkdown,
     testthat (>= 3.0.0),
     vcr (>= 0.6.0)
 Config/testthat/edition: 3
+Depends: 
+    R (>= 4.1.0)
 Imports: 
     dplyr,
     tidyr,

NAMESPACE

@@ -8,4 +8,6 @@ export(get_file)
 export(get_local_data)
 export(get_local_data_by_com)
 export(get_metadata)
+export(get_range)
+export(get_range_geo)
 importFrom(magrittr,"%>%")

NEWS.md

@@ -1,3 +1,7 @@
+# melodi 0.3.0
+- #5 : ajout de fonctions permettant de récupérer les libellés des codes associés à un jeu de données : 
+`get_range_geo` (géographie) and `get_range` (toutes les autres dimensions)
+
 # melodi 0.2.0
 - #16 : `get_all_data` : au lieu de construire la requête d'accès et les noms des fichiers dans le zip manuellement, récupération de l'URL via le catalogue (plus fiable et permet de gérer le cas où le CSV du DS est millésimé)
 - #17 : `get_catalog` : ajout des millésimes géo et niveaux géographiques

R/get_range.R

@@ -0,0 +1,82 @@
+#' Get dataset range (codes and labels)
+#'
+#' Retrieves the list of dimensions and all their possible modalities values
+#' (codes and human-readable labels) for a given dataset.
+#' For GEO dimension, it is recommanded to used dedicated function : get_range_geo()
+#'
+#' @param ds_name dataset name
+#' @param base_url_melodi API Melodi URL - default production URL
+#' @param lang french or english labels - default french ("fr")
+#' @param exclusions_list exclude some dimensions for a faster and light result - default : "GEO", "TIME_PERIOD"
+#'
+#' @return A data frame with dimensions and modalities codes and labels
+#' @export
+#'
+#' @examples
+#' get_range("DS_POPULATIONS_REFERENCE")
+#' get_range(ds_name = "DS_EC_DECES", lang = "en")
+get_range <- function(
+    ds_name,
+    base_url_melodi = "https://api.insee.fr/melodi",
+    lang = "fr",
+    exclusions_list = c("GEO")
+) {
+  # check parameters
+  if (!lang %in% c("fr", "en")) {
+    stop("lang must be : fr or en")
+  }
+  url <- paste0(base_url_melodi, "/range/", ds_name)
+
+  message("Request dataset range : ", url)
+
+  dataset <- httr2::request(url) |>
+    httr2::req_perform() |>
+    httr2::resp_body_json(simplifyVector = FALSE)
+
+  range <- dataset[["range"]]
+
+  # Keep or exclude TIME_PERIOD, exlude GEO
+  range <- Filter(function(x) {
+    concept_code <- x[["concept"]][["code"]]
+    !(concept_code %in% exclusions_list)
+  }, range)
+
+  # for null cases (English GEO labels...)
+  safe_extract <- function(x) {
+    if (is.null(x)) NA else x
+  }
+
+  codebook_list <- list()
+
+  for (i in seq_along(range)) {
+    # concepts returned by the API are effectively dimensions of the dataset
+    dimension <- range[[i]][["concept"]][["code"]] |> safe_extract()
+    dimension_label <- range[[i]][["concept"]][["label"]][[lang]] |> safe_extract()
+
+    values <- range[[i]][["values"]]
+
+    for (j in seq_along(values)) {
+      value <- values[[j]][["code"]] |> safe_extract()
+      value_label <- values[[j]][["label"]][[lang]] |> safe_extract()
+
+      entry <- list(
+        DIM = dimension,
+        DIM_LABEL = dimension_label,
+        MOD = value,
+        MOD_LABEL = value_label
+      )
+
+      # Ajouter l'entrée au codebook
+      codebook_list[[length(codebook_list) + 1]] <- entry
+    }
+  }
+
+  codebook_df <- do.call(rbind, lapply(codebook_list, as.data.frame))
+  rownames(codebook_df) <- NULL
+
+  codebook_df <- codebook_df |>
+    dplyr::arrange(dimension, value) # |>
+  # dplyr::add_count(dimension, name = "value_count")
+
+  return(codebook_df)
+}

R/get_range_geo.R

@@ -0,0 +1,86 @@
+#' Get dataset's geography : codes and labels
+#'
+#' Retrieves the list of geo dimensions and all their possible values
+#' (codes and human-readable labels) for a given dataset.
+#'
+#' For other dimensions, refer to get_range()
+#'
+#' @param ds_name dataset name
+#' @param base_url_melodi API Melodi URL - default production URL
+#' @param lang french or english labels - default french ("fr")
+#'
+#' @return A data frame with columns `GEO_REF`, `GEO_OBJECT`, `GEO`, `GEO_LABEL`
+#' @export
+#'
+#' @examples
+#' get_range_geo("DS_POPULATIONS_REFERENCE")
+#' get_range("DS_TICM_PRATIQUES")
+get_range_geo <- function(
+    ds_name,
+    base_url_melodi = "https://api.insee.fr/melodi",
+    lang = "fr"
+) {
+  # check parameters
+  if (!lang %in% c("fr", "en")) {
+    stop("lang must be : fr or en")
+  }
+  url <- paste0(base_url_melodi, "/range/", ds_name)
+
+  message("Request dataset range : ", url)
+
+  dataset <- httr2::request(url) |>
+    httr2::req_perform() |>
+    httr2::resp_body_json(simplifyVector = FALSE)
+
+  range <- dataset[["range"]]
+
+  # Keep GEO only
+  range <- Filter(function(x) {
+    x[["concept"]][["code"]] == "GEO"
+  }, range)
+
+  if (length(range) == 0) {
+    stop("Error: 'GEO' dimension is not present in the dataset.")
+  }
+
+  # for null cases (English GEO labels...)
+  safe_extract <- function(x) {
+    if (is.null(x)) NA else x
+  }
+
+  codebook_list <- list()
+
+  for (i in seq_along(range)) {
+    # concepts returned by the API are effectively dimensions of the dataset
+    dimension <- range[[i]][["concept"]][["code"]] |> safe_extract()
+    dimension_label <- range[[i]][["concept"]][["label"]][[lang]] |> safe_extract()
+
+    values <- range[[i]][["values"]] |> safe_extract()
+
+    for (j in seq_along(values)) {
+      value <- values[[j]][["code"]] |> safe_extract()
+      value_label <- values[[j]][["label"]][[lang]] |> safe_extract()
+      value_id <- values[[j]][["id"]] |> safe_extract()
+
+      # Créer la liste sans geo_object si dimension_geo est FALSE
+      codebook_list[[length(codebook_list) + 1]]  <- list(
+        dimension = dimension,
+        dimension_label = dimension_label,
+        value = value,
+        value_label = value_label,
+        value_id = value_id)
+    }
+  }
+
+  codebook_df <- do.call(rbind, lapply(codebook_list, as.data.frame))
+  rownames(codebook_df) <- NULL
+
+  codebook_df <- codebook_df |>
+    dplyr::arrange(dimension, value) |>
+    tidyr::separate(value_id, into = c("GEO_REF", "GEO_OBJECT", "GEO"), sep = "-") |>
+    dplyr::mutate(GEO_LABEL = value_label) |>
+    dplyr::select(GEO_REF, GEO_OBJECT, GEO, GEO_LABEL) |>
+    dplyr::arrange(GEO_OBJECT, GEO)
+
+  return(codebook_df)
+}

R/globals.R

@@ -9,6 +9,8 @@ globalVariables(
     # get_all_data
     "COD_VAR", "LIB_VAR", "language", "accessURL", "filename",
     # get_data
-    "value", "GEO"
+    "value", "GEO",
+    # get_range_geo
+    "GEO_REF", "GEO_OBJECT", "GEO_LABEL"
   )
 )