From e9ffd729480bd031b29fcfb7775ab6648b4b6ef5 Mon Sep 17 00:00:00 2001 From: "R.Andres Castaneda" Date: Tue, 2 May 2023 09:44:32 -0400 Subject: [PATCH 01/15] fix title and description in DESCRIPTION --- DESCRIPTION | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 79b3146..8ddf607 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: pipr -Title: Client for the PIP API +Title: Client for the Poverty and Inequality Platform ('PIP') API Version: 1.0.0 Authors@R: c(person(given = "Tony", @@ -14,14 +14,14 @@ Authors@R: family = "Shah", role = "aut", email = "shahronak47@yahoo.in"), - person(given = "R. Andrés", + person(given = "R.Andrés", family = "Castañeda", role = "aut", email = "acastanedaa@worldbank.org"), person(given = "World Bank", role = "cph") ) -Description: Provides an interface to compute poverty and inequality +Description: An interface to compute poverty and inequality indicators for more than 160 countries and regions from the World Bank's database of household surveys. License: MIT + file LICENSE From 575c3f884a8a42be6969a22cac04c48f5fd9c159 Mon Sep 17 00:00:00 2001 From: "R.Andres Castaneda" Date: Tue, 2 May 2023 09:53:08 -0400 Subject: [PATCH 02/15] Add API url with angle brakets --- DESCRIPTION | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8ddf607..a577330 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,8 +29,9 @@ Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 -URL: https://github.com/worldbank/pipr, - https://worldbank.github.io/pipr/ +URL: https://worldbank.github.io/pipr/, + https://github.com/worldbank/pipr, + BugReports: https://github.com/worldbank/pipr/issues Suggests: covr, From cd36991423050430311d895ae8551b9678da948e Mon Sep 17 00:00:00 2001 From: "R.Andres Castaneda" Date: Tue, 2 May 2023 10:28:20 -0400 Subject: [PATCH 03/15] add information about the pip_api class --- R/aaa.R | 9 ++------- R/get_aux.R | 4 ++-- R/utils.R | 7 ++++++- man/parse_response.Rd | 23 +++++++++++++++++++++++ 4 files changed, 33 insertions(+), 10 deletions(-) create mode 100644 man/parse_response.Rd diff --git a/R/aaa.R b/R/aaa.R index 88535e8..84d15a3 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -28,10 +28,7 @@ set_aux <- function(table, if (to_set == 2) { msg <- c("Setting {.field {table}} into {.code .pip} aborted") - cli::cli_abort(msg, - class = "stamp_error", - wrap = TRUE - ) + cli::cli_abort(msg, wrap = TRUE) } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -122,9 +119,7 @@ call_aux <- function(table = NULL) { return(rlang::env_get(.pip, table)) } else { msg <- c("*" = "Table {.field {table}} does not exist") - cli::cli_abort(msg, - class = "pipr_error", - wrap = TRUE) + cli::cli_abort(msg, wrap = TRUE) } } diff --git a/R/get_aux.R b/R/get_aux.R index 8dfc363..2bcd92f 100644 --- a/R/get_aux.R +++ b/R/get_aux.R @@ -95,7 +95,7 @@ get_aux <- function(table = NULL, } else { msg <- c("Invalid sintax in {.field assign_tb}", "*" = "{.field assign_tb} must be logical or character.") - cli::cli_abort(msg, class = "pipr_error", wrap = TRUE) + cli::cli_abort(msg, wrap = TRUE) } srt <- set_aux(table = tb_name, @@ -116,7 +116,7 @@ get_aux <- function(table = NULL, } else { msg <- c("table {.strong {table}} could not be saved in env {.env .pip}") - cli::cli_abort(msg, class = "pipr_error", wrap = TRUE) + cli::cli_abort(msg, wrap = TRUE) } diff --git a/R/utils.R b/R/utils.R index 9e5f181..6df7e68 100644 --- a/R/utils.R +++ b/R/utils.R @@ -101,10 +101,15 @@ build_args <- function(.country = NULL, return(args) } + #' parse_response #' @param res A httr response #' @inheritParams get_stats -#' @noRd +#' +#' @return If `simplify = TRUE`, it returns a tibble with the requested content. +#' If `simplify = FALSE`, it returns a list of class "pip_api" with +#' information about the PIP API query +#' @keywords internal parse_response <- function(res, simplify) { # Get response type diff --git a/man/parse_response.Rd b/man/parse_response.Rd new file mode 100644 index 0000000..2902dd0 --- /dev/null +++ b/man/parse_response.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{parse_response} +\alias{parse_response} +\title{parse_response} +\usage{ +parse_response(res, simplify) +} +\arguments{ +\item{res}{A httr response} + +\item{simplify}{logical: If TRUE (the default) the response is returned as a +\code{tibble}} +} +\value{ +If \code{simplify = TRUE}, it returns a tibble with the requested content. +If \code{simplify = FALSE}, it returns a list of class "pip_api" with +information about the PIP API query +} +\description{ +parse_response +} +\keyword{internal} From c05f3334d0063c9b0fec1d865b82a25304f19406 Mon Sep 17 00:00:00 2001 From: "R.Andres Castaneda" Date: Tue, 2 May 2023 10:50:21 -0400 Subject: [PATCH 04/15] delete Rd for aux specific functions and combine with get_aux --- NAMESPACE | 13 -- R/get_aux.R | 113 ++++++---------- man/get_aux.Rd | 240 +++++++++++++++++++++++++++++++++- man/get_countries.Rd | 38 ------ man/get_cpi.Rd | 39 ------ man/get_dictionary.Rd | 38 ------ man/get_gdp.Rd | 38 ------ man/get_hfce.Rd | 38 ------ man/get_incgrp_coverage.Rd | 39 ------ man/get_interpolated_means.Rd | 41 ------ man/get_pop.Rd | 38 ------ man/get_pop_region.Rd | 38 ------ man/get_ppp.Rd | 38 ------ man/get_region_coverage.Rd | 38 ------ man/get_regions.Rd | 38 ------ man/get_survey_means.Rd | 39 ------ 16 files changed, 276 insertions(+), 590 deletions(-) delete mode 100644 man/get_countries.Rd delete mode 100644 man/get_cpi.Rd delete mode 100644 man/get_dictionary.Rd delete mode 100644 man/get_gdp.Rd delete mode 100644 man/get_hfce.Rd delete mode 100644 man/get_incgrp_coverage.Rd delete mode 100644 man/get_interpolated_means.Rd delete mode 100644 man/get_pop.Rd delete mode 100644 man/get_pop_region.Rd delete mode 100644 man/get_ppp.Rd delete mode 100644 man/get_region_coverage.Rd delete mode 100644 man/get_regions.Rd delete mode 100644 man/get_survey_means.Rd diff --git a/NAMESPACE b/NAMESPACE index 9d2ad3a..9a730e2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,20 +4,7 @@ export(call_aux) export(check_api) export(display_aux) export(get_aux) -export(get_countries) -export(get_cpi) -export(get_dictionary) -export(get_gdp) -export(get_hfce) -export(get_incgrp_coverage) -export(get_interpolated_means) export(get_pip_info) -export(get_pop) -export(get_pop_region) -export(get_ppp) -export(get_region_coverage) -export(get_regions) export(get_stats) -export(get_survey_means) export(get_versions) export(get_wb) diff --git a/R/get_aux.R b/R/get_aux.R index 2bcd92f..58f6bf7 100644 --- a/R/get_aux.R +++ b/R/get_aux.R @@ -1,7 +1,11 @@ #' Get auxiliary data #' -#' Get an auxiliary dataset. If no table is specified a vector with possible -#' inputs will be returned. +#' @description `get_aux()` Get an auxiliary dataset. If no table is specified a +#' vector with possible inputs will be returned. +#' +#' `get_countries()` Returns a table countries with their full names, ISO codes, +#' and associated region code +#' #' #' @param table Aux table #' @param assign_tb assigns table to specified name to the `.pip` environment. @@ -12,7 +16,8 @@ #' @param force logical: force replacement. Default is FALSE #' #' @return tibble or list. If `assign_tb` is TRUE or character, it will return -#' TRUE if data was assign properly to .pip env +#' TRUE if data was assign properly to .pip env. If `simplify = FALSE`, it +#' returns a list of class "pip_api" #' @export #' @examples #' \dontrun{ @@ -127,11 +132,8 @@ get_aux <- function(table = NULL, } -#' get_countries -#' @description Returns a table countries with their full names, ISO codes, and -#' associated region code -#' @inheritParams get_aux -#' @export +#' @describeIn get_aux Returns a table countries with their full names, ISO +#' codes, and associated region code #' @examples #' \dontrun{ #' # Short hand to get countries @@ -153,11 +155,8 @@ get_countries <- function(version = NULL, } -#' get_regions -#' @description Returns a table regional grouping used for computing aggregate -#' poverty statistics. -#' @inheritParams get_aux -#' @export +#' @describeIn get_aux Returns a table regional grouping used for computing +#' aggregate poverty statistics. #' @examples #' \dontrun{ #' # Short hand to get regions @@ -179,12 +178,8 @@ get_regions <- function(version = NULL, } -#' get_cpi() -#' @description Returns a table of Consumer Price Index (CPI) values used for -#' poverty and inequality computations. -#' statistics -#' @inheritParams get_aux -#' @export +#' @describeIn get_aux Returns a table of Consumer Price Index (CPI) values used +#' for poverty and inequality computations. statistics #' @examples #' \dontrun{ #' # Short hand to get cpi @@ -206,11 +201,8 @@ get_cpi <- function(version = NULL, } -#' get_dictionary -#' @description Returns a data dictionary with a description of all variables -#' available through the PIP API. -#' @inheritParams get_aux -#' @export +#' @describeIn get_aux Returns a data dictionary with a description of all +#' variables available through the PIP API. #' @examples #' \dontrun{ #' # Short hand to get dictionary @@ -232,11 +224,8 @@ get_dictionary <- function(version = NULL, } -#' get_gdp() -#' @description Returns a table of Growth Domestic Product (GDP) values used for -#' poverty and inequality statistics. -#' @inheritParams get_aux -#' @export +#' @describeIn get_aux Returns a table of Growth Domestic Product (GDP) values +#' used for poverty and inequality statistics. #' @examples #' \dontrun{ #' # Short hand to get gdp @@ -258,12 +247,9 @@ get_gdp <- function(version = NULL, } -#' get_incgrp_coverage -#' @description Returns a table of survey coverage for low and lower-middle -#' income countries. If this coverage is less than 50%, World level aggregate -#' statistics will not be computed. -#' @inheritParams get_aux -#' @export +#' @describeIn get_aux Returns a table of survey coverage for low and +#' lower-middle income countries. If this coverage is less than 50%, World +#' level aggregate statistics will not be computed. #' @examples #' \dontrun{ #' # Short hand to get incgrp_coverage @@ -285,14 +271,11 @@ get_incgrp_coverage <- function(version = NULL, } -#' get_interpolated_means -#' @description Returns a table of key information and statistics for all years -#' for which poverty and inequality statistics are either available (household -#' survey exists) or extra- / interpolated. -#' Please see \code{\link{get_dictionary}} for more information about -#' each variable available in this table. -#' @inheritParams get_aux -#' @export +#' @describeIn get_aux Returns a table of key information and statistics for all +#' years for which poverty and inequality statistics are either available +#' (household survey exists) or extra- / interpolated. Please see +#' \code{\link{get_dictionary}} for more information about each variable +#' available in this table. #' @examples #' \dontrun{ #' # Short hand to get interpolated_means @@ -313,12 +296,8 @@ get_interpolated_means <- function(version = NULL, ) } -#' get_hfce -#' -#' @description Returns a table of Household Final Consumption Expenditure (HFCE) values -#' used for poverty and inequality computations. -#' @inheritParams get_aux -#' @export +#' @describeIn get_aux Returns a table of Household Final Consumption +#' Expenditure (HFCE) values used for poverty and inequality computations. #' @examples #' \dontrun{ #' # Short hand to get hfce @@ -339,11 +318,8 @@ get_hfce <- function(version = NULL, ) } -#' get_pop -#' @description Returns a table of population values used for poverty and +#' @describeIn get_aux Returns a table of population values used for poverty and #' inequality computations. -#' @inheritParams get_aux -#' @export #' @examples #' \dontrun{ #' # Short hand to get pop @@ -364,11 +340,9 @@ get_pop <- function(version = NULL, ) } -#' get_pop_region -#' @description Returns a table of total population by region-year. These values -#' are used for the computation of regional aggregate poverty statistics. -#' @inheritParams get_aux -#' @export +#' @describeIn get_aux Returns a table of total population by region-year. These +#' values are used for the computation of regional aggregate poverty +#' statistics. #' @examples #' \dontrun{ #' # Short hand to get pop_region @@ -390,11 +364,8 @@ get_pop_region <- function(version = NULL, } -#' get_ppp -#' @description Returns a table of Purchasing Power Parity (PPP) values -#' used for poverty and inequality computations. -#' @inheritParams get_aux -#' @export +#' @describeIn get_aux Returns a table of Purchasing Power Parity (PPP) values +#' used for poverty and inequality computations. #' @examples #' \dontrun{ #' # Short hand to get ppp @@ -415,11 +386,8 @@ get_ppp <- function(version = NULL, ) } -#' get_region_coverage -#' @description Return a table of regional survey coverage: Percentage of -#' available surveys for a specific region-year. -#' @inheritParams get_aux -#' @export +#' @describeIn get_aux Return a table of regional survey coverage: Percentage of +#' available surveys for a specific region-year. #' @examples #' \dontrun{ #' # Short hand to get region_coverage @@ -441,12 +409,9 @@ get_region_coverage <- function(version = NULL, } -#' get_survey_means -#' @description Returns a table of all available surveys and associated key -#' statistics. Please see \code{\link{get_dictionary}} for more information about -#' each variable available in this table. -#' @inheritParams get_aux -#' @export +#' @describeIn get_aux Returns a table of all available surveys and associated +#' key statistics. Please see \code{\link{get_dictionary}} for more +#' information about each variable available in this table. #' @examples #' \dontrun{ #' # Short hand to get survey_means diff --git a/man/get_aux.Rd b/man/get_aux.Rd index b7d1604..e1d8ebf 100644 --- a/man/get_aux.Rd +++ b/man/get_aux.Rd @@ -2,6 +2,19 @@ % Please edit documentation in R/get_aux.R \name{get_aux} \alias{get_aux} +\alias{get_countries} +\alias{get_regions} +\alias{get_cpi} +\alias{get_dictionary} +\alias{get_gdp} +\alias{get_incgrp_coverage} +\alias{get_interpolated_means} +\alias{get_hfce} +\alias{get_pop} +\alias{get_pop_region} +\alias{get_ppp} +\alias{get_region_coverage} +\alias{get_survey_means} \title{Get auxiliary data} \usage{ get_aux( @@ -16,6 +29,123 @@ get_aux( assign_tb = FALSE, force = FALSE ) + +get_countries( + version = NULL, + ppp_version = NULL, + release_version = NULL, + api_version = "v1", + format = c("rds", "json", "csv"), + server = NULL +) + +get_regions( + version = NULL, + ppp_version = NULL, + release_version = NULL, + api_version = "v1", + format = c("rds", "json", "csv"), + server = NULL +) + +get_cpi( + version = NULL, + ppp_version = NULL, + release_version = NULL, + api_version = "v1", + format = c("rds", "json", "csv"), + server = NULL +) + +get_dictionary( + version = NULL, + ppp_version = NULL, + release_version = NULL, + api_version = "v1", + format = c("rds", "json", "csv"), + server = NULL +) + +get_gdp( + version = NULL, + ppp_version = NULL, + release_version = NULL, + api_version = "v1", + format = c("rds", "json", "csv"), + server = NULL +) + +get_incgrp_coverage( + version = NULL, + ppp_version = NULL, + release_version = NULL, + api_version = "v1", + format = c("rds", "json", "csv"), + server = NULL +) + +get_interpolated_means( + version = NULL, + ppp_version = NULL, + release_version = NULL, + api_version = "v1", + format = c("rds", "json", "csv"), + server = NULL +) + +get_hfce( + version = NULL, + ppp_version = NULL, + release_version = NULL, + api_version = "v1", + format = c("rds", "json", "csv"), + server = NULL +) + +get_pop( + version = NULL, + ppp_version = NULL, + release_version = NULL, + api_version = "v1", + format = c("rds", "json", "csv"), + server = NULL +) + +get_pop_region( + version = NULL, + ppp_version = NULL, + release_version = NULL, + api_version = "v1", + format = c("rds", "json", "csv"), + server = NULL +) + +get_ppp( + version = NULL, + ppp_version = NULL, + release_version = NULL, + api_version = "v1", + format = c("rds", "json", "csv"), + server = NULL +) + +get_region_coverage( + version = NULL, + ppp_version = NULL, + release_version = NULL, + api_version = "v1", + format = c("rds", "json", "csv"), + server = NULL +) + +get_survey_means( + version = NULL, + ppp_version = NULL, + release_version = NULL, + api_version = "v1", + format = c("rds", "json", "csv"), + server = NULL +) } \arguments{ \item{table}{Aux table} @@ -44,12 +174,64 @@ character, the table will be assigned to that name.} } \value{ tibble or list. If \code{assign_tb} is TRUE or character, it will return -TRUE if data was assign properly to .pip env +TRUE if data was assign properly to .pip env. If \code{simplify = FALSE}, it +returns a list of class "pip_api" } \description{ -Get an auxiliary dataset. If no table is specified a vector with possible -inputs will be returned. +\code{get_aux()} Get an auxiliary dataset. If no table is specified a +vector with possible inputs will be returned. + +\code{get_countries()} Returns a table countries with their full names, ISO codes, +and associated region code } +\section{Functions}{ +\itemize{ +\item \code{get_countries()}: Returns a table countries with their full names, ISO +codes, and associated region code + +\item \code{get_regions()}: Returns a table regional grouping used for computing +aggregate poverty statistics. + +\item \code{get_cpi()}: Returns a table of Consumer Price Index (CPI) values used +for poverty and inequality computations. statistics + +\item \code{get_dictionary()}: Returns a data dictionary with a description of all +variables available through the PIP API. + +\item \code{get_gdp()}: Returns a table of Growth Domestic Product (GDP) values +used for poverty and inequality statistics. + +\item \code{get_incgrp_coverage()}: Returns a table of survey coverage for low and +lower-middle income countries. If this coverage is less than 50\%, World +level aggregate statistics will not be computed. + +\item \code{get_interpolated_means()}: Returns a table of key information and statistics for all +years for which poverty and inequality statistics are either available +(household survey exists) or extra- / interpolated. Please see +\code{\link{get_dictionary}} for more information about each variable +available in this table. + +\item \code{get_hfce()}: Returns a table of Household Final Consumption +Expenditure (HFCE) values used for poverty and inequality computations. + +\item \code{get_pop()}: Returns a table of population values used for poverty and +inequality computations. + +\item \code{get_pop_region()}: Returns a table of total population by region-year. These +values are used for the computation of regional aggregate poverty +statistics. + +\item \code{get_ppp()}: Returns a table of Purchasing Power Parity (PPP) values +used for poverty and inequality computations. + +\item \code{get_region_coverage()}: Return a table of regional survey coverage: Percentage of +available surveys for a specific region-year. + +\item \code{get_survey_means()}: Returns a table of all available surveys and associated +key statistics. Please see \code{\link{get_dictionary}} for more +information about each variable available in this table. + +}} \examples{ \dontrun{ # Get list of tables @@ -73,5 +255,57 @@ get_aux("gdp", assign_tb = TRUE) # Bind gdp table to "new_name" in .pip env get_aux("gdp", assign_tb = "new_name") +} +\dontrun{ +# Short hand to get countries +get_countries() +} +\dontrun{ +# Short hand to get regions +get_regions() +} +\dontrun{ +# Short hand to get cpi +get_cpi() +} +\dontrun{ +# Short hand to get dictionary +get_dictionary() +} +\dontrun{ +# Short hand to get gdp +get_gdp() +} +\dontrun{ +# Short hand to get incgrp_coverage +get_incgrp_coverage() +} +\dontrun{ +# Short hand to get interpolated_means +get_interpolated_means() +} +\dontrun{ +# Short hand to get hfce +get_hfce() +} +\dontrun{ +# Short hand to get pop +get_pop() +} +\dontrun{ +# Short hand to get pop_region +get_pop_region() +} +\dontrun{ +# Short hand to get ppp +get_ppp() +} +\dontrun{ +# Short hand to get region_coverage +get_region_coverage() +} +\dontrun{ +# Short hand to get survey_means +get_survey_means() } } diff --git a/man/get_countries.Rd b/man/get_countries.Rd deleted file mode 100644 index 0be4405..0000000 --- a/man/get_countries.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_aux.R -\name{get_countries} -\alias{get_countries} -\title{get_countries} -\usage{ -get_countries( - version = NULL, - ppp_version = NULL, - release_version = NULL, - api_version = "v1", - format = c("rds", "json", "csv"), - server = NULL -) -} -\arguments{ -\item{version}{character: Data version. See \code{get_versions()}} - -\item{ppp_version}{ppp year to be used} - -\item{release_version}{date when the data was published in YYYYMMDD format} - -\item{api_version}{character: API version} - -\item{format}{character: Response format either of c("rds", "json", "csv")} - -\item{server}{character: Server. For WB internal use only} -} -\description{ -Returns a table countries with their full names, ISO codes, and -associated region code -} -\examples{ -\dontrun{ -# Short hand to get countries -get_countries() -} -} diff --git a/man/get_cpi.Rd b/man/get_cpi.Rd deleted file mode 100644 index eaa3038..0000000 --- a/man/get_cpi.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_aux.R -\name{get_cpi} -\alias{get_cpi} -\title{get_cpi()} -\usage{ -get_cpi( - version = NULL, - ppp_version = NULL, - release_version = NULL, - api_version = "v1", - format = c("rds", "json", "csv"), - server = NULL -) -} -\arguments{ -\item{version}{character: Data version. See \code{get_versions()}} - -\item{ppp_version}{ppp year to be used} - -\item{release_version}{date when the data was published in YYYYMMDD format} - -\item{api_version}{character: API version} - -\item{format}{character: Response format either of c("rds", "json", "csv")} - -\item{server}{character: Server. For WB internal use only} -} -\description{ -Returns a table of Consumer Price Index (CPI) values used for -poverty and inequality computations. -statistics -} -\examples{ -\dontrun{ -# Short hand to get cpi -get_cpi() -} -} diff --git a/man/get_dictionary.Rd b/man/get_dictionary.Rd deleted file mode 100644 index c0334f1..0000000 --- a/man/get_dictionary.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_aux.R -\name{get_dictionary} -\alias{get_dictionary} -\title{get_dictionary} -\usage{ -get_dictionary( - version = NULL, - ppp_version = NULL, - release_version = NULL, - api_version = "v1", - format = c("rds", "json", "csv"), - server = NULL -) -} -\arguments{ -\item{version}{character: Data version. See \code{get_versions()}} - -\item{ppp_version}{ppp year to be used} - -\item{release_version}{date when the data was published in YYYYMMDD format} - -\item{api_version}{character: API version} - -\item{format}{character: Response format either of c("rds", "json", "csv")} - -\item{server}{character: Server. For WB internal use only} -} -\description{ -Returns a data dictionary with a description of all variables -available through the PIP API. -} -\examples{ -\dontrun{ -# Short hand to get dictionary -get_dictionary() -} -} diff --git a/man/get_gdp.Rd b/man/get_gdp.Rd deleted file mode 100644 index b1cd274..0000000 --- a/man/get_gdp.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_aux.R -\name{get_gdp} -\alias{get_gdp} -\title{get_gdp()} -\usage{ -get_gdp( - version = NULL, - ppp_version = NULL, - release_version = NULL, - api_version = "v1", - format = c("rds", "json", "csv"), - server = NULL -) -} -\arguments{ -\item{version}{character: Data version. See \code{get_versions()}} - -\item{ppp_version}{ppp year to be used} - -\item{release_version}{date when the data was published in YYYYMMDD format} - -\item{api_version}{character: API version} - -\item{format}{character: Response format either of c("rds", "json", "csv")} - -\item{server}{character: Server. For WB internal use only} -} -\description{ -Returns a table of Growth Domestic Product (GDP) values used for -poverty and inequality statistics. -} -\examples{ -\dontrun{ -# Short hand to get gdp -get_gdp() -} -} diff --git a/man/get_hfce.Rd b/man/get_hfce.Rd deleted file mode 100644 index 5c267b2..0000000 --- a/man/get_hfce.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_aux.R -\name{get_hfce} -\alias{get_hfce} -\title{get_hfce} -\usage{ -get_hfce( - version = NULL, - ppp_version = NULL, - release_version = NULL, - api_version = "v1", - format = c("rds", "json", "csv"), - server = NULL -) -} -\arguments{ -\item{version}{character: Data version. See \code{get_versions()}} - -\item{ppp_version}{ppp year to be used} - -\item{release_version}{date when the data was published in YYYYMMDD format} - -\item{api_version}{character: API version} - -\item{format}{character: Response format either of c("rds", "json", "csv")} - -\item{server}{character: Server. For WB internal use only} -} -\description{ -Returns a table of Household Final Consumption Expenditure (HFCE) values -used for poverty and inequality computations. -} -\examples{ -\dontrun{ -# Short hand to get hfce -get_hfce() -} -} diff --git a/man/get_incgrp_coverage.Rd b/man/get_incgrp_coverage.Rd deleted file mode 100644 index 774632f..0000000 --- a/man/get_incgrp_coverage.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_aux.R -\name{get_incgrp_coverage} -\alias{get_incgrp_coverage} -\title{get_incgrp_coverage} -\usage{ -get_incgrp_coverage( - version = NULL, - ppp_version = NULL, - release_version = NULL, - api_version = "v1", - format = c("rds", "json", "csv"), - server = NULL -) -} -\arguments{ -\item{version}{character: Data version. See \code{get_versions()}} - -\item{ppp_version}{ppp year to be used} - -\item{release_version}{date when the data was published in YYYYMMDD format} - -\item{api_version}{character: API version} - -\item{format}{character: Response format either of c("rds", "json", "csv")} - -\item{server}{character: Server. For WB internal use only} -} -\description{ -Returns a table of survey coverage for low and lower-middle -income countries. If this coverage is less than 50\%, World level aggregate -statistics will not be computed. -} -\examples{ -\dontrun{ -# Short hand to get incgrp_coverage -get_incgrp_coverage() -} -} diff --git a/man/get_interpolated_means.Rd b/man/get_interpolated_means.Rd deleted file mode 100644 index 5434524..0000000 --- a/man/get_interpolated_means.Rd +++ /dev/null @@ -1,41 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_aux.R -\name{get_interpolated_means} -\alias{get_interpolated_means} -\title{get_interpolated_means} -\usage{ -get_interpolated_means( - version = NULL, - ppp_version = NULL, - release_version = NULL, - api_version = "v1", - format = c("rds", "json", "csv"), - server = NULL -) -} -\arguments{ -\item{version}{character: Data version. See \code{get_versions()}} - -\item{ppp_version}{ppp year to be used} - -\item{release_version}{date when the data was published in YYYYMMDD format} - -\item{api_version}{character: API version} - -\item{format}{character: Response format either of c("rds", "json", "csv")} - -\item{server}{character: Server. For WB internal use only} -} -\description{ -Returns a table of key information and statistics for all years -for which poverty and inequality statistics are either available (household -survey exists) or extra- / interpolated. -Please see \code{\link{get_dictionary}} for more information about -each variable available in this table. -} -\examples{ -\dontrun{ -# Short hand to get interpolated_means -get_interpolated_means() -} -} diff --git a/man/get_pop.Rd b/man/get_pop.Rd deleted file mode 100644 index 39c1bad..0000000 --- a/man/get_pop.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_aux.R -\name{get_pop} -\alias{get_pop} -\title{get_pop} -\usage{ -get_pop( - version = NULL, - ppp_version = NULL, - release_version = NULL, - api_version = "v1", - format = c("rds", "json", "csv"), - server = NULL -) -} -\arguments{ -\item{version}{character: Data version. See \code{get_versions()}} - -\item{ppp_version}{ppp year to be used} - -\item{release_version}{date when the data was published in YYYYMMDD format} - -\item{api_version}{character: API version} - -\item{format}{character: Response format either of c("rds", "json", "csv")} - -\item{server}{character: Server. For WB internal use only} -} -\description{ -Returns a table of population values used for poverty and -inequality computations. -} -\examples{ -\dontrun{ -# Short hand to get pop -get_pop() -} -} diff --git a/man/get_pop_region.Rd b/man/get_pop_region.Rd deleted file mode 100644 index 6d9cb8f..0000000 --- a/man/get_pop_region.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_aux.R -\name{get_pop_region} -\alias{get_pop_region} -\title{get_pop_region} -\usage{ -get_pop_region( - version = NULL, - ppp_version = NULL, - release_version = NULL, - api_version = "v1", - format = c("rds", "json", "csv"), - server = NULL -) -} -\arguments{ -\item{version}{character: Data version. See \code{get_versions()}} - -\item{ppp_version}{ppp year to be used} - -\item{release_version}{date when the data was published in YYYYMMDD format} - -\item{api_version}{character: API version} - -\item{format}{character: Response format either of c("rds", "json", "csv")} - -\item{server}{character: Server. For WB internal use only} -} -\description{ -Returns a table of total population by region-year. These values -are used for the computation of regional aggregate poverty statistics. -} -\examples{ -\dontrun{ -# Short hand to get pop_region -get_pop_region() -} -} diff --git a/man/get_ppp.Rd b/man/get_ppp.Rd deleted file mode 100644 index a61630d..0000000 --- a/man/get_ppp.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_aux.R -\name{get_ppp} -\alias{get_ppp} -\title{get_ppp} -\usage{ -get_ppp( - version = NULL, - ppp_version = NULL, - release_version = NULL, - api_version = "v1", - format = c("rds", "json", "csv"), - server = NULL -) -} -\arguments{ -\item{version}{character: Data version. See \code{get_versions()}} - -\item{ppp_version}{ppp year to be used} - -\item{release_version}{date when the data was published in YYYYMMDD format} - -\item{api_version}{character: API version} - -\item{format}{character: Response format either of c("rds", "json", "csv")} - -\item{server}{character: Server. For WB internal use only} -} -\description{ -Returns a table of Purchasing Power Parity (PPP) values -used for poverty and inequality computations. -} -\examples{ -\dontrun{ -# Short hand to get ppp -get_ppp() -} -} diff --git a/man/get_region_coverage.Rd b/man/get_region_coverage.Rd deleted file mode 100644 index bc2d3cf..0000000 --- a/man/get_region_coverage.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_aux.R -\name{get_region_coverage} -\alias{get_region_coverage} -\title{get_region_coverage} -\usage{ -get_region_coverage( - version = NULL, - ppp_version = NULL, - release_version = NULL, - api_version = "v1", - format = c("rds", "json", "csv"), - server = NULL -) -} -\arguments{ -\item{version}{character: Data version. See \code{get_versions()}} - -\item{ppp_version}{ppp year to be used} - -\item{release_version}{date when the data was published in YYYYMMDD format} - -\item{api_version}{character: API version} - -\item{format}{character: Response format either of c("rds", "json", "csv")} - -\item{server}{character: Server. For WB internal use only} -} -\description{ -Return a table of regional survey coverage: Percentage of -available surveys for a specific region-year. -} -\examples{ -\dontrun{ -# Short hand to get region_coverage -get_region_coverage() -} -} diff --git a/man/get_regions.Rd b/man/get_regions.Rd deleted file mode 100644 index bad0c4f..0000000 --- a/man/get_regions.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_aux.R -\name{get_regions} -\alias{get_regions} -\title{get_regions} -\usage{ -get_regions( - version = NULL, - ppp_version = NULL, - release_version = NULL, - api_version = "v1", - format = c("rds", "json", "csv"), - server = NULL -) -} -\arguments{ -\item{version}{character: Data version. See \code{get_versions()}} - -\item{ppp_version}{ppp year to be used} - -\item{release_version}{date when the data was published in YYYYMMDD format} - -\item{api_version}{character: API version} - -\item{format}{character: Response format either of c("rds", "json", "csv")} - -\item{server}{character: Server. For WB internal use only} -} -\description{ -Returns a table regional grouping used for computing aggregate -poverty statistics. -} -\examples{ -\dontrun{ -# Short hand to get regions -get_regions() -} -} diff --git a/man/get_survey_means.Rd b/man/get_survey_means.Rd deleted file mode 100644 index a8e8255..0000000 --- a/man/get_survey_means.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_aux.R -\name{get_survey_means} -\alias{get_survey_means} -\title{get_survey_means} -\usage{ -get_survey_means( - version = NULL, - ppp_version = NULL, - release_version = NULL, - api_version = "v1", - format = c("rds", "json", "csv"), - server = NULL -) -} -\arguments{ -\item{version}{character: Data version. See \code{get_versions()}} - -\item{ppp_version}{ppp year to be used} - -\item{release_version}{date when the data was published in YYYYMMDD format} - -\item{api_version}{character: API version} - -\item{format}{character: Response format either of c("rds", "json", "csv")} - -\item{server}{character: Server. For WB internal use only} -} -\description{ -Returns a table of all available surveys and associated key -statistics. Please see \code{\link{get_dictionary}} for more information about -each variable available in this table. -} -\examples{ -\dontrun{ -# Short hand to get survey_means -get_survey_means() -} -} From 5007a1eb2231eb18a4c40357111eacf5563f27f9 Mon Sep 17 00:00:00 2001 From: "R.Andres Castaneda" Date: Tue, 2 May 2023 10:57:22 -0400 Subject: [PATCH 05/15] improve description of returned data in get_aux --- R/get_aux.R | 14 ++++++++------ man/get_aux.Rd | 10 +++++----- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/R/get_aux.R b/R/get_aux.R index 58f6bf7..bab4396 100644 --- a/R/get_aux.R +++ b/R/get_aux.R @@ -1,10 +1,10 @@ #' Get auxiliary data #' #' @description `get_aux()` Get an auxiliary dataset. If no table is specified a -#' vector with possible inputs will be returned. +#' vector with possible inputs will be returned. #' -#' `get_countries()` Returns a table countries with their full names, ISO codes, -#' and associated region code +#' `get_countries()` Returns a table countries with their full names, ISO +#' codes, and associated region code #' #' #' @param table Aux table @@ -15,9 +15,11 @@ #' @inheritParams get_stats #' @param force logical: force replacement. Default is FALSE #' -#' @return tibble or list. If `assign_tb` is TRUE or character, it will return -#' TRUE if data was assign properly to .pip env. If `simplify = FALSE`, it -#' returns a list of class "pip_api" +#' @return If `simplify = FALSE`, it returns a list of class "pip_api". If +#' `simplify = TRUE`, it returns a tibble with the requested data. This is the +#' default. Only for `get_aux()`, If `assign_tb = TRUE` or character, it +#' returns TRUE when data was assign properly to .pip env. FALSE, if it was +#' not assigned. #' @export #' @examples #' \dontrun{ diff --git a/man/get_aux.Rd b/man/get_aux.Rd index e1d8ebf..385520d 100644 --- a/man/get_aux.Rd +++ b/man/get_aux.Rd @@ -173,16 +173,16 @@ character, the table will be assigned to that name.} \item{force}{logical: force replacement. Default is FALSE} } \value{ -tibble or list. If \code{assign_tb} is TRUE or character, it will return -TRUE if data was assign properly to .pip env. If \code{simplify = FALSE}, it -returns a list of class "pip_api" +If \code{assign_tb = TRUE} or character, it returns TRUE when data was +assign properly to .pip env. FALSE, if it was not assigned. If \code{simplify = FALSE}, it returns a list of class "pip_api". If \code{simplify = TRUE}, it +returns a tibble with the requested data. This is the default. } \description{ \code{get_aux()} Get an auxiliary dataset. If no table is specified a vector with possible inputs will be returned. -\code{get_countries()} Returns a table countries with their full names, ISO codes, -and associated region code +\code{get_countries()} Returns a table countries with their full names, ISO +codes, and associated region code } \section{Functions}{ \itemize{ From 1f57b97a7e39d3a365904efc98a1bc32e5cc5b4c Mon Sep 17 00:00:00 2001 From: "R.Andres Castaneda" Date: Tue, 2 May 2023 11:02:49 -0400 Subject: [PATCH 06/15] explain functions results further --- R/get_stats.R | 6 +++++- man/get_aux.Rd | 8 +++++--- man/get_stats.Rd | 6 +++++- 3 files changed, 15 insertions(+), 5 deletions(-) diff --git a/R/get_stats.R b/R/get_stats.R index b5782da..0b0a6a6 100644 --- a/R/get_stats.R +++ b/R/get_stats.R @@ -21,7 +21,11 @@ #' `tibble` #' @param server character: Server. For WB internal use only #' -#' @return tibble or list +#' @return If `simplify = FALSE`, it returns a list of class "pip_api". If +#' `simplify = TRUE`, it returns a tibble with the requested data. This is the +#' default. Only for `get_aux()`, If `assign_tb = TRUE` or character, it +#' returns TRUE when data was assign properly to .pip env. FALSE, if it was +#' not assigned. #' @export #' #' @examples diff --git a/man/get_aux.Rd b/man/get_aux.Rd index 385520d..60209ed 100644 --- a/man/get_aux.Rd +++ b/man/get_aux.Rd @@ -173,9 +173,11 @@ character, the table will be assigned to that name.} \item{force}{logical: force replacement. Default is FALSE} } \value{ -If \code{assign_tb = TRUE} or character, it returns TRUE when data was -assign properly to .pip env. FALSE, if it was not assigned. If \code{simplify = FALSE}, it returns a list of class "pip_api". If \code{simplify = TRUE}, it -returns a tibble with the requested data. This is the default. +If \code{simplify = FALSE}, it returns a list of class "pip_api". If +\code{simplify = TRUE}, it returns a tibble with the requested data. This is the +default. Only for \code{get_aux()}, If \code{assign_tb = TRUE} or character, it +returns TRUE when data was assign properly to .pip env. FALSE, if it was +not assigned. } \description{ \code{get_aux()} Get an auxiliary dataset. If no table is specified a diff --git a/man/get_stats.Rd b/man/get_stats.Rd index 4cf3799..d42902c 100644 --- a/man/get_stats.Rd +++ b/man/get_stats.Rd @@ -72,7 +72,11 @@ sub-groups. Either 'wb_regions' or 'none'.} \item{server}{character: Server. For WB internal use only} } \value{ -tibble or list +If \code{simplify = FALSE}, it returns a list of class "pip_api". If +\code{simplify = TRUE}, it returns a tibble with the requested data. This is the +default. Only for \code{get_aux()}, If \code{assign_tb = TRUE} or character, it +returns TRUE when data was assign properly to .pip env. FALSE, if it was +not assigned. } \description{ Get poverty and inequality statistics From 6a47c2ec556bc9f8e322717a16f5bf3b2bd6be0e Mon Sep 17 00:00:00 2001 From: "R.Andres Castaneda" Date: Tue, 2 May 2023 18:30:45 -0400 Subject: [PATCH 07/15] create alternative caching --- R/aaa.R | 4 +++- R/get_stats.R | 37 +++++++++++++++++++++++++++++++++---- R/utils.R | 27 +++++++++++++++++++++++++++ R/zzz.R | 11 ++++++----- man/get_fun_hash.Rd | 15 +++++++++++++++ 5 files changed, 84 insertions(+), 10 deletions(-) create mode 100644 man/get_fun_hash.Rd diff --git a/R/aaa.R b/R/aaa.R index 84d15a3..3be10aa 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -119,7 +119,9 @@ call_aux <- function(table = NULL) { return(rlang::env_get(.pip, table)) } else { msg <- c("*" = "Table {.field {table}} does not exist") - cli::cli_abort(msg, wrap = TRUE) + cli::cli_abort(msg, + class = "pipr_error", + wrap = TRUE) } } diff --git a/R/get_stats.R b/R/get_stats.R index 0b0a6a6..0a94581 100644 --- a/R/get_stats.R +++ b/R/get_stats.R @@ -73,10 +73,19 @@ get_stats <- function(country = "all", simplify = TRUE, server = NULL) { # Match args - welfare_type <- match.arg(welfare_type) + welfare_type <- match.arg(welfare_type) reporting_level <- match.arg(reporting_level) - api_version <- match.arg(api_version) - format <- match.arg(format) + api_version <- match.arg(api_version) + format <- match.arg(format) + + # get function function hash + fhash <- get_fun_hash() + if (rlang::env_has(.pip, fhash)) { + cli::cli_alert("loading from cache") + return(rlang::env_get(.pip, fhash)) + } + + # popshare can't be used together with povline if (!is.null(popshare)) povline <- NULL @@ -116,6 +125,12 @@ get_stats <- function(country = "all", # Parse result out <- parse_response(res, simplify) + if (!rlang::env_has(.pip, fhash)) { # this should always be TRUE + cli::cli_alert("creating cache") + rlang::env_poke(env = .pip, + nm = fhash, + value = out) + } return(out) } @@ -133,7 +148,15 @@ get_wb <- function(year = "all", # Match args api_version <- match.arg(api_version) - format <- match.arg(format) + format <- match.arg(format) + + # get function function hash + fhash <- get_fun_hash() + if (rlang::env_has(.pip, fhash)) { + cli::cli_alert("loading from cache") + return(rlang::env_get(.pip, fhash)) + } + # Build query string args <- build_args( @@ -153,6 +176,12 @@ get_wb <- function(year = "all", # Parse result out <- parse_response(res, simplify) + if (!rlang::env_has(.pip, fhash)) { # this should always be TRUE + cli::cli_alert("creating cache") + rlang::env_poke(env = .pip, + nm = fhash, + value = out) + } return(out) } diff --git a/R/utils.R b/R/utils.R index 6df7e68..81d4816 100644 --- a/R/utils.R +++ b/R/utils.R @@ -193,3 +193,30 @@ tmp_rename_cols <- function(df, url = "") { return(df) } + + + + +#' Get parent function hash for caching +#' +#' @return function hash +#' @keywords internal +get_fun_hash <- function() { + # name of parent function + fname <- match.call(definition = sys.function(-1), + call = sys.call(-1))[[1]] |> + as.character() + + # get environment of parent function. this MUST placer right after all + # match.arg() calls + fargs <- + parent.frame() |> + as.list() + + # get function body in case it changes (this should not be necessary) + fbody <- body(fname) |> + as.character() + + list(fbody, fargs) |> + rlang::hash() +} diff --git a/R/zzz.R b/R/zzz.R index f6a0d22..db8cdac 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,15 +1,16 @@ .onLoad <- function(libname, pkgname) { + if (!Sys.getenv("PIPR_DISABLE_CACHING") == "TRUE") { # d <- rappdirs::user_cache_dir("pipr") # cm <- cachem::cache_disk(d, # evict = "lru", # max_size = 512 * 1024^2) - cm <- cachem::cache_mem(max_size = 512 * 1024^2, evict = "lru") - get_stats <<- memoise::memoise(get_stats, cache = cm) - get_wb <<- memoise::memoise(get_wb, cache = cm) - get_aux <<- memoise::memoise(get_aux, cache = cm) - get_versions <<- memoise::memoise(get_versions, cache = cm) + # cm <- cachem::cache_mem(max_size = 512 * 1024^2, evict = "lru") + # get_stats <<- memoise::memoise(get_stats, cache = cm) + # get_wb <<- memoise::memoise(get_wb, cache = cm) + # get_aux <<- memoise::memoise(get_aux, cache = cm) + # get_versions <<- memoise::memoise(get_versions, cache = cm) } options(cli.ignore_unknown_rstudio_theme = TRUE) diff --git a/man/get_fun_hash.Rd b/man/get_fun_hash.Rd new file mode 100644 index 0000000..c2b8c9b --- /dev/null +++ b/man/get_fun_hash.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{get_fun_hash} +\alias{get_fun_hash} +\title{Get parent function hash for caching} +\usage{ +get_fun_hash() +} +\value{ +function hash +} +\description{ +Get parent function hash for caching +} +\keyword{internal} From 41aab2954f85a684d4ce6222bee1a8a9c1cd6ca2 Mon Sep 17 00:00:00 2001 From: "R.Andres Castaneda" Date: Thu, 4 May 2023 15:13:52 -0400 Subject: [PATCH 08/15] update documentation and format --- R/aaa.R | 11 ++- R/get_aux.R | 205 ++++++++++++++++++++++++----------------- R/get_stats.R | 130 +++++++++++++------------- R/utils.R | 57 +++++++++++- man/cache_available.Rd | 35 +++++++ man/call_aux.Rd | 4 +- man/get_aux.Rd | 8 +- man/get_stats.Rd | 8 +- man/set_aux.Rd | 5 +- 9 files changed, 301 insertions(+), 162 deletions(-) create mode 100644 man/cache_available.Rd diff --git a/R/aaa.R b/R/aaa.R index 3be10aa..1e2dae6 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -1,4 +1,5 @@ -.pip <- new.env(parent = emptyenv()) +.pip <- new.env(parent = emptyenv()) +.pipcache <- new.env(parent = emptyenv()) #' Set auxiliary table in .pip environment for later call @@ -11,13 +12,13 @@ #' @keywords internal set_aux <- function(table, value, - force = FALSE) { + replace = FALSE) { #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ## Evaluate if exists -------- to_set <- 1 if (rlang::env_has(.pip, table)) { - if (force == FALSE) { + if (replace == FALSE) { cli::cli_alert("Table {.field {table}} already exists.") to_set <- utils::menu(c("Replace with new table", "Abort")) } @@ -65,12 +66,12 @@ set_aux <- function(table, #' @examples #' # call one table #' -#' get_aux("gdp", assign_tb = TRUE, force = TRUE) +#' get_aux("gdp", assign_tb = TRUE, replace = TRUE) #' call_aux("gdp") #' #' # see the name of several tables in memory #' tb <- c("cpi", "ppp", "pop") -#' lapply(tb, get_aux, assign_tb = TRUE, force = TRUE) +#' lapply(tb, get_aux, assign_tb = TRUE, replace = TRUE) #' call_aux() call_aux <- function(table = NULL) { diff --git a/R/get_aux.R b/R/get_aux.R index bab4396..5d1009f 100644 --- a/R/get_aux.R +++ b/R/get_aux.R @@ -13,7 +13,8 @@ #' assigned to exactly the same name as the one of the desired table. If #' character, the table will be assigned to that name. #' @inheritParams get_stats -#' @param force logical: force replacement. Default is FALSE +#' @param replace logical: force replacement of aux files in `.pip` env. Default +#' is FALSE #' #' @return If `simplify = FALSE`, it returns a list of class "pip_api". If #' `simplify = TRUE`, it returns a tibble with the requested data. This is the @@ -54,12 +55,21 @@ get_aux <- function(table = NULL, simplify = TRUE, server = NULL, assign_tb = FALSE, - force = FALSE) { + replace = FALSE, + force_cache = FALSE) { # Match args api_version <- match.arg(api_version) format <- match.arg(format) run_cli <- run_cli() + + # get function function hash and load if available + fhash <- get_fun_hash() + if (cache_available(fhash)) { + return(load_cache(fhash)) + } + + # Build query string u <- build_url(server, "aux", api_version = api_version) @@ -105,14 +115,14 @@ get_aux <- function(table = NULL, cli::cli_abort(msg, wrap = TRUE) } - srt <- set_aux(table = tb_name, - value = rt, - force = force) + srt <- set_aux(table = tb_name, + value = rt, + replace = replace) if (isTRUE(srt)) { - cltxt <- paste0("Auxiliary table {.strong {table}} successfully fetched. ", - "You can now call it by typing {.", + cltxt <- paste0("Auxiliary table {.strong {table}} successfully fetched.", + " You can now call it by typing {.", ifelse(run_cli, "run", "code"), " pipr::call_aux(", shQuote(tb_name), ")}") @@ -129,6 +139,9 @@ get_aux <- function(table = NULL, } else { # NO: Just return the table + save_cache(fhash = fhash, + out = rt, + force = force_cache) return(rt) } @@ -147,12 +160,14 @@ get_countries <- function(version = NULL, api_version = "v1", format = c("rds", "json", "csv"), server = NULL) { - get_aux("countries", - version = version, - ppp_version = ppp_version, + get_aux( + "countries", + version = version, + ppp_version = ppp_version, release_version = release_version, - api_version = api_version, - format = format, server = server + api_version = api_version, + format = format, + server = server ) } @@ -170,12 +185,14 @@ get_regions <- function(version = NULL, api_version = "v1", format = c("rds", "json", "csv"), server = NULL) { - get_aux("regions", - version = version, - ppp_version = ppp_version, + get_aux( + "regions", + version = version, + ppp_version = ppp_version, release_version = release_version, - api_version = api_version, - format = format, server = server + api_version = api_version, + format = format, + server = server ) } @@ -193,12 +210,14 @@ get_cpi <- function(version = NULL, api_version = "v1", format = c("rds", "json", "csv"), server = NULL) { - get_aux("cpi", - version = version, - ppp_version = ppp_version, - release_version = release_version, - api_version = api_version, - format = format, server = server + get_aux( + "cpi", + version = version, + ppp_version = ppp_version, + release_version = release_version, + api_version = api_version, + format = format, + server = server ) } @@ -216,12 +235,14 @@ get_dictionary <- function(version = NULL, api_version = "v1", format = c("rds", "json", "csv"), server = NULL) { - get_aux("dictionary", - version = version, - ppp_version = ppp_version, - release_version = release_version, - api_version = api_version, - format = format, server = server + get_aux( + "dictionary", + version = version, + ppp_version = ppp_version, + release_version = release_version, + api_version = api_version, + format = format, + server = server ) } @@ -239,12 +260,14 @@ get_gdp <- function(version = NULL, api_version = "v1", format = c("rds", "json", "csv"), server = NULL) { - get_aux("gdp", - version = version, - ppp_version = ppp_version, - release_version = release_version, - api_version = api_version, - format = format, server = server + get_aux( + "gdp", + version = version, + ppp_version = ppp_version, + release_version = release_version, + api_version = api_version, + format = format, + server = server ) } @@ -263,12 +286,14 @@ get_incgrp_coverage <- function(version = NULL, api_version = "v1", format = c("rds", "json", "csv"), server = NULL) { - get_aux("incgrp_coverage", - version = version, - ppp_version = ppp_version, - release_version = release_version, - api_version = api_version, - format = format, server = server + get_aux( + "incgrp_coverage", + version = version, + ppp_version = ppp_version, + release_version = release_version, + api_version = api_version, + format = format, + server = server ) } @@ -289,12 +314,14 @@ get_interpolated_means <- function(version = NULL, api_version = "v1", format = c("rds", "json", "csv"), server = NULL) { - get_aux("interpolated_means", - version = version, - ppp_version = ppp_version, - release_version = release_version, - api_version = api_version, - format = format, server = server + get_aux( + "interpolated_means", + version = version, + ppp_version = ppp_version, + release_version = release_version, + api_version = api_version, + format = format, + server = server ) } @@ -311,12 +338,14 @@ get_hfce <- function(version = NULL, api_version = "v1", format = c("rds", "json", "csv"), server = NULL) { - get_aux("pce", - version = version, - ppp_version = ppp_version, - release_version = release_version, - api_version = api_version, - format = format, server = server + get_aux( + "pce", + version = version, + ppp_version = ppp_version, + release_version = release_version, + api_version = api_version, + format = format, + server = server ) } @@ -333,12 +362,14 @@ get_pop <- function(version = NULL, api_version = "v1", format = c("rds", "json", "csv"), server = NULL) { - get_aux("pop", - version = version, - ppp_version = ppp_version, - release_version = release_version, - api_version = api_version, - format = format, server = server + get_aux( + "pop", + version = version, + ppp_version = ppp_version, + release_version = release_version, + api_version = api_version, + format = format, + server = server ) } @@ -356,12 +387,14 @@ get_pop_region <- function(version = NULL, api_version = "v1", format = c("rds", "json", "csv"), server = NULL) { - get_aux("pop_region", - version = version, - ppp_version = ppp_version, - release_version = release_version, - api_version = api_version, - format = format, server = server + get_aux( + "pop_region", + version = version, + ppp_version = ppp_version, + release_version = release_version, + api_version = api_version, + format = format, + server = server ) } @@ -379,12 +412,14 @@ get_ppp <- function(version = NULL, api_version = "v1", format = c("rds", "json", "csv"), server = NULL) { - get_aux("ppp", - version = version, - ppp_version = ppp_version, - release_version = release_version, - api_version = api_version, - format = format, server = server + get_aux( + "ppp", + version = version, + ppp_version = ppp_version, + release_version = release_version, + api_version = api_version, + format = format, + server = server ) } @@ -401,12 +436,14 @@ get_region_coverage <- function(version = NULL, api_version = "v1", format = c("rds", "json", "csv"), server = NULL) { - get_aux("region_coverage", - version = version, - ppp_version = ppp_version, - release_version = release_version, - api_version = api_version, - format = format, server = server + get_aux( + "region_coverage", + version = version, + ppp_version = ppp_version, + release_version = release_version, + api_version = api_version, + format = format, + server = server ) } @@ -425,11 +462,13 @@ get_survey_means <- function(version = NULL, api_version = "v1", format = c("rds", "json", "csv"), server = NULL) { - get_aux("survey_means", - version = version, - ppp_version = ppp_version, - release_version = release_version, - api_version = api_version, - format = format, server = server + get_aux( + "survey_means", + version = version, + ppp_version = ppp_version, + release_version = release_version, + api_version = api_version, + format = format, + server = server ) } diff --git a/R/get_stats.R b/R/get_stats.R index 0a94581..b23d33f 100644 --- a/R/get_stats.R +++ b/R/get_stats.R @@ -20,6 +20,7 @@ #' @param simplify logical: If TRUE (the default) the response is returned as a #' `tibble` #' @param server character: Server. For WB internal use only +#' @param force_cache Logical: force creation of cache even when available #' #' @return If `simplify = FALSE`, it returns a list of class "pip_api". If #' `simplify = TRUE`, it returns a tibble with the requested data. This is the @@ -57,42 +58,41 @@ #' # Custom aggregates #' res <- get_stats(c("ARG", "BRA"), year = "all", subgroup = "none") #' } -get_stats <- function(country = "all", - year = "all", - povline = NULL, - popshare = NULL, - fill_gaps = FALSE, - subgroup = NULL, - welfare_type = c("all", "income", "consumption"), +get_stats <- function(country = "all", + year = "all", + povline = NULL, + popshare = NULL, + fill_gaps = FALSE, + subgroup = NULL, + welfare_type = c("all", "income", "consumption"), reporting_level = c("all", "national", "urban", "rural"), - version = NULL, - ppp_version = NULL, + version = NULL, + ppp_version = NULL, release_version = NULL, - api_version = "v1", - format = c("rds", "json", "csv"), - simplify = TRUE, - server = NULL) { + api_version = "v1", + format = c("rds", "json", "csv"), + simplify = TRUE, + server = NULL, + force_cache = FALSE) { # Match args welfare_type <- match.arg(welfare_type) reporting_level <- match.arg(reporting_level) api_version <- match.arg(api_version) format <- match.arg(format) - # get function function hash + # get function function hash and load if available fhash <- get_fun_hash() - if (rlang::env_has(.pip, fhash)) { - cli::cli_alert("loading from cache") - return(rlang::env_get(.pip, fhash)) + if (cache_available(fhash)) { + return(load_cache(fhash)) } - # popshare can't be used together with povline if (!is.null(popshare)) povline <- NULL if (!is.null(subgroup)) { fill_gaps <- NULL # subgroup can't be used together with fill_gaps - endpoint <- "pip-grp" - subgroup <- match.arg(subgroup, c("none", "wb_regions")) + endpoint <- "pip-grp" + subgroup <- match.arg(subgroup, c("none", "wb_regions")) if (subgroup == "wb_regions") { group_by <- "wb" } else { @@ -105,83 +105,85 @@ get_stats <- function(country = "all", # Build query string args <- build_args( - .country = country, - .year = year, - .povline = povline, - .popshare = popshare, - .fill_gaps = fill_gaps, - .group_by = group_by, - .welfare_type = welfare_type, + .country = country, + .year = year, + .povline = povline, + .popshare = popshare, + .fill_gaps = fill_gaps, + .group_by = group_by, + .welfare_type = welfare_type, .reporting_level = reporting_level, - .version = version, - .ppp_version = ppp_version, + .version = version, + .ppp_version = ppp_version, .release_version = release_version, - .format = format + .format = format ) + u <- build_url(server, endpoint, api_version) + # Send query - res <- httr::GET(u, query = args, httr::user_agent(pipr_user_agent)) + res <- httr::GET(url = u, + query = args, + config = httr::user_agent(pipr_user_agent)) # Parse result - out <- parse_response(res, simplify) + out <- parse_response(res = res, + simplify = simplify) - if (!rlang::env_has(.pip, fhash)) { # this should always be TRUE - cli::cli_alert("creating cache") - rlang::env_poke(env = .pip, - nm = fhash, - value = out) - } + save_cache(fhash = fhash, + out = out, + force = force_cache) return(out) } #' @rdname get_stats #' @export -get_wb <- function(year = "all", - povline = 1.9, - version = NULL, - ppp_version = NULL, +get_wb <- function(year = "all", + povline = 1.9, + version = NULL, + ppp_version = NULL, release_version = NULL, - api_version = "v1", - format = c("rds", "json", "csv"), - simplify = TRUE, - server = NULL) { + api_version = "v1", + format = c("rds", "json", "csv"), + simplify = TRUE, + server = NULL, + force_cache = FALSE) { # Match args api_version <- match.arg(api_version) format <- match.arg(format) - # get function function hash + # get function function hash and load if available fhash <- get_fun_hash() - if (rlang::env_has(.pip, fhash)) { - cli::cli_alert("loading from cache") - return(rlang::env_get(.pip, fhash)) + if (cache_available(fhash)) { + return(load_cache(fhash)) } # Build query string args <- build_args( - .country = "all", - .year = year, - .povline = povline, - .group_by = "wb", - .version = version, - .ppp_version = ppp_version, + .country = "all", + .year = year, + .povline = povline, + .group_by = "wb", + .version = version, + .ppp_version = ppp_version, .release_version = release_version, - .format = format + .format = format ) u <- build_url(server, "pip-grp", api_version) # Send query - res <- httr::GET(u, query = args, httr::user_agent(pipr_user_agent)) + res <- httr::GET(url = u, + query = args, + config = httr::user_agent(pipr_user_agent)) # Parse result out <- parse_response(res, simplify) - if (!rlang::env_has(.pip, fhash)) { # this should always be TRUE - cli::cli_alert("creating cache") - rlang::env_poke(env = .pip, - nm = fhash, - value = out) - } + + save_cache(fhash = fhash, + out = out, + force = force_cache) return(out) } diff --git a/R/utils.R b/R/utils.R index 81d4816..a4a10aa 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,3 +1,7 @@ +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Parsing and checking functions ------------- +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + #' check_internet #' @noRd check_internet <- function() { @@ -178,6 +182,11 @@ select_base_url <- function(server) { return(base_url) } + +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Formatting functions ------------- +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + #' Rename columns #' TEMP function to rename response cols #' @param df A data.frame @@ -194,8 +203,9 @@ tmp_rename_cols <- function(df, url = "") { return(df) } - - +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Caching functions ------------- +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #' Get parent function hash for caching #' @@ -220,3 +230,46 @@ get_fun_hash <- function() { list(fbody, fargs) |> rlang::hash() } + + +#' Check if cache is available +#' +#' @param fhash character: hash of calling function +#' +#' @return function hash +#' @keywords internal +cache_available <- function(fhash) { + rlang::env_has(.pipcache, fhash) +} + + +#' @describeIn cache_available Load cached data +load_cache <- function(fhash) { + + cli::cli_alert("loading from cache") + rlang::env_get(.pipcache, fhash) + +} + +#' @param out data to be cached +#' @param force logical. If TRUE force the creation of cache. Default is FALSE +#' +#' @describeIn cache_available Saves cache data +save_cache <- function(fhash, out, force = FALSE) { + + # early return + if (cache_available(fhash) && force == FALSE) { + return(invisible(TRUE)) + } + + # save cache + cli::cli_alert("creating cache") + rlang::env_poke(env = .pipcache, + nm = fhash, + value = out) + + # Return invisible available of cache + cache_available(fhash) |> + invisible() +} + diff --git a/man/cache_available.Rd b/man/cache_available.Rd new file mode 100644 index 0000000..0583492 --- /dev/null +++ b/man/cache_available.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{cache_available} +\alias{cache_available} +\alias{load_cache} +\alias{save_cache} +\title{Check if cache is available} +\usage{ +cache_available(fhash) + +load_cache(fhash) + +save_cache(fhash, out, force = FALSE) +} +\arguments{ +\item{fhash}{character: hash of calling function} + +\item{out}{data to be cached} + +\item{force}{logical. If TRUE force the creation of cache. Default is FALSE} +} +\value{ +function hash +} +\description{ +Check if cache is available +} +\section{Functions}{ +\itemize{ +\item \code{load_cache()}: Load cached data + +\item \code{save_cache()}: Saves cache data + +}} +\keyword{internal} diff --git a/man/call_aux.Rd b/man/call_aux.Rd index 6487b0e..e93aaa5 100644 --- a/man/call_aux.Rd +++ b/man/call_aux.Rd @@ -19,11 +19,11 @@ call a table from .pip env \examples{ # call one table -get_aux("gdp", assign_tb = TRUE, force = TRUE) +get_aux("gdp", assign_tb = TRUE, replace = TRUE) call_aux("gdp") # see the name of several tables in memory tb <- c("cpi", "ppp", "pop") -lapply(tb, get_aux, assign_tb = TRUE, force = TRUE) +lapply(tb, get_aux, assign_tb = TRUE, replace = TRUE) call_aux() } diff --git a/man/get_aux.Rd b/man/get_aux.Rd index 60209ed..ee584b5 100644 --- a/man/get_aux.Rd +++ b/man/get_aux.Rd @@ -27,7 +27,8 @@ get_aux( simplify = TRUE, server = NULL, assign_tb = FALSE, - force = FALSE + replace = FALSE, + force_cache = FALSE ) get_countries( @@ -170,7 +171,10 @@ If \code{FALSE} no assignment will performed. If \code{TRUE}, the table will be assigned to exactly the same name as the one of the desired table. If character, the table will be assigned to that name.} -\item{force}{logical: force replacement. Default is FALSE} +\item{replace}{logical: force replacement of aux files in \code{.pip} env. Default +is FALSE} + +\item{force_cache}{Logical: force creation of cache even when available} } \value{ If \code{simplify = FALSE}, it returns a list of class "pip_api". If diff --git a/man/get_stats.Rd b/man/get_stats.Rd index d42902c..e8d71b3 100644 --- a/man/get_stats.Rd +++ b/man/get_stats.Rd @@ -20,7 +20,8 @@ get_stats( api_version = "v1", format = c("rds", "json", "csv"), simplify = TRUE, - server = NULL + server = NULL, + force_cache = FALSE ) get_wb( @@ -32,7 +33,8 @@ get_wb( api_version = "v1", format = c("rds", "json", "csv"), simplify = TRUE, - server = NULL + server = NULL, + force_cache = FALSE ) } \arguments{ @@ -70,6 +72,8 @@ sub-groups. Either 'wb_regions' or 'none'.} \code{tibble}} \item{server}{character: Server. For WB internal use only} + +\item{force_cache}{Logical: force creation of cache even when available} } \value{ If \code{simplify = FALSE}, it returns a list of class "pip_api". If diff --git a/man/set_aux.Rd b/man/set_aux.Rd index 2d097fe..494f199 100644 --- a/man/set_aux.Rd +++ b/man/set_aux.Rd @@ -4,14 +4,15 @@ \alias{set_aux} \title{Set auxiliary table in .pip environment for later call} \usage{ -set_aux(table, value, force = FALSE) +set_aux(table, value, replace = FALSE) } \arguments{ \item{table}{character: name of the table in .pip env} \item{value}{data to be saved} -\item{force}{logical: force replacement. Default is FALSE} +\item{replace}{logical: force replacement of aux files in \code{.pip} env. Default +is FALSE} } \value{ Invisible TRUE if set correctly. FALSE otherwise From abf1cfcf89ee606bba0966d61dba8a26afb22f16 Mon Sep 17 00:00:00 2001 From: "R.Andres Castaneda" Date: Thu, 4 May 2023 17:48:30 -0400 Subject: [PATCH 09/15] document and fix tests with new caching --- DESCRIPTION | 2 - R/aaa.R | 2 +- R/get_aux.R | 2 +- R/get_stats.R | 6 +- R/utils.R | 78 +++++++++++++++++++----- R/zzz.R | 14 +---- man/call_aux.Rd | 2 +- man/{cache_available.Rd => is_cached.Rd} | 12 ++-- tests/testthat/test-caching.R | 41 ++++++++++--- tests/testthat/test-get_aux.R | 4 +- 10 files changed, 114 insertions(+), 49 deletions(-) rename man/{cache_available.Rd => is_cached.Rd} (72%) diff --git a/DESCRIPTION b/DESCRIPTION index a577330..e6f2c09 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -57,8 +57,6 @@ Imports: jsonlite, tibble, purrr, - memoise, - cachem, data.table, cli, rlang, diff --git a/R/aaa.R b/R/aaa.R index 1e2dae6..0eda33d 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -71,7 +71,7 @@ set_aux <- function(table, #' #' # see the name of several tables in memory #' tb <- c("cpi", "ppp", "pop") -#' lapply(tb, get_aux, assign_tb = TRUE, replace = TRUE) +#' lr <- lapply(tb, get_aux, assign_tb = TRUE, replace = TRUE) #' call_aux() call_aux <- function(table = NULL) { diff --git a/R/get_aux.R b/R/get_aux.R index 5d1009f..09c520c 100644 --- a/R/get_aux.R +++ b/R/get_aux.R @@ -65,7 +65,7 @@ get_aux <- function(table = NULL, # get function function hash and load if available fhash <- get_fun_hash() - if (cache_available(fhash)) { + if (is_cached(fhash = fhash)) { return(load_cache(fhash)) } diff --git a/R/get_stats.R b/R/get_stats.R index b23d33f..a9b56cd 100644 --- a/R/get_stats.R +++ b/R/get_stats.R @@ -82,7 +82,7 @@ get_stats <- function(country = "all", # get function function hash and load if available fhash <- get_fun_hash() - if (cache_available(fhash)) { + if (is_cached(fhash = fhash)) { return(load_cache(fhash)) } @@ -129,10 +129,10 @@ get_stats <- function(country = "all", # Parse result out <- parse_response(res = res, simplify = simplify) - save_cache(fhash = fhash, out = out, force = force_cache) + return(out) } @@ -155,7 +155,7 @@ get_wb <- function(year = "all", # get function function hash and load if available fhash <- get_fun_hash() - if (cache_available(fhash)) { + if (is_cached(fhash = fhash)) { return(load_cache(fhash)) } diff --git a/R/utils.R b/R/utils.R index a4a10aa..f4c2e4e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -193,12 +193,24 @@ select_base_url <- function(server) { #' @param url response url #' @noRd tmp_rename_cols <- function(df, url = "") { - df <- data.table::setnames( - df, - old = c("survey_year", "reporting_year", "reporting_pop", "reporting_gdp", "reporting_pce", "pce_data_level"), - new = c("welfare_time", "year", "pop", "gdp", "hfce", "hfce_data_level"), - skip_absent = TRUE - ) + data.table::setnames( + df, + old = c( + "survey_year", + "reporting_year", + "reporting_pop", + "reporting_gdp", + "reporting_pce", + "pce_data_level" + ), + new = c("welfare_time", + "year", + "pop", + "gdp", + "hfce", + "hfce_data_level"), + skip_absent = TRUE + ) return(df) } @@ -213,8 +225,17 @@ tmp_rename_cols <- function(df, url = "") { #' @keywords internal get_fun_hash <- function() { # name of parent function + + scall <- sys.call(-1) + chcall <- as.character(scall) + + # early return + if (!grepl("^get_", chcall[1])) { + return(invisible(FALSE)) + } + fname <- match.call(definition = sys.function(-1), - call = sys.call(-1))[[1]] |> + call = scall)[[1]] |> as.character() # get environment of parent function. this MUST placer right after all @@ -234,18 +255,42 @@ get_fun_hash <- function() { #' Check if cache is available #' +#' Checks whether hash or dataframe is cached. Only of the two is +#' +#' @param df dataframe #' @param fhash character: hash of calling function #' -#' @return function hash +#' @return logical. whether the hash exist of the dataframe is cached. #' @keywords internal -cache_available <- function(fhash) { - rlang::env_has(.pipcache, fhash) +is_cached <- function(df = NULL, fhash = NULL) { + + stopifnot(exprs = { + !(is.null(fhash) && is.null(df)) # both null + !(!is.null(fhash) && !is.null(df)) # both no null + }) + + ic <- + if (isFALSE(fhash)) { + FALSE + } + else if (!is.null(fhash)) { + rlang::env_has(.pipcache, fhash) + } else { + attr(df, "is_cached") + } + + ic } -#' @describeIn cache_available Load cached data +#' @describeIn is_cached Load cached data load_cache <- function(fhash) { + # early return + if (isFALSE(fhash)) { + return(invisible(FALSE)) + } + cli::cli_alert("loading from cache") rlang::env_get(.pipcache, fhash) @@ -254,22 +299,27 @@ load_cache <- function(fhash) { #' @param out data to be cached #' @param force logical. If TRUE force the creation of cache. Default is FALSE #' -#' @describeIn cache_available Saves cache data +#' @describeIn is_cached Saves cache data save_cache <- function(fhash, out, force = FALSE) { # early return - if (cache_available(fhash) && force == FALSE) { + if (isFALSE(fhash)) { + return(invisible(FALSE)) + } + + if (is_cached(fhash = fhash) && force == FALSE) { return(invisible(TRUE)) } # save cache cli::cli_alert("creating cache") + attr(out, "is_cached") <- TRUE rlang::env_poke(env = .pipcache, nm = fhash, value = out) # Return invisible available of cache - cache_available(fhash) |> + is_cached(out) |> invisible() } diff --git a/R/zzz.R b/R/zzz.R index db8cdac..3c2984a 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,24 +1,12 @@ .onLoad <- function(libname, pkgname) { - if (!Sys.getenv("PIPR_DISABLE_CACHING") == "TRUE") { - # d <- rappdirs::user_cache_dir("pipr") - # cm <- cachem::cache_disk(d, - # evict = "lru", - # max_size = 512 * 1024^2) - # cm <- cachem::cache_mem(max_size = 512 * 1024^2, evict = "lru") - # get_stats <<- memoise::memoise(get_stats, cache = cm) - # get_wb <<- memoise::memoise(get_wb, cache = cm) - # get_aux <<- memoise::memoise(get_aux, cache = cm) - # get_versions <<- memoise::memoise(get_versions, cache = cm) - } - options(cli.ignore_unknown_rstudio_theme = TRUE) } .onAttach <- function(libname, pkgname) { if (!Sys.getenv("PIPR_DISABLE_CACHING") == "TRUE") { - packageStartupMessage("Info: Session based caching is enabled.") + # packageStartupMessage("Info: Session based caching is enabled.") } } diff --git a/man/call_aux.Rd b/man/call_aux.Rd index e93aaa5..bced92f 100644 --- a/man/call_aux.Rd +++ b/man/call_aux.Rd @@ -24,6 +24,6 @@ call_aux("gdp") # see the name of several tables in memory tb <- c("cpi", "ppp", "pop") -lapply(tb, get_aux, assign_tb = TRUE, replace = TRUE) +lr <- lapply(tb, get_aux, assign_tb = TRUE, replace = TRUE) call_aux() } diff --git a/man/cache_available.Rd b/man/is_cached.Rd similarity index 72% rename from man/cache_available.Rd rename to man/is_cached.Rd index 0583492..247a373 100644 --- a/man/cache_available.Rd +++ b/man/is_cached.Rd @@ -1,18 +1,20 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R -\name{cache_available} -\alias{cache_available} +\name{is_cached} +\alias{is_cached} \alias{load_cache} \alias{save_cache} \title{Check if cache is available} \usage{ -cache_available(fhash) +is_cached(df = NULL, fhash = NULL) load_cache(fhash) save_cache(fhash, out, force = FALSE) } \arguments{ +\item{df}{dataframe} + \item{fhash}{character: hash of calling function} \item{out}{data to be cached} @@ -20,10 +22,10 @@ save_cache(fhash, out, force = FALSE) \item{force}{logical. If TRUE force the creation of cache. Default is FALSE} } \value{ -function hash +logical. whether the hash exist of the dataframe is cached. } \description{ -Check if cache is available +Checks whether hash or dataframe is cached. Only of the two is } \section{Functions}{ \itemize{ diff --git a/tests/testthat/test-caching.R b/tests/testthat/test-caching.R index ca55a93..429b24e 100644 --- a/tests/testthat/test-caching.R +++ b/tests/testthat/test-caching.R @@ -4,18 +4,45 @@ test_that("Caching is enabled by default", { skip_on_cran() # Setup external R session r <- callr::r_session$new(options = callr::r_session_options(user_profile = FALSE)) - r$run(function() Sys.setenv("PIPR_DISABLE_CACHING" = "FALSE")) + # r$run(function() Sys.setenv("PIPR_DISABLE_CACHING" = "FALSE")) r$run(function() library(pipr)) # Check that main functions are cached - tmp <- r$run(function() memoise::is.memoised(get_stats)) - expect_true(tmp) - tmp <- r$run(function() memoise::is.memoised(get_wb)) - expect_true(tmp) - tmp <- r$run(function() memoise::is.memoised(get_aux)) - expect_true(tmp) + + ## get_stats ------ + r$run(function() get_stats()) |> + pipr:::is_cached(df = _) |> + expect_null() + + + r$run(function() get_stats()) |> + pipr:::is_cached(df = _) |> + expect_true() + + ## get_wb ------ + r$run(function() get_wb()) |> + pipr:::is_cached(df = _) |> + expect_null() + + + r$run(function() get_wb()) |> + pipr:::is_cached(df = _) |> + expect_true() + + ## get_aux ------ + r$run(function() get_aux(table = "countries")) |> + pipr:::is_cached(df = _) |> + expect_null() + + + r$run(function() get_aux(table = "countries")) |> + pipr:::is_cached(df = _) |> + expect_true() + + r$kill() }) +skip("can't not be disabled right not") test_that("Caching can be disabled", { skip_on_cran() # Setup external R session diff --git a/tests/testthat/test-get_aux.R b/tests/testthat/test-get_aux.R index 4579f64..2728db6 100644 --- a/tests/testthat/test-get_aux.R +++ b/tests/testthat/test-get_aux.R @@ -71,7 +71,7 @@ test_that("get_countries() works", { res <- get_countries() res2 <- get_aux("countries") expect_true(tibble::is_tibble(res)) - expect_identical(res, res2) + expect_identical(res, res2, ignore_attr = TRUE) }) test_that("get_regions() works", { @@ -80,7 +80,7 @@ test_that("get_regions() works", { res <- get_regions() res2 <- get_aux("regions") expect_true(tibble::is_tibble(res)) - expect_identical(res, res2) + expect_identical(res, res2, ignore_attr = TRUE) }) From f2a7e34b1f986a557f427145f7c0d677240d53e4 Mon Sep 17 00:00:00 2001 From: "R.Andres Castaneda" Date: Thu, 4 May 2023 18:49:44 -0400 Subject: [PATCH 10/15] remove data.table import --- DESCRIPTION | 1 - R/utils.R | 79 +++++++++++++++++++++++++++++++++++------------ man/renamecols.Rd | 22 +++++++++++++ 3 files changed, 82 insertions(+), 20 deletions(-) create mode 100644 man/renamecols.Rd diff --git a/DESCRIPTION b/DESCRIPTION index e6f2c09..dec3cfd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -57,7 +57,6 @@ Imports: jsonlite, tibble, purrr, - data.table, cli, rlang, utils diff --git a/R/utils.R b/R/utils.R index f4c2e4e..e8c5af2 100644 --- a/R/utils.R +++ b/R/utils.R @@ -117,7 +117,8 @@ build_args <- function(.country = NULL, parse_response <- function(res, simplify) { # Get response type - type <- tryCatch(suppressWarnings(httr::http_type(res)), error = function(e) NULL) + type <- tryCatch(suppressWarnings(httr::http_type(res)), + error = function(e) NULL) # Stop if response type is unknown attempt::stop_if(is.null(type), msg = "Invalid response format") @@ -187,32 +188,72 @@ select_base_url <- function(server) { # Formatting functions ------------- #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +#' rename columns in dataframe +#' +#' @param df data frame +#' @param oldnames character: old names +#' @param newnames character: new names +#' +#' @return data frame with new names +#' @keywords internal +renamecols <- function(df, oldnames, newnames) { + + # __________________________________________________________ + # Defenses #### + stopifnot( exprs = { + is.data.frame(df) + length(oldnames) == length(newnames) + # all(oldnames %in% names(df)) + } + ) + + # _______________________________________________________________ + # Computations #### + df_names <- names(df) + old_position <- which(oldnames %in% df_names) + old_available <- oldnames[old_position] + new_available <- newnames[old_position] + + for (i in seq_along(old_available)) { + tochange <- which(df_names %in% old_available[i]) + df_names[tochange] <- new_available[i] + } + + names(df) <- df_names + + # ________________________________________________________________ + # Return #### + return(df) + +} + + #' Rename columns #' TEMP function to rename response cols #' @param df A data.frame #' @param url response url #' @noRd tmp_rename_cols <- function(df, url = "") { - data.table::setnames( - df, - old = c( - "survey_year", - "reporting_year", - "reporting_pop", - "reporting_gdp", - "reporting_pce", - "pce_data_level" - ), - new = c("welfare_time", - "year", - "pop", - "gdp", - "hfce", - "hfce_data_level"), - skip_absent = TRUE + + oldnames = c( + "survey_year", + "reporting_year", + "reporting_pop", + "reporting_gdp", + "reporting_pce", + "pce_data_level" ) - return(df) + newnames = c("welfare_time", + "year", + "pop", + "gdp", + "hfce", + "hfce_data_level") + + renamecols(df,oldnames, newnames = newnames) } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/man/renamecols.Rd b/man/renamecols.Rd new file mode 100644 index 0000000..087edaf --- /dev/null +++ b/man/renamecols.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{renamecols} +\alias{renamecols} +\title{rename columns in dataframe} +\usage{ +renamecols(df, oldnames, newnames) +} +\arguments{ +\item{df}{data frame} + +\item{oldnames}{character: old names} + +\item{newnames}{character: new names} +} +\value{ +data frame with new names +} +\description{ +rename columns in dataframe +} +\keyword{internal} From 39f6b84e2403aa2de2bed71965cc7253963dc4c9 Mon Sep 17 00:00:00 2001 From: "R.Andres Castaneda" Date: Thu, 4 May 2023 18:52:09 -0400 Subject: [PATCH 11/15] update --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index e8c5af2..eaab0a4 100644 --- a/R/utils.R +++ b/R/utils.R @@ -253,7 +253,7 @@ tmp_rename_cols <- function(df, url = "") { "hfce", "hfce_data_level") - renamecols(df,oldnames, newnames = newnames) + renamecols(df,oldnames, newnames) } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From aa85f33ef23825ec1b4f9ba285896c7797f12f1f Mon Sep 17 00:00:00 2001 From: "R.Andres Castaneda" Date: Thu, 4 May 2023 18:53:52 -0400 Subject: [PATCH 12/15] remove unnecesary tests --- tests/testthat/test-caching.R | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/tests/testthat/test-caching.R b/tests/testthat/test-caching.R index 429b24e..3fb36ea 100644 --- a/tests/testthat/test-caching.R +++ b/tests/testthat/test-caching.R @@ -41,20 +41,3 @@ test_that("Caching is enabled by default", { r$kill() }) - -skip("can't not be disabled right not") -test_that("Caching can be disabled", { - skip_on_cran() - # Setup external R session - r <- callr::r_session$new(options = callr::r_session_options(user_profile = FALSE)) - r$run(function() Sys.setenv("PIPR_DISABLE_CACHING" = "TRUE")) - r$run(function() library(pipr)) - # Check that main functions are NOT cached - tmp <- r$run(function() memoise::is.memoised(get_stats)) - expect_false(tmp) - tmp <- r$run(function() memoise::is.memoised(get_wb)) - expect_false(tmp) - tmp <- r$run(function() memoise::is.memoised(get_aux)) - expect_false(tmp) - r$kill() -}) From a83c7d29d0675d380a5f2f888c809ef427e2c287 Mon Sep 17 00:00:00 2001 From: "R.Andres Castaneda" Date: Thu, 4 May 2023 21:59:29 -0400 Subject: [PATCH 13/15] improve renamecols efficiency --- R/utils.R | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/R/utils.R b/R/utils.R index eaab0a4..631ce89 100644 --- a/R/utils.R +++ b/R/utils.R @@ -200,8 +200,8 @@ select_base_url <- function(server) { #' @keywords internal renamecols <- function(df, oldnames, newnames) { - # __________________________________________________________ - # Defenses #### + # _______________________________________ + # Defenses #### stopifnot( exprs = { is.data.frame(df) length(oldnames) == length(newnames) @@ -209,22 +209,25 @@ renamecols <- function(df, oldnames, newnames) { } ) - # _______________________________________________________________ - # Computations #### + # ___________________________________________ + # Computations #### df_names <- names(df) + old_position <- which(oldnames %in% df_names) old_available <- oldnames[old_position] new_available <- newnames[old_position] + tochange <- vector(length = length(old_available)) + for (i in seq_along(old_available)) { - tochange <- which(df_names %in% old_available[i]) - df_names[tochange] <- new_available[i] + tochange[i] <- which(df_names %in% old_available[i]) } - names(df) <- df_names + names(df)[tochange] <- new_available + - # ________________________________________________________________ - # Return #### + # ____________________________________________ + # Return #### return(df) } From 8e15a47ae2b0750cac9dd4c2177a05ae80d77a90 Mon Sep 17 00:00:00 2001 From: "R.Andres Castaneda" Date: Fri, 5 May 2023 10:08:20 -0400 Subject: [PATCH 14/15] implement Ronak suggestions --- R/aaa.R | 2 +- R/utils.R | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/aaa.R b/R/aaa.R index 0eda33d..e1e4534 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -18,7 +18,7 @@ set_aux <- function(table, to_set <- 1 if (rlang::env_has(.pip, table)) { - if (replace == FALSE) { + if (isFALSE(replace)) { cli::cli_alert("Table {.field {table}} already exists.") to_set <- utils::menu(c("Replace with new table", "Abort")) } diff --git a/R/utils.R b/R/utils.R index 631ce89..d8f40b8 100644 --- a/R/utils.R +++ b/R/utils.R @@ -198,7 +198,7 @@ select_base_url <- function(server) { #' #' @return data frame with new names #' @keywords internal -renamecols <- function(df, oldnames, newnames) { +rename_cols <- function(df, oldnames, newnames) { # _______________________________________ # Defenses #### @@ -256,7 +256,7 @@ tmp_rename_cols <- function(df, url = "") { "hfce", "hfce_data_level") - renamecols(df,oldnames, newnames) + rename_cols(df,oldnames, newnames) } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -351,7 +351,7 @@ save_cache <- function(fhash, out, force = FALSE) { return(invisible(FALSE)) } - if (is_cached(fhash = fhash) && force == FALSE) { + if (is_cached(fhash = fhash) && isFALSE(force)) { return(invisible(TRUE)) } From 20edbfb6f29522c0fba56bd2ba314977da2e426f Mon Sep 17 00:00:00 2001 From: "R.Andres Castaneda" Date: Wed, 10 May 2023 14:54:29 -0400 Subject: [PATCH 15/15] update documentation --- man/{renamecols.Rd => rename_cols.Rd} | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) rename man/{renamecols.Rd => rename_cols.Rd} (82%) diff --git a/man/renamecols.Rd b/man/rename_cols.Rd similarity index 82% rename from man/renamecols.Rd rename to man/rename_cols.Rd index 087edaf..9443ad3 100644 --- a/man/renamecols.Rd +++ b/man/rename_cols.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R -\name{renamecols} -\alias{renamecols} +\name{rename_cols} +\alias{rename_cols} \title{rename columns in dataframe} \usage{ -renamecols(df, oldnames, newnames) +rename_cols(df, oldnames, newnames) } \arguments{ \item{df}{data frame}