Skip to content
Snippets Groups Projects
Commit 3108b45c authored by Juliette Engelaere-Lefebvre's avatar Juliette Engelaere-Lefebvre
Browse files

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 :heavy_check_mark: | 0 warnings :heavy_check_mark: | 0 notes :heavy_check_mark:

R CMD check succeeded
parent a95cbc90
No related branches found
No related tags found
1 merge request!2Resolve "Mieux gérer les facteurs"
Pipeline #103894 passed
Package: datalibaba Package: datalibaba
Title: Interface De Connexion a Une Base Posgres Postgis Title: Interface De Connexion a Une Base Posgres Postgis
Version: 0.0.0.9003 Version: 0.0.0.9004
Authors@R: Authors@R:
c(person(given = "Maël", c(person(given = "Maël",
family = "Theulière", family = "Theulière",
...@@ -32,14 +32,14 @@ Imports: ...@@ -32,14 +32,14 @@ Imports:
magrittr, magrittr,
tibble, tibble,
units, units,
tidyr, tidyr
gtools Suggests:
knitr,
rmarkdown,
RPostgres
Encoding: UTF-8 Encoding: UTF-8
LazyData: true LazyData: true
Roxygen: list(markdown = TRUE) Roxygen: list(markdown = TRUE)
URL: https://dreal-datalab.gitlab.io/datalibaba/index.html, https://gitlab.com/dreal-datalab/datalibaba 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.1.2 RoxygenNote: 7.2.3
Suggests:
knitr,
rmarkdown
VignetteBuilder: knitr VignetteBuilder: knitr
...@@ -61,7 +61,6 @@ importFrom(fs,path) ...@@ -61,7 +61,6 @@ importFrom(fs,path)
importFrom(fs,path_expand) importFrom(fs,path_expand)
importFrom(fs,path_home_r) importFrom(fs,path_home_r)
importFrom(glue,glue) importFrom(glue,glue)
importFrom(gtools,ASCIIfy)
importFrom(magrittr,"%>%") importFrom(magrittr,"%>%")
importFrom(odbc,odbc) importFrom(odbc,odbc)
importFrom(purrr,map) importFrom(purrr,map)
......
# datalibaba 0.0.0.9004
- Meilleure gestion des facteurs ( encodage + échappement du caractère spécial " dans les levels)
# datalibaba 0.0.0.9003 # 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. - 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. - Amélioration de la documentation sur la configuration du .Renviron.
......
#' Connexion au serveur datamart #' Connexion au serveur datamart
#' #'
#' @param db la database sur laquelle se connecter #' @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_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 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 #' @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 DBI dbDriver dbConnect
#' @importFrom odbc odbc #' @importFrom odbc odbc
#' @importFrom glue glue #' @importFrom glue glue
...@@ -15,10 +15,10 @@ ...@@ -15,10 +15,10 @@
#' \dontrun{ #' \dontrun{
#' connect_to_db() #' connect_to_db()
#' } #' }
connect_to_db <- function(db="datamart", connect_to_db <- function(db = "datamart",
user="does", user = "does",
user_id=paste0("user_",user), user_id = paste0("user_", user),
user_pwd = paste0("pwd_",user), user_pwd = paste0("pwd_", user),
server = NULL){ server = NULL){
drv <- DBI::dbDriver("PostgreSQL") drv <- DBI::dbDriver("PostgreSQL")
...@@ -32,6 +32,7 @@ connect_to_db <- function(db="datamart", ...@@ -32,6 +32,7 @@ connect_to_db <- function(db="datamart",
user=Sys.getenv(user_id), user=Sys.getenv(user_id),
password=Sys.getenv(user_pwd) password=Sys.getenv(user_pwd)
) )
return(con) return(con)
} }
...@@ -70,6 +71,9 @@ connect_to_dbi <- function(db="datamart", ...@@ -70,6 +71,9 @@ connect_to_dbi <- function(db="datamart",
.connection_string = , .connection_string = ,
timeout = 10, timeout = 10,
encoding = "UTF-8") 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) return(con)
} }
...@@ -16,7 +16,7 @@ get_data <- function(con = NULL, ...@@ -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(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(schema, is.null, msg = "schema n'est pas renseign\u00e9")
attempt::stop_if(table, is.null, msg = "table 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)) data <- DBI::dbReadTable(con, c(schema,table))
return(data) return(data)
} }
...@@ -41,7 +41,6 @@ get_data_dbi <- function(con = NULL, ...@@ -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(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(schema, is.null, msg = "schema n'est pas renseign\u00e9")
attempt::stop_if(table, is.null, msg = "table 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) tbl <- DBI::Id(schema = schema, table = table)
data <- DBI::dbReadTable(con, tbl) data <- DBI::dbReadTable(con, tbl)
return(data) return(data)
...@@ -60,6 +59,7 @@ get_data_dbi <- function(con = NULL, ...@@ -60,6 +59,7 @@ get_data_dbi <- function(con = NULL,
#' @importFrom attempt stop_if stop_if_not #' @importFrom attempt stop_if stop_if_not
#' @importFrom DBI dbExistsTable dbReadTable dbDisconnect #' @importFrom DBI dbExistsTable dbReadTable dbDisconnect
#' @importFrom dplyr filter arrange select all_of relocate rename_with #' @importFrom dplyr filter arrange select all_of relocate rename_with
#' @importFrom glue glue
#' @importFrom rlang .data #' @importFrom rlang .data
#' @importFrom rpostgis dbTableInfo #' @importFrom rpostgis dbTableInfo
#' @importFrom sf st_read st_drop_geometry st_geometry #' @importFrom sf st_read st_drop_geometry st_geometry
...@@ -146,9 +146,14 @@ importer_data <- function(table = NULL, schema = NULL, db = "public", server = ...@@ -146,9 +146,14 @@ importer_data <- function(table = NULL, schema = NULL, db = "public", server =
## (add new below) handle factors ## (add new below) handle factors
if (att$defs %in% c("factor", "ordered")) { if (att$defs %in% c("factor", "ordered")) {
levs <- unlist(strsplit(att$atts, "/*/", fixed = TRUE)) levs <- unlist(strsplit(att$atts, "/*/", fixed = TRUE))
ordered <- ifelse(att$defs == "ordered", TRUE, ordered <- ifelse(att$defs == "ordered", TRUE, FALSE)
FALSE) # une précaution pour s'assurer que les levels ne presentent pas d'anomalie d'encodage ou autre par rapport au donnees chargees
data[, i] <- factor(as.character(data[, i]), levels = levs[levs != ""], ordered = ordered) 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 ## handle POSIX time zones
if (att$defs %in% c("POSIXct", "POSIXt")) { if (att$defs %in% c("POSIXct", "POSIXt")) {
...@@ -197,4 +202,8 @@ importer_data <- function(table = NULL, schema = NULL, db = "public", server = ...@@ -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") # 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 # 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 # 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)
...@@ -42,7 +42,6 @@ post_data <- function(con, ...@@ -42,7 +42,6 @@ post_data <- function(con,
#' @param overwrite TRUE si on veut ecraser le fichier deja present. #' @param overwrite TRUE si on veut ecraser le fichier deja present.
#' @importFrom attempt stop_if stop_if_not #' @importFrom attempt stop_if stop_if_not
#' @importFrom DBI dbWriteTable Id dbSendQuery #' @importFrom DBI dbWriteTable Id dbSendQuery
#' @importFrom gtools ASCIIfy
#' @importFrom glue glue #' @importFrom glue glue
#' #'
#' @return NULL, la fonction lance le chargement du dataset present dans l'environnement R et son ecriture sur le serveur #' @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, ...@@ -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(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_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")) 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) tbl <- DBI::Id(schema = schema, table = table)
DBI::dbWriteTable(con, tbl, data, overwrite = overwrite ) DBI::dbWriteTable(con, tbl, data, overwrite = overwrite )
return(invisible(NULL)) return(invisible(NULL))
...@@ -186,11 +184,17 @@ poster_data <- function(data = NULL, ...@@ -186,11 +184,17 @@ poster_data <- function(data = NULL,
} }
### Gerer les facteurs ### 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) { fact <- unlist(lapply(d[1, ], function(x) {
paste0("/*/", paste(attr(x, "levels"), collapse = "/*/"), paste0("/*/", paste(attr(x, "levels"), collapse = "/*/"),
"/*/") "/*/")
})) }))
fact <- gsub(",", "\\,", fact, fixed = TRUE) fact <- gsub(",", "\\,", fact, fixed = TRUE)
fact <- gsub('"', '\\"', fact, fixed = TRUE)
attr2[!fact == "/*//*/"] <- fact[!fact == "/*//*/"] attr2[!fact == "/*//*/"] <- fact[!fact == "/*//*/"]
### fin factor ### fin factor
...@@ -200,15 +204,12 @@ poster_data <- function(data = NULL, ...@@ -200,15 +204,12 @@ poster_data <- function(data = NULL,
paste(as.character(attr2), collapse = ","), "},{", paste(as.character(attr2), collapse = ","), "},{",
paste(noms_r, 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({ suppressWarnings(suppressMessages({
rpostgis::pgInsert(con, c(schema, "zz_r_df_def"), defs2, upsert.using = "table_nm", rpostgis::pgInsert(con, c(schema, "zz_r_df_def"), defs2, upsert.using = "table_nm",
row.names = FALSE) 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--------- # nom des variables de la cle primaire---------
if(is.null(pk)) { if(is.null(pk)) {
...@@ -282,10 +283,13 @@ poster_data <- function(data = NULL, ...@@ -282,10 +283,13 @@ poster_data <- function(data = NULL,
} }
#
# poster_data(data = ecln_cogifie, table = "test_ecln_cog", schema = "public", db = "public", server = "localhost", # 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") # 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", # poster_data(data = iris, table = "test_iris", schema = "public", db = "public", server = "localhost",
# pk = NULL, post_row_name = TRUE, overwrite = TRUE, user = "does") # 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", # 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") # 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")
...@@ -15,7 +15,7 @@ connect_to_db( ...@@ -15,7 +15,7 @@ connect_to_db(
\arguments{ \arguments{
\item{db}{la database sur laquelle se connecter} \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} \item{user_id}{le nom utilisateur avec lequel se connecter tel que renseigné dans votre renviron}
...@@ -24,7 +24,7 @@ connect_to_db( ...@@ -24,7 +24,7 @@ connect_to_db(
\item{server}{l'adresse ip du serveur, laisser à NULL pour utiliser le variable d'environnement du .Renviron} \item{server}{l'adresse ip du serveur, laisser à NULL pour utiliser le variable d'environnement du .Renviron}
} }
\value{ \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{ \description{
Connexion au serveur datamart Connexion au serveur datamart
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment