merges PJ OPAG

Merge branch 'OPAG' of https://github.com/timriffe/DemoTools into OPAG

# Conflicts:
#	.gitignore
#	dev/.gitignore

.Rbuildignore

@@ -27,3 +27,4 @@ Spreadsheets
 ^tic\.R$
 rcppExports.cpp
 stanExports_*
+^data-raw$

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

@@ -55,14 +55,16 @@ jobs:
         uses: actions/cache@v2
         with:
           path: ${{ env.R_LIBS_USER }}
-          key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}
-          restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-
+          # For the later part of v1, this serves to invalidate the cache whenever is needed.
+          # See https://stackoverflow.com/questions/63521430/clear-cache-in-github-actions
+          key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}-v1
+          restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-v1
 
       # To install rgl in macOS it needs xquartz
       - name: macOS dependencies
         if: runner.os == 'macOS'
         run: |
-          brew cask install xquartz
+          brew install xquartz
 
       # Adds manual deps to rgl in first line
       - name: Linux dependencies
@@ -86,6 +88,7 @@ jobs:
         run: |
           remotes::install_deps(dependencies = TRUE)
           remotes::install_cran("rcmdcheck")
+          install.packages("rgl")
         shell: Rscript {0}
 
         # Why a separate check for macOS/Linux? Because rgl needs to export DISPLAY

.gitignore

@@ -21,3 +21,5 @@ Spreadsheets
 *.so
 docs/
 .gitsum
+.RData
+

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: DemoTools
 Type: Package
 Title: Standardize, Evaluate, and Adjust Demographic Data
