Commit 5ecae477 authored by Pauline Maury Laribière's avatar Pauline Maury Laribière
Browse files

fix bug with language

parent cabda009
Pipeline #325581 passed with stage
in 3 minutes and 54 seconds
#' Get a codelist based on an identifier #' Get a codelist based on an identifier
#' #'
#' @param identifier the codelist's identifier #' @param identifier the codelist's identifier
#' @param server server on which to query API
#' Available are 'i14y' and 'abn'.
#' @param language string for language(s) to return. #' @param language string for language(s) to return.
#' Available are 'all', 'fr', 'de', 'it', 'en'. #' Available are 'all', 'fr', 'de', 'it', 'en'.
#' If 'all' (default), all languages are returned. #' If 'all' (default), all languages are returned.
...@@ -13,12 +15,14 @@ ...@@ -13,12 +15,14 @@
#' @return response based on the export format #' @return response based on the export format
#' @export #' @export
get_codelist <- function(identifier, get_codelist <- function(identifier,
server = 'I14Y',
language = "all", language = "all",
export_format = "SDMX-ML", export_format = "SDMX-ML",
version_format = 2.1, version_format = 2.1,
annotations = FALSE) { annotations = FALSE) {
api <- api_class( api <- api_class(
api_type = "codelist", api_type = "codelist",
server = server,
id = identifier, id = identifier,
language = language, language = language,
export_format = export_format, export_format = export_format,
...@@ -31,6 +35,8 @@ get_codelist <- function(identifier, ...@@ -31,6 +35,8 @@ get_codelist <- function(identifier,
#' Get one level of a nomenclature #' Get one level of a nomenclature
#' #'
#' @param identifier nomenclature's identifier #' @param identifier nomenclature's identifier
#' @param server server on which to query API
#' Available are 'i14y' and 'abn'.
#' @param filters additionnal filters #' @param filters additionnal filters
#' @param level_number level to export #' @param level_number level to export
#' @param language the language of the response data #' @param language the language of the response data
...@@ -41,6 +47,7 @@ get_codelist <- function(identifier, ...@@ -41,6 +47,7 @@ get_codelist <- function(identifier,
#' (Code, Parent and Name in the selected language) #' (Code, Parent and Name in the selected language)
#' @export #' @export
get_nomenclature_one_level <- function(identifier, get_nomenclature_one_level <- function(identifier,
server = 'I14Y',
filters = list(), filters = list(),
level_number = 1, level_number = 1,
language = "all", language = "all",
...@@ -52,6 +59,7 @@ get_nomenclature_one_level <- function(identifier, ...@@ -52,6 +59,7 @@ get_nomenclature_one_level <- function(identifier,
) )
api <- api_class( api <- api_class(
api_type = "nomenclature_one_level", api_type = "nomenclature_one_level",
server = server,
id = identifier, id = identifier,
language = language, language = language,
parameters = parameters, parameters = parameters,
...@@ -64,6 +72,8 @@ get_nomenclature_one_level <- function(identifier, ...@@ -64,6 +72,8 @@ get_nomenclature_one_level <- function(identifier,
#' Get multiple levels of a nomenclature (from `level_from` to `level_to`) #' Get multiple levels of a nomenclature (from `level_from` to `level_to`)
#' #'
#' @param identifier nomenclature's identifier #' @param identifier nomenclature's identifier
#' @param server server on which to query API
#' Available are 'i14y' and 'abn'.
#' @param filters additionnal filters #' @param filters additionnal filters
#' @param level_from the 1st level to include #' @param level_from the 1st level to include
#' @param level_to the last level to include #' @param level_to the last level to include
...@@ -75,6 +85,7 @@ get_nomenclature_one_level <- function(identifier, ...@@ -75,6 +85,7 @@ get_nomenclature_one_level <- function(identifier,
#' from `level_from` to `level_to` codes #' from `level_from` to `level_to` codes
#' @export #' @export
get_nomenclature_multiple_levels <- function(identifier, get_nomenclature_multiple_levels <- function(identifier,
server = 'I14Y',
filters = list(), filters = list(),
level_from = 1, level_from = 1,
level_to = 2, level_to = 2,
...@@ -89,6 +100,7 @@ get_nomenclature_multiple_levels <- function(identifier, ...@@ -89,6 +100,7 @@ get_nomenclature_multiple_levels <- function(identifier,
) )
api <- api_class( api <- api_class(
api_type = "nomenclature_multiple_levels", api_type = "nomenclature_multiple_levels",
server = server,
id = identifier, id = identifier,
parameters = parameters, parameters = parameters,
export_format = "CSV" export_format = "CSV"
......
...@@ -2,6 +2,8 @@ ...@@ -2,6 +2,8 @@
#' Api class to make appropriate request based on parameters #' Api class to make appropriate request based on parameters
#' #'
#' @field api_type character. The name of the api to call (see url_mapping) #' @field api_type character. The name of the api to call (see url_mapping)
#' @field server server on which to query API
#' Available are 'I14Y' and 'ABN'
#' @field export_format character (default = "JSON"). The export's format #' @field export_format character (default = "JSON"). The export's format
#' Available are CSV, XLSX, SDMX-ML and JSON #' Available are CSV, XLSX, SDMX-ML and JSON
#' @field parameters character. Additional request parameters #' @field parameters character. Additional request parameters
...@@ -18,6 +20,7 @@ api_class <- setRefClass( ...@@ -18,6 +20,7 @@ api_class <- setRefClass(
"Api", "Api",
fields = list( fields = list(
api_type = "character", api_type = "character",
server = "character",
export_format = "character", export_format = "character",
parameters = "character", parameters = "character",
id = "character", id = "character",
...@@ -27,6 +30,7 @@ api_class <- setRefClass( ...@@ -27,6 +30,7 @@ api_class <- setRefClass(
), ),
methods = list( methods = list(
initialize = function(..., initialize = function(...,
server = 'I14Y',
export_format = "JSON", export_format = "JSON",
parameters = "", parameters = "",
id = "", id = "",
...@@ -34,6 +38,7 @@ api_class <- setRefClass( ...@@ -34,6 +38,7 @@ api_class <- setRefClass(
version_format = 2.1) { version_format = 2.1) {
callSuper( callSuper(
..., ...,
server = server,
export_format = export_format, export_format = export_format,
parameters = parameters, parameters = parameters,
id = id, id = id,
...@@ -42,39 +47,41 @@ api_class <- setRefClass( ...@@ -42,39 +47,41 @@ api_class <- setRefClass(
) )
get_url(id, export_format, version_format, language) get_url(id, export_format, version_format, language)
}, },
get_response = function() {
# Select type of call to API
request_function <- REQUEST_FUNCTION_MAPPING[[export_format]]
if (parameters == "") {
url <- glue::glue("{BASE_URL}/api/{api_url}")
} else {
url <- glue::glue("{BASE_URL}/api/{api_url}?{parameters}")
}
# API call
res <- request_function(url)
# If specified language, keep only language specific columns
if(language != "all") {
res <- dplyr::select(
res, dplyr::contains(language) | dplyr::matches("id")
)
}
res
},
get_url = function(id, export_format, version_format, language) { get_url = function(id, export_format, version_format, language) {
# Map function names to specific API URL # Map function names to specific API URL
url_mapping <- list( url_mapping <- list(
"codelist" = "codelist" =
glue::glue("CodeLists/{id}/exports/{export_format}/{version_format}"), glue::glue("CodeLists/{id}/exports/{export_format}/{version_format}"),
"dcat_data_structure" =
glue::glue("DataStructures/{id}/{language}"),
"nomenclature_one_level" = "nomenclature_one_level" =
glue::glue("Nomenclatures/{id}/levelexport/CSV"), glue::glue("Nomenclatures/{id}/levelexport/CSV"),
"nomenclature_multiple_levels" = "nomenclature_multiple_levels" =
glue::glue("Nomenclatures/{id}/multiplelevels/CSV") glue::glue("Nomenclatures/{id}/multiplelevels/CSV")
) )
api_url <<- url_mapping[[api_type]] api_url <<- url_mapping[[api_type]]
},
get_response = function() {
# API call to url
url <- glue::glue("{SERVERS[[server]]}/api/{api_url}?{parameters}")
res <- REQUEST_FUNCTION_MAPPING[[export_format]](url)
# If specified language, keep only language specific columns
if(language != "all") { res <- remove_other_languages(res, language) }
res
} }
) )
) )
#' Remove columns that belong to other languages than the selected one
#'
#' @param df data.frame returned from API with columns for all languages
#' @param language language to keep
#'
#' @return dataframe with columns relevant to selected language only
remove_other_languages <- function(df, language) {
to_remove <- glue::glue(
"[.|_]+({paste(LANGUAGES[LANGUAGES != language], collapse = '|')})$"
)
df[, ! names(df) %in% names(df)[stringr::str_detect(names(df), to_remove)]]
}
\ No newline at end of file
# Root URL constants # Root URL constants¨
BASE_URL <- "https://www.i14y.admin.ch" SERVERS <- list(
"I14Y" = "https://www.i14y.admin.ch",
"ABN" = "iop-a.app.cfap02.atlantica.admin.ch"
)
LANGUAGES <- c('en', 'de', 'fr', 'it')
...@@ -55,3 +55,4 @@ list_to_string <- function(filters) { ...@@ -55,3 +55,4 @@ list_to_string <- function(filters) {
} }
string string
} }
...@@ -6,46 +6,57 @@ devtools::install_url("https://renkulab.io/gitlab/dscc/metadata-auto-r-library/- ...@@ -6,46 +6,57 @@ devtools::install_url("https://renkulab.io/gitlab/dscc/metadata-auto-r-library/-
library("fso.metadata") library("fso.metadata")
# Get a codelist ## Get a codelist
# In german # All languages
codelist <- get_codelist(identifier='CL_NOGA_SECTION', language='de') codelist <- get_codelist(identifier='CL_NOGA_SECTION')
head(codelist$label.de) names(codelist)
head(codelist$id) head(codelist)
# In french # In french
codelist <- get_codelist(identifier='CL_NOGA_SECTION', language='fr') codelist <- get_codelist(identifier='CL_NOGA_SECTION', language='fr')
names(codelist)
head(codelist$label.fr) head(codelist$label.fr)
head(codelist$id) head(codelist$id)
## Get a nomenclature of one level ## Get a nomenclature of one level
# French 2 levels # All language: Level 1
nomenclature <- get_nomenclature_one_level(
identifier='HCL_CH_ISCO_19_PROF', level_number=2
)
names(nomenclature)
head(nomenclature, 5)
# French: Level 2
nomenclature_fr <- get_nomenclature_one_level( nomenclature_fr <- get_nomenclature_one_level(
identifier='HCL_CH_ISCO_19_PROF', level_number=2, language='fr' identifier='HCL_CH_ISCO_19_PROF', level_number=1, language='fr'
) )
head(nomenclature_fr, 10) names(nomenclature_fr)
head(nomenclature_fr, 5)
# German 3 levels
nomenclature_de <- get_nomenclature_one_level( nomenclature_de <- get_nomenclature_one_level(
identifier='HCL_CH_ISCO_19_PROF', level_number=3, language='de' identifier='HCL_CH_ISCO_19_PROF', level_number=1, language='de'
) )
head(nomenclature_de, 10) names(nomenclature_de)
head(nomenclature_de, 5)
## Get a nomenclature of multiple levels ## Get a nomenclature of multiple levels
# French # French
multi_nomenclature_fr <- get_nomenclature_multiple_levels( multi_nomenclature_fr <- get_nomenclature_multiple_levels(
identifier='HCL_CH_ISCO_19_PROF', identifier='HCL_CH_ISCO_19_PROF',
level_from=2, level_from=1,
level_to=5, level_to=5,
language='fr' language='fr'
) )
head(multi_nomenclature_fr, 10) head(multi_nomenclature_fr, 5)
# German # German
multi_nomenclature_de <- get_nomenclature_multiple_levels( multi_nomenclature_de <- get_nomenclature_multiple_levels(
identifier='HCL_CH_ISCO_19_PROF', identifier='HCL_CH_ISCO_19_PROF',
level_from=1, level_from=2,
level_to=3, level_to=3,
language='de' language='de'
) )
head(multi_nomenclature_de, 10) head(multi_nomenclature_de, 5)
...@@ -5,7 +5,7 @@ install.packages(c( ...@@ -5,7 +5,7 @@ install.packages(c(
devtools::install_github("opensdmx/rsdmx") devtools::install_github("opensdmx/rsdmx")
## Load and test library ## Load and test library
# pkgload::load_all('.') # pkgload::load_all('.', TRUE)
# styler::style_pkg('.') # styler::style_pkg('.')
# devtools::check('.') # devtools::check('.')
# testthat::test_file("tests/testthat.R") # testthat::test_file("tests/testthat.R")
......
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