Meilleure gestion des facteurs ( encodage + échappement du caractère spécial "...

Meilleure gestion des facteurs ( encodage + échappement du caractère spécial " dans les levels + imports standards en cas d'incompatibilité entre les levels definis et les données en base)

── R CMD check results ───────────── datalibaba 0.0.0.9004 ────
Duration: 3m 52.1s

0 errors  | 0 warnings  | 0 notes 

R CMD check succeeded

DESCRIPTION

 Package: datalibaba
 Title: Interface De Connexion a Une Base Posgres Postgis
-Version: 0.0.0.9003
+Version: 0.0.0.9004
 Authors@R: 
     c(person(given = "Maël",
              family = "Theulière",
@@ -32,14 +32,14 @@ Imports:
     magrittr,
     tibble,
     units,
-    tidyr,
-    gtools
+    tidyr
+Suggests: 
+    knitr,
+    rmarkdown,
+    RPostgres
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-URL: https://dreal-datalab.gitlab.io/datalibaba/index.html, https://gitlab.com/dreal-datalab/datalibaba
-RoxygenNote: 7.1.2
-Suggests: 
-    knitr,
-    rmarkdown
+URL: https://dreal-pdl.gitlab-pages.din.developpement-durable.gouv.fr/csd/datalibaba/index.html, https://gitlab-forge.din.developpement-durable.gouv.fr/dreal-pdl/csd/datalibaba
+RoxygenNote: 7.2.3
 VignetteBuilder: knitr

NAMESPACE

@@ -61,7 +61,6 @@ importFrom(fs,path)
 importFrom(fs,path_expand)
 importFrom(fs,path_home_r)
 importFrom(glue,glue)
-importFrom(gtools,ASCIIfy)
 importFrom(magrittr,"%>%")
 importFrom(odbc,odbc)
 importFrom(purrr,map)

NEWS.md

+# datalibaba 0.0.0.9004
+- Meilleure gestion des facteurs ( encodage + échappement du caractère spécial " dans les levels)
+
 # datalibaba 0.0.0.9003
 - Correction d'un bug dans `poster_data()`, la fonction plantait si les modalités d'un facteur contenaient des caractères spéciaux.
 - Amélioration de la documentation sur la configuration du .Renviron.

R/connect_to_db.R

 #' Connexion au serveur datamart
 #'
 #' @param db la database sur laquelle se connecter
-#' @param user le profil utilisateur avec lequel se connecter : does ou dreal
+#' @param user le profil utilisateur avec lequel se connecter : does ou dreal, suffixe utilise pour les variable d'environnement
 #' @param user_id le nom utilisateur avec lequel se connecter tel que renseigné dans votre renviron
 #' @param user_pwd le mot de passe avec lequel se connecter tel que renseigné dans votre renviron
 #' @param server l'adresse ip du serveur, laisser à NULL pour utiliser le variable d'environnement du .Renviron
-#' @return La fonction créé un connecteur pour se connecter à la base posgresql du serveur via le driver "PostgreSQL".
+#' @return La fonction cree un connecteur pour se connecter à la base posgresql du serveur via le driver DBI "PostgreSQL".
 #' @importFrom DBI dbDriver dbConnect
 #' @importFrom odbc odbc
 #' @importFrom glue glue
@@ -15,10 +15,10 @@
 #' \dontrun{
 #' connect_to_db()
 #' }
-connect_to_db <- function(db="datamart",
-                          user="does",
-                          user_id=paste0("user_",user),
-                          user_pwd = paste0("pwd_",user),
+connect_to_db <- function(db = "datamart",
+                          user = "does",
+                          user_id = paste0("user_", user),
+                          user_pwd = paste0("pwd_", user),
                           server = NULL){
 
   drv <- DBI::dbDriver("PostgreSQL")
@@ -32,6 +32,7 @@ connect_to_db <- function(db="datamart",
                         user=Sys.getenv(user_id),
                         password=Sys.getenv(user_pwd)
                         )
+
   return(con)
 }
 
@@ -70,6 +71,9 @@ connect_to_dbi <- function(db="datamart",
                         .connection_string = ,
                         timeout = 10,
                         encoding = "UTF-8")
-  DBI::dbSendQuery(con,"SET client_encoding TO 'windows-1252'")
+  # if(.Platform$OS.type == "windows") {
+  #   DBI::dbSendQuery(con,"SET client_encoding TO \'windows-1252\'")
+  #   }
+
   return(con)
 }

R/get_data.R

@@ -16,7 +16,7 @@ get_data <- function(con = NULL,
   attempt::stop_if(con, is.null, msg = "con n'est pas renseign\u00e9")
   attempt::stop_if(schema, is.null, msg = "schema n'est pas renseign\u00e9")
   attempt::stop_if(table, is.null, msg = "table n'est pas renseign\u00e9")
-  RPostgreSQL::postgresqlpqExec(con, "SET client_encoding = 'windows-1252'")
+
   data <- DBI::dbReadTable(con, c(schema,table))
   return(data)
 }
@@ -41,7 +41,6 @@ get_data_dbi <- function(con = NULL,
   attempt::stop_if(con, is.null, msg = "con n'est pas renseign\u00e9")
   attempt::stop_if(schema, is.null, msg = "schema n'est pas renseign\u00e9")
   attempt::stop_if(table, is.null, msg = "table n'est pas renseign\u00e9")
-  DBI::dbSendQuery(con,"SET client_encoding TO 'windows-1252'")
   tbl <- DBI::Id(schema = schema, table = table)
   data <- DBI::dbReadTable(con, tbl)
   return(data)
@@ -60,6 +59,7 @@ get_data_dbi <- function(con = NULL,
 #' @importFrom attempt stop_if stop_if_not
 #' @importFrom DBI dbExistsTable dbReadTable dbDisconnect
 #' @importFrom dplyr filter arrange select all_of relocate rename_with
+#' @importFrom glue glue
 #' @importFrom rlang .data
 #' @importFrom rpostgis dbTableInfo
 #' @importFrom sf st_read st_drop_geometry st_geometry
@@ -146,9 +146,14 @@ importer_data <- function(table = NULL, schema = NULL, db  = "public", server =
         ## (add new below) handle factors
         if (att$defs %in% c("factor", "ordered")) {
           levs <- unlist(strsplit(att$atts, "/*/", fixed = TRUE))
-          ordered <- ifelse(att$defs == "ordered", TRUE,
-                            FALSE)
-          data[, i] <- factor(as.character(data[, i]), levels = levs[levs != ""], ordered = ordered)
+          ordered <- ifelse(att$defs == "ordered", TRUE, FALSE)
+          # une précaution pour s'assurer que les levels ne presentent pas d'anomalie d'encodage ou autre par rapport au donnees chargees
+          if(all(data[, i] %in% c(levs, NA, ""))) {
+            data[, i] <- factor(as.character(data[, i]), levels = levs[levs != ""], ordered = ordered)
+          } else {
+            message(glue::glue("Les levels du facteur {{i}} sont incompatibles avec les donnees en base, cette variable est importee avec le type character"))
+          }
+
         }
         ## handle POSIX time zones
         if (att$defs %in% c("POSIXct", "POSIXt")) {
@@ -197,4 +202,8 @@ importer_data <- function(table = NULL, schema = NULL, db  = "public", server =
 
 # ecln_cogifie2 <- importer_data(table = "test_ecln_cog", schema = "public", db = "public", server = "localhost", user = "does")
 # iris2 <- importer_data(table = "test_iris", schema = "public", db = "public", server = "localhost", user = "does") # pk = NULL, post_row_name = TRUE, overwrite = TRUE
+# all(iris == iris2)
 # dep_geo <- importer_data(table = "test_dep", schema = "public", db = "public", server = "localhost", user = "does") # pk = "DEP", post_row_name = FALSE, overwrite = TRUE
+# test_epci <- COGiter::epci %>% dplyr::select(-ends_with("DE_L_EPCI")) %>% dplyr::slice(1:270) %>% dplyr::mutate_if(is.factor, forcats::fct_drop)
+# epci_test <- importer_data(table = "test_epci", schema = "public", db = "datamart", user = "does")
+# all(epci_test == test_epci)

R/post_data.R

@@ -42,7 +42,6 @@ post_data <- function(con,
 #' @param overwrite TRUE si on veut ecraser le fichier deja present.
 #' @importFrom attempt stop_if stop_if_not
 #' @importFrom DBI dbWriteTable Id dbSendQuery
-#' @importFrom gtools ASCIIfy
 #' @importFrom glue glue
 #'
 #' @return NULL, la fonction lance le chargement du dataset present dans l'environnement R et son ecriture sur le serveur
@@ -62,7 +61,6 @@ post_data_dbi <- function(con = NULL,
   attempt::stop_if(table, is.null, msg = "table n\'est pas renseign\u00e9")
   attempt::stop_if_not(schema, ~ .x %in% list_schemas(con), msg = glue::glue("le schema {schema} n\'existe pas"))
   attempt::stop_if(table %in% list_tables(con,schema) & !overwrite, msg = glue::glue("La table {table} existe d\u00e9j\u00e0 sur le schema {schema} et le param\u00e8 tre overwrite est \u00e0 FALSE"))
-  DBI::dbSendQuery(con,"SET client_encoding TO \'windows-1252\'")
   tbl <- DBI::Id(schema = schema, table = table)
   DBI::dbWriteTable(con, tbl,  data, overwrite = overwrite )
   return(invisible(NULL))
@@ -186,11 +184,17 @@ poster_data <- function(data = NULL,
   }
 
   ### Gerer les facteurs
+
+  # precaution d'encodage des variables de type texte ou categorielles---------------
+  d <- dplyr::mutate(d, dplyr::across(tidyselect::vars_select_helpers$where(is.character), enc2utf8),
+                     dplyr::across(tidyselect::vars_select_helpers$where(is.factor), ~ forcats::fct_relabel(.x, enc2utf8)))
+
   fact <- unlist(lapply(d[1, ], function(x) {
     paste0("/*/", paste(attr(x, "levels"), collapse = "/*/"),
            "/*/")
   }))
   fact <- gsub(",", "\\,", fact, fixed = TRUE)
+  fact <- gsub('"', '\\"', fact, fixed = TRUE)
   attr2[!fact == "/*//*/"] <- fact[!fact == "/*//*/"]
   ### fin factor
 
@@ -200,15 +204,12 @@ poster_data <- function(data = NULL,
                  paste(as.character(attr2), collapse = ","), "},{",
                  paste(noms_r, collapse = ","), "}}")
 
-  defs2 <- data.frame(table_nm = table, df_def = gtools::ASCIIfy(defs))
+  defs2 <- data.frame(table_nm = table, df_def = enc2native(defs))
   suppressWarnings(suppressMessages({
     rpostgis::pgInsert(con, c(schema, "zz_r_df_def"), defs2, upsert.using = "table_nm",
                        row.names = FALSE)
   }))
 
-  # precaution d'encodage des variables de type texte ou categorielles---------------
-  d <- dplyr::mutate(d, dplyr::across(tidyselect::vars_select_helpers$where(is.character), enc2utf8),
-                     dplyr::across(tidyselect::vars_select_helpers$where(is.factor), ~ forcats::fct_relabel(.x, enc2utf8)))
 
   # nom des variables de la cle primaire---------
   if(is.null(pk)) {
@@ -282,10 +283,13 @@ poster_data <- function(data = NULL,
 
 }
 
-#
+
 # poster_data(data = ecln_cogifie, table = "test_ecln_cog", schema = "public", db = "public", server = "localhost",
 #             pk = c("TypeZone", "CodeZone", "date"), post_row_name = FALSE, overwrite = TRUE, user = "does")
 # poster_data(data = iris, table = "test_iris", schema = "public", db = "public", server = "localhost",
 #             pk = NULL, post_row_name = TRUE, overwrite = TRUE, user = "does")
 # poster_data(data = COGiter::departements_geo, table = "test_dep", schema = "public", db = "public", server = "localhost",
 #             pk = "DEP", post_row_name = FALSE, overwrite = TRUE, user = "does")
+# poster_data(data = COGiter::epci %>% dplyr::select(-ends_with("DE_L_EPCI")) %>% dplyr::slice(1:270) %>% dplyr::mutate_if(is.factor, forcats::fct_drop),
+#             table = "test_epci", schema = "public",
+#             db = "datamart", pk = "EPCI", post_row_name = FALSE, overwrite = TRUE, user = "does")

man/connect_to_db.Rd

@@ -15,7 +15,7 @@ connect_to_db(
 \arguments{
 \item{db}{la database sur laquelle se connecter}
 
-\item{user}{le profil utilisateur avec lequel se connecter : does ou dreal}
+\item{user}{le profil utilisateur avec lequel se connecter : does ou dreal, suffixe utilise pour les variable d'environnement}
 
 \item{user_id}{le nom utilisateur avec lequel se connecter tel que renseigné dans votre renviron}
 
@@ -24,7 +24,7 @@ connect_to_db(
 \item{server}{l'adresse ip du serveur, laisser à NULL pour utiliser le variable d'environnement du .Renviron}
 }
 \value{
-La fonction créé un connecteur pour se connecter à la base posgresql du serveur via le driver "PostgreSQL".
+La fonction cree un connecteur pour se connecter à la base posgresql du serveur via le driver DBI "PostgreSQL".
 }
 \description{
 Connexion au serveur datamart