Skip to content

Commit

Permalink
🚀first commit
Browse files Browse the repository at this point in the history
  • Loading branch information
pierucci committed Mar 3, 2016
0 parents commit 25f6859
Show file tree
Hide file tree
Showing 23 changed files with 554 additions and 0 deletions.
2 changes: 2 additions & 0 deletions .Rbuildignore
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
^.*\.Rproj$
^\.Rproj\.user$
4 changes: 4 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
.Rproj.user
.Rhistory
.RData
.Ruserdata
17 changes: 17 additions & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -0,0 +1,17 @@
Package: rgho
Title: Access WHO Global Health Observatory Data From R
Version: 0.0.0.9000
Author: Antoine Filipovic-Pierucci [aut,cre]
Maintainer: Antoine Filipovic-Pierucci <[email protected]>
Description: Access WHO GHO data from R via the Athena web service,
an API providing a simple query interface to the World
Health Organization's data and statistics content.
License: GPL (>= 3)
LazyData: TRUE
Depends: R (>= 3.2.2)
Imports: httr, curl, xml2, memoise, readr, magrittr
Suggests: testthat, knitr, rmarkdown
VignetteBuilder: knitr
RoxygenNote: 5.0.1
URL: https://github.com/pierucci/rgho, https://pierucci.github.io
BugReports: https://github.com/pierucci/rgho/issues
20 changes: 20 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -0,0 +1,20 @@
# Generated by roxygen2: do not edit by hand

export(get_gho_codes)
export(get_gho_data)
export(get_gho_dimensions)
export(seach_codes)
export(search_dimensions)
importFrom(curl,ie_get_proxy_for_url)
importFrom(httr,build_url)
importFrom(httr,content)
importFrom(httr,parse_url)
importFrom(httr,use_proxy)
importFrom(magrittr,"%<>%")
importFrom(magrittr,"%>%")
importFrom(magrittr,"extract2")
importFrom(memoise,memoise)
importFrom(readr,read_csv)
importFrom(xml2,xml_attr)
importFrom(xml2,xml_contents)
importFrom(xml2,xml_find_all)
47 changes: 47 additions & 0 deletions R/build_url.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,47 @@
#' Construct GHO request URL
#'
#' @param base_url Base URL of the API.
#' @param dimension Dimension of interest.
#' @param code A vector of requested codes.
#' @param filter A named list of filtering parameters.
#' @param ... Other optional URL parameters.
#'
#' @return An URL as a string.
#'
#'
build_gho_url_ <- function(base_url = "http://apps.who.int/gho/athena/api/",
dimension = "GHO", code = NULL,
filter = NULL, ...) {

if (is.null(dimension) & ! is.null(code)) {
stop("A 'dimension' is needed to define a 'code'.")
}

url <- httr::parse_url(base_url)

url$path <- paste0(url$path, dimension)

if (! is.null(code)){
url$path <- paste0(
url$path,
"/",
paste(code, collapse = ",")
)
}

if (! is.null(filter)) {
url$query$filter <- names(filter) %>%
paste(unlist(filter), sep = ":") %>%
paste(collapse = ";")
}

if (length(list(...))) {
url$query %<>%
c(Filter(function(x) ! is.null(x), list(...)))
}

httr::build_url(url)
}

#' @rdname build_gho_url_
build_gho_url <- memoise::memoise(build_gho_url_)
30 changes: 30 additions & 0 deletions R/get_codes.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,30 @@
#' Returns GHO Codes for a Given Dimension
#'
#' @param dimension A GHO dimension.
#'
#' @return GHO codes as a character vector, and labels as a \code{label} attribute.
get_gho_codes_ <- function(dimension) {
stopifnot(
dimension %in% get_gho_dimensions()
)

xml_codes <- get_gho(
url = build_gho_url(dimension = dimension)
) %>%
httr::content() %>%
xml2::xml_find_all("//Code")

res <- xml_codes %>%
xml2::xml_attr("Label")

labels <- xml_codes[1] %>%
xml2::xml_find_all("//Code/Display") %>%
xml2::xml_contents() %>%
as.character()

structure(res, labels = labels)
}

#' @rdname get_gho_codes_
#' @export
get_gho_codes <- memoise::memoise(get_gho_codes_)
40 changes: 40 additions & 0 deletions R/get_data.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,40 @@
#' Returns GHO Data
#'
#' Given a dimension and a code, returns the corresponding GHO data.
#'
#' Filtering parameters are given as a named list of the form
#' \code{list(COUNTRY = "FRA", ...)}.
#'
#' Query parameters follow the specification described on the WHO website
#' \url{http://apps.who.int/gho/data/node.resources.api}.
#'
#' @param dimension A GHO dimension.
#' @param code A GHO code.
#' @param filter A named list of filtering parameters (see details).
#' @param ... Additional query parameters (see details).
#'
#' @return A \code{data_frame}.
#'
get_gho_data_ <- function(dimension, code, filter, ...) {

stopifnot(
dimension %in% get_gho_dimensions(),
code %in% get_gho_codes(dimension = dimension)
)

res_data <- get_gho(
url = build_gho_url(
dimension = dimension,
code = code,
format = "csv",
filter = filter,
...
)
) %>%
httr::content(type = "text") %>%
readr::read_csv()
}

