Commit 83952928 authored by Sébastien Galais's avatar Sébastien Galais

Correct function get_geo_names() and additional_geo_mapping

parent 821bb165
Pipeline #87956 passed with stage
in 11 minutes and 26 seconds
......@@ -216,9 +216,37 @@ rdb_by_api_link <- function(
additional_geo_column <- get_geo_colname(DBlist)
additional_geo_mapping <- get_geo_names(DBlist, additional_geo_column)
# Check coherence
if (is.null(additional_geo_column) | is.null(additional_geo_mapping)) {
additional_geo_column <- additional_geo_mapping <- NULL
}
if (!is.null(additional_geo_column) & !is.null(additional_geo_mapping)) {
if (length(additional_geo_column) != length(additional_geo_mapping)) {
additional_geo_column <- additional_geo_mapping <- NULL
if (
length(additional_geo_column) == 0 |
length(additional_geo_mapping) == 0
) {
additional_geo_column <- additional_geo_mapping <- NULL
} else {
check_agc <- sapply(additional_geo_column, paste0, collapse = "|")
additional_geo_column <- stats::setNames(additional_geo_column, check_agc)
check_agm <- sapply(additional_geo_mapping, function(u) {
u1 <- u$dataset_code[1]
u2 <- colnames(u)[2:3]
u2 <- paste0(u2, collapse = "|")
paste0(u1, "|", u2)
})
additional_geo_mapping <- stats::setNames(additional_geo_mapping, check_agm)
keep <- intersect(check_agc, check_agm)
if (length(keep) == 0) {
additional_geo_column <- additional_geo_mapping <- NULL
} else {
additional_geo_column <- additional_geo_column[sort(keep)]
additional_geo_mapping <- additional_geo_mapping[sort(keep)]
}
}
}
}
}
......
......@@ -585,38 +585,42 @@ get_geo_names <- function(x, colname) {
y <- try(
{
codes <- sapply(colname, `[[`, 1)
codes <- unique(codes)
nm <- sapply(colname, `[[`, 2)
nm <- unique(nm)
expr <- paste0(
"(", paste0(codes, collapse = "|"), ")*",
"\\.dimensions_value[s]*_label[s]*\\.(",
paste0(nm, collapse = "|"),
"){1}\\."
)
elt <- grep(expr, names(unlist(x)), value = TRUE)
for (y in nm) {
elt <- gsub(paste0(y, '\\..*'), y, elt)
}
elt <- unique(elt)
codes <- sapply(colname, `[[`, 1)
DTs <- lapply(seq_along(codes), function(i) {
expr <- paste0(
"(", paste0(codes[i], collapse = "|"), ")*",
"\\.dimensions_value[s]*_label[s]*\\.(",
paste0(nm[i], collapse = "|"),
"){1}\\."
)
lapply(seq_along(elt), function(i) {
z <- elt[i]
elt_ <- gsub('\\.', '"]][["', z)
elt_ <- paste0('[["', elt_, '"]]')
x <- eval(parse(text = paste0("x", elt_)))
suppressWarnings(
setnames(
data.table(X1 = codes[i], X2 = names(x), X3 = unname(unlist(x))),
c("dataset_code", colname[[i]][2:3])
elt <- grep(expr, names(unlist(x)), value = TRUE)
for (y in nm) {
elt <- gsub(paste0(y, '\\..*'), y, elt)
}
elt <- unique(elt)
if (length(elt) > 0) {
elt_ <- gsub('\\.', '"]][["', elt)
elt_ <- paste0('[["', elt_, '"]]')
y <- eval(parse(text = paste0("x", elt_)))
suppressWarnings(
setnames(
data.table(X1 = codes[i], X2 = names(y), X3 = unname(unlist(y))),
c("dataset_code", colname[[i]][2:3])
)[]
)
)
} else {
NULL
}
})
DTs <- Filter(Negate(is.null), DTs)
if (length(DTs) <= 0) {
NULL
} else {
DTs
}
},
silent = TRUE
)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment