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

adding doc for website and improving demo with agriculture data

parent 05206233
Pipeline #326981 passed with stage
in 11 seconds
...@@ -13,6 +13,7 @@ Dockerfile ...@@ -13,6 +13,7 @@ Dockerfile
environment.yml environment.yml
example.Rmd example.Rmd
install.R install.R
public/*
requirements.txt requirements.txt
^_pkgdown\.yml$ ^_pkgdown\.yml$
......
data/* filter=lfs diff=lfs merge=lfs -text
...@@ -20,7 +20,7 @@ image_build: ...@@ -20,7 +20,7 @@ image_build:
- image-build - image-build
except: except:
variables: variables:
- $CI_PROJECT_URL == "https://gitlab.com/d6538/fso-metadata-r" - $CI_PROJECT_URL == "https://gitlab.com/DSCC/fso-metadata-r"
pages: pages:
stage: deploy stage: deploy
...@@ -32,4 +32,4 @@ pages: ...@@ -32,4 +32,4 @@ pages:
- public - public
only: only:
variables: variables:
- $CI_PROJECT_URL == "https://gitlab.com/d6538/fso-metadata-r" - $CI_PROJECT_URL == "https://gitlab.com/DSCC/fso-metadata-r"
...@@ -20,5 +20,6 @@ Imports: ...@@ -20,5 +20,6 @@ Imports:
jsonlite, jsonlite,
methods, methods,
rsdmx, rsdmx,
stringr,
testthat testthat
RoxygenNote: 7.1.1 RoxygenNote: 7.1.1
#' 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 #' @param environment environment on which to query API
#' Available are 'i14y' and 'abn'. #' Available are 'PRD', 'ABN', 'TEST', 'QA' and 'DEV'.
#' @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.
...@@ -15,14 +15,14 @@ ...@@ -15,14 +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', environment = "PRD",
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, environment = environment,
id = identifier, id = identifier,
language = language, language = language,
export_format = export_format, export_format = export_format,
...@@ -35,8 +35,8 @@ get_codelist <- function(identifier, ...@@ -35,8 +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 #' @param environment environment on which to query API
#' Available are 'i14y' and 'abn'. #' Available are 'PRD', 'ABN', 'TEST', 'QA' and 'DEV'.
#' @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
...@@ -47,7 +47,7 @@ get_codelist <- function(identifier, ...@@ -47,7 +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', environment = "PRD",
filters = list(), filters = list(),
level_number = 1, level_number = 1,
language = "all", language = "all",
...@@ -59,7 +59,7 @@ get_nomenclature_one_level <- function(identifier, ...@@ -59,7 +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, environment = environment,
id = identifier, id = identifier,
language = language, language = language,
parameters = parameters, parameters = parameters,
...@@ -72,8 +72,8 @@ get_nomenclature_one_level <- function(identifier, ...@@ -72,8 +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 #' @param environment environment on which to query API
#' Available are 'i14y' and 'abn'. #' Available are 'PRD', 'ABN', 'TEST', 'QA' and 'DEV'.
#' @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
...@@ -85,7 +85,7 @@ get_nomenclature_one_level <- function(identifier, ...@@ -85,7 +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', environment = "PRD",
filters = list(), filters = list(),
level_from = 1, level_from = 1,
level_to = 2, level_to = 2,
...@@ -100,7 +100,7 @@ get_nomenclature_multiple_levels <- function(identifier, ...@@ -100,7 +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, environment = environment,
id = identifier, id = identifier,
parameters = parameters, parameters = parameters,
export_format = "CSV" export_format = "CSV"
......
...@@ -2,8 +2,8 @@ ...@@ -2,8 +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 #' @field environment environment on which to query API
#' Available are 'I14Y' and 'ABN' #' Available are 'PRD', 'ABN', 'TEST', 'QA' and 'DEV'.
#' @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
...@@ -20,7 +20,7 @@ api_class <- setRefClass( ...@@ -20,7 +20,7 @@ api_class <- setRefClass(
"Api", "Api",
fields = list( fields = list(
api_type = "character", api_type = "character",
server = "character", environment = "character",
export_format = "character", export_format = "character",
parameters = "character", parameters = "character",
id = "character", id = "character",
...@@ -30,7 +30,7 @@ api_class <- setRefClass( ...@@ -30,7 +30,7 @@ api_class <- setRefClass(
), ),
methods = list( methods = list(
initialize = function(..., initialize = function(...,
server = 'I14Y', environment = "PRD",
export_format = "JSON", export_format = "JSON",
parameters = "", parameters = "",
id = "", id = "",
...@@ -38,7 +38,7 @@ api_class <- setRefClass( ...@@ -38,7 +38,7 @@ api_class <- setRefClass(
version_format = 2.1) { version_format = 2.1) {
callSuper( callSuper(
..., ...,
server = server, environment = environment,
export_format = export_format, export_format = export_format,
parameters = parameters, parameters = parameters,
id = id, id = id,
...@@ -61,11 +61,13 @@ api_class <- setRefClass( ...@@ -61,11 +61,13 @@ api_class <- setRefClass(
}, },
get_response = function() { get_response = function() {
# API call to url # API call to url
url <- glue::glue("{SERVERS[[server]]}/api/{api_url}?{parameters}") url <- glue::glue("{ENVIRONMENTS[[environment]]}/api/{api_url}?{parameters}")
res <- REQUEST_FUNCTION_MAPPING[[export_format]](url) res <- REQUEST_FUNCTION_MAPPING[[export_format]](url)
# If specified language, keep only language specific columns # If specified language, keep only language specific columns
if(language != "all") { res <- remove_other_languages(res, language) } if (language != "all") {
res <- remove_other_languages(res, language)
}
res res
} }
...@@ -83,5 +85,5 @@ remove_other_languages <- function(df, language) { ...@@ -83,5 +85,5 @@ remove_other_languages <- function(df, language) {
to_remove <- glue::glue( to_remove <- glue::glue(
"[.|_]+({paste(LANGUAGES[LANGUAGES != language], collapse = '|')})$" "[.|_]+({paste(LANGUAGES[LANGUAGES != language], collapse = '|')})$"
) )
df[, ! names(df) %in% names(df)[stringr::str_detect(names(df), to_remove)]] df[, !names(df) %in% names(df)[stringr::str_detect(names(df), to_remove)]]
} }
# Root URL constants¨ # Root URL constants
SERVERS <- list( ENVIRONMENTS <- list(
"I14Y" = "https://www.i14y.admin.ch", "PRD" = "https://www.i14y.admin.ch",
"ABN" = "iop-a.app.cfap02.atlantica.admin.ch" "ABN" = "iop-a.app.cfap02.atlantica.admin.ch",
"TEST" = "iop-t.app.cfap02.atlantica.admin.ch",
"QA" = "iop-q.app.cfap02.atlantica.admin.ch",
"DEV" = "iop-d.app.cfap02.atlantica.admin.ch"
) )
LANGUAGES <- c('en', 'de', 'fr', 'it') # Possible languages
LANGUAGES <- c("en", "de", "fr", "it")
...@@ -24,7 +24,7 @@ json_request <- function(url) { ...@@ -24,7 +24,7 @@ json_request <- function(url) {
#' #'
#' @return dataframe response #' @return dataframe response
csv_request <- function(url) { csv_request <- function(url) {
read.csv(url) read.csv(url, encoding = "UTF-8")
} }
# Request function based on expected response # Request function based on expected response
...@@ -55,4 +55,3 @@ list_to_string <- function(filters) { ...@@ -55,4 +55,3 @@ list_to_string <- function(filters) {
} }
string string
} }
...@@ -10,7 +10,8 @@ This public library is made available for the internal FSO staff, the federal ad ...@@ -10,7 +10,8 @@ This public library is made available for the internal FSO staff, the federal ad
You can install the library with You can install the library with
``` ```
devtools::install_url("https://renkulab.io/gitlab/dscc/metadata-auto-r-library/-/archive/v002/metadata-auto-r-library-v002.tar.gz") install.packages("remotes")
remotes::install_gitlab("DSCC/fso-metadata-r")
``` ```
then at the beginning of your R script, you will need to then at the beginning of your R script, you will need to
...@@ -25,11 +26,15 @@ Based on the metadata that you want, you will call certain functions and paramet ...@@ -25,11 +26,15 @@ Based on the metadata that you want, you will call certain functions and paramet
### Codelists ### Codelists
1. Export a codelist based on an identifier 1. Export a codelist based on an identifier
``` ```
codelist <- get_codelist(identifier, export_format, version_format, annotations) codelist <- get_codelist(identifier, environment, language, export_format, version_format, annotations)
``` ```
Parameters: Parameters:
- identifier ("character"): the codelist's identifier - identifier ("character"): the codelist's identifier
- environment ("character", default="PRD" for production)
Available are 'PRD', 'ABN', 'TEST', 'QA' and 'DEV'.
- language ("character", default="all" for all languages, no filtering)
Available are 'all', 'fr', 'de', 'it', 'en'.
- export_format ("character", default="SDMX-ML"): the export's format. - export_format ("character", default="SDMX-ML"): the export's format.
Available are CSV, XLSX, SDMX-ML or SDMX-JSON. Available are CSV, XLSX, SDMX-ML or SDMX-JSON.
- version_format ("numeric", default=2.1): the export format's version - version_format ("numeric", default=2.1): the export format's version
...@@ -45,11 +50,13 @@ codelist <- get_codelist(identifier, export_format, version_format, annotations) ...@@ -45,11 +50,13 @@ codelist <- get_codelist(identifier, export_format, version_format, annotations)
1. Export one level of a nomenclature 1. Export one level of a nomenclature
``` ```
one_level_df <- get_nomenclature_one_level(identifier, level_number, filters, language, annotations) one_level_df <- get_nomenclature_one_level(identifier, environment, level_number, filters, language, annotations)
``` ```
Parameters: Parameters:
- identifier ("character"): nomenclature's identifier - identifier ("character"): nomenclature's identifier
- environment ("character", default="PRD" for production)
Available are 'PRD', 'ABN', 'TEST', 'QA' and 'DEV'.
- level_number ("numeric"): level to export - level_number ("numeric"): level to export
- filter (list): additionnal filters in form of named list - filter (list): additionnal filters in form of named list
- language ("character", default='fr'): response data's language - language ("character", default='fr'): response data's language
...@@ -62,11 +69,13 @@ one_level_df <- get_nomenclature_one_level(identifier, level_number, filters, la ...@@ -62,11 +69,13 @@ one_level_df <- get_nomenclature_one_level(identifier, level_number, filters, la
2. Export multiple levels of a nomenclature (from `level_from` to `level_to`) 2. Export multiple levels of a nomenclature (from `level_from` to `level_to`)
``` ```
multiple_levels_df = get_nomenclature_multiple_levels(identifier, level_from, level_to, filters, language, annotations) multiple_levels_df = get_nomenclature_multiple_levels(identifier, environment, level_from, level_to, filters, language, annotations)
``` ```
Parameters: Parameters:
- identifier ("character"): nomenclature's identifier - identifier ("character"): nomenclature's identifier
- environment ("character", default="PRD" for production)
Available are 'PRD', 'ABN', 'TEST', 'QA' and 'DEV'.
- level_from ("numeric"): the 1st level to include - level_from ("numeric"): the 1st level to include
- level_to ("numeric"): the last level to include - level_to ("numeric"): the last level to include
- filter (list): additionnal filters in form of named list - filter (list): additionnal filters in form of named list
...@@ -103,4 +112,6 @@ All the APIs made available in this library are also documented in Swagger UI sh ...@@ -103,4 +112,6 @@ All the APIs made available in this library are also documented in Swagger UI sh
Examples for each API are provided in the [R Markdown](https://renkulab.io/gitlab/dscc/metadata-auto-r-library/-/blob/master/example.Rmd). Examples for each API are provided in the [R Markdown](https://renkulab.io/gitlab/dscc/metadata-auto-r-library/-/blob/master/example.Rmd).
A documentation page is also available [here](https://d6538.gitlab.io/fso-metadata-r/). Practical [demo](https://renkulab.io/gitlab/dscc/metadata-auto-r-library/-/blob/master/demo.R).
A documentation page is also available [here](https://DSCC.gitlab.io/fso-metadata-r/).
File added
install.packages("remotes")
remotes::install_gitlab("DSCC/fso-metadata-r")
### Preparation ###
devtools::install_url("https://renkulab.io/gitlab/dscc/metadata-auto-r-library/-/archive/v002/metadata-auto-r-library-v002.tar.gz")
library(fso.metadata) library(fso.metadata)
library(ggplot2)
library(tidyverse)
### 1. Get a codelist ### ### 1. Get a codelist ###
# All languages # All languages
codelist <- get_codelist(identifier='CL_NOGA_SECTION') codelist <- get_codelist(identifier = "CL_NOGA_DIVISION")
head(codelist, 3) head(codelist, 3)
### 1. Get a codelist ###
# In french # In french
codelist_fr <- get_codelist(identifier='CL_NOGA_SECTION', language='fr') codelist_fr <- get_codelist(identifier = "CL_NOGA_SECTION", language = "fr")
head(codelist_fr, 3) head(codelist_fr, 3)
# In german
codelist_de <- get_codelist(identifier = "CL_NOGA_SECTION", language = "de")
head(codelist_de, 3)
### 2. Get a nomenclature of one level ###
# All language: Level 1
nomenclature <- get_nomenclature_one_level(
identifier='HCL_CH_ISCO_19_PROF',
level_number=2
)
head(nomenclature, 3)
# French: Level 2 ### 2. Get a nomenclature of multiple levels ###
nomenclature_fr <- get_nomenclature_one_level( # In italian
identifier='HCL_CH_ISCO_19_PROF', multi_nomenclature_it <- get_nomenclature_multiple_levels(
level_number=1, identifier = "HCL_CH_ISCO_19_PROF",
language='fr' level_from = 1,
level_to = 6,
language = "it"
) )
head(nomenclature_fr, 5) head(multi_nomenclature_it, 8)
### 3. Concrete example from Mr. van Nieuwkoop with Noga Data
library(ggplot2)
library(tidyverse)
# Load the production account data for the agriculture divisions
load("data/pk_agr.Rdata")
pk_agr <- rename(pk_agr, Component = Komponent, Year = Jahr)
head(pk_agr)
### 3. Get a nomenclature of multiple levels ### # Load the descriptions of the NOGA divisions
# French noga2 <- as_tibble(
multi_nomenclature_fr <- get_nomenclature_multiple_levels( get_codelist(identifier='CL_NOGA_DIVISION', language='fr')
identifier='HCL_CH_ISCO_19_PROF',
level_from=1,
level_to=6,
language='fr'
) )
head(multi_nomenclature_fr, 10) names(noga2) <- c("id", "label", "name")
head(noga2)
# Join the production account data with the noga2 descriptions
pk <- pk_agr %>%
left_join(noga2, by = c("Code" = "id")) %>%
select(-name) %>%
relocate(label, .after = Code) %>%
rename(Department = label)
head(pk)
# Plot the intermediate consumption (CI), the value added (VA), and the
# production value (VP) for the section A (agriculture)
pk %>%
select(Code, Department, Component, Year, Nominal) %>%
filter(Nominal > 0 & !is.na(Department)) %>%
ggplot(aes(Year, Nominal, color = Component)) +
geom_line() +
ylab("in Mio. CHF") +
facet_wrap(~Department, scales = "free")
### 4. Concrete example from Mr. van Nieuwkoop with Noga Data
load("data/pkagg.Rdata")
head(pk_agg$A88)
noga2 <- as_tibble(get_codelist(identifier='CL_NOGA_DIVISION', language='it'))
names(noga2) <- c('id', 'label', 'name')
head(noga2)
# Get the completely disaggregated production accounts
# and join them with the noga2 descriptions
a88 <- pk_agg$A88 %>%
left_join(noga2, by = c("Code" = "id"))
head(a88) plot_agriculture <- function(pk_agr, language) {
# Load the descriptions of the NOGA divisions
noga2 <- as_tibble(
get_codelist(
identifier='CL_NOGA_DIVISION',
language=language,
environment='ABN') # for the demo, only available within network
)
names(noga2) <- c("id", "label", "name")
# Filter and prepare data # Join the production account data with the noga2 descriptions
a88_filtered <- a88 %>% pk <- pk_agr %>%
select(-Beschreibung, -name) %>% left_join(noga2, by = c("Code" = "id")) %>%
select(-name) %>%
relocate(label, .after = Code) %>% relocate(label, .after = Code) %>%
rename(Department = label, Year = Jahr, Component = Komponent) %>% rename(Department = label)
select(Code, Department, Component, Year, Nominal) %>%
filter( Nominal > 0) %>%
filter(!is.na(Department)) %>% # keep
filter(Code %in% c("01","02", "03")) # keep first 3 department
# Plot the intermediate consumption (CI), the value added (VA), and the # Plot the intermediate consumption (CI), the value added (VA), and the
# production value (VP) for the section A (agriculture) # production value (VP) for the section A (agriculture)
ggplot(a88_filtered, aes(Year, Nominal, color = Component)) + pk %>%
select(Code, Department, Component, Year, Nominal) %>%
filter(Nominal > 0 & !is.na(Department)) %>%
ggplot(aes(Year, Nominal, color = Component)) +
geom_line() + geom_line() +
ylab("in Mio. CHF") + ylab("in Mio. CHF") +
facet_wrap(~Department, scales = "free") facet_wrap(~Department, scales = "free")
}
plot_agriculture(pk_agr, language='fr')
plot_agriculture(pk_agr, language='de')
plot_agriculture(pk_agr, language='it')
plot_agriculture(pk_agr, language='en')
...@@ -14,7 +14,8 @@ knitr::opts_chunk$set(echo = TRUE) ...@@ -14,7 +14,8 @@ knitr::opts_chunk$set(echo = TRUE)
You can install the library with You can install the library with
```{r install} ```{r install}
devtools::install_url("https://renkulab.io/gitlab/dscc/metadata-auto-r-library/-/archive/v002/metadata-auto-r-library-v002.tar.gz") install.packages("remotes")
remotes::install_gitlab("DSCC/fso-metadata-r")
``` ```
then at the beginning of your R script, you will need to then at the beginning of your R script, you will need to
...@@ -43,7 +44,7 @@ my_filters <- list( ...@@ -43,7 +44,7 @@ my_filters <- list(
```{r , echo=FALSE} ```{r , echo=FALSE}
res <- get_nomenclature_one_level(identifier='HCL_CH_ISCO_19_PROF', filters=my_filters, level_number=2, language='fr') res <- get_nomenclature_one_level(identifier='HCL_CH_ISCO_19_PROF', filters=my_filters, level_number=2, language='fr')
names(res) head(res)
``` ```
```{r , echo=FALSE} ```{r , echo=FALSE}
......
...@@ -13,6 +13,9 @@ Api class to make appropriate request based on parameters ...@@ -13,6 +13,9 @@ Api class to make appropriate request based on parameters
\describe{ \describe{
\item{\code{api_type}}{character. The name of the api to call (see url_mapping)} \item{\code{api_type}}{character. The name of the api to call (see url_mapping)}
\item{\code{environment}}{environment on which to query API
Available are 'PRD', 'ABN', 'TEST', 'QA' and 'DEV'.}
\item{\code{export_format}}{character (default = "JSON"). The export's format \item{\code{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}
...@@ -20,8 +23,8 @@ Available are CSV, XLSX, SDMX-ML and JSON} ...@@ -20,8 +23,8 @@ Available are CSV, XLSX, SDMX-ML and JSON}
\item{\code{id}}{character. The identifier or id of the request's object} \item{\code{id}}{character. The identifier or id of the request's object}
\item{\code{language}}{character (default = "en"). Language of the response data. \item{\code{language}}{character (default = "all"). Language of the response data.
Available are 'fr', 'de', 'it', 'en'} Available are 'all', 'fr', 'de', 'it', 'en'}
\item{\code{version_format}}{numeric (default = 2.1). The export format's version