Merge pull request #103 from ropensci/nearest_neighbours

fixes #101

.Rbuildignore

@@ -6,7 +6,6 @@ monitoring/
 changelog/
 cran-comments.md
 ^\.travis\.yml$
-^README\.Rmd$
 ^README-.*\.png$
 \.ssh/*
 ^revdep$
@@ -18,6 +17,7 @@ vignettes/references.bib
 ^CODE_OF_CONDUCT\.md$
 ^CRAN-RELEASE$
 ^CONTRIBUTING\.md$
+README.Rmd
 
 paper/
 _pkgdown.yml

.gitignore

@@ -40,7 +40,6 @@ paper/
 *.zip
 *.xls*
 inst/doc
-README\.Rmd
 \.ssh/*
 monitoring/
 changelog/

DESCRIPTION

@@ -1,18 +1,19 @@
 Package: fingertipsR
 Type: Package
-Version: 1.0.7.9000
+Version: 1.0.8
 Title: Fingertips Data for Public Health
 Description: Fingertips (<http://fingertips.phe.org.uk/>) contains data for many indicators of public health in England. The underlying data is now more easily accessible by making use of the API.
 Maintainer: Sebastian Fox <[email protected]>
 Depends: R (>= 3.4.0)
-Authors@R: c(person("Sebastian", "Fox", , "sebastian.fox@phe.gov.uk", c("aut", "cre")),
+Authors@R: c(person("Sebastian", "Fox", , "sebastian.fox@dhsc.gov.uk", c("aut", "cre")),
     person("Julian", "Flowers", , "[email protected]", c("aut","ctb")),
     person("Simon", "Thelwall", , "[email protected]", c("ctb"), 
       comment = c(ORCID = "0000-0002-0434-2724")),
-    person("Duncan", "Gormansway", , "[email protected]", c("ctb")),
+    person("Duncan", "Garmonsway", , "[email protected]", c("ctb")),
     person("Carl", "Ganz", , "[email protected]", c("ctb")),
     person("David", "Whiting", , "[email protected]", c("ctb")),
     person("Luke", "Bradley", , "[email protected]", c("ctb")),
+    person("Samuel", "Cutler", , "[email protected]", c("ctb")),
     person("Crown Copyright 2020", , , , c("cph")))
 URL: https://fingertips.phe.org.uk, 
     https://github.com/ropensci/fingertipsR, 
@@ -34,9 +35,10 @@ Suggests:
     knitr,
     pander,
     rmarkdown,
-    testthat
+    testthat (>= 3.0.0)
 VignetteBuilder: knitr
 License: GPL-3
 Encoding: UTF-8
 LazyData: true
 RoxygenNote: 7.1.2
+Config/testthat/edition: 3

NAMESPACE

@@ -12,6 +12,7 @@ export(indicator_metadata)
 export(indicator_order)
 export(indicators)
 export(indicators_unique)
+export(nearest_neighbour_areatypeids)
 export(nearest_neighbours)
 export(profiles)
 export(select_indicators)

NEWS.md

@@ -1,6 +1,8 @@
-# fingertipsR 1.0.7.9000
+# fingertipsR 1.0.8
 
 * Fixed issue introduced to `fingertips_data()` where `AreaTypeID = "All"`
+* More `AreaTypeID`s available for `nearest_neighbour()`
+* `nearest_neighbour_areatypeids()` added
 
 # fingertipsR 1.0.7
 

R/area_types.R

@@ -192,60 +192,53 @@ indicator_areatypes <- function(IndicatorID, AreaTypeID, path) {
 #' \href{https://www.gov.uk/government/publications/local-authority-interactive-tool-lait}{Children's
 #' services statistical neighbour benchmarking tool}
 #'
-#' @details Use AreaTypeID = 102 for the AreaTypeID related to Children's
-#'   services statistical neighbours
 #' @return A character vector of area codes
 #' @param AreaTypeID AreaTypeID of the nearest neighbours (see
-#'   \code{\link{area_types}}) for IDs. Only returns information on AreaTypeIDs
-#'   101, 102, 201, 202, 152, 153 and 154
-#' @param measure string; when AreaTypeID = 102 measure must be either "CIPFA"
-#'   for CIPFA local authority nearest neighbours or "CSSN" for Children's
-#'   services statistical neighbours
+#'   \code{\link{nearest_neighbour_areatypeids}}) for available IDs
+#' @param measure deprecated. Previously a string; when AreaTypeID = 102 measure
+#'   must be either "CIPFA" for CIPFA local authority nearest neighbours or
+#'   "CSSN" for Children's services statistical neighbours
 #' @inheritParams fingertips_data
 #' @import dplyr
 #' @importFrom utils head
+#' @importFrom rlang .data
 #' @examples
 #' \dontrun{
 #' nearest_neighbours(AreaCode = "E38000002", AreaTypeID = 154)}
 #' @export
 #' @family lookup functions
-#' @seealso \code{\link{indicators}} for indicator lookups,
-#'   \code{\link{profiles}} for profile lookups,
-#'   \code{\link{deprivation_decile}} for deprivation decile lookups,
-#'   \code{\link{area_types}} for area type lookups,
-#'   \code{\link{category_types}} for category type lookups,
-#'   \code{\link{indicators_unique}} for unique indicatorids and their names,
-#'   \code{\link{indicator_areatypes}} for indicators by area types lookups and
-#'   \code{\link{indicator_order}} for the order indicators are presented on the
-#'   Fingertips website within a Domain
-nearest_neighbours <- function(AreaCode, AreaTypeID = 101, measure, path) {
+#' @seealso \code{\link{nearest_neighbour_areatypeids}} for the AreaTypeIDs
+#'   available for this function
+nearest_neighbours <- function(AreaCode, AreaTypeID, measure, path) {
+
         if (missing(path)) path <- fingertips_endpoint()
         fingertips_ensure_api_available(endpoint = path)
-        if (AreaTypeID == 102) {
-                if (missing(measure)) {
-                        stop("If using AreaTypeID = 102, you must specify measure (CIPFA or CSSN)")
-                } else if (!(measure %in% c("CIPFA","CSSN"))) {
-                        stop("Measure must be either CIPFA or CSSN")
-                }
-        }
-        if (missing(measure)) measure <- NA
-        if (AreaTypeID == 101) {
-                val <- 1
-        } else if (AreaTypeID == 102 & measure == "CSSN") {
-                val <- 3
-        } else if (AreaTypeID == 102 & measure == "CIPFA") {
-                val <- 1
-        } else if (AreaTypeID == 152) {
-                val <- 4
-        } else if (AreaTypeID == 154) {
-                val <- 6
-        } else if (AreaTypeID == 202) {
-                val <- 7
-        } else if (AreaTypeID == 201) {
-                val <- 7
+
+        url <- "https://fingertips.phe.org.uk/api/nearest_neighbour_types"
+
+        nn_table <- get_fingertips_api(url) %>%
+                rename(measure = .data$Name)
+
+        df <- nn_table %>%
+                select(.data$NeighbourTypeId, .data$ApplicableAreaTypes) %>%
+                fingertips_deframe() %>%
+                bind_rows(.id = "NeighbourTypeId") %>%
+                mutate(NeighbourTypeId = as.integer(.data$NeighbourTypeId)) %>%
+                left_join(nn_table, by = "NeighbourTypeId") %>%
+                dplyr::select(AreaTypeID = .data$Id,
+                              .data$NeighbourTypeId,
+                              .data$measure)
+
+        val <- if(AreaTypeID %in% df$AreaTypeID) {
+                df$NeighbourTypeId[df$AreaTypeID == AreaTypeID]
         } else {
-                val <- NA
+                stop("AreaTypeID not found. Use function `nearest_neighbour_areatypeids()` to see available AreaTypeIDs.")
+        }
+
+        if (!(missing(measure))) {
+                warning("Measure argument is now deprecated.")
         }
+
         ParentAreaTypeID <- area_types(AreaTypeID = AreaTypeID) %>%
                 pull(.data$ParentAreaTypeID) %>%
                 head(1)
@@ -256,15 +249,19 @@ nearest_neighbours <- function(AreaCode, AreaTypeID = 101, measure, path) {
                                     ParentAreaTypeID)) %>%
                 get_fingertips_api() %>%
                 unlist(use.names = FALSE)
+
         areacheck <- areacheck[grepl("^E", areacheck)]
+
+        # Check if AreaCode in the AreaTypeID
         if (!(AreaCode %in% areacheck)) stop(paste0(AreaCode, " not in AreaTypeID = ", AreaTypeID))
-        if (is.na(val)) stop("AreaTypeID must be one of 101, 102, 201, 202, 152 or 154")
+
         path <- paste0(path,
                        sprintf("areas/by_parent_area_code?area_type_id=%s&parent_area_code=nn-%s-%s",
                                AreaTypeID, val, AreaCode))
         set_config(config(ssl_verifypeer = 0L))
         nearest_neighbours <- path %>%
                 get_fingertips_api()
+
         if (length(nearest_neighbours) != 0) {
                 nearest_neighbours <- nearest_neighbours %>%
                         pull(.data$Code)
@@ -274,7 +271,6 @@ nearest_neighbours <- function(AreaCode, AreaTypeID = 101, measure, path) {
         return(nearest_neighbours)
 }
 
-
 areas_by_profile <- function(AreaTypeID, ProfileID, path) {
         set_config(config(ssl_verifypeer = 0L))
         fingertips_ensure_api_available(endpoint = path)
@@ -314,3 +310,33 @@ areas_by_profile <- function(AreaTypeID, ProfileID, path) {
                 mutate(ParentAreaTypeID = 15)
         return(areas_by_profile)
 }
+
+#' Nearest neighbours area type ids
+#'
+#' Outputs a table of AreaTypeIDs available for the nearest_neighbour function
+#' @return table of AreaTypeIDs
+#' @importFrom rlang .data
+#' @export
+#' @seealso \code{\link{nearest_neighbours}} to access the geogaphy codes of the
+#'   nearest neighbours for a locality
+#' @examples
+#' \dontrun{
+#' nearest_neighbour_areatypeids()}
+nearest_neighbour_areatypeids <- function() {
+
+        url <- "https://fingertips.phe.org.uk/api/nearest_neighbour_types"
+
+        areatypeid_table <- get_fingertips_api(url) %>%
+                rename(measure = .data$Name)
+
+        df <- areatypeid_table %>%
+                select(.data$NeighbourTypeId, .data$ApplicableAreaTypes) %>%
+                fingertips_deframe() %>%
+                bind_rows(.id = "NeighbourTypeId") %>%
+                mutate(NeighbourTypeId = as.integer(.data$NeighbourTypeId)) %>%
+                left_join(areatypeid_table, by = "NeighbourTypeId") %>%
+                dplyr::select(AreaTypeID = .data$Id)
+
+                return(df)
+}
+

R/retrieve_data.R

@@ -1,5 +1,6 @@
 #' @importFrom httr set_config config
 #' @importFrom utils setTxtProgressBar
+#' @import dplyr
 retrieve_indicator <- function(IndicatorIDs, ProfileIDs, ChildAreaTypeIDs, ParentAreaTypeIDs, path) {
         if (missing(ProfileIDs)) {
                 ProfileIDs <- ""

R/utils.R

@@ -58,3 +58,14 @@ fingertips_ensure_api_available <- function(endpoint = fingertips_endpoint()) {
         }
         stop(paste(errtext, collapse='\n  '), call. = FALSE)
 }
+
+#' fingertips_deframe
+#'
+#' @description mimic tibble::deframe() without needing to import the function
+#' @param data list whose first item is a vector of names, and second item is a
+#'   list. Items 1 and 2 must be equal length
+fingertips_deframe <- function(data) {
+        out <- structure(.Data = data[[2]],
+                         .Names = data[[1]])
+        return(out)
+}

README.Rmd

@@ -0,0 +1,93 @@
+---
+output: github_document
+---
+
+<!-- README.md is generated from README.Rmd. Please edit that file -->
+
+```{r, echo = FALSE}
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>",
+  fig.path = "README-"
+)
+```
+
+[![codecov](https://codecov.io/gh/ropensci/fingertipsR/branch/master/graph/badge.svg?token=MpVheRqaRo)](https://codecov.io/gh/ropensci/fingertipsR)
+[![](https://badges.ropensci.org/168_status.svg)](https://github.com/ropensci/software-review/issues/168)
+[![R build status](https://github.com/ropensci/fingertipsR/workflows/R-CMD-check/badge.svg)](https://github.com/ropensci/fingertipsR/actions)
+
+# fingertipsR
+
+This is an R package to interact with Public Health England's [Fingertips](http://fingertips.phe.org.uk/) data tool. Fingertips is a major public repository of population and public health indicators for England. The site presents the information in many ways to improve accessibility for a wide range of audiences ranging from public health professionals and researchers to the general public. The information presented is a mixture of data available from other public sources, and those that are available through user access agreements with other organisations. The source of each indicator presented is available using the `indicator_metadata()` function.
+
+This package can be used to load data from the Fingertips API into R for further use. 
+
+## Installation
+
+### rOpenSci
+
+Get the latest released, stable version from rOpenSci:
+
+```{r CRAN-install, eval=FALSE}
+install.packages("fingertipsR", repos = "https://dev.ropensci.org")
+```
+
+### With remotes
+
+You can install the latest development version from github using [remotes](https://github.com/r-lib/remotes):
+
+```{r gh-installation, eval = FALSE}
+# install.packages("remotes")
+remotes::install_github("rOpenSci/fingertipsR",
+                        build_vignettes = TRUE,
+                        dependencies = "suggests")
+```
+
+
+## Example
+
+This is an example of a workflow for downloading data for the indicator on *Healthy Life Expectancy at Birth* from the *Public Health Outcomes Framework* profile.
+
+The `profiles()` function presents all of the available profiles:
+
+```{r profiles example}
+library(fingertipsR)
+profs <- profiles()
+profs <- profs[grepl("Public Health Outcomes Framework", profs$ProfileName),]
+head(profs)
+```
+
+This table shows that the `ProfileID` for the Public Health Outcomes Framework is 19. This can be used as an input for the `indicators()` function:
+
+```{r indicators example}
+profid <- 19
+inds <- indicators(ProfileID = profid)
+print(inds[grepl("Healthy", inds$IndicatorName), c("IndicatorID", "IndicatorName")])
+```
+
+Healthy Life Expectancy at Birth has the `IndicatorID` equal to 90362.
+
+Finally, the data can be extracted using the `fingertips_data()` function using that `IndicatorID`:
+
+```{r fingertips_data example}
+indid <- 90362
+df <- fingertips_data(IndicatorID = indid, AreaTypeID = 202)
+head(df)
+```
+
+## Use
+
+Please see the vignettes for information on use.
+
+```{r use, eval=FALSE}
+browseVignettes("fingertipsR")
+```
+
+## More information
+
+* Please note that the 'fingertipsR' project is released with a
+[Contributor Code of Conduct](https://github.com/ropensci/fingertipsR/blob/master/CODE_OF_CONDUCT.md).
+By contributing to this project, you agree to abide by its terms.
+* License: [GPL-3](https://opensource.org/licenses/GPL-3.0)
+
+[![ropensci\_footer](https://ropensci.org/public_images/ropensci_footer.png)](https://ropensci.org)

README.md

@@ -1,8 +1,6 @@
 
 <!-- README.md is generated from README.Rmd. Please edit that file -->
 
-[![Build
-Status](https://travis-ci.org/ropensci/fingertipsR.svg)](https://travis-ci.org/ropensci/fingertipsR)
 [![codecov](https://codecov.io/gh/ropensci/fingertipsR/branch/master/graph/badge.svg?token=MpVheRqaRo)](https://codecov.io/gh/ropensci/fingertipsR)
 [![](https://badges.ropensci.org/168_status.svg)](https://github.com/ropensci/software-review/issues/168)
 [![R build