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
#'
#' @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.
#' Available are 'all', 'fr', 'de', 'it', 'en'.
#' If 'all' (default), all languages are returned.
......@@ -13,12 +15,14 @@
#' @return response based on the export format
#' @export
get_codelist <- function(identifier,
server = 'I14Y',
language = "all",
export_format = "SDMX-ML",
version_format = 2.1,
annotations = FALSE) {
api <- api_class(
api_type = "codelist",
server = server,
id = identifier,
language = language,
export_format = export_format,
......@@ -31,6 +35,8 @@ get_codelist <- function(identifier,
#' Get one level of a nomenclature
#'
#' @param identifier nomenclature's identifier
#' @param server server on which to query API
#' Available are 'i14y' and 'abn'.
#' @param filters additionnal filters
#' @param level_number level to export
#' @param language the language of the response data
......@@ -41,6 +47,7 @@ get_codelist <- function(identifier,
#' (Code, Parent and Name in the selected language)
#' @export
get_nomenclature_one_level <- function(identifier,
server = 'I14Y',
filters = list(),
level_number = 1,
language = "all",
......@@ -52,6 +59,7 @@ get_nomenclature_one_level <- function(identifier,
)
api <- api_class(
api_type = "nomenclature_one_level",
server = server,
id = identifier,
language = language,
parameters = parameters,
......@@ -64,6 +72,8 @@ get_nomenclature_one_level <- function(identifier,
#' Get multiple levels of a nomenclature (from `level_from` to `level_to`)
#'
#' @param identifier nomenclature's identifier
#' @param server server on which to query API
#' Available are 'i14y' and 'abn'.
#' @param filters additionnal filters
#' @param level_from the 1st level to include
#' @param level_to the last level to include
......@@ -75,6 +85,7 @@ get_nomenclature_one_level <- function(identifier,
#' from `level_from` to `level_to` codes
#' @export
get_nomenclature_multiple_levels <- function(identifier,
server = 'I14Y',
filters = list(),
level_from = 1,
level_to = 2,
......@@ -89,6 +100,7 @@ get_nomenclature_multiple_levels <- function(identifier,
)
api <- api_class(
api_type = "nomenclature_multiple_levels",
server = server,
id = identifier,
parameters = parameters,
export_format = "CSV"
......
......@@ -2,6 +2,8 @@
#' Api class to make appropriate request based on parameters
#'
#' @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
#' Available are CSV, XLSX, SDMX-ML and JSON
#' @field parameters character. Additional request parameters
......@@ -18,6 +20,7 @@ api_class <- setRefClass(
"Api",
fields = list(
api_type = "character",
server = "character",
export_format = "character",
parameters = "character",
id = "character",
......@@ -27,6 +30,7 @@ api_class <- setRefClass(
),
methods = list(
initialize = function(...,
server = 'I14Y',
export_format = "JSON",
parameters = "",
id = "",
......@@ -34,6 +38,7 @@ api_class <- setRefClass(
version_format = 2.1) {
callSuper(
...,
server = server,
export_format = export_format,
parameters = parameters,
id = id,
......@@ -42,39 +47,41 @@ api_class <- setRefClass(
)
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) {
# Map function names to specific API URL
url_mapping <- list(
"codelist" =
glue::glue("CodeLists/{id}/exports/{export_format}/{version_format}"),
"dcat_data_structure" =
glue::glue("DataStructures/{id}/{language}"),
"nomenclature_one_level" =
glue::glue("Nomenclatures/{id}/levelexport/CSV"),
"nomenclature_multiple_levels" =
glue::glue("Nomenclatures/{id}/multiplelevels/CSV")
)
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
BASE_URL <- "https://www.i14y.admin.ch"
# Root URL constants¨
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) {
}
string
}
......@@ -6,46 +6,57 @@ devtools::install_url("https://renkulab.io/gitlab/dscc/metadata-auto-r-library/-
library("fso.metadata")
# Get a codelist
# In german
codelist <- get_codelist(identifier='CL_NOGA_SECTION', language='de')
head(codelist$label.de)
head(codelist$id)
## Get a codelist
# All languages
codelist <- get_codelist(identifier='CL_NOGA_SECTION')
names(codelist)
head(codelist)
# In french
codelist <- get_codelist(identifier='CL_NOGA_SECTION', language='fr')
names(codelist)
head(codelist$label.fr)
head(codelist$id)
## 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(
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(
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
# French
multi_nomenclature_fr <- get_nomenclature_multiple_levels(
identifier='HCL_CH_ISCO_19_PROF',
level_from=2,
level_from=1,
level_to=5,
language='fr'
)
head(multi_nomenclature_fr, 10)
head(multi_nomenclature_fr, 5)
# German
multi_nomenclature_de <- get_nomenclature_multiple_levels(
identifier='HCL_CH_ISCO_19_PROF',
level_from=1,
level_from=2,
level_to=3,
language='de'
)
head(multi_nomenclature_de, 10)
head(multi_nomenclature_de, 5)
......@@ -5,7 +5,7 @@ install.packages(c(
devtools::install_github("opensdmx/rsdmx")
## Load and test library
# pkgload::load_all('.')
# pkgload::load_all('.', TRUE)
# styler::style_pkg('.')
# devtools::check('.')
# 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