-Version: 01.11.03
-Date: 2021-01-12
+Version: 01.13.55
+Date: 2021-05-31
 Authors@R: c(
    person("Tim", "Riffe", role = c("aut", "cre"), 
           email = "[email protected]", comment = c(ORCID = "0000-0002-2673-4622")),
@@ -12,6 +12,7 @@ Authors@R: c(
    person("Marius D.", "Pascariu", role = "aut", comment = c(ORCID = "0000-0002-2568-6489")),
    person("Sara", "Hertog", role = "aut"),
    person("Sean", "Fennell", role = "aut"),
+   person("Peter", "Johnson", role = "ctb"),
    person("Jorge", "Cimentada", role = "ctb", comment = c(ORCID = "0000-0001-5594-1156")),
    person("Juan", "Galeano", role = "ctb", comment = c(ORCID = "0000-0002-3682-1797")),
    person("Derek", "Burk", role = "ctb"),
@@ -24,35 +25,34 @@ Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.1.1
 Depends:
     R (>= 3.6),
-    Rcpp (>= 0.12.0)
+    Rcpp (>= 0.12.0),
 Suggests:
     covr,
     testthat (>= 2.1.0),
     knitr,
     rmarkdown,
+    markdown,
     DT,
     ggplot2
 RdMacros: Rdpack
 Imports:
+    data.table (>= 1.13.6),
     demogR,
+    DemoToolsData (>= 0.1.1),
     dplyr,
+    fertestr (>= 0.0.5),
+    lubridate,
     magrittr,
-    methods,
     MortalityLaws (>= 1.7.0),
-    RcppParallel (>= 5.0.1),
     Rdpack,
     rlang,
     rstan (>= 2.18.1),
     tibble,
     tidybayes,
-    ungroup,
-    lubridate,
-    fertestr,
-    DemoToolsData
+    ungroup
 BugReports: https://github.com/timriffe/DemoTools/issues
 Remotes: 
-    https://github.com/josehcms/fertestr,
-    https://github.com/mpascariu/ungroup,
-    https://github.com/timriffe/DemoToolsData
+    github::josehcms/fertestr,
+    github::timriffe/DemoToolsData
 Encoding: UTF-8
 VignetteBuilder: knitr

NAMESPACE

@@ -23,7 +23,6 @@ export(basepop_five)
 export(birthCohorts)
 export(calcAgeAbr)
 export(calcAgeN)
-export(census_cohort_adjust)
 export(check_heaping_bachi)
 export(check_heaping_coale_li)
 export(check_heaping_jdanov)
@@ -35,8 +34,10 @@ export(check_heaping_sawtooth)
 export(check_heaping_spoorenberg)
 export(check_heaping_whipple)
 export(dec.date)
+export(downloadAsfr)
 export(downloadSRB)
 export(downloadnLx)
+export(fetch_wpp_births)
 export(getModelLifeTable)
 export(graduate)
 export(graduate_beers)
@@ -57,7 +58,12 @@ export(inferAgeIntAbr)
 export(int2age)
 export(int2ageN)
 export(interp)
-export(interp_coh_bare)
+export(interp_coh)
+export(interp_lc_lim)
+export(interp_lc_lim_abk_m)
+export(interp_lc_lim_estimate)
+export(interp_lc_lim_group)
+export(interp_lc_lim_kt_min)
 export(interpolatePop)
 export(is_abridged)
 export(is_age_coherent)
@@ -69,9 +75,14 @@ export(lt_a_closeout)
 export(lt_a_pas)
 export(lt_a_un)
 export(lt_abridged)
+export(lt_abridged2single)
+export(lt_ambiguous)
 export(lt_id_L_T)
 export(lt_id_Ll_S)
+export(lt_id_d_l)
+export(lt_id_d_q)
 export(lt_id_l_d)
+export(lt_id_l_q)
 export(lt_id_lda_L)
 export(lt_id_ma_q)
 export(lt_id_morq_a)
@@ -92,15 +103,19 @@ export(lt_rule_m_extrapolate)
 export(lt_single2abridged)
 export(lt_single_mx)
 export(lt_single_qx)
+export(lt_smooth_ambiguous)
 export(lthat.logquad)
 export(ma)
 export(mav)
 export(maxA2abridged)
+export(mig_beta)
 export(mig_calculate_rc)
 export(mig_estimate_rc)
+export(mig_resid)
 export(mig_resid_cohort)
 export(mig_resid_stock)
 export(mig_resid_time)
+export(mig_un_fam)
 export(names2age)
 export(poly_smth1)
 export(ratx)
@@ -109,6 +124,7 @@ export(rescale_vector)
 export(rlog)
 export(sexRatioScore)
 export(shift.vector)
+export(shift_census_ages_to_cohorts)
 export(simplify.text)
 export(single2abridged)
 export(smooth_age_5)
@@ -135,17 +151,29 @@ import(Rdpack)
 import(demogR)
 importFrom(MortalityLaws,MortalityLaw)
 importFrom(Rdpack,reprompt)
+importFrom(data.table,":=")
+importFrom(data.table,as.data.table)
+importFrom(data.table,between)
+importFrom(data.table,data.table)
+importFrom(data.table,dcast)
+importFrom(data.table,melt)
+importFrom(data.table,rbindlist)
+importFrom(data.table,setDT)
+importFrom(data.table,uniqueN)
 importFrom(demogR,cdmltw)
 importFrom(dplyr,group_by)
 importFrom(dplyr,mutate)
 importFrom(dplyr,rename)
 importFrom(dplyr,summarise)
+importFrom(fertestr,get_location_code)
+importFrom(fertestr,is_LocID)
 importFrom(magrittr,"%>%")
-importFrom(rlang,.data)
 importFrom(rlang,sym)
 importFrom(rstan,extract)
 importFrom(rstan,stan)
+importFrom(stats,aggregate)
 importFrom(stats,approx)
+importFrom(stats,as.formula)
 importFrom(stats,coef)
 importFrom(stats,filter)
 importFrom(stats,lm)
@@ -155,6 +183,8 @@ importFrom(stats,optim)
 importFrom(stats,optimize)
 importFrom(stats,predict)
 importFrom(stats,quantile)
+importFrom(stats,reshape)
+importFrom(stats,setNames)
 importFrom(stats,splinefun)
 importFrom(stats,uniroot)
 importFrom(tibble,as.tibble)

R/AGEINT.R

@@ -89,6 +89,7 @@ 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 ... 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.
 #'
@@ -196,30 +197,51 @@ interp <- function(popmat,
                    datesOut,
                    method = c("linear", "exponential", "power"),
                    power = 2,
+                   extrap = FALSE,
                    ...) {
   # ... args passed to stats::approx . Can give control over extrap assumptions
+  # IW: extrap=T for extrapolate following each slope in extreme pairwise. 
+      # If not is explicit extrap=T, returns NA at those points
+
   # a basic check
   stopifnot(ncol(popmat) == length(datesIn))
 
   # no sense documenting this wrapper ...
-  .approxwrap <- function(x, y, xout, ...) {
-    stats::approx(x = x,
-                  y = y,
-                  xout = xout,
-                  ...)$y
+  .approxwrap <- function(x, y, xout, extrap, ...) {
+
+    # interp
+    yout = stats::approx(x = x,
+                         y = y,
+                         xout = xout,
+                         ...)$y
+
+    if (extrap){
+      # extrap (each side)
+      rg <- range(x)
+      xext <- xout < rg[1]
+      if(any(xext))
+        yout[xext] <- (y[2]-y[1])/(x[2]-x[1])*(xout[xext]-x[1])+y[1]
+      xext <- xout > rg[2]
+      n <- length(y)
+      if(any(xext))
+        yout[xext] <- (y[n]-y[n-1])/(x[n]-x[n-1])*(xout[xext]-x[n-1])+y[n-1]
+    }
+
+    return(yout)
   }
 
+
   # -----------------------
   # clean method declaration
   # match.arg does partial matching and it's safer:
   # match.arg("lin", c("linear", "exponential", "power"))
-  method <- tolower(match.arg(method))
+  method <- tolower(match.arg(method, 
+                              choices = c("linear", "exponential", "power")))
   # -----------------------
 
   # coerce dates to decimal if necessary
-  datesIn  <- sapply(datesIn, dec.date)
-  datesOut <- sapply(datesOut, dec.date)
-
+  datesIn  <-  dec.date(datesIn)
+  datesOut <-  dec.date(datesOut)
 
   # carry out transform 1
   if (method == "exponential") {
@@ -241,6 +263,7 @@ interp <- function(popmat,
                .approxwrap,
                x = datesIn,
                xout = datesOut,
+               extrap = extrap,
                ...)
   dims            <- dim(int)
   if (!is.null(dims)) {
@@ -259,5 +282,11 @@ 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  
+  }
+
   int
 }