#' @rdname get_gho_data_
#' @export
get_gho_data <- memoise::memoize(get_gho_data_)
25 changes: 25 additions & 0 deletions R/get_dimensions.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,25 @@
#' Returns Available GHO Dimensions
#'
#' @return GHO dimensions as a character vector, and labels as a \code{label} attribute.
#'
get_gho_dimensions_ <- function() {
xml_dim <- get_gho(
url = build_gho_url(dimension = NULL)
) %>%
httr::content() %>%
xml2::xml_find_all("//Dimension")

res <- xml_dim %>%
xml2::xml_attr("Label")

labels <- xml_dim %>%
xml2::xml_find_all("//Dimension//Display") %>%
xml2::xml_contents() %>%
as.character()

structure(res, labels = labels)
}

#' @rdname get_gho_dimensions_
#' @export
get_gho_dimensions <- memoise::memoise(get_gho_dimensions_)
25 changes: 25 additions & 0 deletions R/get_gho.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,25 @@
#' GET a GHO URL
#'
#' Given a url, tries to find local proxy settings and GET the content of the GHO page.
#'
#' @param url the url to retrieve, given as a character string.
#'
#' @return The result from \code{httr} GET function.
#'
get_gho_ <- function(url) {
proxy_list <- get_proxy_list(url)

for (i in seq_along(proxy_list)) {
res <- httr::GET(url = url, config = proxy_list[[i]])
if (! httr::http_error(res)) {
break
}
}
if (httr::http_error(res)) {
stop(httr::http_status(res)$message)
}
res
}

#' @rdname get_gho_
get_gho <- memoise::memoise(get_gho_)
21 changes: 21 additions & 0 deletions R/imports.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,21 @@
#' @importFrom httr parse_url
#' @importFrom httr build_url
#' @importFrom httr use_proxy
#' @importFrom httr content
#'
#' @importFrom memoise memoise
#'
#' @importFrom curl ie_get_proxy_for_url
#'
#' @importFrom xml2 xml_find_all
#' @importFrom xml2 xml_attr
#' @importFrom xml2 xml_contents
#' @importFrom xml2 xml_contents
#'
#' @importFrom readr read_csv
#'
#' @importFrom magrittr "%>%"
#' @importFrom magrittr "%<>%"
#' @importFrom magrittr "extract2"
#'
NULL
34 changes: 34 additions & 0 deletions R/proxy.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,34 @@
#' Find Local Proxy Settings
#'
#' Tries to find the local proxy settings to access a given url.
#'
#' @param url The url to access, as a character string.
#'
#' @return A list of proxy.
#'
get_proxy_list <- function(url) {
parse_proxy_string(
curl::ie_get_proxy_for_url(target_url = url)
)
}

#' Parse Proxy IP From a Character String
#'
#' Given character string containig a list of proxy,
#' returns the list in a more computer readable form.
#'
#' @param proxy_string A list of proxy IP as a concatenated string.
#'
#' @return A list of proxy settings.
#'
parse_proxy_string <- function(proxy_string) {
proxy_string %>%
strsplit(";") %>%
extract2(1) %>%
strsplit(":") %>%
lapply(
function(x) {
httr::use_proxy(x[1], as.integer(x[2]))
}
)
}
34 changes: 34 additions & 0 deletions R/search.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,34 @@
#' Search Codes or Dimensions Labels
#'
#' @param x A character string to find in GHO labels.
#' @param dimension A GHO dimension where codes will be searched.
#' @param gho An object from \code{\link{get_gho_dimensions}} or
#' \code{\link{get_gho_codes}}.
#'
#' @return A vector of dimensions or codes whose labels mach the search string.
#' Labels are given as as a \code{label} attribute.
#'
search_gho <- function(gho, x) {
pos <- grep(
tolower(x),
tolower(attr(gho, "label")),
useBytes = TRUE,
fixed = TRUE
)
structure(
gho[pos],
label = attr(gho, "label")[pos]
)
}

#' @rdname search_gho
#' @export
search_dimensions <- function(x) {
search_gho(get_gho_dimensions(), x)
}

#' @rdname search_gho
#' @export
seach_codes <- function(dimension, x) {
search_gho(get_gho_codes(dimension), x)
}
26 changes: 26 additions & 0 deletions README.md
Original file line number Diff line number Diff line change
@@ -0,0 +1,26 @@
# rgho - Access WHO Global Health Observatory Data From R

`rgho` is an `R` package to access WHO GHO data from R via the Athena web service, an API providing a simple query interface to the World Health Organization's data and statistics content.

You can install:

* the latest released version from CRAN with:

```r
install.packages("rgho")
```

* the latest development version from github with:

```r
devtools::install_github("pierucci/rgho")
```

## Main features

* List available dimensions and codes with `get_gho_dimensions()` and `get_gho_codes()`.
* Download data with `get_gho_data()`

## Devs

[Antoine Filipović-Pierucci](https://pierucci.github.io/).
31 changes: 31 additions & 0 deletions man/build_gho_url_.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

21 changes: 21 additions & 0 deletions man/get_gho_.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

0 comments on commit 25f6859

Please sign in to comment.