Merge pull request #273 from IvanWilli/IW

logquad adjustment for old ages

.Rbuildignore

@@ -27,4 +27,8 @@ Spreadsheets
 ^tic\.R$
 rcppExports.cpp
 stanExports_*
-^data-raw$
+^data-raw$
+version_lookup.R
+version_lookup.csv
+.gitsum
+Presentations

.gitignore

@@ -19,5 +19,8 @@ Spreadsheets
 *.h
 *.o
 *.so
-docs/
+.gitsum
 .RData
+/doc/
+/Meta/
+Presentations

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: DemoTools
 Type: Package
 Title: Standardize, Evaluate, and Adjust Demographic Data
-Version: 01.13.39
-Date: 2021-03-23
+Version: 01.13.80
+Date: 2023-12-29
 Authors@R: c(
    person("Tim", "Riffe", role = c("aut", "cre"), 
           email = "[email protected]", comment = c(ORCID = "0000-0002-2673-4622")),
@@ -22,7 +22,7 @@ License: file LICENSE
 LazyLoad: yes
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.1
+RoxygenNote: 7.2.3
 Depends:
     R (>= 3.6),
     Rcpp (>= 0.12.0),
@@ -31,15 +31,16 @@ Suggests:
     testthat (>= 2.1.0),
     knitr,
     rmarkdown,
+    markdown,
     DT,
     ggplot2
 RdMacros: Rdpack
 Imports:
     data.table (>= 1.13.6),
     demogR,
-    DemoToolsData (>= 0.1.1),
+    DemoToolsData (>= 0.1.5),
     dplyr,
-    fertestr (>= 0.0.5),
+    fertestr (>= 0.10.00),
     lubridate,
     magrittr,
     MortalityLaws (>= 1.7.0),
@@ -48,10 +49,11 @@ Imports:
     rstan (>= 2.18.1),
     tibble,
     tidybayes,
-    ungroup
+    ungroup (>= 1.4.2)
 BugReports: https://github.com/timriffe/DemoTools/issues
 Remotes: 
-    github::josehcms/fertestr,
-    github::timriffe/DemoToolsData
+    github::timriffe/fertestr,
+    github::timriffe/DemoToolsData,
+    github::timriffe/MortalityLaws
 Encoding: UTF-8
 VignetteBuilder: knitr

NAMESPACE

@@ -3,6 +3,7 @@
 export("%>%")
 export(ADM)
 export(AGEN)
+export(HMD_old_logquad)
 export(ID)
 export(IRD)
 export(OPAG)
@@ -71,6 +72,7 @@ export(is_age_redundant)
 export(is_age_sequential)
 export(is_single)
 export(loess_smth1)
+export(logquad_augmented)
 export(lt_a_closeout)
 export(lt_a_pas)
 export(lt_a_un)
@@ -161,6 +163,7 @@ importFrom(data.table,rbindlist)
 importFrom(data.table,setDT)
 importFrom(data.table,uniqueN)
 importFrom(demogR,cdmltw)
+importFrom(dplyr,case_when)
 importFrom(dplyr,group_by)
 importFrom(dplyr,mutate)
 importFrom(dplyr,rename)
@@ -192,3 +195,4 @@ importFrom(tibble,tibble)
 importFrom(tidybayes,gather_draws)
 importFrom(ungroup,pclm)
 importFrom(utils,head)
+importFrom(utils,tail)

NEWS.md

@@ -1,14 +1,17 @@
 # Changes in this update
-2018-08-15
+
+## 2018-08-15
 
  - NEWS.md file added. When a first release comes out, major functionality
    and features will be listed here at that time.
 
-2019-11-28
+## 2019-11-28
 
  - new function mig_calculate_rc() added
  - several function names harmonized, see ?DemoTools-renamed
- - graduate_sprage() and other graduation functions no longer support matrix inputs
+ - graduate_sprague() and other graduation functions no longer support matrix inputs
 
+## 2023-12-29
+ - minor fixes to pass checks
 
 

R/AGEINT.R

@@ -89,7 +89,8 @@ interpolatePop <-
 #' @param datesOut vector of dates. The desired dates to interpolate to. See details for ways to express it.
 #' @param method string. The method to use for the interpolation, either \code{"linear"}, \code{"exponential"}, or \code{"power"}. Default \code{"linear"}.
 #' @param power numeric power to interpolate by, if \code{method = "power"}. Default 2.
-#' @param extrap logical. In case \code{datesOut} is out of range of datesIn, do extrapolation using slope in extreme pairwise. Deafult \code{FALSE}.
+#' @param extrap logical. In case \code{datesOut} is out of range of `datesIn`, do extrapolation using slope in extreme pairwise. Default \code{FALSE}.
+#' @param negatives logical. In case negative output are accepted, set to \code{TRUE}. Default \code{FALSE}.
 #' @param ... arguments passed to \code{stats::approx}. For example, \code{rule}, which controls extrapolation behavior.
 #' @details The age group structure of the output is the same as that of the input. Ideally, \code{datesOut} should be within the range of \code{datesIn}. If not, the left-side and right-side output are held constant outside the range if \code{rule = 2} is passed in, otherwise \code{NA} is returned (see examples). Dates can be given in three ways 1) a \code{Date} class object, 2) an unambiguous character string in the format \code{"YYYY-MM-DD"}, or 3) as a decimal date consisting in the year plus the fraction of the year passed as of the given date.
 #'
@@ -198,6 +199,7 @@ interp <- function(popmat,
                    method = c("linear", "exponential", "power"),
                    power = 2,
                    extrap = FALSE,
+                   negatives = FALSE,
                    ...) {
   # ... args passed to stats::approx . Can give control over extrap assumptions
   # IW: extrap=T for extrapolate following each slope in extreme pairwise. 
@@ -282,10 +284,10 @@ interp <- function(popmat,
     int           <- int ^ power
   }
 
-  # IW: no negatives when extrapolate. Thinking in pop and lt expressions
-  if(all(!is.na(int)) & any(int<0)){
-    cat("Negative values were turned 0. No accepted in population counts, fertility rates or life table functions.\n")
-    int[int<0] <- 0  
+  # IW: no negatives when extrapolate. Thinking in pop and lt expressions. Inactive when explicitly are accepted negatives
+  if(!negatives & all(!is.na(int)) & any(int < 0)){
+    cat("Negative values have been replaced with 0s.\nNegatives not accepted in population counts,\n fertility rates or life table functions.\nYou can allow negatives (e.g. interpolating net migration)\n by specifying negatives = TRUE")
+    int[int < 0] <- 0  
   }
 
   int

R/AGESEX.R

@@ -19,7 +19,7 @@
 #'  It is also assumed that the final age group is open, unless \code{ageMax < max(Age)}.
 #'  Setting \code{OAG = FALSE} will override this and potentially include \code{max(Age)} in calculations.
 #'  The method argument determines the weighting of numerators and denominators, where the UN method puts
-#' twice the numerator over the sum of the adjacent ages classes, Zelnich does thrice the
+#' twice the numerator over the sum of the adjacent ages classes, Zelnik does thrice the
 #' numerator over the sum of the whole range from the next lowest to the next highest age, and
 #' Ramachandran does four times the numerator over the same sum, but with the central age
 #' double-counted in the numerator.

R/MAV.R

@@ -1,22 +1,22 @@
-# Author: JG
-# Edited 9-Dec-2017 by TR
-# Edited Aug 2018 by TR
-
-###############################################################################
 
 #' Calculate the moving average (mav) over 3 or 5 years.
 #' @description  This arithmetic smoothing technique aims to eliminate irregularities of the population pyramid by averaging values in a moving window of user-defined width.
-#' @details The moving window is applied symmetrically. Data endpoints are imputed with \code{NA}s in output: the is nothing under 0 or over the highest closed age group to average with. The open age group is imputed with \code{NA} prior to calculations, since it cannot be averaged into the next lowest group. For example, for \code{n=3}, age 0 will be \code{NA}, as will the open age group and next lowest age. Age intervals are assumed uniform. This function could be used with either single or 5-year age groups.
+#' @details
+#' The moving window is applied symmetrically. By default (`tails = FALSE`) data endpoints are imputed with `NA`s in output: the is nothing under 0 or over the highest closed age group to average with. The open age group is not used in averaging, and it is returned as-is. Age intervals are assumed uniform. This function could be used with either single or 5-year age groups.
+#'
+#' If `tails` is set to `TRUE`, then tails have been imputed using moving averages with successively smaller values of `n`, the cascade method.
 
 #' @param Value numeric. A vector of demographic counts in single age groups.
 #' @param n integer. A single number, (often 3 or 5), indicating the number of years taken to smooth the population distribution by single ages.
 #' @param Age integer. A vector of ages corresponding to the lower integer bound of the counts.
-#' @param OAG logical. Whether or not the top age group is open. Default \code{TRUE}.
-#' @details Ages may be single or grouped, but all age intervals are assumed equal.
+#' @param OAG logical. Whether or not the top age group is open. Default `TRUE`.
+#' @param tails logical. If set to `TRUE`, smaller-n moving averages are applied on both tails
+#' such that all values are non-NA. If `FALSE` (default), tails are set to NA
+#' due to the lag of moving averages.
 
 #' @return Vector with the smoothed demographic counts.
+#'
 #' @export
-#' @author Juan Galeano
 
 #' @references
 #' \insertRef{GDA1981IREDA}{DemoTools}
@@ -31,9 +31,16 @@
 #'		323263,9535,13906,9063,8294,90459,9817,6376,8884,3773,160609)
 #'Age  <- 0:70
 #'# final age group assumed open
-#'mav(Pop, n = 3, Age = Age)
+#' mav(Pop, n = 3, Age = Age)
+#'
 #'\dontrun{
-#'	nwindows <- sapply(seq(3, 11, by = 2),mav, Value = Pop, Age = Age)
+#'  odds <- seq(3, 11, by = 2)
+#'	nwindows <- sapply(odds,
+#'	                   mav, 
+#'	                   Value = Pop, 
+#'	                   Age = Age,
+#'	                   OAG = TRUE,
+#'	                   tails = FALSE)
 #'	cols     <- gray(seq(.8, 0, length = 5))
 #'	lwds     <- seq(3, 1, length = 5)
 #'	plot(Age,Pop, col = "red", xlab = "Age", ylab = "The counts", pch=16,
@@ -45,21 +52,92 @@
 #'			lwd = lwds,
 #'			legend = paste0("n=",seq(3,11,by=2)))
 #'}
+#'
+#' # For cascading smoothing on the tails:
+#' mav(Pop, Age, tails = TRUE)
+#'
+#'\dontrun{
+#'# Compare
+#' nwindows_tails <- sapply(odds,
+#'                          mav, 
+#'                          Value = Pop, 
+#'                          Age = Age, 
+#'                          OAG = TRUE, 
+#'                          tails = TRUE)
+#' 
+#' colnames(nwindows)        <- odds
+#' colnamaes(nwindows_tails) <- odds
+#' 
+#' # NA triangles are completed with
+#' # successively smaller ns.
+#' head(nwindows)
+#' head(nwindows_tails)
+#' 
+#' tail(nwindows)
+#' tail(nwindows_tails)
+#' }
 
-mav <- function(Value, Age, n = 3, OAG = TRUE) {
+mav <- function(Value, Age, n = 3, OAG = TRUE, tails = FALSE) {
   In <- Value
   if (missing(Age)) {
     Age <- as.integer(names(Value))
   }
+
+  # save OAG 
   if (OAG) {
+    OrigOAGpop           <- Value[length(Value)]
     Value[length(Value)] <- NA
   }
-  # TR: not sure why n needs to be hard coded
+
   Out <- ma(Value, n)
 
+  # apply cascading tails if needed
+  if (tails){
+    Out <- mav_tails(Value = Value, 
+                     Age = Age, 
+                     MavOut = Out, 
+                     n = n, 
+                     OAG = OAG) 
+  }
+  # plug OAG back in
+  if (OAG){
+    Out[length(Value)] <- OrigOAGpop 
+  }
+
   structure(Out, names = Age)
 }
 
+# Not exported since it can be called with tails = FALSE on mav.
+mav_tails <- function(Value, Age, MavOut, n = 3, OAG = TRUE) {
+  NewMavOut <- MavOut
+
+  #Last should point to last age group to use
+  Last <- length(Age)
+  if (OAG) {
+    Last <- Last - 1
+    NewMavOut[Last+1] <- Value[Last+1]
+  }
+
+  NewMavOut[1]    <- Value[1]
+  NewMavOut[Last] <- Value[Last]
+
+  MavLev <- c(1,2,4,6,8)
+
+  if (n >= 2)   {
+    for(i in 2:(as.integer(n/2))) {
+
+      # TR: why not just calculate the whole thing and once and pick out
+      # the two values as needed?
+        NewMavOut[i] <- ma(Value[1:(MavLev[i]+1)], n = MavLev[i])[i]
+        # subscripts right and select just the correct age
+        NewMavOut[Last - i + 1] <- ma(Value[(Last - MavLev[i] ):Last], 
+                                      n = MavLev[i])[ i ]
+
+    }
+ }
+
+  NewMavOut
+}
 
 
 #Pop  <-c(303583,390782,523903,458546,517996,400630,485606,325423,471481,189710,

R/OGIVE.R

@@ -182,7 +182,7 @@ poly_smth1 <-
 #' @details LOESS (locally weighted smoothing) helps to smooth data over age, preserving the open age group if necessary.
 #'  It is a popular tool to create a smooth line through a timeplot or scatter plot.
 #'  Loess smoothness may be tweaked by specifying an optional \code{"span"} argument.
-#' Polynomial  fitting is used to mooth data over age or time fitting linear models.
+#' Polynomial  fitting is used to smooth data over age or time fitting linear models.
 #' It can be tweaked by changing the degree and by either log or power transforming.
 #' The open age group can be kept as-is if desired by specifying \code{OAG = TRUE}.
 #' May be used on any age groups, including irregularly spaced, single age, or 5-year age groups.