Fine-tuning some functions.

NEWS.md

@@ -2,6 +2,7 @@
 - added function for Halley bands
 - added function for population simulation
 - added helper functions for the random generating and applying of age categories
+- added reprasentativity check via Total fertility rate
 
 # mortAAR 1.1.6
 - fixed the error in plotting that occurred after the fix of "aes_string" of ggplot2

R/lifetable_indices.R

@@ -21,6 +21,8 @@
 #'   \item \bold{D0_14_D}:   proportion of individuals aged 0--14
 #'   according to \emph{McFadden & Oxenham 2018a} if infants are represented
 #'   well.
+#'   \item \bold{D15_49_D15plus}:   proportion of individuals aged 15--49
+#'   according to \emph{Taylor & Oxenham 2024}.
 #'   \item \bold{e0}:   life expectancy at age 0.
 #'}
 #'
@@ -34,6 +36,8 @@
 #'
 #' \insertRef{mcfadden_oxenham_2018a}{mortAAR}
 #'
+#' \insertRef{taylor_oxenham_2024}{mortAAR}
+#'
 #' @examples
 #' schleswig <- life.table(schleswig_ma[c("a", "Dx")])
 #' lt.indices(schleswig)
@@ -63,6 +67,8 @@ lt.indices.mortaar_life_table_list <- function(life_table) {
 #' @noRd
 lt.indices.mortaar_life_table <- function(life_table) {
 
+  # please note that "all_age" denotes the upper limit of the age categories,
+  # so the queries for the indices are counterintuitive.
   all_age <- life_table$a %>% cumsum
 
   # Children index according to Masset and Bocquet 1977
@@ -75,7 +81,7 @@ lt.indices.mortaar_life_table <- function(life_table) {
   d20plus <- life_table$Dx[all_age > 20] %>% sum
   d5_14_d20plus <- d5_14 / d20plus
 
-    # Senility index according to Masset and Bocquet 1977
+  # Senility index according to Masset and Bocquet 1977
   d60plus <- life_table$Dx[all_age > 60] %>% sum
   d60_d20plus <- d60plus / d20plus
 
@@ -94,6 +100,11 @@ lt.indices.mortaar_life_table <- function(life_table) {
   d0plus <- life_table$Dx %>% sum
   D0_14_D <- d0_14 / d0plus
 
+  # D15_49_D15plus index according to Taylor and Oxenham 2024
+  d15_49 <- life_table$Dx[all_age >= 20 & all_age <= 50] %>% sum
+  d15plus <- life_table$Dx[all_age >= 20] %>% sum
+  D15_49_D15plus <- d15_49 / d15plus
+
   # Life expectancy at age 0
   e0 <- life_table$ex[[1]]
 
@@ -103,7 +114,8 @@ lt.indices.mortaar_life_table <- function(life_table) {
     juvenile_i = d5_14_d20plus, d5_14 = d5_14, d20plus = d20plus,
     senility_i = d60_d20plus, d0plus= d0plus, d60plus = d60plus,
     p5_19 = p5_19,D30_D5 = D30_D5,
-     D0_14_D = D0_14_D, d0_14 = d0_14,
+    D0_14_D = D0_14_D, d0_14 = d0_14,
+    D15_49_D15plus = D15_49_D15plus,
     e0 = e0
   )
 
@@ -131,6 +143,8 @@ lt.indices.mortaar_life_table <- function(life_table) {
 #' @keywords internal
 lt.mortality <- function(life_table) {
 
+  indx <- lt.indices(life_table)
+
   all_age <- life_table$a %>% cumsum
 
   # Indices for representativity after Weiss 1973 and Model life tables
@@ -149,6 +163,15 @@ lt.mortality <- function(life_table) {
   lx10 <- life_table$lx[all_age == 15]
   q15_45 <- d15_45 / lx10 * 100
 
-  result_list <- list(q0_5 = q0_5, q10_5 = q10_5, q15_5 = q15_5, q15_45 = q15_45)
+  # Total fertility rate from subadults and adults
+  TFR_subadult <-  indx$D0_14_D * 7.210 + 2.381
+  TFR_adult <- indx$D15_49_D15plus * 8.569 + 2.578
+
+  result_list <- list(q0_5 = q0_5,
+                      q10_5 = q10_5,
+                      q15_5 = q15_5,
+                      q15_45 = q15_45,
+                      TFR_subadult = TFR_subadult,
+                      TFR_adult = TFR_adult)
   result_list
 }

R/representativity.R

@@ -5,8 +5,10 @@
 #' \emph{Herrmann et al. 1990}, 306f.) have devised indices which check
 #' if the non-adult age groups are represented in proportions as can be
 #' expected from modern comparable data. Whether this is really applicable
-#' to archaeological data-sets is a matter of debate.
-#'
+#' to archaeological data-sets is a matter of debate.\cr
+#' Quite recently, \emph{Taylor and Oxenham 2024} added a comparison of Total
+#' fertility rates (TRF) according to different formulas which depend either
+#' on subadults or adults.\cr
 #' Weiss chose the mortality (qx) as deciding factor and claimed that
 #' (1) the probability of death of the age group 10--15 (5q10)
 #' should be lower than that of the group 15--20 (5q15) and that (2)
@@ -17,6 +19,13 @@
 #' (5D5) to those having died between 10 and 15 (5D15) should be equal or
 #' larger than 2 and that (2) the ratio of those having died between 5 and 15
 #' (10D5) and all adults (>= 20) should be 0.1 or larger.\cr
+#' The formualas Taylor and Oxenham used either weigh all individuals aged 0--14
+#' against all individuals or all individuals aged 15--49 against all individuals
+#' aged 15+. The formulas differ from the original ones published by
+#' \emph{McFadden and Oxenham 2018} and \emph{Taylor et al. 2023} because the
+#' data basis is slighty different. If the results of the formulas deviate
+#' by more than 0.692 (the standard error of estimate, SEE), there is a problem
+#' with the age structure.\cr
 #' Due to the specific nature of the indices, they only give meaningful
 #' results if 5-year-age categories have been chosen for the non-adults.
 #'
@@ -30,8 +39,13 @@
 #'
 #' \insertRef{masset_bocquet_1977}{mortAAR}
 #'
+#' mcfadden_oxenham_2018a
+#'
 #' \insertRef{weiss_demography_1973}{mortAAR}
 #'
+#' \insertRef{taylor_oxenham_2024}{mortAAR}
+#' taylor_et_al_2023
+#'
 #' @examples
 #' schleswig <- life.table(schleswig_ma[c("a", "Dx")])
 #' lt.representativity(schleswig)
@@ -65,17 +79,20 @@ lt.representativity.mortaar_life_table <- function(life_table) {
   indx <- lt.indices(life_table)
 
   representativity_verdict <- data.frame(
-    approach = c("weiss_i1", "weiss_i2", "child_i", "juvenile_i"),
+    approach = c("weiss_i1", "weiss_i2", "child_i", "juvenile_i", "TFR"),
     condition = c(
       "5q0 > 5q15", "5q10 < 5q15", "(5D5 / 5D10) >= 2",
-      "(10D5 / D20+) >= 0.1"
+      "(10D5 / D20+) >= 0.1", "TFR_SA = TFR_A"
     ),
-    value1 = round(c(mortality$q0_5, mortality$q10_5, indx$d5_9, indx$d5_14), 2),
-    value2 = round(c(mortality$q15_5, mortality$q15_5, indx$d10_14, indx$d20plus), 2),
+    value1 = round(c(mortality$q0_5, mortality$q10_5, indx$d5_9,
+                     indx$d5_14, mortality$TFR_subadult), 2),
+    value2 = round(c(mortality$q15_5, mortality$q15_5, indx$d10_14,
+                     indx$d20plus, mortality$TFR_adult), 2),
     result = round(
       c(
         mortality$q0_5 / mortality$q15_5, mortality$q10_5 / mortality$q15_5,
-        indx$child_i, indx$juvenile_i
+        indx$child_i, indx$juvenile_i,  abs(mortality$TFR_subadult -
+                                              mortality$TFR_adult)
       ), 2
     ),
     outcome = c(
@@ -84,7 +101,8 @@ lt.representativity.mortaar_life_table <- function(life_table) {
       mortality$q10_5 < mortality$q15_5,
       # Criteria for representativity after Bocquet-Appel and Masset
       indx$child_i >= 2,
-      indx$juvenile_i >= 0.1
+      indx$juvenile_i >= 0.1,
+      abs(mortality$TFR_subadult - mortality$TFR_adult) <= 0.692
     ),
     stringsAsFactors = FALSE
   )

R/reproduction_indices.R

@@ -21,6 +21,9 @@
 #' 2002}. We approximated the ratio by three different methods of
 #' fitting (linear, logistic, power) and recommend logistic fitting,
 #' but the others are available as well.\cr
+#' We have also added the option to use the formula by \emph{Taylor et al.
+#' 2023} that uses the ratio of adults aged 15--49 in relation to those aged
+#' 15 or older.\cr
 #' The Gross reproduction rate (GRR) is calculated by multiplying the TFR
 #' with the ratio of female newborns, assumed to be a constant of 48.8%
 #' of all children (\emph{Hassan} 1981, 136). The Net reproduction rate is
@@ -42,19 +45,21 @@
 #' is reported that is usually (but probably erroneously for archaic societies
 #' (\emph{Grupe et al. 2015}, 423) assumed to apply to those aged below 15 or
 #' 60 and above.\cr
-#' Finally, \emph{Buikstra et al. 1986}. have made the interesting observation that
+#' Finally, \emph{Buikstra et al. 1986} have made the interesting observation that
 #' the relation of those individuals aged 30 years and above to those aged
 #' 5 years and above is very closely related to the birth rate and also closely
 #' (but less significantly) related to the death rate. Therefore, these indices
 #' are calculated as well.
 #'
 #' @param life_table an object of class mortaar_life_table.
 #' @param fertility_rate string or numeric. Either fertility rate according to
-#' \emph{McFadden & Oxenham 2018a} if infants are represented well or fertility
-#' rate according to data by \emph{McFadden & Oxenham 2018a} for P(5-19) index
-#' after \emph{Bocquet-Appel 2002}. Options: 'McFO' (McFadden/Oxenham), 'BA_linear'
-#' (linear fit), 'BA_power' (power fit) or 'BA_log' (logistic fit). Default: BA_log'.
-#' Additionally, the user can specify an arbitrary number in lieu of the fertility rate.
+#' \emph{McFadden & Oxenham 2018a} if infants are represented well or
+#' \emph{Taylor et al.} or fertility rate according to data by \emph{McFadden &
+#' Oxenham 2018a} for P(5-19) index after \emph{Bocquet-Appel 2002}. Options:
+#' 'McFO' (McFadden/Oxenham), 'TOMc' (Taylor et al.), 'BA_linear' (linear fit),
+#' 'BA_power' (power fit) or 'BA_log' (logistic fit). Default: BA_log'.
+#' Additionally, the user can specify an arbitrary number in lieu of the
+#' fertility rate.
 #' @param growth_rate string or numeric. Either derived directly from the fertility
 #' calculations or from regression analysis by either \emph{McFadden & Oxenham 2018b}
 #' (\eqn{10.06 * D0--14/D) -- 1.61}) or \emph{Bocquet-Appel and Masset}
@@ -123,6 +128,8 @@
 #'
 #' \insertRef{mcfadden_oxenham_2018b}{mortAAR}
 #'
+#' \insertRef{taylor_et_al_2023}{mortAAR}
+#'
 #' @examples
 #' schleswig <- life.table(schleswig_ma[c("a", "Dx")])
 #' lt.reproduction(schleswig)
@@ -164,7 +171,10 @@ lt.reproduction.mortaar_life_table <- function(life_table, fertility_rate = "BA_
   # switch to set fertil_rate
   if (is.character(fertility_rate)) {
     switch(fertility_rate,
+      # according to McFadden % Oxenham 2018
       McFO = { fertil_rate <- indx$D0_14_D[[1]] * 7.734 + 2.224 },
+      # according to Taylor et al. 2023
+      TOMc = { fertil_rate <- indx$D15_49_D15plus[[1]] * 8.564 + 2.508 },
       # Linear regression
       BA_linear = { fertil_rate <- indx$p5_19[[1]] * 25.7557 + 2.85273 },
       # power fit
@@ -206,7 +216,7 @@ lt.reproduction.mortaar_life_table <- function(life_table, fertility_rate = "BA_
   # mortality rate according to Bocquet/Masset 1977
   mortality_rate <- 0.127 * indx$juvenile_i + 0.016
 
-  # switch to set growthl_rate
+  # switch to set growth_rate
   if (is.character(growth_rate)) {
     switch(growth_rate,
            # Intrinsic growth rate in percent per year after Hassan

inst/REFERENCES.bib

@@ -528,6 +528,29 @@ @Book{spindler_magdalenenberg_vi
 year = {1980}
 }
 
+@Article{taylor_oxenham_2024,
+author = {Taylor, Bonnie R. and Oxenham, Marc F.},
+title = {{A method for detecting bias in human archaeological cemetery samples}},
+journal = {{International Journal of Osteoarchaeology}},
+volume = {},
+number = {},
+doi = {10.1002/oa.3379},
+pages = {0},
+year = {2024},
+location = {},
+keywords = {}}
+
+@Article{taylor_et_al_2023,
+author = {Taylor, B.R. and Oxenham, M. and McFadden, C.},
+title = {{Estimating fertility using adults: A method for under-enumerated pre-adult skeletal samples}},
+journal = {{American Journal of Biological Anthropology}},
+volume = {181},
+number = {2},
+doi = {10.1002/ajpa.24739},
+pages = {262–270},
+year = {2023},
+keywords = {}}
+
 @Article{tvrdy_2016,
 author = {Tvrdý, Z.},
 title = {{Anthropology of the Neolithic population from Nitra-Horné Krškany (Slovakia)}},