Merge pull request #27 from moj-analytical-services/dev

Update master branch

.Rbuildignore

@@ -3,4 +3,4 @@
 ^packrat/
 ^\.Rprofile$
 ^codecov\.yml$
-.travis.yml
+^\.github$

.github/.gitignore

@@ -0,0 +1 @@
+*.html

.github/workflows/R-CMD-check.yaml

@@ -0,0 +1,58 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/master/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [dev, main, master]
+  pull_request:
+    branches: [dev, main, master]
+
+name: R-CMD-check
+
+jobs:
+  R-CMD-check:
+    runs-on: ${{ matrix.config.os }}
+
+    name: ${{ matrix.config.os }} (${{ matrix.config.r }})
+
+    strategy:
+      fail-fast: false
+      matrix:
+        config:
+          - {os: macOS-latest,   r: 'release'}
+          - {os: windows-latest, r: 'release'}
+          - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
+          - {os: ubuntu-latest,   r: 'release'}
+          - {os: ubuntu-latest,   r: 'oldrel-1'}
+
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      R_KEEP_PKG_SOURCE: yes
+
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-pandoc@v1
+
+      - uses: r-lib/actions/setup-r@v1
+        with:
+          r-version: ${{ matrix.config.r }}
+          http-user-agent: ${{ matrix.config.http-user-agent }}
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v1
+        with:
+          extra-packages: rcmdcheck
+
+      - uses: r-lib/actions/check-r-package@v1
+
+      - name: Show testthat output
+        if: always()
+        run: find check -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload check results
+        if: failure()
+        uses: actions/upload-artifact@main
+        with:
+          name: ${{ runner.os }}-r${{ matrix.config.r }}-results
+          path: check

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: mojrap
 Type: Package
 Title: Generic Functions for Reproducible Analytical Pipelines in MoJ
-Version: 0.1.0
+Version: 0.2.0
 Authors@R: c(
     person("Christopher", "Fairbanks", , "[email protected]", c("aut")),
     person("Ross", "Kennedy", , "[email protected]", role = "aut"),
@@ -11,6 +11,7 @@ Description: Package to hold generic functions for MoJ RAP projects.
 License: GPL-3
 Encoding: UTF-8
 Imports:
+    s3tools,
     scales,
     lubridate,
     dplyr,
@@ -20,7 +21,14 @@ Imports:
     data.table,
     formattable,
     stringr,
-    openxlsx
+    openxlsx,
+    tibble,
+    magrittr,
+    haven,
+    readr,
+    rlang
+Remotes:
+    moj-analytical-services/s3tools
 LazyData: true
 RoxygenNote: 7.1.1
 Suggests: 

NAMESPACE

@@ -1,9 +1,14 @@
 # Generated by roxygen2: do not edit by hand
 
+export(addSuperScriptToCell)
+export(add_lookups)
 export(arrow_image)
 export(arrow_pdf)
 export(arrow_utf)
 export(as_number)
+export(change)
+export(change_desc)
+export(choose_value)
 export(col_series)
 export(connector)
 export(date_type)
@@ -14,8 +19,12 @@ export(incdec)
 export(moj_col)
 export(mojquarter)
 export(pluralise)
+export(previous_quarter)
 export(pub_date)
 export(quarter_dates)
+export(read_cases_to_data)
 export(write_formatted_table)
 importFrom(lubridate,"%m+%")
 importFrom(lubridate,"%m-%")
+importFrom(magrittr,"%>%")
+importFrom(rlang,.data)

R/add_lookups.R

@@ -0,0 +1,53 @@
+# add lookups
+#
+#' @title Add values from a lookup file stored in S3 to a dataset
+#
+#' @description Takes a vector of lookup files stored as CSVs in S3 and matches them to a data frame by a corresponding vector of variables.
+#' The file and variable names must be in the same position in their respective vectors and both vectors must be the same length.
+#
+#' @param data Data frame the lookups are to be added to.
+#' @param path A character vector of paths to lookup files in S3.
+#' @param vars A character vector of variables by which to join the lookups to the data.
+#'
+#' @examples
+#' \dontrun{
+#' add_lookups(mydata,"alpha-test-data/lookup-file.csv","regionname")
+#' # joins lookup-file.csv to mydata by variable "regionname".
+#' }
+#' @export
+#'
+
+
+add_lookups <- function(data,path,vars){
+
+  # checks on arguments-----------
+
+  if (length(path) != length(vars)){
+
+    stop("Argument 'path' and argument 'vars' must be the same length.")
+
+  } else if (!is.character(path)) {
+
+    stop("Argument 'path' must be a character vector")
+
+  } else if (!is.character(vars)) {
+
+    stop("Argument 'vars' must be a character vector")
+
+  }
+
+  # MAIN BODY----------------------
+
+  for (i in 1: length(path)) {
+
+    lookup <- s3tools::read_using(FUN = readr::read_csv,
+                                s3_path = path[i],
+                                col_types = readr::cols(.default = "c"))
+
+    data <- dplyr::left_join(data,lookup,by = vars[i])
+
+  }
+
+  return(data)
+
+}

R/change.R

@@ -0,0 +1,129 @@
+#' Calculate changes over a given time period
+#'
+#' Calculates either the absolute or percentage change in a given variable from a dataframe over a certain period of time.
+#'
+#' @param df A dataframe.
+#' @param var_name The name of the variable to calculate the change for, as a string.
+#' @param date_col The name of the column containing time periods, as a string.
+#' @param base_date The base date to calculate the change between.
+#' @param second_date The second date to calculate the change between.
+#' @param type Specify either an "absolute" or a "percentage" change. Defaults to "absolute".
+#'
+#' @return A numeric value, if calculating absolute changes, otherwise a string for percentage changes.
+#'
+#' @examples
+#'
+#' df <- data.frame("yrqtr" = c("2020 Q1", "2020 Q2", "2020 Q3", "2020 Q4"),
+#' "receipts" = seq(10, 40, 10))
+#'
+#' change(df, "receipts", "yrqtr", "2020 Q2", "2020 Q4") # returns 20
+#' change(df, "receipts", "yrqtr", "2020 Q2", "2020 Q4", type = "percentage") # returns "100%"
+#'
+#' @export
+
+change <- function(df, var_name, date_col, base_date, second_date, type = "absolute"){
+
+  # Checks on input arguments------------------------------------
+
+  ### df checks
+
+  # Check if df is of type dataframe
+  if (!is.data.frame(df)){
+
+    stop("Input to df is not a dataframe")
+  }
+
+  ### var_name checks
+
+  if (!is.character(var_name)){
+
+    stop("Please provide var_name as a string")
+  }
+
+  # Check var_name is one of the variables in the dataframe
+  if(var_name %in% colnames(df) == FALSE){
+
+    stop("The variable specified in var_name is not present in the dataframe")
+  }
+
+  ### date_col checks
+
+  # Check if the column name given to date_col is a string
+
+  if (!is.character(date_col)){
+    stop("Please provide the column name in date_col as a string")
+  }
+
+  # Check the column name given to date_col is a column in the dataframe
+  if(!date_col %in% colnames(df)){
+
+    stop("The column name provided for the date column is not in the dataframe")
+  }
+
+  ### base_date checks
+
+  # Check if base_date is NA/NaN
+
+  if(is.na(base_date)){
+
+    stop("NA/NaN value has been provided to base_date")
+  }
+
+  # Check the value given to base_date is an actual value in the specified column
+  if(base_date %in% df[[date_col]] == FALSE){
+
+    stop("The value provided to base_date is not in the specified date column")
+  }
+
+  ### second_date checks
+
+  # Check if second_date is NA/NaN
+
+  if(is.na(second_date)){
+
+    stop("NA/NaN value has been provided to second_date")
+  }
+
+  # Check the value given to base_date is an actual value in the specified column
+  if(second_date %in% df[[date_col]] == FALSE){
+
+    stop("The value provided to second_date is not in the specified date column")
+  }
+
+  ### type checks
+
+  # Check the type argument is correct
+  if (!type %in% c("absolute", "percentage")){
+
+    stop("The type argument must be either 'absolute' or 'percentage', to specify the type of change calculated")
+  }
+
+  # MAIN BODY-------------------------------------------------------------------
+
+  # Extract the required values from the dataframe
+  base_val <- choose_value(df, var_name, date_col, base_date)
+  second_val <- choose_value(df, var_name, date_col, second_date)
+
+  # Calculate the absolute change and return it
+
+  if (type == "absolute"){
+
+    diff <- second_val - base_val
+    return(diff)
+
+  # Alternatively, calculate the percentage change and return it
+
+  } else if (type == "percentage") {
+
+    diff <- (second_val - base_val) / base_val
+    if (is.infinite(diff)){
+
+      stop("Error: the percentage change from a zero value is not defined")
+    }
+    perc <- format_perc(diff)
+    return(perc)
+
+  }
+
+}
+