From dfc1eabc7ce713053eba42c6be97aba822129061 Mon Sep 17 00:00:00 2001 From: Sebastian Fox Date: Wed, 11 May 2022 13:47:02 +0100 Subject: [PATCH 1/3] indicator_update_information() added --- DESCRIPTION | 2 +- NAMESPACE | 1 + NEWS.md | 3 +- R/indicator_metadata.R | 277 +++++++++++++++++----------- fingertipsR.Rproj | 2 +- man/indicator_update_information.Rd | 28 +++ tests/testthat/test-metadata.R | 75 +++++--- 7 files changed, 255 insertions(+), 133 deletions(-) create mode 100644 man/indicator_update_information.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 4ceee1e..bf824d1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: fingertipsR Type: Package -Version: 1.0.8.9000 +Version: 1.0.8.9001 Title: Fingertips Data for Public Health Description: Fingertips () 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 diff --git a/NAMESPACE b/NAMESPACE index 80422f3..78394b4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,7 @@ export(fingertips_stats) export(indicator_areatypes) export(indicator_metadata) export(indicator_order) +export(indicator_update_information) export(indicators) export(indicators_unique) export(nearest_neighbour_areatypeids) diff --git a/NEWS.md b/NEWS.md index b95128d..0e2edfb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,8 @@ -# fingertipsR 1.0.8.9000 +# fingertipsR 1.0.8.9001 * Bug fixes for indicators() function where many groups exist * Fixed bug around class of the new `Time period range` field; now ensured to be a character field +* included indicator_update_information() to provide users with details of when the indicator was last updated (available from 7th June 2022) # fingertipsR 1.0.8 diff --git a/R/indicator_metadata.R b/R/indicator_metadata.R index 9925513..63941f0 100644 --- a/R/indicator_metadata.R +++ b/R/indicator_metadata.R @@ -39,115 +39,178 @@ indicator_metadata <- function(IndicatorID = NULL, DomainID = NULL, ProfileID = NULL, path) { - set_config(config(ssl_verifypeer = 0L)) - types <- cols(`Indicator ID` = "i", - Indicator = "c", - `Definition` = "c", - `Rationale` = "c", - `Data source` = "c", - `Indicator source` = "c", - `Methodology` = "c", - `Standard population/values` = "c", - `Confidence interval details` = "c", - `Source of numerator` = "c", - `Definition of numerator` = "c", - `Source of denominator` = "c", - `Definition of denominator` = "c", - `Disclosure control` = "c", - `Caveats` = "c", - `Copyright` = "c", - `Data re-use` = "c", - `Links` = "c", - `Indicator number` = "c", - `Notes` = "c", - `Frequency` = "c", - `Rounding` = "c", - `Indicator Content` = "c", - `Specific rationale` = "c", - `Unit` = "c", - `Value type` = "c", - `Year type` = "c", - `Polarity` = "c", - `Impact of COVID-19` = "c") + set_config(config(ssl_verifypeer = 0L)) + types <- cols(`Indicator ID` = "i", + Indicator = "c", + `Definition` = "c", + `Rationale` = "c", + `Data source` = "c", + `Indicator source` = "c", + `Methodology` = "c", + `Standard population/values` = "c", + `Confidence interval details` = "c", + `Source of numerator` = "c", + `Definition of numerator` = "c", + `Source of denominator` = "c", + `Definition of denominator` = "c", + `Disclosure control` = "c", + `Caveats` = "c", + `Copyright` = "c", + `Data re-use` = "c", + `Links` = "c", + `Indicator number` = "c", + `Notes` = "c", + `Frequency` = "c", + `Rounding` = "c", + `Indicator Content` = "c", + `Specific rationale` = "c", + `Unit` = "c", + `Value type` = "c", + `Year type` = "c", + `Polarity` = "c", + `Impact of COVID-19` = "c") - if (missing(path)) path <- fingertips_endpoint() - set_config(config(ssl_verifypeer = 0L)) - fingertips_ensure_api_available(endpoint = path) - if (!(is.null(IndicatorID))) { - AllIndicators <- indicators(path = path) + if (missing(path)) path <- fingertips_endpoint() + set_config(config(ssl_verifypeer = 0L)) + fingertips_ensure_api_available(endpoint = path) + if (!(is.null(IndicatorID))) { + AllIndicators <- indicators(path = path) - if (identical(IndicatorID, "All")) { - dataurl <- paste0(path, "indicator_metadata/csv/all") - indicator_metadata <- dataurl %>% - GET(use_proxy(ie_get_proxy_for_url(), - username = "", - password = "", - auth = "ntlm")) %>% - content("parsed", - type = "text/csv", - encoding = "UTF-8", - col_types = types) + if (identical(IndicatorID, "All")) { + dataurl <- paste0(path, "indicator_metadata/csv/all") + indicator_metadata <- dataurl %>% + GET(use_proxy(ie_get_proxy_for_url(), + username = "", + password = "", + auth = "ntlm")) %>% + content("parsed", + type = "text/csv", + encoding = "UTF-8", + col_types = types) - } else if (sum(AllIndicators$IndicatorID %in% IndicatorID) == 0) { - stop("IndicatorID(s) do not exist, use indicators() to identify existing indicators") - } else { - path <- paste0(path, "indicator_metadata/csv/by_indicator_id?indicator_ids=") - dataurl <- paste0(path, - paste(IndicatorID, collapse = "%2C")) - if (!(is.null(ProfileID)) & length(ProfileID == 1)) - dataurl <- paste0(dataurl, "&profile_id=", ProfileID) - indicator_metadata <- dataurl %>% - GET(use_proxy(ie_get_proxy_for_url(), - username = "", - password = "", - auth = "ntlm")) %>% - content("parsed", - type = "text/csv", - encoding = "UTF-8", - col_types = types) - } + } else if (sum(AllIndicators$IndicatorID %in% IndicatorID) == 0) { + stop("IndicatorID(s) do not exist, use indicators() to identify existing indicators") + } else { + path <- paste0(path, "indicator_metadata/csv/by_indicator_id?indicator_ids=") + dataurl <- paste0(path, + paste(IndicatorID, collapse = "%2C")) + if (!(is.null(ProfileID)) & length(ProfileID == 1)) + dataurl <- paste0(dataurl, "&profile_id=", ProfileID) + indicator_metadata <- dataurl %>% + GET(use_proxy(ie_get_proxy_for_url(), + username = "", + password = "", + auth = "ntlm")) %>% + content("parsed", + type = "text/csv", + encoding = "UTF-8", + col_types = types) + } - } else if (!(is.null(DomainID))) { - AllProfiles <- profiles(path = path) - if (sum(AllProfiles$DomainID %in% DomainID) == 0){ - stop("DomainID(s) do not exist, use profiles() to identify existing domains") - } - path <- paste0(path, "indicator_metadata/csv/by_group_id?group_id=") - indicator_metadata <- paste0(path, DomainID) %>% - lapply(function(dataurl) { - dataurl %>% - GET(use_proxy(ie_get_proxy_for_url(), - username = "", - password = "", - auth = "ntlm")) %>% - content("parsed", - type = "text/csv", - encoding = "UTF-8", - col_types = types) - }) %>% - bind_rows() - } else if (!(is.null(ProfileID))) { - AllProfiles <- profiles(path = path) - if (sum(AllProfiles$ProfileID %in% ProfileID) == 0){ - stop("ProfileID(s) do not exist, use profiles() to identify existing profiles") - } - path <- paste0(path, "indicator_metadata/csv/by_profile_id?profile_id=") - indicator_metadata <- paste0(path, ProfileID) %>% - lapply(function(dataurl) { - dataurl %>% - GET(use_proxy(ie_get_proxy_for_url(), - username = "", - password = "", - auth = "ntlm")) %>% - content("parsed", - type = "text/csv", - encoding = "UTF-8", - col_types = types) - }) %>% - bind_rows() - } else { - stop("One of IndicatorID, DomainID or ProfileID must be populated") - } - colnames(indicator_metadata)[colnames(indicator_metadata)=="Indicator ID"] <- "IndicatorID" - return(indicator_metadata) + } else if (!(is.null(DomainID))) { + AllProfiles <- profiles(path = path) + if (sum(AllProfiles$DomainID %in% DomainID) == 0){ + stop("DomainID(s) do not exist, use profiles() to identify existing domains") + } + path <- paste0(path, "indicator_metadata/csv/by_group_id?group_id=") + indicator_metadata <- paste0(path, DomainID) %>% + lapply(function(dataurl) { + dataurl %>% + GET(use_proxy(ie_get_proxy_for_url(), + username = "", + password = "", + auth = "ntlm")) %>% + content("parsed", + type = "text/csv", + encoding = "UTF-8", + col_types = types) + }) %>% + bind_rows() + } else if (!(is.null(ProfileID))) { + AllProfiles <- profiles(path = path) + if (sum(AllProfiles$ProfileID %in% ProfileID) == 0){ + stop("ProfileID(s) do not exist, use profiles() to identify existing profiles") + } + path <- paste0(path, "indicator_metadata/csv/by_profile_id?profile_id=") + indicator_metadata <- paste0(path, ProfileID) %>% + lapply(function(dataurl) { + dataurl %>% + GET(use_proxy(ie_get_proxy_for_url(), + username = "", + password = "", + auth = "ntlm")) %>% + content("parsed", + type = "text/csv", + encoding = "UTF-8", + col_types = types) + }) %>% + bind_rows() + } else { + stop("One of IndicatorID, DomainID or ProfileID must be populated") + } + colnames(indicator_metadata)[colnames(indicator_metadata)=="Indicator ID"] <- "IndicatorID" + return(indicator_metadata) +} + + +#' Indicator update information +#' +#' Outputs a data frame which provides a date of when an indicator was last update +#' @param IndicatorID Integer, id of the indicators of interest +#' @param ProfileID Integer (optional), whether to restrict the indicators to a particular profile +#' @inheritParams fingertips_data +#' @examples +#' \dontrun{ +#' # Returns metadata for indicator ID 90362 and 1107 +#' indicatorIDs <- c(90362, 1107) +#' indicator_update_information(indicatorIDs)} +#' @return The date of latst data update for selected indicators +#' @importFrom httr GET content set_config config use_proxy +#' @importFrom curl ie_get_proxy_for_url +#' @importFrom jsonlite fromJSON +#' @export + +indicator_update_information <- function(IndicatorID, ProfileID = NULL, path) { + + if (missing(path)) path <- fingertips_endpoint() + set_config(config(ssl_verifypeer = 0L)) + fingertips_ensure_api_available(endpoint = path) + + + IndicatorID_collapsed <- paste(IndicatorID, + collapse = "%2C") + if (!is.null(ProfileID)) { + + profile_check <- indicators(ProfileID = ProfileID, + path = path) + if (!any(IndicatorID %in% profile_check$IndicatorID)) + stop("Not all IndicatorIDs are avaible within the provided ProfileID(s)") + + ProfileID_collapsed <- paste(ProfileID, + collapse = "%2C") + api_path <- sprintf("indicator_metadata/by_indicator_id?indicator_ids=%s&restrict_to_profile_ids=%s", + IndicatorID_collapsed, ProfileID_collapsed) + } else { + api_path <- sprintf("indicator_metadata/by_indicator_id?indicator_ids=%s", + IndicatorID_collapsed) + } + + info <- paste0(path, + api_path) %>% + GET(use_proxy(ie_get_proxy_for_url(), + username = "", + password = "", + auth = "ntlm")) %>% + content("text") %>% + fromJSON(flatten = TRUE) %>% + lapply(function(x) x[c("IID", "DataChange")]) %>% + lapply(unlist) %>% + dplyr::bind_rows() %>% + dplyr::select(IndicatorID = IID, + LastDataUploadDate = DataChange.LastUploadedAt) %>% + dplyr::mutate( + IndicatorID = as.integer(IndicatorID), + LastDataUploadDate = as.Date(LastDataUploadDate)) + + return(info) } diff --git a/fingertipsR.Rproj b/fingertipsR.Rproj index 6f4d748..f0d6187 100644 --- a/fingertipsR.Rproj +++ b/fingertipsR.Rproj @@ -6,7 +6,7 @@ AlwaysSaveHistory: Default EnableCodeIndexing: Yes UseSpacesForTab: Yes -NumSpacesForTab: 4 +NumSpacesForTab: 2 Encoding: UTF-8 RnwWeave: Sweave diff --git a/man/indicator_update_information.Rd b/man/indicator_update_information.Rd new file mode 100644 index 0000000..71e91e8 --- /dev/null +++ b/man/indicator_update_information.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/indicator_metadata.R +\name{indicator_update_information} +\alias{indicator_update_information} +\title{Indicator update information} +\usage{ +indicator_update_information(IndicatorID, ProfileID = NULL, path) +} +\arguments{ +\item{IndicatorID}{Integer, id of the indicators of interest} + +\item{ProfileID}{Integer (optional), whether to restrict the indicators to a particular profile} + +\item{path}{String; Fingertips API address. Function will default to the +correct address} +} +\value{ +The date of latst data update for selected indicators +} +\description{ +Outputs a data frame which provides a date of when an indicator was last update +} +\examples{ +\dontrun{ +# Returns metadata for indicator ID 90362 and 1107 +indicatorIDs <- c(90362, 1107) +indicator_update_information(indicatorIDs)} +} diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 50fefb7..d109039 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -3,57 +3,86 @@ library(fingertipsR) ncols <- 29 +# Error tests ------------------------------------------------------------- + test_that("indicator_metadata errors when bad input to IndicatorID provided", { - skip_on_cran() - expect_error(indicator_metadata("blah blah"), - "IndicatorID\\(s\\) do not exist, use indicators\\(\\) to identify existing indicators") - }) + skip_on_cran() + expect_error(indicator_metadata("blah blah"), + "IndicatorID\\(s\\) do not exist, use indicators\\(\\) to identify existing indicators") +}) test_that("indicator_metadata errors when incorrect DomainID provided", { - skip_on_cran() - expect_error(indicator_metadata(DomainID = 1), - "DomainID\\(s\\) do not exist, use profiles\\(\\) to identify existing domains") + skip_on_cran() + expect_error(indicator_metadata(DomainID = 1), + "DomainID\\(s\\) do not exist, use profiles\\(\\) to identify existing domains") }) test_that("indicator_metadata errors when incorrect ProfileID provided", { - skip_on_cran() - expect_error(indicator_metadata(ProfileID = "1234 blah blah"), - "ProfileID\\(s\\) do not exist, use profiles\\(\\) to identify existing profiles") + skip_on_cran() + expect_error(indicator_metadata(ProfileID = "1234 blah blah"), + "ProfileID\\(s\\) do not exist, use profiles\\(\\) to identify existing profiles") }) test_that("indicator_metadata errors when nothing provided", { - skip_on_cran() - expect_error(indicator_metadata(), - "One of IndicatorID, DomainID or ProfileID must be populated") + skip_on_cran() + expect_error(indicator_metadata(), + "One of IndicatorID, DomainID or ProfileID must be populated") }) +test_that("indicator_update_information errors when there is no relationship between IndicatorID and ProfileID", { + skip_on_cran() + expect_error( + indicator_update_information( + IndicatorID = c(10301, 10401), + ProfileID = c(18)), + "Not all IndicatorIDs are avaible within the provided ProfileID\\(s\\)") +}) + + test_that("indicator_metadata returns correct number of columns when IndicatorID provided", { - skip_on_cran() - expect_equal(ncol(indicator_metadata(IndicatorID = 10101)), ncols) + skip_on_cran() + expect_equal(ncol(indicator_metadata(IndicatorID = 10101)), ncols) }) +# testing dimensions ------------------------------------------------------ + test_that("indicator_metadata returns correct number of columns when DomainID provided", { - skip_on_cran() - expect_equal(ncol(indicator_metadata(DomainID = 1938133294)), ncols) + skip_on_cran() + expect_equal(ncol(indicator_metadata(DomainID = 1938133294)), ncols) }) test_that("indicator_metadata returns correct number of columns when ProfileID provided", { - skip_on_cran() - expect_equal(ncol(indicator_metadata(ProfileID = 156)), ncols) + skip_on_cran() + expect_equal(ncol(indicator_metadata(ProfileID = 156)), ncols) }) test_that("indicator_metadata returns correct number of columns when ProfileID and IndicatorID provided", { - skip_on_cran() - expect_equal(ncol(indicator_metadata(IndicatorID = 90362, ProfileID = 156)), ncols) + skip_on_cran() + expect_equal(ncol(indicator_metadata(IndicatorID = 90362, ProfileID = 156)), ncols) }) test_that("indicator_metadata returns correct number of columns when IndicatorID option 'All' is supplied", { - skip_on_cran() - expect_equal(ncol(indicator_metadata(IndicatorID = "All")), ncols) + skip_on_cran() + expect_equal(ncol(indicator_metadata(IndicatorID = "All")), ncols) +}) + +test_that("dimensions of indicator_update_information are correct when ProfileID isn't provided", { + dim( + indicator_update_information( + IndicatorID = c(10301, 10401)), + c(2, 2)) +}) + +test_that("dimensions of indicator_update_information are correct when ProfileID is provided", { + dim( + indicator_update_information( + IndicatorID = c(10301, 10401), + ProfileID = c(19)), + c(2, 2)) }) From 6b75aaffe2c9ddb6a9d7544903ca405918735462 Mon Sep 17 00:00:00 2001 From: Sebastian Fox Date: Wed, 11 May 2022 13:49:28 +0100 Subject: [PATCH 2/3] version number increased --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index bf824d1..77f0d19 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: fingertipsR Type: Package -Version: 1.0.8.9001 +Version: 1.0.9 Title: Fingertips Data for Public Health Description: Fingertips () 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 diff --git a/NEWS.md b/NEWS.md index 0e2edfb..9898e02 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# fingertipsR 1.0.8.9001 +# fingertipsR 1.0.9 * Bug fixes for indicators() function where many groups exist * Fixed bug around class of the new `Time period range` field; now ensured to be a character field From 76fa1078d144d8efedb178ce6744da6a2d2c1662 Mon Sep 17 00:00:00 2001 From: Sebastian Fox Date: Wed, 8 Jun 2022 14:22:43 +0100 Subject: [PATCH 3/3] minor test changes --- R/indicator_metadata.R | 9 +++++---- tests/testthat/test-metadata.R | 21 +++++++++++++-------- 2 files changed, 18 insertions(+), 12 deletions(-) diff --git a/R/indicator_metadata.R b/R/indicator_metadata.R index 63941f0..acd31ae 100644 --- a/R/indicator_metadata.R +++ b/R/indicator_metadata.R @@ -168,6 +168,7 @@ indicator_metadata <- function(IndicatorID = NULL, #' @importFrom httr GET content set_config config use_proxy #' @importFrom curl ie_get_proxy_for_url #' @importFrom jsonlite fromJSON +#' @importFrom rlang .data #' @export indicator_update_information <- function(IndicatorID, ProfileID = NULL, path) { @@ -206,11 +207,11 @@ indicator_update_information <- function(IndicatorID, ProfileID = NULL, path) { lapply(function(x) x[c("IID", "DataChange")]) %>% lapply(unlist) %>% dplyr::bind_rows() %>% - dplyr::select(IndicatorID = IID, - LastDataUploadDate = DataChange.LastUploadedAt) %>% + dplyr::select(IndicatorID = .data$IID, + LastDataUploadDate = .data$DataChange.LastUploadedAt) %>% dplyr::mutate( - IndicatorID = as.integer(IndicatorID), - LastDataUploadDate = as.Date(LastDataUploadDate)) + IndicatorID = as.integer(.data$IndicatorID), + LastDataUploadDate = as.Date(.data$LastDataUploadDate)) return(info) } diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index d109039..a17078f 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -1,7 +1,7 @@ library(testthat) library(fingertipsR) -ncols <- 29 +ncols <- 30 # Error tests ------------------------------------------------------------- @@ -73,16 +73,21 @@ test_that("indicator_metadata returns correct number of columns when IndicatorID }) test_that("dimensions of indicator_update_information are correct when ProfileID isn't provided", { - dim( - indicator_update_information( - IndicatorID = c(10301, 10401)), + skip_on_cran() + expect_equal( + dim( + indicator_update_information( + IndicatorID = c(10301, 10401))), c(2, 2)) }) test_that("dimensions of indicator_update_information are correct when ProfileID is provided", { - dim( - indicator_update_information( - IndicatorID = c(10301, 10401), - ProfileID = c(19)), + skip_on_cran() + expect_equal( + dim( + indicator_update_information( + IndicatorID = c(10301, 10401), + ProfileID = c(19))), c(2, 2)) + })